couples.lisp (4565B)
1 #| 2 Auteur : John CHARRON 3 email : charron.john@gmail.com 4 5 Ce petit program a plein de défauts, je le sais, n'en parlons pas pour l'instant. 6 L'idée ici était de m'amuser, de faire des progrès en LISP, de faire une implémentation 7 d'une question de complexité : le programme sera amélioré par la suite (meilleurs moyens 8 de récupérer des données (plus efficace), etc.), il ne s'agit qu'un début. 9 L'idée ici est de générer des couples avec une clé : 10 - *current* est la liste courante (clé x y) 11 - *db* est la base de données, les valeurs générées sont stockées dans *db* 12 (inefficace, je sais, car il faudrait pour l'instant faire un parcours séquentiel pour 13 retrouver la donnée... j'améliorera cela par la suite, laisser pour l'instant) 14 - les fonctions "right" "down-left", "down", "up-right" imitent le movement des 15 coordonnées sur un graphe mais au les coordonnées "y" positifs sont en DESSOUS du graphe 16 - "move" s'occupe de choisir "right", "down-left" etc. selon les valeurs dans *current* 17 - Pour que "move" marche, il faut mettre à jour à chaque "move" *max-x* et *max-y* (ici à l'aide 18 de la fonction "update-max-x-y" 19 - "zig-zag" fait n "move-and-update" en un seul coup et affiche le contenu de *db* (toutes les couples) 20 |# 21 22 23 24 ;; définition des variables globales (toujours entre astérisques) 25 (defvar *current* (list 0 0 0)) ;; liste courante "(code x y)" 26 (setf *current* (list 0 0 0)) 27 (defvar *db* nil) ;; base de données qui stocke tous les "(code x y)" 28 (setf *db* nil) 29 (push *current* *db*) 30 31 (defvar *max-x* 0) ;; valeur maximal courante de x 32 (setf *max-x* 0) 33 (defvar *max-y* 0) ;; valeur maximal courante de y 34 (setf *max-y* 0) 35 36 #| pour remettre toutes les variables globales à leur valeurs par défaut 37 afin de tester, de refaire un 'zig-zag', etc. 38 |# 39 (defun reset () 40 (progn 41 (defvar *current* (list 0 0 0)) ;; liste courante (clé x y) 42 (setf *current* (list 0 0 0)) 43 (defvar *db* nil) ;; base de données qui stocke tous les "(clé x y)" 44 (setf *db* nil) 45 (push *current* *db*) 46 (defvar *max-x* 0) ;; valeur maximal de x jusque "là" 47 (setf *max-x* 0) 48 (defvar *max-y* 0) ;; valeur maximal de y jusque "là" 49 (setf *max-y* 0) 50 *current*)) 51 52 #| Les fonctions "right" "down-left", "down", "up-right" imitent le movement des 53 coordonnées sur un graphe mais au les coordonnées "y" positifs sont en DESSOUS du graphe 54 |# 55 (defun right (L) 56 (progn 57 (push 58 (setf *current* 59 (cons (+ 1 (first L)) (cons (+ 1 (second L)) (last L)))) *db*) 60 *current*)) 61 62 (defun down (L) 63 (progn 64 (push 65 (setf *current* 66 (cons (+ 1 (first L)) (cons (second L) (cons (+ 1 (third L)) ())))) *db*) 67 *current*)) 68 69 (defun up-right (L) 70 (progn 71 (push 72 (setf *current* 73 (cons (+ 1 (first L)) (cons (+ 1 (second L)) (cons (- (third L) 1) ())))) *db*) 74 *current*)) 75 76 (defun down-left (L) 77 (progn 78 (push 79 (setf *current* 80 (cons (+ 1 (first L)) (cons (- (second L) 1) (cons (+ 1 (third L)) ())))) *db*) 81 *current*)) 82 83 (defun update-max-x (L) 84 (if (> (second L) *max-x*) 85 (setf *max-x* (second L)) 86 nil)) 87 88 (defun update-max-y (L) 89 (if (> (third L) *max-y*) 90 (setf *max-y* (third L)) 91 nil)) 92 93 (defun update-max-x-y (L) 94 (cond 95 ((> (second L) *max-x*) 96 (setf *max-x* (second L))) 97 ((> (third L) *max-y*) 98 (setf *max-y* (third L))) 99 (t ()))) 100 101 ;; "move" s'occupe de choisir "right", "down-left" etc. selon les valeurs dans *current* 102 (defun move (L) 103 (cond 104 ((and (zerop (third L)) (= *max-x* *max-y*)) ;; RIGHT takes precedence over LEFT becuase it occurs first 105 (print "in RIGHT") ;; 106 (right L)) 107 ((and (zerop (second L)) (= *max-x* *max-y*)) ;; DOWN 108 (print "in DOWN") 109 (down L)) 110 ((> *max-x* *max-y*) ;; DOWN-LEFT 111 (print "in DOWN-LEFT") 112 (down-left L)) 113 ((< *max-x* *max-y*) ;; UP-RIGHT 114 (print "in UP-RIGHT") 115 (up-right L)))) 116 117 #| 118 On fait un "move" et puis un "update-max-x-y" 119 Attention : il faut bien faire un setf L, sinon, le paramètre L de "update-max-x-y utilise la valeur 120 de L inchangé ! 121 |# 122 (defun move-and-update (L) 123 (progn 124 (setf L (move L)) 125 (update-max-x-y L) 126 *db*)) 127 128 ;; "zig-zag" fait n "move-and-update" en un seul coup et affiche le contenu de *db* (toutes les couples) 129 (defun zig-zag (L n) 130 (if (zerop n) 131 (move-and-update *current*) 132 (progn 133 (move-and-update *current*) 134 (zig-zag L (- n 1)))))