4 Génération
Où programmes se transmuteront en compilateurs et
compilateurs en psychologues.
Le filtrage: le retour
Exercice 35 : Plutôt que d'être interprété par la fonction filtrer3
(cf. exercice 20).
le filtre (foo ?- bar) pourrait être transformé en une
fonction réalisant le même effet. On demande donc de réaliser
une curryfication de filtrer3 sur son filtre.
Par exemple:
? (TRANSFORMER-FILTRE5 '(FOO ?- BAR ... HUX))
= #<a Function>
? ((TRANSFORMER-FILTRE5 '(FOO ?- BAR ... HUX))
'(FOO 5 BAR HUX))
= #T
? ((TRANSFORMER-FILTRE5 '(FOO ?- BAR ... HUX))
'(FOO 5 BAR 7 4 5 HUX))
= #T
? ((TRANSFORMER-FILTRE5 '(FOO ?- BAR ... HUX))
'(FOO . BAR))
= #F
(define (filtrer3-curryfiee filtre)
(lambda (expression)
(filtrer3 expression filtre) ) )
Solution de l'exercice 35 :
;;;
(define (transformer-filtre5 filtre)
(define (transformer-liste filtres)
(if (pair? filtres)
(if (equal? (car filtres) '...)
(let ((filtre-cdr (transformer-liste (cdr filtres))))
(letrec ((filtre
(lambda (expressions)
(or (filtre-cdr expressions)
(and (pair? expressions)
(filtre (cdr expressions)) ) ) ) ) )
filtre ) )
(let ((filtre-car (transformer-filtre5 (car filtres)))
(filtre-cdr (transformer-filtre5 (cdr filtres))) )
;;
(lambda (expressions)
(and (pair? expressions)
(filtre-car (car expressions))
(filtre-cdr (cdr expressions)) ) ) ) )
(lambda (expressions) (equal? expressions filtres)) ) )
(if (equal? filtre '?-)
(lambda (expression) #t)
(if (equal? filtre '...)
(lambda (expression)
(error 'transformer-filtre5 "... ne peut survenir ici") )
(if (pair? filtre)
(transformer-liste filtre)
(lambda (expression) (equal? filtre expression)) ) ) ) )
Exercice 36 : Plutôt que d'être interprété par la fonction
filtrer3, le filtre
(foo ?- bar) pourrait être compilé en un
code équivalent. Par exemple:
? (PP (COMPILER-FILTRER3 '(FOO ?- BAR)))(LAMBDA (EXPRESSION)
(AND (PAIR? EXPRESSION)
(EQUAL? (CAR EXPRESSION) 'FOO)
(AND (PAIR? (CDR EXPRESSION))
#t
(AND (PAIR? (CDR (CDR EXPRESSION)))
(EQUAL? (CAR (CDR (CDR EXPRESSION))) 'BAR)
(EQUAL? (CDR (CDR (CDR EXPRESSION))) '())))))
Concevoir la fonction compiler-filtrer3 réalisant cet effet.
On pourra dans un premier temps ne pas traiter le trou extensible.
Solution de l'exercice 36 : Observez que c'est un saupoudrage d'accents graves ou aigus et de virgules.
;;;
(define (compiler-filtrer3 filtre)
(define (filtrer3-liste expressions filtres)
(if (pair? filtres)
(if (equal? (car filtres) '...)
(let ((loop (gensym))
(e (gensym)) )
`(let ,loop ((,e ,expressions))
(or ,(filtrer3-liste e (cdr filtres))
(and (pair? ,e)
(,loop (cdr ,e)) ) ) ) )
`(and (pair? ,expressions)
,(filtrer3 `(car ,expressions) (car filtres))
,(filtrer3-liste `(cdr ,expressions) (cdr filtres)) ) )
`(equal? ,expressions ',filtres) ) )
(define (filtrer3 expression filtre)
(if (equal? filtre '?-)
'#t
(if (equal? filtre '...)
`(error 'filtrer3 "... ne peut survenir ici")
(if (pair? filtre)
(filtrer3-liste expression filtre)
`(equal? ,expression ',filtre) ) ) ) )
`(lambda (expression) ,(filtrer3 'expression filtre)) )
Exercice 37 : Ajouter à la fonction filtrer3 le filtre *or qui permet
d'exprimer un choix de filtres. Par exemple:
? (FILTRER4 '(B) '((*OR A B)))
Solution de l'exercice 37 :
;;;
(define (filtrer4 expression filtre)
(define (filtrer4-liste expressions filtres)
(if (pair? filtres)
(if (equal? (car filtres) '...)
(or (filtrer4-liste expressions (cdr filtres))
(and (pair? expressions)
(filtrer4-liste (cdr expressions) filtres) ) )
(and (pair? expressions)
(filtrer4 (car expressions) (car filtres))
(filtrer4-liste (cdr expressions) (cdr filtres)) ) )
(equal? expressions filtres) ) )
(define (filtrer4-or expression filtres)
(if (pair? filtres)
(or (filtrer4 expression (car filtres))
(filtrer4-or expression (cdr filtres)) )
#f ) )
(or (equal? filtre '?-)
(if (equal? filtre '...)
(error 'filtrer4 "... ne peut survenir ici") )
(if (pair? filtre)
(if (equal? (car filtre) '*or)
(filtrer4-or expression (cdr filtre))
(filtrer4-liste expression filtre) )
(equal? expression filtre) ) ) )
Exercice 38 : Ajouter la précédente fioriture au compilateur déjà
réalisé (compiler-filtre3). Par exemple:
? (PP (COMPILER-FILTRER4 '(... (*OR PERE MERE) ...)))(LAMBDA (EXPRESSION)
(LET g1120 ((g1119 EXPRESSION))
(OR (AND (PAIR? g1119)
(OR (EQUAL? (CAR g1119) 'PERE)
(OR (EQUAL? (CAR g1119) 'MERE) #f))
(LET g1122 ((g1121 (CDR g1119)))
(OR (EQUAL? g1121 '())
(AND (PAIR? g1121) (g1122 (CDR g1121))))))
(AND (PAIR? g1119) (g1120 (CDR g1119))))))
Solution de l'exercice 38 :
;;;
(define (compiler-filtrer4 filtre)
(define (filtrer4-liste expressions filtres)
(if (pair? filtres)
(if (equal? (car filtres) '...)
(let ((loop (gensym))
(e (gensym)) )
`(let ,loop ((,e ,expressions))
(or ,(filtrer4-liste e (cdr filtres))
(and (pair? ,e)
(,loop (cdr ,e)) ) ) ) )
`(and (pair? ,expressions)
,(filtrer4 `(car ,expressions) (car filtres))
,(filtrer4-liste `(cdr ,expressions) (cdr filtres)) ) )
`(equal? ,expressions ',filtres) ) )
(define (filtrer4-or expression filtres)
(if (pair? filtres)
`(or ,(filtrer4 expression (car filtres))
,(filtrer4-or expression (cdr filtres)) )
'#f ) )
(define (filtrer4 expression filtre)
(if (equal? filtre '?-)
'#t
(if (equal? filtre '...)
`(error 'filtrer4 "... ne peut survenir ici")
(if (pair? filtre)
(if (equal? (car filtre) '*or)
(filtrer4-or expression (cdr filtre))
(filtrer4-liste expression filtre) )
`(equal? ,expression ',filtre) ) ) ) )
`(lambda (expression) ,(filtrer4 'expression filtre)) )
Recherche de motifs
La technique de Boyer-Moore est à la base d'algorithmes rapides de
recherche d'un mot dans une phrase. Pour chercher le mot babar,
on recherche d'abord la lettre r. Si la lettre correspondante du
texte est un r, on teste les précédentes (de la droite vers la
gauche). Si la lettre n'est pas un r mais, par exemple, un z
alors, comme z n'apparaît pas dans le mot babar on peut
se décaler dans le texte de cinq positions et recommencer.
Exercice 39 : Écrire la fonction boyer-moore qui prend un motif et un texte
et retourne le segment terminal de texte commençant par motif ou
#f si motif n'apparaît pas dans texte. Par exemple:
(boyer-moore '(b a b a r)
'(e n c o r e - g a b a r i t - b a b a r - f u t - g r a n d) )
® (b a b a r - f u t - g r a n d)
Ce calcul induit les comparaisons que montre le schéma suivant:
e n c o r e - g a b a r i t - b a b a r - f u t - g r a n d
. . . . r r Î babar
. . . o r o Ï babar, decalage de 5
. . . . r b Ï babar, decalage de 2
. . . . r
. . . a r
. . b a r
. a b a r
g a b a r g Ï babar, decalage de 5
. . . . r a Î babar, decalage de 1
. . . . r b Î babar, decalage de 2
. . . . r
Pour simplifier, le décalage à effectuer ne sera fonction que de la lettre
provoquant l'échec.
Solution de l'exercice 39 :
(define (boyer-moore motif texte)
(let ((fitom (reverse motif)))
(define (bm lettres longueur texte)
(if (pair? lettres)
(if (>= (length texte) longueur)
(let ((lettre-en-regard (list-ref texte longueur)))
(if (equal? (car lettres) lettre-en-regard)
(bm (cdr lettres) (- longueur 1) texte)
(let ((n (decalage lettre-en-regard lettres)))
(bm fitom (- (length motif) 1) (list-tail texte n)) ) ) )
#f )
texte ) )
(bm fitom (- (length motif) 1) texte) ) )
;;;;;;;;;;;;;;;;
(define (decalage lettre fitom)
(define (calcul lettre fitom resultat)
(if (and (pair? fitom)
(not (equal? lettre (car fitom))) )
(calcul lettre (cdr fitom) (+ 1 resultat))
resultat ) )
(calcul lettre fitom 0) )
Exercice 40 : Écrire une fonction prenant un motif et retournant la définition
d'une fonction qui attendra un texte et cherchera la première
occurrence du motif en lui. On s'attachera à précalculer ce que
l'on peut déduire du motif. Voici un exemple (il va de soi que l'on
peut mieux exploiter le motif):
? (PP (COMPILER-BOYER-MOORE '(B A B A R)))(LAMBDA (TEXTE)
(LET CBMF ((TEXTE TEXTE))
(IF (>= (LENGTH TEXTE) 5)
(CASE (LIST-REF TEXTE 4)
((R)
(CASE (LIST-REF TEXTE 3)
((A)
(CASE (LIST-REF TEXTE 2)
((B)
(CASE (LIST-REF TEXTE 1)
((A)
(CASE (LIST-REF TEXTE 0)
((B) TEXTE)
(ELSE (CBMF (LIST-TAIL TEXTE 5)))))
((B) (CBMF (LIST-TAIL TEXTE 2)))
(ELSE (CBMF (LIST-TAIL TEXTE 5)))))
((A) (CBMF (LIST-TAIL TEXTE 1)))
(ELSE (CBMF (LIST-TAIL TEXTE 5)))))
((B) (CBMF (LIST-TAIL TEXTE 2)))
(ELSE (CBMF (LIST-TAIL TEXTE 5)))))
((A) (CBMF (LIST-TAIL TEXTE 1)))
((B) (CBMF (LIST-TAIL TEXTE 2)))
(ELSE (CBMF (LIST-TAIL TEXTE 5))))
#f)))
Solution de l'exercice 40 :
(define (compiler-boyer-moore motif)
(define (cbm motif texte)
(let ((fitom (reverse motif)))
(define (ibm lettres texte)
(if (pair? lettres)
`(case (list-ref ,texte ,(- (length lettres) 1))
((,(car lettres))
,(ibm (cdr lettres) texte) )
,@(let enum ((lettres (cdr lettres))
(dejavues (list (car lettres))) )
(if (pair? lettres)
(if (member (car lettres) dejavues)
(enum (cdr lettres) dejavues)
`(((,(car lettres))
(cbmf (list-tail
,texte
,(decalage (car lettres) fitom))) )
,@(enum (cdr lettres)
(cons (car lettres) dejavues) ) ) )
`((else (cbmf (list-tail ,texte ,(length motif))))) ) ) )
texte ) )
`(let cbmf ((,texte ,texte))
(if (>= (length texte) ,(length motif))
,(ibm fitom texte)
#f ) ) ) )
`(lambda (texte)
,(cbm motif 'texte) ) )
De l'abréviation comme l'un des beaux-arts
Exercice 41 : Écrire une macro, nommée ifn, telle que
(ifn a b g) soit équivalente à
(if (not a) b g) (on peut faire mieux).
Dans un deuxième temps, adapter la solution afin de rendre
g optionnel ou prenant un nombre quelconque de formes.
Par exemple
? (IFN (= 1 1) 2 3)
= 3
? (IFN2 (= 1 1) 2 3 4)
= 4 ;
? (IFN2 (= 1 2) 3)
= 3
Solution de l'exercice 41 : La version suivante évite la capture éventuelle de la variable
not.
;;;
(define-macro (ifn condition alors sinon)
`(if ,condition ,sinon ,alors) )
(define-macro (ifn2 condition alors . sinon)
(if (pair? sinon)
`(if ,condition (begin . ,sinon) ,alors)
`(if (not ,condition) ,alors) ) )
Exercice 42 : Écrire une macro (yf a b g) telle que
a est tout d'abord évaluée. Si sa valeur est non fausse, ce
doit être une fonction et la valeur de la forme yf est la
valeur de cette fonction appliquée à b sinon c'est la valeur
de g. Par exemple:
? (YF CAR '(1 2) 3)
= 1
? (YF (= 1 2) '(1 2) 3)
= 3
Solution de l'exercice 42 : On fera attention aux environnements où les calculs doivent être
effectués.
(define-macro (yf condition alors sinon)
`(let ((condition ,condition)
(alors (lambda () ,alors))
(sinon (lambda () ,sinon)) )
(if condition
(condition (alors))
(sinon) ) ) )
Exercice 43 : Étudier le programme suivant (connu sous le nom d'Eliza ou doctor et
présent en de nombreux endroits, notamment sous Emacs) et dont
voici une illustration:
? (Freud)
Allongez-vous et causons.
(je me sens si fatigue actuellement)
Racontez-moi cela en detail.
(vous etes de la police ?)
Parlez-moi plutot de vous.
(c est a cause de ma mere)
Comment s'est deroule votre enfance ?
(cela n a pas de rapport)
Je ne vous comprend pas tres bien.
(vous etes stupide)
Parlez-moi plutot de vous.
(pourquoi)
Soyez plus explicite.
(pourquoi voulez vous savoir)
Je ne vous comprend pas tres bien.
(au revoir)
L'important, c'est de vouloir guerir ...
Cela vous fera 376 francs.
La fonction Freud et les comportements sont ainsi définis:
;;;
(define (Freud)
(define (repondre phrase base)
(if (pair? base)
(let ((filtre (caar base))
(reponse (cdar base)) )
(if (filtre phrase)
(reponse phrase)
(repondre phrase (cdr base)) ) )
(begin (display "Je ne vous comprend pas tres bien.")
(newline)
#t ) ) )
(define (au-revoir n)
(display "L'important, c'est de vouloir guerir ...")(newline)
(display "Cela vous fera ")
(display (* n 47))
(display " francs.") )
(display "Allongez-vous et causons.")(newline)
(let analyse ((e (read))(n 1))
(if (eof-object? e)
(au-revoir n)
(if (repondre e comportement-de-Freud)
(analyse (read) (+ 1 n))
(au-revoir n) ) ) ))
(define comportement-de-Freud '())
(define-macro (definir-comportement filtre . comportement)
`(begin
(set! comportement-de-Freud
(cons (cons ,(compiler-filtrer4 filtre)
(lambda (phrase) . ,comportement) )
comportement-de-Freud ) )
'OK ) )
(definir-comportement
(*or (au revoir) (adieu))
#f ) ;
(definir-comportement
((*or j je) ... (*or deprime fatigue) ...)
(display "Racontez-moi cela en detail.")
(newline)
#t ) ;
(definir-comportement
((*or vous tu) ...)
(display "Parlez-moi plutot de vous.")
(newline)
#t )
(definir-comportement
(?-)
(display "Soyez plus explicite.")
(newline)
#t )
(definir-comportement
(... (*or pere mere) ...)
(display "Comment s'est deroule votre enfance ?")
(newline)
#t )
On demande d'abstraire ce programme de manière à pouvoir créer
simplement des psychologues différents. On s'attachera à définir
une fonction creer-psychologue et une macro de définition de
comportements qui s'emploiera comme suit:
(define-psychologue Freud
(definir-comportement motif
réaction )
... )
Enfin on crééra, de toute pièce, un nouveau psychologue.
Solution de l'exercice 43 : On pourrait paramétrer aussi le tarif, la phrase initiale, la phrase
finale etc.
(define (creer-psychologue comportement)
(define (repondre phrase base)
(if (pair? base)
(let ((filtre (caar base))
(reponse (cdar base)) )
(if (filtre phrase)
(reponse phrase)
(repondre phrase (cdr base)) ) )
;;
#f ) )
(define (au-revoir n)
(display "Cela vous fera ")
(display (* n 47)) ;
(display " francs.") )
(lambda ()
(display "Allongez-vous et causons.")(newline)
(let analyse ((e (read))(n 1))
(if (eof-object? e)
(au-revoir n)
(if (repondre e comportement)
(analyse (read) (+ 1 n))
(au-revoir n) ) ) ) ) )
(define-macro (definir-psychologue nom . comportements)
`(define ,nom
(creer-psychologue
(list ,@comportements) ) ) )
(define-macro (definir-comportement filtre . comportement)
`(begin
(set! comportement-de-Freud
(cons (cons ,(compiler-filtrer4 filtre)
(lambda (phrase) . ,comportement) )
comportement-de-Freud ) )
'OK ) )
Et voici un psychologue rudimentaire:
(definir-psychologue Dumbkopf
(definir-comportement (... Freud ...)
(display "Sortez immediatement de mon cabinet!")
(newline)
#f )
(definir-comportement (...)
(display "Pouvez-vous repeter?")
(newline)
#t ) )