;; (load "./tp4.lisp")
;(load "C:/Code/Lisp/Lisp/tp/tp1/tp1.lisp")
;(load "C:/Lecture/M1/IA/Lisp/Lisp/tp/tp1/tp1.lisp")
;; (load "./tp2.lisp")
;(load "C:/Users/HP/Documents/DIC2/IA/tp4/tp4.lisp")
(defun faitSatisfaitUneCondition(fait conditions)
(let
( (environements)
(cond_restants)
(environement)
(cond_pas_remplit)
(out)
)
;(progn
;(print "bonj")
(dolist (condi conditions)
;(progn
(setq cond_pas_remplit conditions)
(setq environement (match fait condi nil))
(if (not (equal environement echec)) (progn
(push environement environements)
(setq cond_pas_remplit(remove condi cond_pas_remplit))
(push cond_pas_remplit cond_restants )
;(nconc cond_restants cond_pas_remplit)
)
)
; )
)
(push cond_restants out)
(push environements out)
;)
out
)
)
(defun satisfaitUneCondition (condition listeEnvironements)
(let ((possible_envs nil)
(resultMatch nil)
)
(dolist (env listeEnvironements)
(dolist (fait faits)
(setq resultMatch (match fait condition env))
(if (not (equal resultMatch echec))
(push resultMatch possible_envs)
)
)
)
possible_envs
)
)
(defun satisfaitConditions(conditions environement)
(let (
(liste_env)
(liste_env (list environement))
; (condi)
)
(progn
;(if environement (setq liste_env (list environement)))
(setq liste_env (list environement))
(dolist (condi conditions)
;(if (null liste_env)
; (return-from satisfaitConditions liste_env)
;(setq liste_env
(setq liste_env (satisfaitUneCondition condi liste_env))
; )
)
)
liste_env
)
)
(defun instantieVariables (conclusionderegle listeEnvironements)
(let
( (liste_faits)
)
(dolist (env listeEnvironements)
(push (substitueVariables conclusionderegle env) liste_faits)
)
liste_faits
)
)
(defun rotate (x)
(cond
((null x) nil)
(( list x) (append (rotate (cdr x)) (list (car x))))
))
;union subtitution
(defun unionSubstitution(substitution1 substitution2)
;(if (testeSubstitution substitution1) (print "ok") (print "non"))
;(if (testeSubstitution substitution2) (print "ok2") (print "non2"))
(if (and
(testeSubstitution substitution1)
(testeSubstitution substitution2)
)
(append substitution1 substitution2) nil)
)
;;;
(defun testeListeVide(x)
(null x)
;(and (testeListe x) (equal (length x) 0))
)
(defun testeAtome(x)
(atom x)
)
(defun testeVariable(x)
(and
(testeAtome x)
(equal (aref x 0) (aref "?" 0))
)
)
(defun estdans(i l)
(cond
((null l) nil)
((equal i (car l)) t)
(t (estdans i (cdr l))))
)
(defun construitSubstitution (variable datum)
(cons (cons variable (cons datum nil)) nil)
)
(defun chainageAvantAvecFiltrage(regles faits_initiaux)
;(defun chainageAvantAvecFiltrage()
(let
( (Q faits_initiaux) (f) (resultat)
;( (Q faits) (f) (resultat)
(environement) (cond_restant) (env) (conds) (envs2) (instances) )
(while Q
;(progn
(setq f (car Q))
(setq Q (cdr Q))
(if (estUneSolution f) (progn
(ajouteFait f)
(imprimeFait f)
)
)
(dolist (r regles)
(progn
(setq resultat (faitSatisfaitUneCondition f (conditionsRegle r)))
(setq environement (car resultat))
(setq cond_restant (cadr resultat))
(dotimes (i (length environement))
(setq env (nth i environement))
(setq conds (nth i cond_restant))
(setq envs2 (satisfaitConditions conds env))
(if envs2
(progn
(setq instances (instantieVariables (consequenceRegle r) envs2))
(dolist (inst instances)
(if (estUneSolution inst)
; (setq Q (cons inst Q ))
(setq Q (append Q (list inst)))
;( progn
; (push inst Q)
; (rotate-left Q)
; )
)
)
)
)
)
)
)
;);prog
)
)
)
(defun testeListe(x)
(typep x 'list)
)
(defun transform (x)
(intern (string-upcase (remove #\? x)))
;dans SBCL ou CLISP
;(intern (upcase (substring x 1)))
;(intern (upcase (substring "?x" 1)))
;si vous etes dans emacs
)
(defvar echec 'echec)
(defvar faits nil)
(defvar regles nil)
(defun initDBs ()
(setq faits nil)
(setq regles nil)
)
(defmacro while (test &rest body)
"Repeat body while test is true."
(list* 'loop
(list 'unless test '(return nil))
body))
(defun ajouteFait (fait)
(push fait faits))
(defun estdans(i l)
(cond
((null l) nil)
((equal i (car l)) t)
(t (estdans i (cdr l))))
)
(defun estUneSolution(fait)
;(print (member fait faits))
; (if (member fait faits) nil t)
(if (estdans fait faits) nil t)
)
(defun ajouteRegle(conditions consequence)
(let ((l))
(progn
(setq l (list conditions consequence))
;(setq regles (cons l regles))
(push l regles)
)
)
)
(defun testeListeVide(x)
(null x)
;(and (testeListe x) (equal (length x) 0))
)
(defun testeAtome(x)
(atom x)
)
(defun retourneListe(x)
(cons x nil)
)
(defun testeSubstitution(x)
(cond
( (null x) t)
; ( (not (typep (car x) 'cons)) nil)
((atom x) nil)
( (atom (car x)) nil)
( (null (cdar x)) nil)
( (not (atom (caar x))) nil)
(( not (null (cddar x))) nil)
( t (testeSubstitution (cdr x)))
))
(defun testeVariable(x)
(and
(testeAtome x)
(equal (aref x 0) (aref "?" 0))
)
)
(defun imprimeFait(fait)
(print fait))
(defun conditionsRegle(regle)
(car regle))
(defun consequenceRegle(regle)
(cadr regle))
(defun construitSubstitution (variable datum)
;(cons (cons variable datum) nil)
(cons (cons variable (cons datum nil)) nil)
;(list (list variable datum) )
)
(defun retourneVariable(substitution)
(caar substitution)
)
(defun retourneValeur(substitution)
(cadar substitution)
)
(defun satisfaitUneCondition(regle lefait)
(if (member lefait (conditionsRegle regle)) t nil))
(defun trouveSubstitution (variable substitutions)
(if (assoc variable substitutions)
(cons (assoc variable substitutions) nil) nil )
)
; avec cette ligne le résultats est correct quelque soit substitute variable
; (load "C:/Lecture/M1/AI/Lisp/Lisp/tp/tp2/tr.lisp")
(defun unionSubstitution(substitution1 substitution2)
;(if (testeSubstitution substitution1) (print "ok") (print "non"))
;(if (testeSubstitution substitution2) (print "ok2") (print "non2"))
(if (and
(testeSubstitution substitution1)
(testeSubstitution substitution2)
)
(append substitution1 substitution2) nil))
(defun substitueVariables(pattern substitutions)
(let
( (out nil)
(temp nil))
(cond
( (null pattern) (setq out nil))
( (testeAtome pattern)
(if
(and (testeVariable pattern)
(trouveSubstitution (transform pattern ) substitutions))
;(assoc pattern substitutions))
(setq out (retourneValeur (trouveSubstitution (transform pattern ) substitutions)))
(setq out pattern)
)
)
( t (progn
(setq temp pattern)
(setq out (cons (substitueVariables (car pattern) substitutions) (substitueVariables (cdr pattern) substitutions)))
;(setf (car out) (substitueVariables (car pattern) substitutions))
; (setf (cdr out) (substitueVariables (cdr pattern) substitutions))
)
)
)
out)
)
; pour le second trouvesustitution cela-ci donne erreur
; (load "C:/Lecture/M1/AI/Lisp/Lisp/tp/tp2/sbinter.lisp")
;
(defun filtrage(datum pattern)
(cond
( (and (testeListeVide pattern) (testeListeVide datum) ) nil )
( (or (testeListeVide pattern) (testeListeVide datum) ) echec )
( (atom pattern) (cond
( (equal pattern datum) nil )
( (testeVariable pattern) (construitSubstitution
(intern (string-upcase (remove #\? pattern )))
;pattern
datum) )
( t echec )
) )
( (atom datum) echec )
( t (let
( (f1 (car datum))
(t1 (cdr datum))
(f2 (car pattern))
(t2 (cdr pattern))
(z1 nil) (z2 nil)
(g1 nil)
(g2 nil)
(out nil) )
(progn
(setq z1 (filtrage f1 f2))
; (print "z1")
; (print z1)
(if (equal z1 echec) (return-from filtrage echec))
(setq g1 t1)
(setq g2 (substitueVariables t2 z1))
(setq z2 (filtrage g1 g2))
; (setq z2 (filtrage t1 (substitueVariables t2 z1)))
; (print "z2")
; (print z2)
(if (equal z2 echec) (return-from filtrage echec))
(setq out (unionSubstitution z1 z2))
)
out
)
)
)
)
(defun match (datum pattern &optional (environement "None"))
(progn
(if (equal environement "None") (setq environement nil))
(if (equal environement echec)(return-from match echec) (progn
(setq pattern (substitueVariables pattern environement))
(if (equal (filtrage datum pattern) echec) (return-from match echec)
(unionSubstitution environement (filtrage datum pattern)))
)
)))
(defun remplir()
(initDBs )
;; (print faits)
(print "Ajout des fait")
(ajouteFait '("pere" "Jacques" "Charles"))
(ajouteFait '("frere" "Charles" "Francois"))
(ajouteFait '("frere" "Jacques" "Pierre"))
(print faits)
(print "Ajout des regles")
;rules
(ajouteRegle '(("pere" "?x" "?y") ("frere" "?y" "?z")) '("pere" "?x" "?z"))
(print "ok ")
(ajouteRegle '(("pere" "?x" "?y") ("frere" "?x" "?z")) '("oncle" "?z" "?y"))
(print "Fin Remplissage")
)
(print "Appel remplir")
(remplir)
(print "Affiche Size faits")
(print (length faits))
(print "Affiche faits")
(print faits)
(print "Affiche Size faits")
(print (length faits))
(print "Affiche size Rules")
(print (length regles))
(print "Affiche Rules")
(print regles)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(print "chainageAvantFiltrage in action")
(chainageAvantAvecFiltrage regles faits)
(print "Fin Chainage Avant Avec Variables ")
(print "................................")
(print "Fin Execution") Write, Run & Share Common Lisp code online using OneCompiler's Common Lisp online compiler for free. It's one of the robust, feature-rich online compilers for Common Lisp language, running the latest Common Lisp version 5.3. Getting started with the OneCompiler's Common Lisp editor is easy and fast. The editor shows sample boilerplate code when you choose language as Common Lisp and start coding.
OneCompiler's Common Lisp online editor supports stdin and users can give inputs to programs using the STDIN textbox under the I/O tab. Following is a sample Common Lisp program which takes name as input and prints hello message with your name.
(setq name (read))
(princ "Hello ")
(write name)
Common Lisp is a generic language suitable for a wide range of industry applications. It is often referred as Programmable programming language because of it's high extensibility, machine independence, extensive control structures, dynamic updation of programs etc.
Common LISP was invented by John McCarthy in 1958 and was first implemenyted by Steve Russell on an IBM 704 computer.
defvar keyword and these variables will be in effect until a new value is assigned.(defvar x 10)
(write x)
let and progare used to declare local variables.(let ((var1 value1) (var2 value2).. (varn valuen))<expressions>)
setq(setq a 10)
This is the simplest looping mechanism in LISP. This allows the execute the set of statements repeatedly until a return statement is encountered.
(loop (s-expressions))
For loop is used to iterate a set of statements based on a condition.
(loop for loop-variable in <a list>
do (action)
)
Do is also used to iterate a set of statements and then check the condition
(do ((var1 val1 updated-val1)
(var2 val2 updated-val2)
(var3 val3 updated-val3)
...)
(test return-value)
(s-expressions)
)
Dotimes is used to iterate for fixed number of iterations.
(dotimes (n val)
statements