;****************************************************************************************************** ;****************************************************************************************************** ;** ** ;** ** ;** ** ;** ** ;** 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]