3 Fonctionnelles
Où l'on verra à l'oeuvre des fonctions manipulant des
fonctions et en synthétisant de nouvelles.
Exercice 21 : Concevoir une représentation fonctionnelle des listes
d'associations. Une première fonction représente la A-liste vide,
une seconde permet d'étendre une A-liste avec un nouveau couple,
enfin on peut scruter une A-liste par sa représentation même.
Par exemple:
? (DEFINE AL (NULL-A-LISTE))
= AL
? (SET! AL (EXTEND-A-LISTE AL 'ONE 1))
? (SET! AL (EXTEND-A-LISTE AL 'ZERO 0))
? (AL 'ONE)
= 1
? ((EXTEND-A-LISTE AL 'ONE 10) 'ONE)
= 10
Solution de l'exercice 21 :
;;;
(define (null-A-liste)
(lambda (element) #f) )
(define (extend-A-liste al clef valeur)
(lambda (element)
(if (equal? clef element)
valeur
(al element) ) ) )
Exercice 22 : Modifier la représentation précédente pour que la propriété
(eq? (null-A-liste) (null-A-liste)) soit vraie.
Solution de l'exercice 22 : On met simplement en facteur le résultat qui est une fonction
n'enclosant aucune variable libre.
(define null-A-liste-commune
(let ((f (lambda (element) #f)))
(lambda () f) ) )
Variations autour de composition
Exercice 23 : Définir la fonction compose qui prend deux fonctions (disons
f et g) en arguments et retourne la fonction unaire appliquant f
puis g. Par exemple:
? (DEFINE KADR (COMPOSE CDR CAR))
= KADR
? (KADR '(A B C))
= B
Solution de l'exercice 23 :
(define (compose f g)
(lambda (x) (g (f x))) )
Exercice 24 : Étendre la fonction compose pour composer une fonction f
prenant un nombre quelconque d'arguments avec une fonction unaire g.
Par exemple:
? (DEFINE LIST-LENGTH (NCOMPOSE LIST LENGTH))
= LIST-LENGTH
? (LIST-LENGTH 1 'B "c")
= 3
Solution de l'exercice 24 :
(define (ncompose f g)
(lambda arguments
(g (apply f arguments)) ) )
Exercice 25 : Étendre encore la fonction compose pour composer un nombre
quelconque de fonctions unaires. Par exemple:
? (DEFINE KADDDR (COMPOSE-N CDR CDR CDR CAR))
= KADDDR
? (KADDDR '(A B C D E))
= D
Solution de l'exercice 25 :
(define (compose-n . fns)
(lambda (x)
((reduce compose (lambda (x) x) fns) x) ) )
Discrétisation et extension de domaine
Exercice 26 :
Il est parfois utile, dans les jeux vidéos, de pouvoir calculer
rapidement des lignes trigométriques. Une façon simple de faire
est de précalculer (tabuler) les lignes dont on aura besoin. On
utilisera des vecteurs pour représenter ces tables et non les
Alistes précédentes.
Écrire la fonctionnelle faire-sinus qui prend en argument le pas
de discrétisation et retourne une fonction équivalente à sinus,
cette dernière retournera pour tout nombre le sinus précalculé
approché. Pour simplifier, on supposera que les nombres dont on
prend le sinus sont compris entre 0 et p/2. L'exemple suivant
discrétise la fonction sinus en 5 intervalles, soit 6 valeurs.
? (DEFINE SINUS1 (FAIRE-SINUS 5))
= SINUS1
? (SINUS1 0)
= 0.0
? (SINUS1 (/ PI 8))
= 0.30901699436641
? (SINUS1 (/ PI 5))
= 0.58778525227794
? (SINUS1 (/ PI 4))
= 0.58778525227794 ;
? (SINUS1 (/ PI 3))
= 0.80901699435911
? (SINUS1 (/ PI 2))
= 1.0
? (DESSINER SINUS1 0 (/ PI 2) (/ PI 10) 0 1 40)* 0=>0.0
* 0.31415926535=>0.30901699436641
* 0.6283185307=>0.58778525227794
* 0.94247779605=>0.80901699435911
* 1.2566370614=>0.95105651628405
* 1.57079632675=>1.0
= #<a Function>
Solution de l'exercice 26 :
(define (faire-sinus nombre)
(let ((pas (/ pi (* 2 nombre)))
(table (make-vector (+ nombre 1) 0.0)) )
(do ((i 0 (+ 1 i)))
((>= i nombre) (vector-set! table nombre 1.0))
(vector-set! table i (sin (* pas i))) )
(lambda (x)
(vector-ref table (inexact->exact (floor (/ x pas)))) ) ) )
Exercice 27 : La fonction sinus précédente n'était valide qu'entre 0 et
p/2. Concevez une fonctionnelle prenant une fonction définie sur
un intervalle [a ... b[ et l'étendant à la manière d'un
sinus sur un intervalle quatre fois plus grand.
Voici un exemple sur une rampe linéaire.
? (DEFINE F4 (ETENDRE (LAMBDA (X) (- X)) 0 1))
= F4
? (DESSINER F4 0 4 (/ 1 5) -1 1 40) * 0=>0
* 0.2=>-0.2
* 0.4=>-0.4
* 0.6=>-0.6
* 0.8=>-0.8
* 1.0=>-1.0
* 1.2=>-0.8
* 1.4=>-0.6
* 1.6=>-0.4
* 1.8=>-0.2
* 2.0=>-2.2204460492503e-16
* 2.2=>0.2
* 2.4=>0.4
* 2.6=>0.6
* 2.8=>0.8
* 3.0=>1.0
* 3.2=>0.8
* 3.4=>0.6
* 3.6=>0.4
* 3.8=>0.2
= #<a Function>
Solution de l'exercice 27 :
(define (etendre fonction debut fin)
(let* ((empan (- fin debut))
(deux-empans (* 2 empan))
(milieu (+ fin empan)) )
(lambda (x)
(if (< x milieu)
(if (< x fin)
(fonction x)
(fonction (- milieu x)) )
(if (< x (+ milieu empan))
(- (fonction (- x milieu)))
(- (fonction (- (+ milieu deux-empans) x))) ) ) ) ) )
Exercice 28 : Un dernier effort suffira maintenant à rendre sinus1 apte à prendre
tout nombre flottant. Concevoir une fonctionnelle prenant une fonction
périodique définie sur un intervalle et retournant une nouvelle
fonction définie partout. Par exemple:
? (DEFINE SINUS
(ITERER (ETENDRE SINUS1 0 (/ PI 2)) 0 (* 2 PI)))
= SINUS
? (SINUS (- (/ PI 4)))
= -0.58778525227794
? (SINUS (- (/ PI 4) (* 6 PI)))
= 0.58778525227794
? (DESSINER SINUS 0 (* 3 PI) (/ PI 10) -1 1 40) * 0=>0.0
* 0.31415926535=>0.30901699436641
* 0.6283185307=>0.58778525227794
* 0.94247779605=>0.80901699435911
* 1.2566370614=>0.95105651628405
* 1.57079632675=>1.0
* 1.8849555921=>0.95105651628405
* 2.19911485745=>0.80901699435911
* 2.5132741228=>0.58778525227794
* 2.82743338815=>0.30901699436641
* 3.1415926535=>0.0
* 3.45575191885=>0.0
* 3.7699111842=>-0.30901699436641
* 4.08407044955=>-0.58778525227794
* 4.3982297149=>-0.80901699435911
* 4.71238898025=>-0.95105651628405
* 5.0265482456=>-0.95105651628405
* 5.34070751095=>-0.80901699435911
* 5.6548667763=>-0.58778525227794
* 5.96902604165=>-0.30901699436641
* 6.283185307=>0.0
* 6.59734457235=>0.0
* 6.9115038377=>0.30901699436641
* 7.22566310305=>0.58778525227794
* 7.5398223684=>0.80901699435911
* 7.85398163375=>0.95105651628405
* 8.1681408991=>0.95105651628405
* 8.48230016445=>0.80901699435911
* 8.7964594298=>0.58778525227794
* 9.11061869515=>0.30901699436641
* 9.4247779605=>0.0
= #<a Function>
Solution de l'exercice 28 :
(define (iterer fonction debut fin)
(let ((empan (- fin debut)))
(lambda (x)
(let* ((f (/ (- x debut) empan))
(r (- (- x debut) (* (floor f) empan))) )
(fonction r)) ) ) )
Exercice 29 :
Écrire une fonction dessinant sinus et autres fonctions de ce
genre. On pourra s'inspirer de la fonction dessiner des exemples
précédents. Elle a pour interface:
(define (dessiner fonction ;
;;
debut ;
fin ;
pas ;
;;
min ;
max ;
ligne ;
) ... )
Solution de l'exercice 29 :
(define (dessiner fonction debut fin pas min max ligne)
(define (display-star y)
(let ((n (inexact->exact (* ligne (/ (- y min) (- max min))))))
(do ((i 0 (+ 1 i)))
((> i ligne)(display " "))
(if (= i n) (display "*") (display " ")) ) ) )
(do ((x debut (+ x pas)))
((> x fin) fonction)
(let ((y (fonction x)))
(display-star y)
;;
(display x)
(display "=>")
(display y)
(newline) ) ) )
Exercice 30 : Plutôt que d'avoir écrit faire-sinus, comme à l'exercice
26, et parce que l'on
dispose de la fonction prédéfinie sin, on pourrait
écrire une fonction de discrétisation. Par exemple:
? (DEFINE SINUS0 (DISCRETISER SIN 0 (/ PI 2) 10))
= SINUS0
? (DESSINER SINUS0 0 (/ PI 2) (/ PI 30) 0 1 40)* 0=>0.0
* 0.10471975511667=>0.0
* 0.20943951023333=>0.1564344650358
* 0.31415926535=>0.30901699436641
* 0.41887902046667=>0.30901699436641
* 0.52359877558333=>0.45399049972755
* 0.6283185307=>0.58778525227794
* 0.73303828581667=>0.58778525227794
* 0.83775804093333=>0.70710678117067
* 0.94247779605=>0.80901699435911
* 1.0471975511667=>0.80901699435911
* 1.1519173062833=>0.8910065241741
* 1.2566370614=>0.95105651628405
* 1.3613568165167=>0.95105651628405
* 1.4660765716333=>0.98768834058882
= #<a Function>
Solution de l'exercice 30 :
(define (discretiser fonction debut fin nombre)
(let ((pas (/ (- fin debut) nombre))
(table (make-vector (+ nombre 1) 0.0)) )
(do ((i 0 (+ 1 i)))
((>= i nombre))
(vector-set! table i (fonction (+ debut (* pas i)))) )
(vector-set! table nombre (fonction fin))
(lambda (x)
(vector-ref table (inexact->exact (floor (/ (- x debut) pas)))) ) ) )
On remarquera que faire-sinus peut se redéfinir avec
discretiser.
(define (faire-sinus-avec-discretiser nombre)
(discretiser sin 0 (/ pi 2) nombre) )
Exercice 31 : Plutôt que d'indiquer le pas de discrétisation, autant le faire
calculer pour que l'erreur n'excède pas une certaine valeur.
Écrire la fonction discretiser2 telle que dans l'exemple
suivant l'erreur de discrétisation soit inférieure à 1/10.
? (DEFINE SINUS00
(ITERER
(ETENDRE
(DISCRETISER2 SIN 0 (/ PI 2) (/ 1 10))
0
(/ PI 2))
0
(* 2 PI)))
= SINUS00
? (DESSINER SINUS00 0 (/ PI 2) (/ PI 31) 0 1 40)* 0=>0.0
* 0.1013416985=>0.098017140326768
* 0.202683397=>0.19509032201062
* 0.3040250955=>0.29028467724641
* 0.405366794=>0.38268343235472
* 0.5067084925=>0.47139673681362
* 0.608050191=>0.5555702330056
* 0.7093918895=>0.63439328414846
* 0.810733588=>0.70710678117067
* 0.9120752865=>0.77301045334672
* 1.013416985=>0.83146961228696
* 1.1147586835=>0.8819212643338
* 1.216100382=>0.9238795324984
* 1.3174420805=>0.95694033572162
* 1.418783779=>0.98078528039557
* 1.5201254775=>0.99518472666807
= #<a Function>
Solution de l'exercice 31 : Seize pas sufffisent pour sinus00.
(define (discretiser2 fonction debut fin erreur)
(let essayer ((nombre-de-pas 2))
(let ((df (discretiser fonction debut fin nombre-de-pas))
(pas (/ (- fin debut) nombre-de-pas)) )
(define (verifier-erreur i fi)
(or (>= i fin)
(let* ((i+1 (+ i pas))
(fi+1 (df i+1)) )
(and (<= (abs (- fi+1 fi)) erreur)
(verifier-erreur i+1 fi+1) ) ) ) )
(if (verifier-erreur debut (df debut))
df
(essayer (+ nombre-de-pas 1)) ) ) ) )
Exercice 32 : La fonction cosinus n'est guère qu'un sinus décalé
de p/2, ce que l'on pourrait écrire:
? (DEFINE COSINUS (DECALER SINUS00 (/ PI 2)))
= COSINUS
? (DESSINER COSINUS 0 (* 2 PI) (/ PI 10) -1 1 40) * 0=>1.0
* 0.31415926535=>0.9238795324984
* 0.6283185307=>0.77301045334672
* 0.94247779605=>0.5555702330056
* 1.2566370614=>0.29028467724641
* 1.57079632675=>0.0
* 1.8849555921=>-0.29028467724641
* 2.19911485745=>-0.5555702330056
* 2.5132741228=>-0.77301045334672
* 2.82743338815=>-0.9238795324984
* 3.1415926535=>-0.99518472666807
* 3.45575191885=>-0.9238795324984
* 3.7699111842=>-0.77301045334672
* 4.08407044955=>-0.5555702330056
* 4.3982297149=>-0.29028467724641
* 4.71238898025=>0.0
* 5.0265482456=>0.29028467724641
* 5.34070751095=>0.5555702330056
* 5.6548667763=>0.77301045334672
* 5.96902604165=>0.9238795324984
* 6.283185307=>0.99518472666807
= #<a Function>
Solution de l'exercice 32 :
(define (decaler fonction delta)
(lambda (x)
(fonction (+ x delta)) ) )
Mémo-fonctions et anté-mémoires
Exercice 33 : Il se peut qu'un même calcul soit demandé plusieurs fois de
suite. Concevoir donc une fonctionnelle prenant en argument une
fonction unaire et memorisant le dernier résultat calculé par
cette fonction unaire. Si celui-ci est redemandé, on retournera
alors ce résultat sans recalcul. On nomme cette technique memoization ou mémo-fonction. Appliquons-la à la fonction
member sur une longue liste que l'on bâtira avec
(define (faire-longue-liste element fin longueur)
(if (> longueur 0)
(faire-longue-liste element (cons element fin) (- longueur 1))
fin ) )
? (DEFINE UNE-LONGUE-LISTE
(FAIRE-LONGUE-LISTE 'FOO '(BAR HUX) 100000))
= UNE-LONGUE-LISTE ;
? (DEFINE CHERCHER
(MEMO (LAMBDA (X) (MEMBER X UNE-LONGUE-LISTE))))
= CHERCHER
? (CHERCHER 'BAR)
= (BAR HUX) ;
? (CHERCHER 'BAR)
= (BAR HUX) ;
Solution de l'exercice 33 :
;;;
(define (memo f)
(let ((au-moins-un-resultat #f)
(dernier-argument #f)
(dernier-resultat #f) )
(lambda (x)
(if (and au-moins-un-resultat (equal? x dernier-argument) )
dernier-resultat
(let ((resultat (f x)))
(set! dernier-argument x)
(set! dernier-resultat resultat)
(set! au-moins-un-resultat #t)
resultat ) ) ) ) )
Exercice 34 : Un cache de profondeur 1 peut ne pas être assez grand pour être
utile. Modifier la solution précédente afin de procurer une plus
grande profondeur de mémorisation. Par exemple: on peut modifier
chercher pour mémoriser les quatre dernières valeurs ayant
servi.
? (DEFINE CHERCHER4
(CACHE (LAMBDA (X) (MEMBER X UNE-LONGUE-LISTE))
4))
= CHERCHER4
? (CHERCHER4 'BAR)
= (BAR HUX) ;
? (CHERCHER4 'HUX)
= (HUX) ;
? (CHERCHER4 'BAR)
= (BAR HUX) ;
Solution de l'exercice 34 : Ce qui suit n'est pas une implantation de la technique dite LRU pour
``least recently used'' où l'on jette du cache la valeur qui a le
moins récemment servi.
(define (cache f taille)
(let ((arguments (make-vector taille #f))
(resultats (make-vector taille #f))
(libre 0) )
(define (echanger i j)
(let ((a (vector-ref arguments i))
(r (vector-ref resultats i)) )
(vector-set! arguments i (vector-ref arguments j))
(vector-set! resultats i (vector-ref resultats j))
(vector-set! arguments j a)
(vector-set! resultats j r)
r ) )
(define (memoriser x i)
(let ((r (f x)) )
(vector-set! arguments i x)
(vector-set! resultats i r)
r ) )
(lambda (x)
(let scruter ((i 0))
(if (>= i libre)
;;
(if (< libre taille)
(let ((i libre))
(set! libre (+ 1 libre))
(memoriser x i) )
(memoriser x (- taille 1)) )
(if (equal? (vector-ref arguments i) x)
;;
(echanger i 0)
(scruter (+ i 1)) ) ) ) ) ) )
Voici une autre solution due à Bruno Salvy.
;;;
(define (cache2 f taille)
(let* ((init (cons #t #f))
(lastargval (vector->list (make-vector taille (cons init init)))) )
(lambda (x)
(let ((found (assoc x lastargval)))
(if found (cdr found)
(begin (set! found (f x))
(set! lastargval (append! (cdr lastargval)
(list (cons x found))))
found ) ) ) ) ) )