Skip to content

Le plus court chemin

Me voici lancé dans les cours d’Intelligence Artificielles de Harvard. Le court entier de Brian Yu sont disponibles sur le lien suivant: https://cs50.harvard.edu/ai/2023/

Le cour porte à la fois sur les algorithmes utilisés en I.A. et sur leurs implantations en Python. Comme je n’aime ni Python ni les choses simples, j’ai donc décidé de suivre les cours et de reproduire autant que faire se peut les algorithmes en Common Lisp (un language bien plus élégant que Python).

Mon premier algorithme est celui de la recherche de solution. Nous avons une liste avec une série de chiffres, tels que 3756421, c’est l’état initial. Et une autre série de chiffres, tels que 1234567, qui représentent l’objectif à atteindre. À chaque coup, il faut bouger échanger deux chiffres, juste deux chiffres.

Attention, ce n’est pas un algorithme de tri, l’objectif n’est pas de trier les chiffres dans le bon ordre. L’objectif est d’implanter un algorithme de résolution d’un problème par étapes en suivant une règle précise.

Ensuite, nous avons une frontière, c’est la liste des solutions possibles en partant d’un état à l’état suivant. Cette liste est rentrée dans une queue. Puis nous avons un agent qui va vérifier pour chaque entrée de cette queue si elle correspond à l’objectif recherché et si non, chercher tous les états frontières qui n’ont pas déjà été vérifiés et les rajouter dans la queue.

Il s’agit de l’algorithme Breadth-First Search. Malheureusement, il n’est jamais plus fort que l’être humain, mais c’est tout à fait normal, puisqu’il ne connait pas l’objectif à l’avance. Il avance à un peu au hasard et retourne la première solution qu’il a trouvé, même si cette dernière n’est pas forcément la meilleure. On peut améliorer cela si on connait l’objectif en comparant l’état de chaque chiffre avec ceux de l’objectif et donc ne bouger que ceux qui nous en rapprochent. Cela porte un nom, c’est la Greedy Best-First Search.

Mon code source:

#!/opt/homebrew/bin/sbcl --script


(defclass node ()
  ((value :initarg :value
	  :accessor node-value)
   (parent :initform nil
	   :initarg :parent
	   :accessor node-parent)))

(defmethod node-name ((obj node))
  (format nil "~A" (node-value obj)))

(defmethod node-parent-name ((obj node))
  (format nil "~A" (node-parent obj)))

(let ((queue ()))
  (defun add-queue (value)
    (push value queue))
  (defun pull-queue ()
    (let ((ret (first (last queue))))
      (setf queue (reverse (cdr (reverse queue))))
      ret)))

(defvar initial-state (make-instance 'node :value (list 3 1 2 7 5 6 4)))
(defvar target-state (make-instance 'node :value (list 1 2 3 4 5 6 7)))

(defun arrived? (state)
  (equal (node-value state) (node-value target-state)))

(defun exchange (s x y)
  (let ((copy-s (copy-list s)))
    (setf (nth x copy-s) (nth y s))
    (setf (nth y copy-s) (nth x s))
    copy-s))
    
(let ((done-state (make-hash-table :test 'equal))
      (frontiers ()))
  (setf (gethash (node-name initial-state) done-state) initial-state)
  (defun frontiers (state)
    (dotimes (i (- (length state) 1))
      (let* ((proposed-state (exchange state 0 (+ 1 i)))
	     (node (make-instance 'node :value proposed-state :parent state)))
	(when (not (gethash (node-name node) done-state))
	  (setf (gethash (node-name node) done-state) node)
	  (add-queue node)))))
  
  (defun find-path (state li)
    (push (node-name state) li)
    (when (null (node-parent state))
      (return-from find-path li))
    (find-path (gethash (node-parent-name state) done-state) li)))


(defun action (state)
  (frontiers (node-value state))
  (loop
    (let ((ff (pull-queue)))
      (when (null ff)
	(format t "No solution~%"))
      (when (arrived? ff)
	(return-from action ff))
      (frontiers (node-value ff)))))


(let ((ff (action initial-state)))
  (format t "From ~A to ~A~%" (node-name initial-state) (node-name ff))
  (format t "~A~%" (find-path ff () )))