Common LISP

FORMAT est une fonction tout à fait exceptionnelle et vraiment propre à Common Lisp. La fonction C la plus proche de FORMAT serait FPRINTF, mais cette dernière ne tient pas la route face aux possibilités, la souplesse et la richesse de FORMAT.

FORMAT sert à formater et à imprimer une chaine de caractère, il prend au moins deux arguments, le descripteur de fichier (ou T pour la sortie standard ou NIL pour retourner la chaine formatée.

Avant tout, FORMAT sait afficher n’importe quoi avec une seule directive. Que la variable soit un nombre, une chaine de caractère, une liste (ça marche aussi avec les vecteurs, les caractères, presque tout en fait), il suffit d’utiliser la directive ~A et format s’adaptera au mieux.

CL-USER> (format t "~A ~A ~A~%" 1 "hop" '(1 2 3))
1 hop (1 2 3)

FORMAT sait également formater des listes:

CL-USER> (format t "~{~A ==> ~}~%" '(1 2 3 4))
1 ==> 2 ==> 3 ==> 4 ==>

~% permet de formater des chiffres décimaux, en rajoutant un préfix on décide du nombre de chiffres après la virgule.

CL-USER> (format t "~$ = ~5$~%" pi pi)
3.14 = 3.14159

Le prefix peut même être remplacé par une variable en utilisant le v

CL-USER> (format t "~v$" 14 pi)
3.14159265358979

~F permet également de formater des décimaux, il prend deux arguments, un pour la taille du nombre et un pour le nombre de chiffres après la virgule, on utilise le premier argument en préfix, mais si on veut utiliser le second, il faut le précéder d’une virgule qui indique à FORMAT d’ignorer le premier argument.

CL-USER> (format t "~5F" pi)
3.142
NIL
CL-USER> (format t "~,5F" pi)
3.14159
NIL

~d permet d’afficher des nombres entiers, il prend également des préfix:

CL-USER> (format t "~d ~:d ~@d ~:@d" 1000000 1000000 1000000 1000000)
1000000 1,000,000 +1000000 +1,000,000

~% et ~& affichent tout deux un retour à la ligne, ~% dans tous les cas et ~& seulement lorsque la ligne n’est pas vide.

~C permet d’afficher un caractère. Cette directive ne sert à rien puisqu’elle a exactement le même fonctionnement que ~A, sauf si on lui rajoute un préfix, alors elle affiche le nom du caractère (très utile pour les caractères non imprimables.

CL-USER> (format t "-~A-~:C~%" #\space #\space)
- -Space

~r permet d’afficher des chiffres en anglais, ou en Romain avec son préfix

(format t "~r ~@r~%" 1234 1234)
one thousand two hundred thirty-four MCCXXXIV

~p affiche un s si la variable qui lui correspond n’est pas un 1. Avec son préfix ~:p, il fait la même chose avec “y” ou “ies”. La variable utilisée est celle qui a servi à la précédente directive.

CL-USER> (format t "~r famil~:@p, ~r famil~:@p~%" 1 2)
one family, two families

Common Lisp propose plusieurs fonctions “map” qui permettent d’appliquer une fonction sur un ensemble de valeurs contenue dans une séquence. Une séquence peut être une chaine de caractères, une liste ou un vecteur. Il y a même une fonction “map” pour les tables de hachages.

“map” est sans doute la plus générique, elle prend un argument qui permet de définir le type de séquence voulue (‘list ou ‘vector), une fonction et une ou plusieurs séquences. La fonction prend autant d’arguments que le nombre de séquences fournies:

CL-USER> (map 'list #'+ '(1 2 3) '(1 2 3) '(1 2 3))
(3 6 9)

Ou encore:

CL-USER> (map 'vector #'identity "Stephane")
#(#\S #\t #\e #\p #\h #\a #\n #\e)

“map-into” applique une fonction sur une séquence et retourne le résultat, elle place également le résultat de façon destructive dans la variable qui lui est passée en argument:

CL-USER> (defvar a '(1 2 3))
A
CL-USER> (map-into a #'1+ a)
(2 3 4)
CL-USER> a
(2 3 4)

“mapcar” fait la même chose que “map”, mais ne travaille qu’avec des listes.

CL-USER> (mapcar #'1+ '(1 2 3))
(2 3 4)
CL-USER>

“mapc” fait la même chose que “mapcar”, mais au lieu de retourner le résultat, cette fonction retourne la liste passée en argument.

CL-USER> (mapc #'1+ '(1 2 3))
(1 2 3)
CL-USER>

“maplist” n’applique pas la fonction à chaque élément de la liste, même à la liste en entier d’abord, puis au CDR de la liste, puis au CDR du CDR de la liste … ainsi de suite jusqu’à ce que la liste soit vide.

CL-USER> (maplist #'identity '(1 2 3))
((1 2 3) (2 3) (3))
CL-USER>

“mapl” est le “mapc” de “maplist”. La fonction donnée en argument s’applique sur la liste de la même façon, mais la valeur retournée est celle de la liste passée en argument.

CL-USER> (mapl #'identity '(1 2 3))
(1 2 3)

“mapcan” est similaire à “mapcar”, mais il construit la liste retournée avec la fonction “nconc” plutôt que “list”, ce qui fait que la fonction doit retourner une liste:

CL-USER> (mapcan #'list '(1 2 3) '(1 2 3))
(1 1 2 2 3 3)
CL-USER> (mapcar #'list '(1 2 3) '(1 2 3))
((1 1) (2 2) (3 3))

“maphash” fait la même chose que “mapcar”, mais sur une table de hashage. La fonction passée en argument prend deux argument, un pour la clef et un pour la valeur.

CL-USER> (setq a (make-hash-table))
#<HASH-TABLE :TEST EQL :COUNT 0 {70088A58D3}>
CL-USER> (setf (gethash "one" a) 1)
1 (1 bit, #x1, #o1, #b1)
CL-USER> (maphash #'(lambda (k v) (format t "~A => ~A~%" k v)) a)
one => 1

Le moyen le plus simple pour charger des librairies extérieures dans Common Lisp est d’utiliser https://www.quicklisp.org/beta/

CL-USER> (ql:quickload 'str)
To load "str":
  Load 1 ASDF system:
    str
; Loading "str"

(STR)
CL-USER> 

• https://github.com/marijnh/Postmodern permet de se connecter à une base de données Postgres. Pour les application multi-threadées, Postmodern permet de passer par un pool de connections.
• https://github.com/lmj/lparallel fait du multi threading sans imposer la complexité du multi threading.
• https://sionescu.github.io/bordeaux-threads/ fait du vrai multi threading.
• https://edicl.github.io/hunchentoot/ est un serveur HTTP.
• https://edicl.github.io/drakma/ est un client HTTP.
• https://edicl.github.io/cl-ppcre/ Les expressions régulières et toutes les fonctions qui vont avec.
• https://github.com/vindarel/cl-str Les fonctions pour travailler sur les strings.
• https://github.com/phmarek/yason JSON en Common Lisp.
• https://edicl.github.io/flexi-streams/ Ne serait que pour travailler avec Drakma
• https://github.com/dardoria/uuid Pour générer des UUID
• https://github.com/mmontone/djula Les templates HTML
• https://asdf.common-lisp.dev/uiop.html Librairie bourrée d’utilitaires tels que CHDIR ou GETENV (et plein d’autres).
• https://local-time.common-lisp.dev/ Manipulation des dates et de l’heure.
• https://common-lisp-libraries.readthedocs.io/usocket/ usocket et usocket-server pour développer des applications réseau TCP et UDP.
• https://common-lisp-libraries.readthedocs.io/ Un lien vers une série de documentations très complètes sur les librairies pour Common Lisp.

Une macro dans Common Lisp est une vraie macro, entendons par là que le compilateur gén`ere le code qu’on lui demande de générer sans se poser de questions:

(defmacro print-random (i) 
                 `(let ((rr (random 10))) 
                       (format t "~A~%" (+ ,i rr))))

En plus d’être inutile, ce code en Common Lisp n’est pas correct, la variable rr peut être en conflit avec une autre variable dans contexte lexical ou cette macro est appelée. Une version correcte serait:

(defmacro print-random (i) 
                  (let ((rr (gensym))) 
                      `(let ((,rr (random 10))) 
                            (format t "~A~%" (+ ,i ,rr)))))

Ici, la variable rr est déclarée dans un champ lexical et associé à un nom unique généré par (gensym), elle est utilisée ensuite de la même façon que n’importe quelle variable passée en argument à la macro. Dans les faits, les deux versions de la macro vont fonctionner très bien, mais seule la seconde assure qu’il n’y aura pas d’effets secondaires.

Clojure est beaucoup plus stricte, il n’accepte pas l’utilisation de variables non déclarées dans ses macro et rend obligatoire l’utilisation de (gensym) dans un tel contexte. Ce qui peut poser problème lorsqu’on veut imbriquer deux macros qui utilisent la même variable.

Afin de simplifier l’utilisation de JDBC, je souhaite déclarer une macro (with-db & body) dans la quelle se trouve un environnement lexical qui me permette d’accéder directement à la base de données avec d’autres macros (fetch-db request) et (exec-db request).

(with-db (fetch-db ["select now()"]))

Le problème étant que le (with-open) utilisé par JDBC génère une variable lexicale qu’il faut reprendre dans les arguments de (jdbc/fetch) ou (jdbc/execute).

C’est ici qu’intervient le principe de LOM, ou Let Over Macro:

(let [cn (gensym)]
  (defmacro with-db [& body]
    `(with-open [~cn (jdbc/connection db)]
       ~@body))

  (defmacro exec-db [request]
    `(jdbc/execute ~cn ~request))

  (defmacro fetch-db [request]
    `(jdbc/fetch ~cn ~request)))

Le (let …) au lieu de se trouver à l’intérieur de la macro se trouve à l’extérieur, afin de créer un environnement lexical auquel toutes les macros peuvent accéder.

Un neurone est une fonction extrêmement simple qui prend un certain nombre de paramètres et retourne soit 0 (ou -1) soit 1 selon la valeur des arguments qui lui sont passés. Il multiplie chacun de ces argument par une valeur, additionne le tout et rajoute une constante. Si le résultat de cette opération est positive, alors il retourne 1, si elle est négative, il retourne -1.

L’intérêt de ce neurone, c’est qu’il est capable d’apprendre, c’est à dire que si on lui montre un jeu de données avec le résultat attendu, il va régler de lui même les constantes à utiliser pour sa petite opération et essayer de trouver une valeur idéale pour retourner la bonne réponse.

Ça vous intéresse, je vous suggère la lecture de la page Wikipedia et de faire vos propres recherches : https://en.wikipedia.org/wiki/Perceptron

Mon implémentation est sans doute très naïve et je suis certain qu’il existe une tonne de librairies qui le font beaucoup mieux que moi. Mais l’objectif ici est de comprendre le rouage de la chose, comment cela fonctionne. Une fois cela compris, il est certain que se tourner vers une librairie, complète, testée et optimisée est tout à fait recommandable pour faire un vrai projet en prod.

(setf data '(
	     (20 2000 1)
	     (40 1000 -1)
	     (30 3000 1)
	     (30 1000 -1)
	     (20 3000 1)
	     (40 2000 -1)
	     (40 4000 1)
	     (20 2000 -1)
	     (30 4000 1)
	     (20 4000 1)
	     (40 3000 -1)))


(defvar w '(1 1 1))

(defun magic (w x y)
  (if (> (+ (first w) (* (second w) x) (* (third w) y)) 0)
      1
      -1))


(dolist (l data)
  (format t "-----~%")
  (format t "~A~%" l)
  (let ((c (magic w (first l) (second l)))
	(alpha 0.00001))
    (format t "G/S=> ~A/~A~%" c (third l))
    
    (setf (first w)
	  (+ (first w) (*
			1
			alpha
			(- (third l) c))))
    (setf (second w)
	  (+ (second w) (*
			 (first l)
			 alpha
			 (- (third l) c ))))
    (setf (third w)
	  (+ (third w) (*
			(second l)
			alpha
			(- (third l) c))))
    (format t "~A~%" w)))
  
  
	     
      

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