;
; Patrick MARIE (groupe du vendredi AM.)
; Tp3 IA: Moteur d'inference chainage arriere

; Partie I: Representations des exemples.

; Nombre d'utilisations des regles:

(define NOMBRE 42)

(define base_regles_ex1
  '(
    (1 0 phanerogame fleur graine)
    (2 0 sapin phanerogame graine-nue)
    (3 0 monocotyledone phanerogame 1-cotyledone)
    (4 0 dicotyledone phanerogame 2-cotyledone)
    (5 0 muguet monocotyledone rhizome)
    (6 0 anemone dicotyledone)
    (7 0 lilas monocotyledone non_rhizome) 
    (8 0 cryptogame feuille fleur)
    (9 0 mousse cryptogame non_racine)
    (10 0 fougere cryptogame racine)
    (11 0 thallophyte non_feuille plante)
    (12 0 algue thallophyte chlorophylle)
    (13 0 champignon thallophyte non_chlorophylle)
    (14 0 colibacille non_feuille non_fleur non_plante)
   )
)

(define base_faits_ex1 '(rhizome fleur graine 1-cotyledone))

; L'exemple suivant est tiré d'un concept d'un jeu de stratégie:
; Il s'agit d'un arbre des technologies, pour accèder à certaines
; technologies, il faut en avoir accomplie certaines autre.

(define base_regles_ex2
  '(
     (35 0 monotheisme moyen_age)
     (36 0 feodalite moyen_age)
     (37 0 ingenierie moyen_age)
     (1 0 construction fer mathematiques)
     (2 0 fer bronze)
     (3 0 mathematiques maconnerie alphabet)
     (4 0 monnaie mathematiques)
     (5 0 republique philosophie loi)
     (45 0 philosophie ecriture)
     (6 0 ecriture alphabet)
     (7 0 loi ecriture)
     (8 0 litterature ecriture)
     (9 0 cartographie poterie ecriture)
     (10 0 equitation roue guerrier)
     (11 0 monarchie guerrier polytheisme)
     (12 0 polytheisme mysticisme)
     (13 0 mysticisme rite_funeraire)
     (14 0 moyen_age construction monnaie republique monarchie)
     (15 0 beaux_arts democratie)
     (16 0 democratie banque imprimerie)
     (17 0 imprimerie theologie)
     (18 0 theologie monotheisme)
     (19 0 education theologie)
     (20 0 solfege education)
     (21 0 chevalerie monotheisme feodalite)
     (22 0 banque education)
     (23 0 economie banque)
     (24 0 navigation astronomie)
     (25 0 physique chimie astronomie)
     (26 0 astronomie education)
     (27 0 gravite physique)
     (28 0 magnetisme physique)
     (29 0 tradition_militaire metalurgie)
     (30 0 metalurgie chimie)
     (31 0 chimie poudre_canon)
     (32 0 poudre_canon invention)
     (33 0 invention feodalite ingenierie)
     (34 0 epoque_industrielle beaux_arts economie navigation gravite tradition_militaire)
     (38 0 bronze antiquite)
     (39 0 maconnerie antiquite)
     (40 0 alphabet antiquite)
     (41 0 poterie antiquite)
     (42 0 roue antiquite)
     (43 0 guerrier antiquite)
     (44 0 rite_funeraire antiquite)
   )
)

; Exemple pour tester les backtracks

(define base_regles_ex3
  '(
     (1 0 arbre vegetal)
     (2 0 arbre famille)
     (3 0 vegetal tronc)
     (4 0 tronc branche)
     (5 0 branche feuille)
     (6 0 famille pere)
     (7 0 pere fils)
   )
)

(define base_regles_ex4
  '(
     (1 0 jaune bleu)
     (2 0 bleu jaune)
  )
)


; Partie II: fonctions de base

; A partir d'une regle, retourne le numero de la regle
(define
  (num_regle r)
  (car r)
)

; A partir d'une regle, retourne si la regle est encore valide ou non
(define
  (isvalide? r)
  (if (equal? (car (cdr r)) NOMBRE)
    #f
    #t
  )
)

; A partir d'une regle, retourne le but de la regle.
(define
  (consequence r)
  (car (cdr (cdr r)))
)

; A partir d'une regle, retourne les antecedents des regles.
(define
  (antecedents r)
  (cdr (cdr (cdr r)))
)

; A partir de la base de regles, retourne quand on a un numero de regle
; les antecedents de la regle
(define
  (get-antec n br)
  (antecedents (getregle n br))
) 

; A part d'un element 'a et d'une liste l, retourne vrai si l'element
; 'a est dans la liste l, sinon faux. 
(define
  (inlist? a l)
    (cond ( (not (list? l)) #f)
          ( (<=  (length l) 0) #f)
          ( (equal? (car l) a) #t)
          (else (inlist? a (cdr l)))
    )
)

; Affichage des faits
(define
  (display-faits faits)
  (if (null? faits) #f 
      (begin
        (display " ")
        (display (car faits))
        (display-faits (cdr faits))
      )
  )
)

; Affichage des buts
(define
  (display-buts bf)
  (begin
    (display "La liste des faits a montrer devient:\n           (")
    (display-faits bf)
    (display " )\n\n")
  )
)

; Affichage d'une regle
(define
  (display-regle r)
  (begin
    (display "          SI ")
    (display-faits (antecedents r))
    (display "\n                ALORS ")
    (display (consequence r))
    (display "\n")
  )
)

; Affichage si un fait est dans les faits observés
(define
  (dans-bfo fait)
  (begin
    (display fait)
    (display " est une observation elle est donc verifiee.\n")
  )
)

(define
  (display-application n br)
  (begin
    (display "Application de la regle ")
    (display n)
    (display ":\n")
    (display-regle (getregle n br))
    (display "\n")
  )
)


; Partie III: fonctions avancees

; ---------------------------------------------------------------------
; nom: getregle
; role: A partir de la base de regles, retourne la regle dont le num
;       est donne.
; signature: num regle * base regle -> regle
; parametre en entree:
;       n: numero de la regle
;       l: base de regles
; sortie:
;       la regle si succes, #f sinon.
; fonctions appelantes: display-application, get-antec,get-antec
; fonctions appellees: null?, equal?, num_regle, car, cdr, getregle
; ---------------------------------------------------------------------
(define
  (getregle n l)
  (cond ((null? l) #f)
        ((equal? n (num_regle (car l))) (car l))
        (else (getregle n (cdr l)))
  )
)

; ---------------------------------------------------------------------
; nom: cherche-regles
; role: Retourne une liste regles applicables en chainage arriere
;       selon le but donné.
; signature: fait * base regle -> liste regles
; parametre en entree: un fait, la base de regles
; sortie:              liste
; fonctions appelantes: cherche-regles, c-ar
; fonctions appelees: isvalide? cherche-regles consequence num_regle
; ---------------------------------------------------------------------
(define
  (cherche-regles fait br)
  (cond ( (null? br) '())
        ( (not (isvalide? (car br))) (cherche-regles fait (cdr br))) 
        ( (equal? (consequence (car br)) fait) 
          (cons (num_regle (car br)) (cherche-regles fait (cdr br))))
        (else (cherche-regles fait (cdr br)))
  )
)

; ---------------------------------------------------------------------
; nom: incrementereg
; role: Incremente le nombre d'utilisations d'une regle: utile pour 
;       savoir si une regle est encore utilisable par la suite ou non.
; signature: num de regle * base de regles -> base de regles
; parametre en entree: le numero de la regle, la base de regles
; sortie:              la nouvelle base de regles
; fonctions appelantes: apply-regle
; fonctions appelees: num_regle, consequence, incrementereg
; ---------------------------------------------------------------------
(define
  (incrementereg n l)
  (cond ((null? l) '())
        ((= n (num_regle (car l))) (cons (cons n (cons (+ 1 (car (cdr (car l))))
                                                       (cons (consequence (car l))
                                                       (antecedents (car l)))))
                                         (cdr l)))
        (else (if (= (length l) 1) l (cons (car l) (incrementereg n (cdr l)))))
  )
)

; ---------------------------------------------------------------------
; nom: some
; role: applique une fonction plusieurs fois jusqu'a ce que celle ci
;       retourne #f
; signature: fonction * liste * param1 * param2 * param3 -> boolean 
; parametre en entree: une fonction, une liste, et les arguments
; sortie:              boolean
; fonctions appelantes: some, c-ar
; fonctions appelees: some

; ---------------------------------------------------------------------
; on redefinit some, car on va avoir besoin de plusieurs autres arguments.
; 1/ l == regles applicables
; 2/ a1 == base de regles
; 3/ a2 == base de faits
; 4/ a3 == base de faits observes

; Note: avec guile (interpréteur de scheme GNU), '() est différent de #f :
; ---------------------------------------------------------------------
; guile> (list? #f)
; #f
; guile> (null? #f)
; #f
; La fonction some gère ce probleme, d'ou le test rajouté dans le cond.

(define
  (some f l a1 a2 a3)
  (cond ( (not (list? l)) #f )
        ( (null? l) #f )
        (else 
          (or (f (car l) a1 a2 a3)
              (begin
                (display "Il semble que nous devons faire un backtrack ici.\n")
                (some f (cdr l) a1 a2 a3)
              )
          ) 
        )
  )
)


; ---------------------------------------------------------------------
; nom: apply-regle 
; role: applique une regle sur la base de fait:
;       * modifie la base de regles (pour l'invalidation);
;       * retire les faits validés et rajoute les nouveaux faits à
;         déduire.
; signature: num regle * base regle * base faits * base faits observés 
;            -> boolean
; parametre en entree: * la regle appliquée
;                      * la base de regle
;                      * la base de faits (buts)
;                      * la base de faits observés
; sortie: Comme la fonction appelle c-ar, elle renvoit un boolean
; fonctions appelantes: c-ar
; fonctions appelees: incrementereg, get-antec, c-ar
; ---------------------------------------------------------------------

; la base de faits est inchangee (on a pas encore applique la regle)
; tout comme la base de regle qui attend qu'on incremente la regle
; cf 3 lignes ci dessus.

(define
  (apply-regle n br bf bfo)
  (begin
    (display-application n br)
    (let (
           (nouvelle-lb (append (get-antec n br) (cdr bf)))
           (nouvelle-br (incrementereg n br))
         )
         (c-ar nouvelle-br nouvelle-lb bfo)
    )
  )
)
; ---------------------------------------------------------------------
; nom: c-ar
; role: chainage avant 
; signature: base regles * liste buts * base faits observés -> boolean
; parametre en entree: base regles, liste buts, base faits observés
; sortie:              boolean
; fonctions appelantes: apply-regle, c-ar
; fonctions appelees: dans-bfo, c-ar, cherche-regles, apply-regle, some
; ---------------------------------------------------------------------

; algo chainage arriere: (c-ar)
; * Si la liste des buts est vide, alors succes.
; * Si le 1er fait a demontrer est dans la liste des buts,
;   alors elimination de la liste des buts, et appel recursif a c-ar
; * Sinon, on cherche la liste des regles pour donner ce but;
; * Pour chacune des regles, on l'applique en appelant c-ar sur 
; * la nouvelle base de faits / base de regles.

(define 
  (c-ar br lb bfo)
  (begin
    (display-buts lb)
; 1er cas: liste des buts vide
    (cond ( (null? lb) #t)
; 2nd cas: 1er but dans les faits observes.
          ( (inlist? (car lb) bfo)
            (begin
              (dans-bfo (car lb))
              (c-ar br (cdr lb) bfo)
            )
          )
; 3eme cas: prochain but, on cherche les prochaines regles, some dessus
;   et voila.
          (else 
            (let ((r (cherche-regles (car lb) br)))
              (some apply-regle r br lb bfo)
            )
          )
    )
  )
)

; Partie IV. Exemples

(display "\n\n")

; Exemple énoncé: 
; (c-ar base_regles_ex1 '(muguet) '(rhizome fleur graine 1-cotyledone))
; (c-ar base_regles_ex2 '(republique) '(alphabet))

; Grand exemple:
; (display "(c-ar base_regles_ex2 '(epoque_industrielle) '(antiquite))\n\n")
; (c-ar base_regles_ex2 '(epoque_industrielle) '(antiquite))

; (display "(c-ar base_regles_ex2 '(equitation) '(monarchie))\n\n")
; (c-ar base_regles_ex2 '(equitation) '(monarchie))

; Exemple back track
(display "(c-ar base_regles_ex3 '(arbre) '(fils))")
(c-ar base_regles_ex3 '(arbre) '(fils))

; Exemple bouclage.
; (c-ar base_regles_ex4 '(jaune) '(vert))