Liste des symboles rencontrés dans ce chapitre:
COPY-LIST COPY-TREE TREE-EQUAL SUBST SUBSTITUTE-IF SUBST-IF SUBST-IF-NOT NSUBST NSUBST-IF NSUBST-IF-NOT ADJOIN PUSHNEW MEMBER MEMBER-IF MEMBER-IF-NOT INTERSECTION UNION SET-DIFFERENCE SET-EXCLUSIVE-OR NINTERSECTION NUNION NSET-DIFFERENCE NSET-EXCLUSIVE-OR SUBSETP ALIST PLIST ASSOC ASSOC-IF ASSOC-IF-NOT RASSOC RASSOC-IF RASSOC-IF-NOT COPY-ALIST PAIRLIS GETF REMF GET-PROPERTIES DESTRUCTURING-BIND &whole
Arbres, ensembles, tables.
(autres utilisations des cellules CONS, en plus des listes):
FONCTIONS D'ARBRES:
COPY-LIST:
COPY-TREE:
(copy-list '((1 2) (3 4) (5 6)))
((1 2) (3 4) (5 6))
seule la liste est copiée et pointe sur les sous-listes non copiées
(copy-tree '((1 2) (3 4) (5 6)))
((1 2) (3 4) (5 6))
ici, liste et sous-listes sont copiés
TREE-EQUAL:
permet de comparer deux arbres (les arbres sont égaux s'ils ont la même
structure et des "feuilles" EQL ou satisfaisant au mot-clé :test)
SUBST:
(subst 10 1 '(1 2 (3 2 1) ((1 1) (2 2))))
(10 2 (3 2 10) ((10 10) (2 2)))
la substitution a lieu dans la liste et les sous-listes (donc dans l'arbre)
Alors que:
(substitute 10 1 '(1 2 (3 2 1) ((1 1) (2 2))))
(10 2 (3 2 1) ((1 1) (2 2)))
la substitution n'a lieu que dans la liste (pas dans les sous-listes)
SUBSTITUTE-IF:
(fonction de listes)
(substitute-IF 9 #'oddp '(1 2 4 1 3 4 5))
(9 2 4 9 9 4 9)
remplace par 9 tous les nombres impairs
(substitute-IF 9 #'evenp '(1 2 4 1 3 4 5) :count 1 :from-end t)
(1 2 4 1 3 9 5)
remplace par 9 le premier nombre pair trouvé à partir de la fin
SUBST-IF:
(subst-if 5 #'listp '(1 2 (3 2 1) ((1 1) (2 2))))
5
rend 5 si l'arbre, passé en argument est une liste
SUBST-IF-NOT:
(subst-if-not 5 #'listp '(1 2 (3 2 1) ((1 1) (2 2))))
(5 5 (5 5 5) ((5 5) (5 5)))
tout ce qui n'est pas une liste est remplacé par 5
NSUBST, NSUBST-IF, NSUBST-IF-NOT:
sont les versions recyclantes de SUBST (la variable concernée change de valeur).
la structure de l'arbre peut être altérée.
LES ENSEMBLES:
ADJOIN:
(defparameter *set* ())
*SET*
définition d'une variable globale
(adjoin 1 *set*)
(1)
pour construire un ensemble
*set*
NIL
*set* inchangé
(setf *set* (adjoin 1 *set*))
(1)
pour modifié l'ensemble (obligation d'utiliser SETF)
on ne peut pas ajouter un élément s'il est déjà dans l'ensemble.
le test d'égalité est EQL par défaut, ou bien
précisé avec la clé :test ou la clé :test-not.
On peut appliquer une fonction sur l'élément à ajouter avec la clé :key.
(setf *set* (adjoin -3 *set* :key #'abs))
(-3 1)
l'élément -3 a été ajouté car sa valeur absolue n'est pas dans l'ensemble
(setf *set* (adjoin -1 *set* :key #'abs))
(-3 1)
par contre, -1 n'est pas ajouté car sa valeur absolue est dans l'ensemble
*set*
(-3 1)
ensemble non modifié
(pop *set*)
-3
rend le premier élément de l'ensemble, mais:
*set*
(1)
set modifié
PUSHNEW:
(pushnew 2 *set*)
(2 1)
pour ajouter un élément dans l'ensemble:
*set*
(2 1)
(pushnew 2 *set*)
(2 1)
on ne peut pas ajouter 2 fois le même élément avec PUSHNEW. Mais:
attention, avec PUSH c'est possible!
MEMBER:
(pushnew 3 *set*)
(3 2 1)
on ajoute un 3ème élément
(member 2 *set*)
(2 1)
rend le sous-ensemble (sous-liste) à partir de l'élément trouvé
le test d'égalité par défault est EQL
(member 4 *set*)
NIL
rend NIL si l'élément n'est pas trouvé.
(member '(3 4) '((1 2) (3 4) (5 6)))
NIL
Ce n'est pas EQL: les pointeurs ne sont pas identiques
On peut changer le test à l'aide du mot-clé :test
(member '(3 4) '((1 2) (3 4) (5 6)) :test #'equal)
((3 4) (5 6))
avec EQUAL, ce sont les valeurs qui sont comparées (pas les pointeurs vers ces valeurs)
Ne pas oublier #' devant EQUAL
On peut, aussi, utiliser un autre mot-clé: :key, pour appliquer une fonction
sur chaque élément de la liste:
(member 3 '((1 2) (3 4) (5 6)) :key #'car)
((3 4) (5 6))
Le deuxième élément répond au critère: y a-t-il un élément commençant par 3 dans la liste?
(member 4 '((a b) (3 4 5) (c d e f) (k)) :key #'length)
((C D E F) (K))
Le troisième élément répond au critère: y a-t-il un élément de longueur 4 dans la liste?
Les deux mots-clés peuvent être utilisés ensemble dans un ordre indifférent:
(on peut aussi utiliser le mot-clé :test-not)
(member '(3 7) '((1 2) ((3 7) 4) (5 6)) :test #'equal :key #'car)
(((3 7) 4) (5 6))
pour chercher un élément répondant à un prédicat:
MEMBER-IF:
MEMBER-IF-NOT:
(member-if #'evenp *set*)
(2 1)
rend le sous-ensemble à partir du 1er nombre pair rencontré
(rappel: *set* valait (3 2 1) plus haut)
Autre exemple: soit la fonction prédicat suivante:
(defun divisible/3? (n)
"rend l'argument s'il est divisible par 3, NIL sinon."
(if (zerop (mod n 3))
n
nil))
(member-if #'divisible/3? '(10 11 12 13 14))
(12 13 14)
rend le sous-ensemble à partir du premier nombre divisible par 3 de la liste
(member-if-not #'oddp *set*)
(2 1)
rend le sous-ensemble à partir du 1er nombre non-impair rencontré
INTERSECTION:
UNION:
SET-DIFFERENCE:
SET-EXCLUSIVE-OR:
Si *set* est (3 2 1) et *ens* est (2 0 4 5):
(intersection *ens* *set*)
(2)
rend un ensemble contenant les éléments communs aux deux ensembles
(union *ens* *set*)
(5 4 0 3 2 1)
rend un ensemble contenant tous les éléments des deux ensembles
(set-difference *ens* *set*)
(5 4 0)
rend un ensemble contenant les éléments de *ens* qui ne sont pas dans *set*
(set-difference *set* *ens*)
(1 3)
rend un ensemble contenant les éléments de *set* qui ne sont pas dans *ens*
(set-exclusive-or *set* *ens*)
(5 4 0 1 3)
rend un ensemble contenant tous les éléments de *set* et *ens* qui ne sont pas dans l'intersection de ces deux ensembles
Les fonctions recyclantes correspondantes sont:
NINTERSECTION:
NUNION:
NSET-DIFFERENCE:
NSET-EXCLUSIVE-OR:
(nintersection *ens* *set*)
(2)
*ens*
(2)
le 1er ensemble a bien changé
NUNION peut modifier ses deux arguments.
SUBSETP: teste si un ensemble est une partie d'un autre. :key, :test peuvent être utilisés.
(subsetp '(3 2 1) '(1 2 3 4))
T
le 1er ensemble est bien sous-ensemble du 2ème.
(subsetp '(4 3 2 1) '(1 2 3))
NIL
ici, ce n'est pas le cas.
LISTES D'ASSOCIATION et LISTES de PROPRIETES:
ALIST:
PLIST:
Une alist est formée de couples pointés (on dit aussi des paires): ((A . 1) (B . 2) (C . 3)), par exemple.
(remarquons qu'une liste quelconque (a b c d) est aussi la paire (a . (b c d)).
Le CAR de chaque couple sert de clé d'accès à l'objet dans le CDR du couple:
Pour le couple (A . 1), A est la clé d'accès à l'objet 1.
Pour le couple (a . (b c d)), a est la clé d'accès à l'objet (b c d).
ASSOC:
(assoc 'b '((a . 1) (b . 2) (c . 3)))
(B . 2)
rend le couple pointé correspondant à B (CAR). Par défaut, c'est EQL qui est utilisé.
(assoc 'd '((a .1) (b . 2) (c . 3)))
NIL
d n'est pas une clé: rend NIL
(cdr (assoc 'b '((a .1) (b . 2) (c . 3))))
2
rend la valeur correspondante à la clé passée en argument
(assoc "b" '(("a" . 1) ("b" . 2) ("c" . 3)) :test #'string=)
("b" . 2)
ici le test est STRING=
Un exemple avec des listes:
On définit une alist sur les préfixes des unités du Système International.
Chaque sous-liste contient le préfixe, suivi de son symbole, et l'exposant de la puissance de 10 qu'il représente.
(defparameter préfixe
'(("déca" "da" 1) ("hecto" "h" 2) ("kilo" "k" 3) ("méga" "M" 6) ("giga" "G" 9) ("téra" "T" 12) ("péta" "P" 15) ("exa" "E" 18) ("zetta" "Z" 21) ("yotta" "Y" 24) ("déci" "d" -1) ("centi" "c" -2) ("milli" "m" -3) ("micro" "μ" -6) ("nano" "n" -9) ("pico" "p" -12) ("femto" "f" -15) ("atto" "a" -18) ("zepto" "z" -21) ("yocto" "y" -24)))
(assoc "giga" préfixe :test #'string=)
("giga" "G" 9) on obtient la sous-liste correspondant à la clé "giga".
(cdr (assoc "giga" préfixe :test #'string=))
("G" 9) ici la valeur correspondant à la clé "giga" est une liste.
Pour avoir le facteur multiplicatif correspondant à la clé "giga":
(expt 10 (caddr (assoc "giga" préfixe :test #'string=)))
1000000000
Voici une fonction qui va rendre les choses plus lisibles:
(defun préfixe-SI (clé)
(multiple-value-bind (x y z) (values-list (assoc clé préfixe :test #'string=)) (format t "Le préfixe ~a a pour symbole ~a et son facteur multiplicateur est ~,,' ,3:d.~%" x y (expt 10 z))))
(préfixe-SI "téra")
Le préfixe téra a pour symbole T et son facteur multiplicateur est 1 000 000 000 000.
NIL voir format: pour la mise en forme.
Revenons aux tables de hachage.
Nous avions vu une fonction qui permettait de convertir une alist en table de hachage.
Rappelons cette fonction:
(defun alist-vers-table-h (l)
(if (endp l)
t
(progn (setf (gethash (caar l) *h*) (cdar l))
(alist-vers-table-h (cdr l)))))
Nous allons appliquer cette conversion à la alist préfixe.
On définit, d'abord, une table de hachage:
(defparameter *h* (make-hash-table :test #'equal))
*H* les clés seront du type string, donc on change le test: EQUAL au lieu de EQL.
(alist-vers-table-h préfixe)
T
(gethash "téra" *h*)
("T" 12)
(car (gethash "téra" *h*))
"T"
Et voici la fonction préfixe-SI modifiée qui utilise la hashtable.
Appelons-la préfixe-SI2:
(defun préfixe-SI2 (clé)
(multiple-value-bind (x y z) (values-list (push clé (gethash clé *h*))) (format t "Le préfixe ~a a pour symbole ~a et son facteur multiplicateur est ~,,' ,3:d.~%" x y (expt 10 z))))
Elle affiche la même chose que la précédente:
(préfixe-SI2 "téra")
Le préfixe téra a pour symbole T et son facteur multiplicateur est 1 000 000 000 000.
Vous avez, maintenant, le choix entre utiliser une alist ou utiliser une table de hachage.
(defparameter alist '((a . 1) (b . 2) (c . 3)))
ALIST
définition d'une alist
(cons (cons 'a 10) alist)
((A . 10) (A . 1) (B . 2) (C . 3))
ajoute une clé, mais sans changer la alist, ou bien:
(acons 'a 20 alist)
((A . 20) (A . 1) (B . 2) (C . 3))
même chose la alist ne change pas:
alist
((A . 1) (B . 2) (C . 3))
(setf alist (acons 'a 30 alist))
((A . 30) (A . 1) (B . 2) (C . 3))
pour changer la alist
alist
((A . 30) (A . 1) (B . 2) (C . 3))
ou bien:
(push (cons 'd 35) alist)
((D . 35) (A . 30) (A . 1) (B . 2) (C . 3))
alist
((D . 35) (A . 30) (A . 1) (B . 2) (C . 3))
Pour changer la valeur d'une clé:
(setf (cdr (assoc 'b alist)) 25)
25
la place (cdr (assoc 'b alist)) contient, maintenant 25 (au lieu de 2)
alist
((D . 35) (A . 30) (A . 1) (B . 25) (C . 3))
vérification
Mais, attention! S'il y a plusieurs fois la même clé:
(setf (cdr (assoc 'a alist)) 33)
33
alist
((D . 35) (A . 33) (A . 1) (B . 25) (C . 3))
c'est la première occurence qui est changée
Construction d'une alist à partir d'une liste plate avec répétition d'éléments:
(defparameter l '(a e a d a c b d b c a b))
L
(defun occur (lst)
"rend des doublets formés des éléments de la liste et de leur occurence."
(if (null lst)
nil
(apply #'list (cons (car lst) (count (car lst) lst)) (occur (remove (car lst) lst)))))
(occur l)
((A . 4) (E . 1) (D . 2) (C . 2) (B . 3))
Ces doublets peuvent être rangés dans l'ordre croissant ou décroissant des occurences:
On récupère les fonctions INS et TRI définies précédemment (voir tri:), en les adaptant à la situation.
(defun ins-doublet (x l)
"insère un doublet dans une liste déjà triée."
(if (null l) (list x)
(if (> (cdr x) (cdr (car l)))
(cons x l)
(cons (car l) (ins-doublet x (cdr l))))))
(defun tri-doublet (l)
"trie une liste de doublets dont le 2ème élément est un nombre, dans le sens décroissant de ces nombres."
(if (null l) nil
(ins-doublet (car l) (tri-doublet (cdr l)))))
(tri-doublet (occur l))
((A . 4) (B . 3) (C . 2) (D . 2) (E . 1))
________________________
Utilisation des alists et des fermetures (voir fermetures: ou closures:).
La fonction suivante permet de créer une alist et une liste de fermetures agissant sur la alist:
(defun make-alist (db)
(setf
(symbol-function 'pays-de) #'(lambda (key)
;chaque fermeture lambda est nommée à l'aide de la fonction SYMBOL-FUNCTION
(cdr (assoc key db)))
(symbol-function 'ajouter-ville-pays) #'(lambda (key val)
(push (cons key val) db) key)
(symbol-function 'supprimer-ville) #'(lambda (key)
(setf db (delete key db :key #'car)) key))
(list 'pays-de 'ajouter-ville-pays 'supprimer-ville))
(defparameter villes nil)
VILLES
pour éviter les messages d'erreur
(setq villes (make-alist '((berlin . allemagne) (paris . france) (londres . angleterre))))
(PAYS-DE AJOUTER-VILLE-PAYS SUPPRIMER-VILLE)
définit une alist explicitement donnée ici
rend la liste des fermetures agissant sur la alist
(pays-de 'paris)
FRANCE
rend le pays correspondant à la clé paris de la alist
(ajouter-ville-pays 'madrid 'espagne)
MADRID
ajoute (madrid . espagne) à la alist
(pays-de 'madrid)
ESPAGNE
vérification
(supprimer-ville 'paris)
PARIS
supprime (paris . france) de la alist
(pays-de 'paris)
NIL
vérification
Construire une documentation des fonctions exportables de COMMON-LISP en français:
Vous pouvez copier ce qui suit dans un fichier-texte appelé "docfr.lisp", entre
début du fichier et fin du fichier. Les ; sont là pour indiquer les commentaires.
Ce fichier n'est pas parfait. Mais le but est de vous faire réviser certaines notions.
Essayez de "décortiquer" les fonctions qu'il contient.
Revenez sur ce que vous avez déjà vu.
Améliorez! Simplifiez!
...Si vous le voulez bien.
;;;Début du fichier DOCFR.lisp
;;;Beginn der DOCFR.lisp-Datei
;;;Ces fonctions autorisent l'accès à la documentation des fonctions COMMON-LISP:
;;;Diese Funktionen ermöglichen den Zugriff auf die Dokumentation der COMMON-LISP-Funktionen:
;;;En français si elles existent dans le fichier "doc-fr-fonctions",
;;;Auf Deutsch, wenn sie in der Datei "doc-DE-Funktionen" vorhanden sind,
;;;sinon en anglais.
;;;Il y a possibilité de traduire en français et d'étoffer ce fichier.
;;;Es ist möglich, ins Deutsche zu übersetzen und diese Datei zu erweitern.
;;;La fonction suivante permet de voir les symboles internes d'un package:
;;;Il n'y en a pas dans "COMMON-LISP", Mais il y en a dans "CL-USER" si vous avez travaillé dans
;;;ce package. En général, "CL-USER" n'a pas de symboles exportables, sauf si vous en avez défini.
(defun symboles-internes (package)
"Rend la liste des symboles internes du package."
(let ((résultat nil)) ;la liste résultat est initialisée à vide (NIL)
(do-symbols (symb package) ;itération sur tous les symboles du package
(when (eq (second (multiple-value-list (find-symbol (symbol-name symb) package))) :internal)
;quand la 2ème valeur rendue par FIND-SYMBOL est :internal...
(push symb résultat))) ;...le symbole est ajouté à la liste résultat
(delete-duplicates résultat))) ;on supprime les résultats dupliqués
;;;La fonction suivante permet de voir les symboles exportables d'un package.
;;;Le package "COMMON-LISP" en possède plus de 900: pour ne pas encombrer votre écran,
;;;n'abusez pas de cette fonction. Utilisez plutôt la fonction aléa-doc-de qui n'affiche
;;;qu'une fonction à la fois.
(defun symboles-externes (package)
"Rend la liste des symboles exportables du package"
(let ((résultat nil))
(do-external-symbols (s package)
(push s résultat))
résultat))
;;;initialisation
(defparameter fich nil)
(defparameter pack nil)
(defparameter clé nil)
(defparameter doc nil)
(defparameter r nil)
(defparameter mon-path nil)
(defparameter entrée nil)
(defparameter listef nil)
(defparameter sortie nil)
(defparameter fonctions-doc nil)
(defparameter caract nil)
(defparameter chaine nil)
;;;Fonction servant à fabriquer une alist et des fermetures (fonctions) agissant dessus:
(defun make-alist-fonctions (db)
"Cette fonction est utilisée par ACCèS-DOC-FR pour définir 4 fermetures agissant sur la documentation
des fonctions COMMON-LISP en français."
(setf ;définition de 4 fermetures utilisant la lambda-fonction.
(symbol-function 'doc-de) #'(lambda (clé)
(cdr (assoc clé db)))
(symbol-function 'ajouter-fonction-doc) #'(lambda (clé val)
(push (cons clé val) db) clé)
(symbol-function 'retirer-fonction-doc) #'(lambda (clé)
(setf db (delete clé db :key #'car)) clé)
(symbol-function 'voir-la-liste-complète) #'(lambda () db))
(list 'doc-de 'ajouter-fonction-doc 'retirer-fonction-doc 'voir-la-liste-complète)) ;rend la liste des fonctions-fermetures ainsi définies
;;;Pour accéder au fichier "doc-fr-fonctions":
;;;Cette fonction accès-doc-fr utilise make-alist-fonctions:
(defun accès-doc-fr (fich) ;fich doit être le nom du fichier écrit entre guillemets
"Définit une alist (fonctions-doc) à partir du fichier fich et rend la liste des fermetures qui agissent sur la alist."
(labels ((accès-doc (fic) ;la fonction accès-doc est définie dans le LABELS de la fonction accès-doc-fr
"Cette fonction ouvre un flux vers le fichier fic, lit le fichier, referme le flux et rend le contenu du fichier fic."
(defparameter listef ()) ;la variable listef est initialisée à vide
(let ((*default-pathname-defaults* '#P"/home/trochet/LISP/Clisp/")) ;à modifier suivant le chemin du fichier fich
(defparameter mon-path (make-pathname :name fic))
(defparameter entrée (open mon-path :direction :input))
(setq listef (read entrée))
(close entrée) listef))) ;la fonction accès-doc rend le contenu de listef lu dans le fichier
(setq fonctions-doc (make-alist-fonctions (accès-doc fich))))) ;la variable fonction-doc contient la alist définie par le fichier fich
;;;L'appel pour avoir accès au fichier de documentations en français et aux fonctions-fermetures est simple:
(accès-doc-fr "doc-fr-fonctions")
;;;La fonction aléa-doc-de a besoin de la fonction symboles-externes pour trouver les symboles du package:
;;;C'est la fonction principale à utiliser:
;;;elle affiche une fonction au hasard et sa documentation.
(defun aléa-doc-de (pack)
"Tire au hasard une fonction exportable du package passé en argument et affiche sa documentation."
(setq *random-state* (make-random-state))
(let* ((liste (symboles-externes pack)) (clé (nth (random (length liste)) liste))) ;clé contient un symbole tiré au hasard
(if (doc-de clé) ;si le symbole a une documentation en français...
(format t "Doc de la fonction ~a: ~a~%" clé (doc-de clé)) ;on affiche le symbole et sa documentation
(if (fboundp clé) ;sinon si le symbole est bien une fonction...
(format t "Doc de la fonction ~a: ~a~%" clé (documentation clé 'function)) ;on affiche le symbole et sa documentation en anglais
(aléa-doc-de pack))))) ;sinon on fait un appel récursif de aléa-doc-de
(defun ad (package)
"ad est un raccourci de aléa-doc-de."
(aléa-doc-de package))
;;;Voici la fonction à ne pas oubier en fin de travail pour mettre à jour le fichier.
;;;Cette fonction utilise la fermeture voir-la-liste-complète.
(defun sauve-doc-fr (fich)
"Permet d'enregistrer les données saisies dans le fichier de documentation des fonctions
COMMON-LISP en français."
(let ((*default-pathname-defaults* '#P"/home/trochet/LISP/Clisp/")) ;à modifier suivant le chemin du fichier fich
(defparameter mon-path (make-pathname :name fich)) ;définition du path vers vers le fichier fich
(defparameter sortie (open mon-path :direction :output :if-exists :supersede)) ;définition du flux en sortie
(prin1 (voir-la-liste-complète) sortie) ;envoie de la alist vers le flux
(close sortie))) ;fermeture du flux et enregistrement du fichier fich.
;;;Pour se simplifier la vie:
(defun afd (clé val)
(ajouter-fonction-doc clé val))
(defun rfd (clé)
(retirer-fonction-doc clé))
;;;Pour éviter un démarrage identique dans SLIME:
(defun réglage-aléa ()
"initialise la fonction random pour ne pas avoir les mêmes résultats."
(do ((i 0 (1+ i))) ((>= i (length (voir-la-liste-complète)))) (random 1.0)))
(réglage-aléa)
;;;Accès ergonomique:
(defun read-default (val-def) ;val-def contient la valeur par défaut (quand on tape Entrée sans rien saisir)
(setq caract (read-char)) ;permet de lire le 1er caractère tapé et de le placer dans la variable caract
(if (string= caract #\Newline) ;si caract contient Newline (donc si on a tapé Entrée)...
(setq chaine val-def) ;...la fonction rend val-def
(concatenate 'string (string caract) (string-downcase (string (read)))))) ;...sinon la fonction rend la chaine saisie entièrement
(defun o-ou-n-p (question)
"Affiche une question dont la réponse sera oui ou non, et attend une réponse:
rend T si la réponse est affirmative, NIL sinon."
(setq question (concatenate 'string question " ")) ;pour la présentation de l'affichage
(format t "~%~a" question) ;affichage de la question
(let ((rép (ignore-errors (read)))) ;attente de la réponse
(case rép ;traitement de la réponse
((o oui yes y ja) t)
((n non no nein) nil)
(t (princ "Répondez par oui ou non svp. ") (o-ou-n-p question))))) ;cas d'une réponse inattendue
;;;La fonction suivante permet de faciliter le travail.
;;;Attention: dans le cas où vous voulez ajouter une documentation (rép = 2), n'oubliez pas
;;;les guillemets, sinon le résultat sera très inattendu.
;;;Je vous laisse résoudre ce problème.
(defun gestion-doc-fr ()
"Cette fonction permet de choisir ce que vous voulez faire."
(format t "Quel fichier voulez-vous ouvrir? Par défaut: \"doc-fr-fonctions\" ~%")
(setq fich (read-default "doc-fr-fonctions"))
(format t "Sur quel package intervenez-vous? Par défaut: \"CL\" ~%")
(setq pack (string-upcase (read-default "cl")))
(accès-doc-fr fich)
(tagbody reprise
(format t "Choisissez une action parmi les suivantes:~%
1- Une documentation au hasard.~%
2- Ajouter une documentation.~%
3- Retirer une documentation.~%
4- Voir la documentation d'une fonction.~%
5- Sauvegarder vos saisies.~%") ;;;block
(do ((x 0 (1+ x))) ((> x 5))
(if (= x 5) (format t "Je vous conseille de sauvegarder vos saisies.~%"))
(format t "Tapez au choix: 1, 2, 3, 4 ou 5 --> ")
(let ((rép (ignore-errors (read))))
(case rép
(1 (format t "~a ~%" (ad pack)))
(2 (format t "Fonction: ") (setq clé (read)) (format t " Documentation (entre guillemets): ") (setq doc (read)) (afd (car (multiple-value-list (intern (string-upcase clé)))) doc))
(3 (format t "Fonction: ") (setq clé (read)) (rfd clé))
(4 (format t "Quelle fonction? ~%") (setq r (read)) (format t "~a ~%" (doc-de r)))
(5 (sauve-doc-fr fich))
(t (format t "Cette réponse n'est pas autorisée. ~%") (setq rép nil) (go reprise)))))
(if (o-ou-n-p "voulez-vous continuer ce travail?~%")
(go reprise)
(progn (sauve-doc-fr fich) (format t "Vous avez ~a fonctions définies en français dans votre fichier.~%" (length (voir-la-liste-complète))))))) ;sauvegarde automatique en fin de travail
;;;Pour afficher quelques explications:
(let ((flux (open "~/LISP/texte-doc-fr" :if-does-not-exist nil))) ;à modifier suivant le chemin du fichier.
(when flux
(loop for ligne = (read-line flux nil) ;itération pour chaque ligne lue ou fin de fichier (NIL)
while ligne do (format t "~a~%" ligne)) ;écriture tant que la fin de fichier n'est pas atteinte
(close flux))) ;fermeture du flux
(gestion-doc-fr)
;;;Fin du fichier
;;;Dateiende
Voici le fichier "texte-doc-fr":
Vous venez de charger le fichier \"docfr.lisp\". Cela vous permet de consulter de façon aléatoire
la documentation sur les fonctions exportables du package COMMON-LISP en français (si elle existe) ou
en anglais sinon.
Vous pouvez, si vous le voulez bien, traduire le texte en anglais pour étoffer le fichier en français.
Vous disposez des fonctions suivantes:
DOC-DE dont l'argument est une fonction (quotée). Cette fonction rend la documentation en français si elle existe.
sinon NIL.
AJOUTER-FONCTION-DOC ou AFD dont le 1er argument est une fonction (quotée) et le 2ème argument la documentation
en français sous forme d'une chaîne de caractères (donc entre guillemets).
RETIRER-FONCTION-DOC ou RFD dont l'argument est une fonction (quotée). Cette fonction permet de supprimer une documentation
du fichier (en cas d'erreur par exemple).
ALéA-DOC-DE ou AD dont l'argument est un package (:cl-user par exemple). Cette fonction affiche une documentation
d'une fonction tirée au hasard.
SAUVE-DOC-FR dont l'argument est le fichier de sauvegarde \"doc-fr-fonctions\". Attention de ne pas oublier cette
sauvegarde si vous modifiez le contenu.
Ces fonctions peuvent être utilisées à la volée, mais il est plus facile de gérer cela avec la fonction:
GESTION-DOC-FR qui est lancée au chargement du fichier DOCFR.LISP comme vous le constatez.
Vous devrez, fort probablement, modifier les chemins d'accès aux deux fichiers "docfr.lisp" et "texte-doc-fr" dans
les fonctions du fichier "docfr.lisp". Les lignes à modifier sont indiquées dans les commentaires.
Mieux! Vous pouvez sortir la variable *defaut-pathname-defaults* des fonctions et la définir selon le chemin que vous avez choisi.
Prenez alors le même chemin pour le fichier texte "texte-doc-fr" et, bien sûr, enregistrez vos deux fichiers dans le répertoire
qui se trouve au bout du chemin.
...Il faut bien que je vous fasse travailler un peu!
Si vous avez quitté la fonction gestion-doc-fr et que vous n'avez pas quitté SLIME-REPL, vous pouvez reprendre facilement ce travail.
Il suffit de taper: (gest et la touche de tabulation (dans EMACS) qui sert à la complétion, puis ) + ENTREE.
Je vous conseille d'utiliser Hyperspec et Google-traduction pour construire votre fichier.
Vous pouvez affiner la traduction dans Google-traduction pour que tout le monde en profite.
Avec quelques copier-coller votre documentation de fonctions prend forme petit à petit.
Si vous n'utilisez pas la fonction gestion-doc-fr qui est cependant bien pratique,
voilà ce que vous pouvez faire:
(accès-doc-fr "doc-fr-fonctions") ;pour lancer l'application
(doc-de 'car)
("rend le 1er objet de la liste.")
Si la doc de CAR est déjà dans le fichier évidemment!
(ajouter-fonction-doc 'cdr "Rend la liste sans son 1er objet.")
CDR
Pour ajouter la doc d'une fonction
(retirer-fonction-doc 'car)
CAR
Pour retirer la doc d'une fonction
Dans ce cas:
(doc-de 'car)
NIL
(ajouter-fonction-doc 'car "Rend le 1er objet de la liste.")
CAR
(doc-de 'car)
"Rend le 1er objet de la liste."
La fonction voir-liste-complète n'est pas conseillée si le fichier est volumineux (toutes les documentations vont s'afficher).
(cette fonction n'a pas besoin d'argument.)
La fonction aléa-doc-de avec comme argument :cl permet d'afficher la documentation d'une fonction de "COMMON-LISP"
en français si elle existe, sinon en anglais (à vous alors de proposer une traduction avec ajouter-fonction-doc).
Comme ces deux fonctions sont sensées être souvent utilisées, on peut se munir de deux raccourcis: ad et afd.
La fonctions retirer-fonction-doc permet de supprimer la documentation d'une fonction (raccourci: rfd).
Enfin, vous avez la fonction sauve-doc-fr qui permet de sauvegarder le fichier "doc-fr-fonctions" immédiatement.
Son argument peut être la variable globale fich.
Par sécurité, en répondant "non" à la question "voulez-vous continuez...?", une sauvegarde automatique est effectuée.
Comme le fichier doit exister au départ, on peut, au début, construire la liste de fermetures de cette façon:
(setq fonction-doc (make-alist-fonctions ((a . b) (c . d))))
Il suffira par la suite de retirer les clé a et c, juste avant de sauvegarder les nouvelles clés.
________________________
ASSOC-IF:
ASSOC-IF-NOT:
(assoc-if #'(lambda (x) (string> x "a")) '(("a" . 1) ("b" . 2)))
("b" . 2)
rend le 1er couple pointé qui vérifie la condition
(assoc-if-not #'(lambda (x) (string> x "a")) '(("a" . 1) ("b" . 2)))
("a" . 1)
idem
RASSOC:
Rappel:
alist
((D . 35) (A . 30) (A . 1) (B . 25) (C . 3)) Vous pouvez redéfinir cette alist si vous l'avez perdue.
(rassoc 30 alist)
(A . 30)
rend le 1er couple pointé dont la valeur (CDR) est passée en argument
RASSOC-IF:
RASSOC-IF-NOT:
(rassoc-if #'evenp alist)
(A . 30)
rend le 1er couple pointé dont la valeur (CDR) est paire
(rassoc-if-not #'(lambda (x) (>= x 30)) alist)
(A . 1)
rend le 1er couple pointé dont la valeur n'est pas supérieure ou égale à 30
COPY-ALIST:
(copy-alist alist)
((D . 35) (A . 30) (A . 1) (B . 2) (C . 3))
rend une copie de la alist
PAIRLIS:
(pairlis '(a b c) '(1 2 3))
((C . 3) (B . 2) (A . 1))
construit une alist à partir d'une liste de clés et d'une liste de valeurs
(reverse (pairlis '(a b c) '(1 2 3)))
((A . 1) (B . 2) (C . 3))
pour avoir la alist dans l'ordre initial des clés
Une plist est une simple liste où clés et valeurs alternent: (A 1 B 2 C 3), par exemple.
Il n'y a qu'une seule fonction fondamentale supportée par la plist: GETF.
Le test par défaut est EQ et non EQL. En conséquence, les clés de plist ne doivent pas être des nombres ou des caractères.
L'exemple, plus bas, montre des plistes qui semblent accepter des nombres comme clés.
GETF:
(getf '(a 1 b 2 c 3) 'a)
1
rend la valeur qui suit la clé A
(defparameter *plist* ())
*PLIST*
définit une plist vide
*plist*
NIL
(setf (getf *plist* :a) 1)
1
C'est le premier argument de SETF qui est traité comme la place à modifier
*plist*
(:A 1)
(setf (getf *plist* :a) 2)
2
la valeur de la clé est changée
*plist*
(:A 2)
(setf (getf *plist* :b) 3)
3
une nouvelle clé et une nouvelle valeur sont placées devant la plist
*plist*
(:B 3 :A 2)
____________________
Pour savoir la date et l'heure de ce jour en ce lieu, on utilise, ici, deux plists: *pjour* et *pmois*.
(let ((*pjour* '(0 lundi 1 mardi 2 mercredi 3 jeudi 4 vendredi 5 samedi 6 dimanche))
(*pmois* '(1 janvier 2 février 3 mars 4 avril 5 mai 6 juin 7 juillet 8 août 9 septembre 10 octobre 11 novembre 12 décembre)))
(multiple-value-bind (secondes minutes heures date mois année jour) (get-decoded-time)
(format t "Il est ~a heures ~a minutes ~a secondes.~%" heures minutes secondes)
(format t "Nous sommes le ~(~a~) ~a ~(~a~) ~a.~%" (getf *pjour* jour) date (getf *pmois* mois) année)))
Il est 19 heures 34 minutes 37 secondes.
Nous sommes le dimanche 12 avril 2015.
NIL
____________________
REMF:
(utilise, comme GETF, EQ pour comparer les clés)
(remf *plist* :a)
T
supprime la clé :a ...
*plist*
(:B 3)
...et sa valeur!
GET-PROPERTIES:
prend en argument une plist et une liste de clés
si *plist* vaut (:c 7 :b 3):
(get-properties *plist* '(:b :c))
:C
rend la première clé trouvée dans la plist, parmi celles proposées
7
rend, aussi, sa valeur
(:C 7 :B 3)
et la sous-plist à partir de cette clé trouvée
Les plists ont des relations particulières avec les symboles: chaque symbole est associé à une plist utilisée pour garder des informations concernant ce symbole.
(Cela semble aussi fonctionner sur des nombres: essayez!)
(setf (get 'info :b) "information sur :b")
"information sur :b"
définit une info sur le symbole :b
(setf (get 'info :c) "information sur :c")
"information sur :c"
définit une info sur le symbole :c
(symbol-plist 'info)
(:C "information sur :c" :B "information sur :b")
rend la plist donnant pour chaque symbole son info
(get 'info :c)
"information sur :c"
rend l'info pour le symbole :c
(ou bien: (getf (symbol-plist 'info) :c))
(remprop 'info :c)
(:C "information sur :c" :B "information sur :b")
supprime l'info concernant le symbole :c
(ou bien: (remf (symbol-plist 'info) :c))
(get 'info :c)
NIL
en effet, il n'y a plus d'info sur :c
DESTRUCTURING-BIND:
(macro)
(destructuring-bind (x y z) (list 1 2 3) (list :x x :y y :z z))
(:X 1 :Y 2 :Z 3)
rend une plist dont les clés sont :x :y :z et les valeurs 1 2 3 respectivement
(destructuring-bind (x y z) (list 1 (list 2 20) 3) (list :x x :y y :z z))
(:X 1 :Y (2 20) :Z 3)
rend une plist dont les clés sont :x :y :z et les valeurs 1 (2 20) 3
(destructuring-bind (x (y1 y2) z) (list 1 (list 2 20) 3) (list :x x :y1 y1 :y2 y2 :z z))
(:X 1 :Y1 2 :Y2 20 :Z 3)
rend une plist dont les clés sont :x :y1 :y2 :z et les valeurs 1 2 20 3
(destructuring-bind (x (y1 &optional y2) z) (list 1 (list 2 20) 3) (list :x x :y1 y1 :y2 y2 :z z))
(:X 1 :Y1 2 :Y2 20 :Z 3)
même chose, mais la valeur de y2 est optionnelle:
(destructuring-bind (x (y1 &optional y2) z) (list 1 (list 2) 3) (list :x x :y1 y1 :y2 y2 :z z))
(:X 1 :Y1 2 :Y2 NIL :Z 3)
ici, :y2 n'a pas de valeur
(destructuring-bind (&key a b c) (list :a 1 :b 2 :c 3) (list :x a :y b :z c))
(:X 1 :Y 2 :Z 3)
(destructuring-bind (&key a b c) (list :a 1 :c 3) (list :x a :y b :z c))
(:X 1 :Y NIL :Z 3)
(destructuring-bind (&key a b c) (list :c 1 :b 2 :a 3) (list :x a :y b :z c))
(:X 3 :Y 2 :Z 1)
&whole:
un autre paramètre.
(destructuring-bind (&whole whole &key a b c) (list :c 1 :b 2 :a 3) (list :x a :y b :z c :whole whole))
(:X 3 :Y 2 :Z 1 :WHOLE (:C 1 :B 2 :A 3))
Bientôt: "Les FICHIERS et les ENTREES/SORTIES: (input/output:)".
