October 2023

Je n’ai pas la moindre idée de comment se nomme ce jeu en Français, il s’agit de cette grille de trois sur trois ou l’on rentre des X et des O. Le premier à avoir aligné trois caractères identique a gagné la partie.

Dans ma course à la compréhension de l’Intelligence artificielle, j’ai donc décidé de m’attaquer `a ce jeu et d’implanter l’algorithme Minimax en Common Lisp.

L’ordinateur n’est pas imbattable, en fait, il suffit d’un peu de stratégie pour gagner, mais il tient quand même la partie. Je pense qu’il faudrait pondérer les coups en fonction du nombre de coups avant de gagner pour améliorer le système. Mais qu’à cela ne tienne, l’ordinateur connait les règles, il essaye de gagner et essaye de faire perdre son adversaire.

Le principle consiste tout simplement à visualiser par avance toutes les parties possibles pour chaque coup et de jouer en priorité ceux qui lui permettent d’arriver à la victoire.

Le code ci-dessous:

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


(defmacro t-equal (p a b c)
  `(and
    (equal ,p ,a)
    (equal ,a ,b)
    (equal ,a ,c)))

(defun arrived (player state)
  (or
   (t-equal player (nth 0 state) (nth 1 state) (nth 2 state))
   (t-equal player (nth 3 state) (nth 4 state) (nth 5 state))
   (t-equal player (nth 6 state) (nth 7 state) (nth 8 state))
   (t-equal player (nth 0 state) (nth 4 state) (nth 8 state))
   (t-equal player (nth 2 state) (nth 4 state) (nth 6 state))
   (t-equal player (nth 0 state) (nth 3 state) (nth 6 state))
   (t-equal player (nth 1 state) (nth 4 state) (nth 7 state))
   (t-equal player (nth 2 state) (nth 5 state) (nth 8 state))))

(defun actions (state player)
  (let ((ret ()))
    (dotimes (i 9)
      (when (null (nth i state))
	(let ((node (copy-list state)))
	  (setf (nth i node) player)
	  (push node ret))))
    ret))

(defun display-board (state)
  (format t "--~%~%~A|~A|~A~%-----~%~A|~A|~A~%-----~%~A|~A|~A~%"
	  (or (nth 0 state) " ")
	  (or (nth 1 state) " ")
	  (or (nth 2 state) " ")
	  (or (nth 3 state) " ")
	  (or (nth 4 state) " ")
	  (or (nth 5 state) " ")
	  (or (nth 6 state) " ")
	  (or (nth 7 state) " ")
	  (or (nth 8 state) " ")))

(defun other-player (player)
  (if (equal player 1)
      2
      1))

(defun utility (state)
  (when (arrived 1 state)
    (return-from utility -1))
  (when (arrived 2 state)
    (return-from utility 1))
  0)

(defun arrived? (state)
  (or
   (arrived 1 state)
   (arrived 2 state)))

(defun max-value (state)
  (when (arrived? state)
    (return-from max-value (utility state)))
  (let ((actions (actions state 2))
	(l '(-99999999999)))
    (dolist (action actions)
      (push (min-value action) l))
    (reduce #'max l)))

(defun min-value (state)
  (when (arrived? state)
    (return-from min-value (utility state)))
  (let ((actions (actions state 1))
	(l '(9999999999)))
    (dolist (action actions)
      (push (max-value action) l))
    (reduce #'min l)))



(defun ask-user (state)
  (display-board state)
  (format t "From 0 to 8, where do you play ?~%")
  (let ((input (read)))
    (setf (nth input state) 1))
  state)

(defvar state '(nil nil nil nil nil nil nil nil nil))

(loop
  (when (arrived? state)
    (display-board state)
    (format t "Computer wins~%")
    (return))
  (setf state (ask-user state))
  (when (arrived? state)
    (display-board state)
    (format t "User wins~%")
    (return))
  
  (let ((actions (actions state 2))
	(temporary-state nil)
	(v -9999))
    (dolist (action actions)
      (let ((w (min-value action)))
	(when (> w v)
	  (display-board action)
	  (format t "Got ~A~%" w)
	  (setf v w)
	  (setf temporary-state action))))
    (setf state temporary-state)))


    

     
  

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 () )))