mirror of
https://github.com/KevinMidboe/linguist.git
synced 2025-10-29 17:50:22 +00:00
105 lines
3.3 KiB
Plaintext
105 lines
3.3 KiB
Plaintext
;;; -*- Mode: LFE; -*-
|
|
;;; Code from Paradigms of Artificial Intelligence Programming
|
|
;;; Copyright (c) 1991 Peter Norvig
|
|
|
|
;;;; File gps1.lisp: First version of GPS (General Problem Solver)
|
|
|
|
;;;; Converted to LFE by Robert Virding
|
|
|
|
;; Define macros for global variable access. This is a hack and very naughty!
|
|
(defsyntax defvar
|
|
([name val] (let ((v val)) (put 'name v) v)))
|
|
|
|
(defsyntax setvar
|
|
([name val] (let ((v val)) (put 'name v) v)))
|
|
|
|
(defsyntax getvar
|
|
([name] (get 'name)))
|
|
|
|
;; Module definition.
|
|
|
|
(defmodule gps1
|
|
(export (gps 2) (gps 3) (school-ops 0))
|
|
(import (from lists (member 2) (all 2) (any 2))
|
|
;; Rename lists functions to be more CL like.
|
|
(rename lists ((all 2) every) ((any 2) some) ((filter 2) find-all))))
|
|
|
|
;; An operation.
|
|
(defrecord op
|
|
action preconds add-list del-list)
|
|
|
|
;; General Problem Solver: achieve all goals using *ops*.
|
|
(defun gps (state goals ops)
|
|
;; Set global variables
|
|
(defvar *state* state) ;The current state: a list of conditions.
|
|
(defvar *ops* ops) ;A list of available operators.
|
|
(if (every (fun achieve 1) goals) 'solved))
|
|
|
|
(defun gps (state goals)
|
|
;; Set global variables, but use existing *ops*
|
|
(defvar *state* state) ;The current state: a list of conditions.
|
|
(if (every (fun achieve 1) goals) 'solved))
|
|
|
|
;; A goal is achieved if it already holds or if there is an
|
|
;; appropriate op for it that is applicable."
|
|
(defun achieve (goal)
|
|
(orelse (member goal (getvar *state*))
|
|
(some (fun apply-op 1)
|
|
(find-all (lambda (op) (appropriate-p goal op))
|
|
(getvar *ops*)))))
|
|
|
|
;; An op is appropriate to a goal if it is in its add list.
|
|
(defun appropriate-p (goal op)
|
|
(member goal (op-add-list op)))
|
|
|
|
;; Print a message and update *state* if op is applicable.
|
|
(defun apply-op (op)
|
|
(if (every (fun achieve 1) (op-preconds op))
|
|
(progn
|
|
(: io fwrite '"executing ~p\n" (list (op-action op)))
|
|
(setvar *state* (set-difference (getvar *state*) (op-del-list op)))
|
|
(setvar *state* (union (getvar *state*) (op-add-list op)))
|
|
'true)))
|
|
|
|
;; Define the set functions to work on list, a listsets module really.
|
|
(defun set-difference
|
|
([(cons e es) s2]
|
|
(if (member e s2)
|
|
(set-difference es s2)
|
|
(cons e (set-difference es s2))))
|
|
([() s2] ()))
|
|
|
|
(defun union
|
|
([(cons e es) s2]
|
|
(if (member e s2) (union es s2) (cons e (union es s2))))
|
|
([() s2] ()))
|
|
|
|
;;; ==============================
|
|
|
|
(defun school-ops ()
|
|
(list
|
|
(make-op action 'drive-son-to-school
|
|
preconds '(son-at-home car-works)
|
|
add-list '(son-at-school)
|
|
del-list '(son-at-home))
|
|
(make-op action 'shop-installs-battery
|
|
preconds '(car-needs-battery shop-knows-problem shop-has-money)
|
|
add-list '(car-works)
|
|
del-list ())
|
|
(make-op action 'tell-shop-problem
|
|
preconds '(in-communication-with-shop)
|
|
add-list '(shop-knows-problem)
|
|
del-list ())
|
|
(make-op action 'telephone-shop
|
|
preconds '(know-phone-number)
|
|
add-list '(in-communication-with-shop)
|
|
del-list ())
|
|
(make-op action 'look-up-number
|
|
preconds '(have-phone-book)
|
|
add-list '(know-phone-number)
|
|
del-list ())
|
|
(make-op action 'give-shop-money
|
|
preconds '(have-money)
|
|
add-list '(shop-has-money)
|
|
del-list '(have-money))))
|