;******************************************************************************************************
;******************************************************************************************************
;** **
;** **
;** **
;** **
;** AN3PG7B2 **
;** **
;** **
;** TP 4 : MOTEUR D'INFERENCES D'ORDRE 1 **
;** **
;** **
;** **
;** **
;******************************************************************************************************
;******************************************************************************************************
;******************************************************************************************************
;* *
;* LA MAISON *
;* *
;******************************************************************************************************
[GCLASSE cree MAISON unite (salles) "La maison"]
[GCLASSE cree SALLES unite (portes x-centre y-centre longueur largeur) "La classe des salles"]
[SALLES definis portes multivalues]
[SALLES apprends
si-cree ((oself)
(+> 'x-centre 10)
(+> 'y-centre 10)
(+> 'longueur 10)
(+> 'largeur 10)
(+> 'portes #{}))
]
[GCLASSE cree PORTE unite (entre-salle x y) "La classe des portes"]
[PORTE definis entre-salle multivalues]
[PORTE apprends
si-cree ((oself)
(let ((-porte oself)
(existe (eval (cons 'and (mapcar (lambda (x) [salles verifie ,x])
[,$entre-salle elements])))))
(or existe
[,$entre-salle applique (lambda (x) (=> salles 'cree x))])
[,$entre-salle applique (lambda (x) (=> x 'portes+ -porte))]
))
]
[PORTE cree porte1 entre-salle #{salle1 salle2} x 7 y 5]
;******************************************************************************************************
;* *
;* LE ROBOT *
;* *
;******************************************************************************************************
[GCLASSE cree ROBOTS unite (x y dans-salle) "La classe des robots"]
[ROBOTS cree shakey dans-salle salle2]
;******************************************************************************************************
;* *
;* GENERATEUR DE PLAN *
;* *
;******************************************************************************************************
[GCLASSE cree generateur unite (but l-plan l-regle sujet)
"Le generateur de plans"]
[generateur apprends
si-cree ((oself)
[fichiers-unites cree regles.url]
[regles.url charge]
(+> 'l-plan [files fabrique])
(+> 'l-regle (=> (=> regles 'instances) 'elements)))
infere ((oself -regle -lassoc -but)
(let ((-gene oself)
(-nouveau-pb (=> -regle 'nouveau-pb))
(-effets (=> -regle 'effets))
(-plans (=> -regle 'plan)))
(=> -nouveau-pb 'applique
(lambda (-pb) (=> -pb 'associe -gene -lassoc)))
(=> -effets 'applique
(lambda (-effet)(=> -effet 'associe -gene -lassoc)))
(=> -plans 'applique
(lambda (-plan) (=> -plan 'associe -gene -lassoc)))
))
planifie ((oself) ; le planificateur
(let ((-l-regles $l-regle))
(while (=> $but 'elements)
(lets ((-but (car (=> $but 'elements)))
(regles-activables ())
(regles-executables ())
(action (=> -but 'determine-action))
(objets (=> -but 'determine-objet action))
(valeurs (cons $sujet objets))
(-heuristique1 (lambda (regle)(equal action (=> regle 'nom))))
(-heuristique2 (lambda (regle) (putprop regle
[,(=> regle 'filtre valeurs) hasard]
'lassoc))))
[,-l-regles
applique
(lambda (regle)
(if (funcall -heuristique1 regle)
(setq regles-activables
(cons regle regles-activables))))]
(print "REGLES ACTIVABLES : " regles-activables)
[,regles-activables
applique
(lambda (regle)
(if (funcall -heuristique2 regle)
(setq regles-executables
(cons regle regles-executables))))]
(print "REGLES EXECUTABLES : " regles-executables)
(if regles-executables
(progn
(setq regle-executee [,regles-executables hasard])
(print "REGLE EXECUTEE : " regle-executee)
(+> 'infere regle-executee
(getprop regle-executee 'lassoc) -but))
(print "IMPOSSIBLE D'ATTEINDRE LE BUT : " (cdr -but)))
(=> $but 'supprime -but)
(ifn (=> $but 'vide) (=> $but tous 'affiche))))))
go ((oself)
(let ((-plan $l-plan))
(+> 'planifie)
(=> (=> -plan 'elements) 'applique affiche)))
]
;******************************************************************************************************
;* *
;* LA CLASSE DES REGLES *
;* *
;******************************************************************************************************
[GCLASSE cree regles unite (nom variables preconditions nouveau-pb effets plan)
"La classe des regles"]
[regles apprends
filtre ((oself -lval)
(letn filtrage ((-precond $preconditions)
(-lassoc (list (mapcar (lambda (x y) (cons x y))
$variables -lval))))
(setq -lassoc (mapcan (lambda (x) (=> (car -precond) 'verif x))
-lassoc))
(if (and -lassoc (cdr -precond))
(filtrage (cdr -precond) -lassoc)
-lassoc)))
]
;******************************************************************************************************
;* *
;* LE TYPE PROBLEME *
;* *
;******************************************************************************************************
[CTYPE cree T-PB tcons () "le type probleme"]
[T-PB apprends
associe ((oself -gene -lassoc)
(lets ((liste (cdr oself)))
(when -lassoc
(setq -but [t-pb fabrique])
[,(sublis -lassoc liste) applique (lambda (elt) (=> -but 'ajoute elt))]
(ifn [,-but vide] (=> (=> -gene 'but) 'ajoute -but)))))
affiche ((oself)
(print "NOUVEAUX BUTS : " (cdr oself)))
]
;******************************************************************************************************
;* *
;* LE TYPE EFFET *
;* *
;******************************************************************************************************
[CTYPE cree T-EFFET tcons () "Le type effet"]
[T-EFFET apprends
associe ((oself -gene -lassoc)
(lets ((liste (cdr oself))
(-effet (when -lassoc [t-effet fabrique ,(sublis -lassoc liste)])))
(when -effet (=> (=> -gene 'l-plan) 'ajoute -effet))))
affiche ((oself)
(let ((-effet (cdr oself)))
(print "Effets :" -effet)
(terpri)))
]
;******************************************************************************************************
;* *
;* LE TYPE PLAN *
;* *
;******************************************************************************************************
[CTYPE cree T-PLAN tcons () "Le type plan"]
[T-PLAN apprends
associe ((oself -gene -lassoc)
(lets ((liste (cdr oself))
(-plan (when -lassoc [t-plan fabrique ,(sublis -lassoc liste)])))
(when -plan (=> (=> -gene 'l-plan) 'ajoute -plan))))
affiche ((oself)
(let ((-plan (cdr oself)))
(print "Plan : " -plan)))
]
;******************************************************************************************************
[ENS apprends
modif_assoc ((oself -al -var) ; Modification de la liste d'association
(mapcar (lambda(x) (acons -var x -al)) [,oself elements]))
]
[TCONS apprends
modif_assoc ((oself -al -var) ; Modification de la liste d'association
(acons -var oself -al))
determine-action ((oself)
(cadr oself) )
determine-objet ((oself -action)
(let ((-list (copy oself)))
(ifn [,-list vide]
(cdr [,-list supprime ,-action])
(cdr -list))))
]
[FIX apprends
modif_assoc ((oself -al -var) ; Modification de la liste d'association
(acons -var oself -al))
]
[SYMBOL apprends
modif_assoc ((oself -al -var) ; Modification de la liste d'association
(acons -var oself -al))
variable? ((oself)
(eq (car (explode oself)) 63))
]
[CONS apprends
= ((oself -val)
(+> 'equal -val))
verif ((oself -lassoc) ; Comparaison de la liste d'association
(let ((t1 (if [,(car oself) variable?] ; et des preconditions.
(cdr (assoc (car oself) -lassoc))
(car oself)))
(t2 (cadr oself))
(t3 (if [,(caddr oself) variable?]
(cond ((assoc (caddr oself) -lassoc)
(cdr (assoc (caddr oself) -lassoc)))
(t (caddr oself)))
(caddr oself)))
(t4 (if (cadddr oself) (cadddr oself)))
(-r))
(cond ([,t3 variable?]
(cond ((eq t2 'verifie)
(=> [,t1 instances] 'modif_assoc -lassoc t3))
(t (list (=> (=> t1 t2) 'modif_assoc -lassoc t3)))))
(t (cond ([multivalues verifie ,
(=> (=> t1 'ma-classe) 'nom-attribut t2)]
(if (member t3 (=> t1 t2)) (list -lassoc)))
((member t2 (=> (=> t1 'ma-classe) 'champs))
(setq -r (=> t1 t2))
(if (equal -r t3)(list -lassoc)))
(t (if (setq -r (=> t1 t2 t3))
(if t4 (list (=> (=> t1 t2 t3)
'modif-assoc -lassoc t4))
(list -lassoc)))))
))))
]
[generateur cree APPLI sujet shakey but ,[files fabrique #(%t-pb aller-dans salle1)]]
[APPLI go]