ia01 tp02

IA01-TP02.cl

(defvar initial '(0 0 0 1 0 1))
(defvar final '(1 1 1 1 1 1))

(defun inverser (x)
  (if (= x 1) 0 1)
  )
(defun new-state(state pos)
  (when (<= (length state) (+ pos 1)) (return-from new-state state))
  (let ((i 0)(new-list '()))
    (dolist (arrow state new-list)
      (if (or (= i pos) (= i (+ pos 1)))
            (setq new-list (append new-list (list (inverser arrow))))
        (setq new-list (append new-list (list arrow)))
        )
      (setq i (+ i 1))
      )
    )
  )

(new-state '(0 0 0 1 0 1) 3)

;; Recherche les successeurs d'un etat
(defun successors (state)
  (let ((succ '()))
    (dotimes (var (- (length state) 1) succ)
      (setq succ (append succ (list (new-state state var)))
      ))
    )
  )

(successors '(0 0 0 1 0 1))

;; Exploration en profondeur
(defun explore-depth (state)
  (print state)
  (if (equal state initial) (setq visited NIL))
  (if (equal state final) (return-from explore-depth T))
  (push state visited)
  (dolist (succ (successors state) NIL)
    (let ((continuer T))
      (dolist (var visited)
        (when (equal succ var)(setq continuer NIL)))
      (when (and continuer (explore-depth succ))
        (return-from explore-depth T))
      )
    )
  )
(explore-depth initial)

;;exploration en largeur
(defun explore-breath (state)
  (let ((state-list (list state)) (new-state-list '()) (retour NIL))
    (while (equal retour NIL)
      (dolist (x state-list)
        (setq new-state-list (append (successors x) new-state-list)))
      (setq state-list new-state-list)
      (print state-list)
      (setq new-state-list '())
      (dolist (x state-list)
        (if (equal x '(1 1 1 1 1 1))
            (setq retour T)))
      )
    retour
    )
  )
(explore-breath initial)

;; Recherche de la proximite entre 2 etats
(defun proximite (state-1 state-2)
  (eval (cons '+ (mapcar #'(lambda (a b) (if (equal a b) 1 0)) state-1 state-2)))
  )

(proximite initial final)

;; Ordonne une liste selon la proximite
(defun trie-proximite (list)
  (let ((tmp-list list) (new-list '()) (succ NIL))
    (loop
      (setq tmp-list list)
      (setq succ NIL)
      (dolist (var tmp-list)
        (when (not (member var new-list))
          (when (equal succ NIL) (setq succ var))
        (when (< (proximite var final) (proximite succ final))
          (setq succ var))
          )
        )
      (push succ new-list)
      (when (= (length new-list) (length list)) (return-from trie-proximite new-list))
      )
    )
  )
;; Exploration en profondeur avec optimisation
(defun explore-depth-2 (state)
  (print state)
  (if (equal state initial) (setq visited NIL))
  (if (equal state final) (return-from explore-depth-2 T))
  (push state visited)
  (dolist (succ (trie-proximite (successors state)) NIL)
    (let ((continuer T))
      (dolist (var visited)
        (when (equal succ var)(setq continuer NIL)))
      (when (and continuer (explore-depth-2 succ))
        (return-from explore-depth-2 T))
      )
    )
  )
(explore-depth-2 initial)

;; Exploration en largeur avec optimisation
(defun explore-breath-2 (state)
  (let ((state-list (list state)) (new-state-list '()) (retour NIL))
    (while (equal retour NIL)
      (dolist (x state-list)
        (setq new-state-list (append (trie-proximite (successors x)) new-state-list)))
      (setq state-list new-state-list)
      (print state-list)
      (setq new-state-list '())
      (dolist (x state-list)
        (if (equal x '(1 1 1 1 1 1))
            (setq retour T)))
      )
    retour
    )
  )
(explore-breath-2 initial)