;;; -*- Mode: Xbvl; ;Syntax: Common-Lisp;; -*-
;;; Code adapted from Paradigms of Artificial Intelligence Programming
;;; de Peter Norvig

;;; File gps1.vlisp: Première version of GPS (General Problem Solver)

(include /home/hw/xbvlisp/myprogs/utilitaires.vlisp)

(defvar *state* nil ; l'état courant : une suite de conditions ;)

(defvar *ops* nil ; la liste d'opérateurs disponibles; )

(defstruct op 
  action preconds add-list del-list)

(de GPS (*state* goals *ops*)
  ; General Problem Solver: atteindre tous les buts en utilisant  *ops*. ;
  (if (every 'achieve goals) 'solved))

(de achieve (goal)
  ; un but est atteint s'il est déja satisfait
  ; ou s'il existe un op applicable approprié
  (or (member goal *state*)
      (null (dbg 'gps "the current goal is" goal))
      (some 'apply-op 
            (find-all goal *ops*  'appropriate-p)))))

(de appropriate-p (goal op)
  ; un op est approprié à un but s'il n'est pas dans la add-list
  (member goal (op-add-list op)))

(de apply-op (op)
  ; imprime un message et met à jour *state* si op est applicable
  (when (every 'achieve (op-preconds op))
    (print (list 'executing (op-action op)))
    (setf *state* (set-difference *state* (op-del-list op)))
    (setf *state* (union *state* (op-add-list op)))
    t))

;;; ==============================

(defparameter *school-ops*
  (list
; premier operateur fait boucler :
; "recursive subgoal problem
;   (make-op 'ask-phone-number
;	     '(in-communication-with-shop)
;	     '(know-phone-number))
    (make-op  'drive-son-to-school
          '(son-at-home car-works)
          '(son-at-school)
         '(son-at-home))
    (make-op  'shop-installs-battery
          '(car-needs-battery shop-knows-problem shop-has-money)
          '(car-works))
    (make-op  'tell-shop-problem
          '(in-communication-with-shop)
          '(shop-knows-problem))
    (make-op  'telephone-shop
          '(know-phone-number)
          '(in-communication-with-shop))
    (make-op  'look-up-number
          '(have-phone-book)
          '(know-phone-number))
    (make-op  'give-shop-money
          '(have-money)
          '(shop-has-money)
          '(have-money))))


(de gps1 ()
    (debug 'gps)
    ; doit marcher
    (print  '(GPS '(son-at-home car-needs-battery have-money have-phone-book)
     '(son-at-school) *school-ops*))
    (print "voulez-vous une trace ? (y/n)") 
    (if (eq (tyi) 121)(debug 'gps)(undebug 'gps))
    (print  (GPS '(son-at-home car-needs-battery have-money have-phone-book)
     '(son-at-school) *school-ops*))
    ; ne marche pas car pas de moyen de contacter le garagiste
    (print  '(GPS '(son-at-home car-needs-battery have-money)
     '(son-at-school) *school-ops*))
    (print "voulez-vous une trace ? (y/n)") 
    (if (eq (tyi) 121)(debug 'gps)(undebug 'gps))
    (print  (GPS '(son-at-home car-needs-battery have-money)
     '(son-at-school) *school-ops*))
    ; marche sans problème : la voitue marche
    (print  '(GPS '(son-at-home car-works)
     '(son-at-school) *school-ops*))
    (print "voulez-vous une trace ? (y/n)") 
    (if (eq (tyi) 121)(debug 'gps)(undebug 'gps)) 
    (print  (GPS '(son-at-home car-works)
     '(son-at-school) *school-ops*))
    ; "clobbering sibbling goal problem"
    (print  '(GPS '(son-at-home have-money car-works)
     '(have-money son-at-school) *school-ops*))
    (print "voulez-vous une trace ? (y/n)") 
    (if (eq (tyi) 121)(debug 'gps)(undebug 'gps))
    (print  (GPS '(son-at-home have-money car-works)
     '(have-money son-at-school) *school-ops*))
    ; "leap before you look"
    ; marche  mais y a plus d'argent
    (print  '(GPS '(son-at-home car-needs-battery have-money have-phone-book)
     '(have-money son-at-school) *school-ops*))
    (print "voulez-vous une trace ? (y/n)") 
    (if (eq (tyi) 121)(debug 'gps)(undebug 'gps))
    (print  (GPS '(son-at-home car-needs-battery have-money have-phone-book)
     '(have-money son-at-school) *school-ops*))
    ; marche pas, mais seulement après avoir fait toutes les actions
    (print  '(GPS '(son-at-home car-needs-battery have-money have-phone-book)
     '(son-at-school have-money) *school-ops*))
    (print "voulez-vous une trace ? (y/n)") 
    (if (eq (tyi) 121)(debug 'gps)(undebug 'gps)) 
    (print  (GPS '(son-at-home car-needs-battery have-money have-phone-book)
     '(son-at-school have-money) *school-ops*))
)