Toujours plus récursif!

2 Toujours plus récursif!

Où de toujours plus complexes récursions sont proposées au lecteur au fil de quelques catastrophes programmatiques.

Toutes les fonctions, solutions des énoncés suivants, sont définissables en moins de vingt lignes.

À la recherche des doublons

Exercice 11 : Extraire d'une liste de symboles ceux qui y figurent au moins deux fois. La réponse peut comporter des répétitions; son ordre est inimportant. Rappelons que poeme-pi vaut (Q U E J A I M E A F A I R E A P P R E N D R E U N N O M B R E U T I L E A U S A G E).

? (DOUBLONS POEME-PI)
= (U E A I M E A A I R E A P R E N R E U N E U E A)

Solution de l'exercice 11 :

;;; Une autre version
(define (doublons liste)
  (if (pair? liste)
      (if (member (car liste) (cdr liste))
          (cons (car liste) (doublons (cdr liste)))
          (doublons (cdr liste)) )
      '() ) )
;;; premier emploi des connecteurs booleens.
(define (apparait-dans mot liste)
  (and (pair? liste)
       (or (equal? (car liste) mot)
           (apparait-dans mot (cdr liste)) ) ) )

La fonction apparait-dans est prédéfinie en Scheme sous le nom member. Une petite différence est que member retourne #f ou le segment terminal de liste débutant par l'élément recherché. On nomme member un semi-prédicat.

On peut aussi écrire (avec une variable tampon aussi appelé accumulateur) mais on comparera les complexités relatives:

;;; Cette version donne des resultats qui comportent des doublons.
(define (doublons1 liste)
  (define (parcourir liste deja-vus) ; deja-vus est une variable tampon
    (if (pair? liste)
        (if (apparait-dans (car liste) deja-vus)
            (cons (car liste) (parcourir (cdr liste) deja-vus))
            (parcourir (cdr liste) (cons (car liste) deja-vus)) )
        '() ) )
  (parcourir liste '()) )

Exercice 12 : Extraire d'une liste de symboles ceux qui y figurent exactement deux fois. La réponse ne doit pas comporter de répétition mais son ordre est inimportant.

? (STRICTS-DOUBLONS POEME-PI)
= (M P)

Solution de l'exercice 12 :

(define (stricts-doublons liste)
  (define (parcourir liste deja-vus doublons trop-vus)
    (if (pair? liste)
        (cond ((member (car liste) trop-vus)
               (parcourir (cdr liste) deja-vus doublons trop-vus) )
              ((member (car liste) doublons)
               (parcourir (cdr liste) deja-vus
                          (retirer (car liste) doublons)
                          (cons (car liste) trop-vus) ) )
              ((member (car liste) deja-vus)
               (parcourir (cdr liste) deja-vus
                           (cons (car liste) doublons) trop-vus ) )
              (else
               (parcourir (cdr liste) (cons (car liste) deja-vus)
                          doublons trop-vus ) ) )
        doublons ) )
  (parcourir liste '() '() '()) )
(define (retirer element liste)
  (if (pair? liste)
      (if (equal? element (car liste))
          (cdr liste)
          (cons (car liste) (retirer element (cdr liste))) )
      '() ) )

On peut aussi écrire:

(define (stricts-doublons2 liste)
  (if (pair? liste)
      (let ((segment (member (car liste) (cdr liste))))
        (if segment
            (if (member (car liste) (cdr segment))
                (stricts-doublons2 (retirer-tous (car liste) (cdr liste)))
                (cons (car liste) (stricts-doublons2 (cdr liste))) )
            (stricts-doublons2 (cdr liste)) ) )
      '() ) )
(define (retirer-tous element liste)
  (if (pair? liste)
      (if (equal? element (car liste))
          (retirer-tous element (cdr liste)) ; continuer l'enlèvement.
          (cons (car liste) (retirer-tous element (cdr liste))) )
      '() ) )

Les résultats de stricts-doublons et stricts-doublons1 ne sont pas comparables. Il faut les comparer avec set-equal?.

(define (set-equal? set1 set2)
  (define (set-included? set1 set2)
    (if (pair? set1)
        (and (member (car set1) set2)
             (set-included? (cdr set1) set2) )
        #t ) )
  (and (set-included? set1 set2)
       (set-included? set2 set1) ) )

Exercice 13 : Extraire d'un arbre binaire de symboles tous ceux qui y figurent exactement deux fois.

? (EXTRAIRE-STRICTS-DOUBLONS
  '((Q U
       E
       (J A I M E)
       ((A) F A I R E)
       A
       P
       P
       R
       E
       N
       D
       R
       E)
    ((U N) ((N O M B R E) (U T I L E (A U))) S A G E)))
= (M P)

Solution de l'exercice 13 : On peut écrire ce qui suit qui use d'un style dit par continuations.

;;; Style par continuation
(define (extraire-stricts-doublons arbre)
  (define (parcourir arbre deja-vus doublons trop-vus suite)
    (if (pair? arbre)
        (parcourir (car arbre)
                   deja-vus
                   doublons
                   trop-vus
                   (lambda (deja-vus doublons trop-vus)
                     (parcourir (cdr arbre)
                                deja-vus
                                doublons
                                trop-vus
                                suite ) ) )
        (if (member arbre deja-vus)
            (if (member arbre trop-vus)
                (suite deja-vus doublons trop-vus)
                (if (member arbre doublons)
                    (suite deja-vus (retirer arbre doublons)
                           (cons arbre trop-vus) )
                    (suite deja-vus (cons arbre doublons) trop-vus) ) )
            (suite (cons arbre deja-vus) doublons trop-vus) ) ) )
  (parcourir arbre '() '() '() (lambda (deja-vus doublons trop-vus)
                                 doublons )) )

On peut aussi écrire, sans trop se fatiguer:

;;; mais on peut aussi aplatir d'abord l'arbre
(define (extraire-stricts-doublons2 arbre)
(stricts-doublons (aplatir arbre)) )

Interlude

Exercice 14 : Concevoir une nouvelle fonction aplatir2 semblable à l'aplatir de l'exercice 8 mais utilisant une sous-fonction dotée d'un accumulateur.

Solution de l'exercice 14 :

(define (aplatir2 e)
  (define (aplatir-interne e r)
    (if (pair? e)
        (aplatir-interne (car e) (aplatir-interne (cdr e) r))
        (if (null? e) r (cons e r)) ) )
  (aplatir-interne e '()) )

Exercice 15 : Concevoir la fonction xpl qui prend une liste de symboles et retourne la liste de tous ses préfixes non vides en ordre croissant. Par exemple:

? (XPL '(A B C))
= ((A) (A B) (A B C))

Solution de l'exercice 15 : Il y a des tas de façons d'écrire cette fonction. Voici deux styles:

(define (xpl liste)
  (define (map-on-all-cdr fonction liste)
    (if (pair? liste)
        (cons (fonction liste)
              (map-on-all-cdr fonction (cdr liste)) )
        '() ) )
  (reverse (map-on-all-cdr reverse (reverse liste))) )
(define (xpl1 l)
  (define (xpl2 l l1)
    (if (null? l) l1
        (xpl2 (cdr l) (map (lambda (u) (cons (car l) u)) (cons '() l1)))))
  (xpl2 (reverse l) '()))

Exercice 16 : Écrire la fonction reduce telle que (reduce f e '(e₁ e₂ ...e_n)) calcule (f 'e₁ (f 'e₂ ...(f 'e_n e) ...)). Par exemple:

? (REDUCE * 1 '(1 2 3 4 5 6))
= 720
? (REDUCE
  (LAMBDA (ELEMENT RESULTAT)
    (APPEND RESULTAT (LIST ELEMENT)))
  '()
  '(A B C D))
= (D C B A)

Solution de l'exercice 16 :

(define (reduce fonction neutre liste)
  (if (pair? liste)
      (fonction (car liste) (reduce fonction neutre (cdr liste)))
      neutre ) )

Exercice 17 : Utiliser la précédente fonction reduce pour définir la fonction prédéfinie map ou même (très très inefficacement) la factorielle de naguère (à l'aide de iota vue en cours).

Solution de l'exercice 17 :

(define (map-car fonction liste)
  (reduce (lambda (x r) (cons (fonction x) r)) '() liste) )
(define (fact-orielle n)
  (reduce * 1 (map-car (lambda (n) (+ n 1))
                       (iota 0 n) )) )
(define (iota debut fin)
  (if (< debut fin)
      (cons debut (iota (+ debut 1) fin))
      '() ) )

Le filtrage

Exercice 18 : Le filtrage est une activité importante en Lisp (ou en ML) qui consiste à vérifier si une expression est conforme à un filtre. Le filtre est une description simple décrivant la forme que doit revêtir une expression pour être acceptable ou filtrée avec succès.

On considère pour l'instant des listes de symboles (ou listes linéaires). Un filtre sera une liste de filtres élémentaires c'est-à-dire soit un symbole, soit un trou élémentaire noté ?-. Le filtre (foo ?- bar) accepte toute expression de trois termes dont le premier est le symbole foo et le dernier, le symbole bar. Le second peut être n'importe quoi.

Programmer cette fonction filtrer1 dont voici quelques exemples:

? (FILTRER1 '(FOO) '(FOO ?- BAR))
= #F
? (FILTRER1 '(FOO BAR BAR) '(FOO ?- BAR))
= #T
? (FILTRER1 '(FOO HUX BAR WIX) '(FOO ?- BAR))
= #F
? (FILTRER1 '(FOO HUX BAR WIX) '(FOO ?- BAR ?-))
= #T

Solution de l'exercice 18 :

;;; filtre ::= ( atome | ?- . filtre )
(define (filtrer1 expression filtre)
  (if (pair? filtre)
      (and (pair? expression)
           (if (equal? (car filtre) '?-)
               (filtrer1 (cdr expression) (cdr filtre))
               (and (equal? (car expression) (car filtre))
                    (filtrer1 (cdr expression) (cdr filtre)) ) ) )
      (null? expression) ) )

Exercice 19 : Un nouveau filtre est créé, le trou extensible, noté ..., qui peut accepter un nombre quelconque de termes. Ainsi le filtre (foo ... bar) accepte-t-il toute liste débutant par foo et s'achevant par bar.

? (FILTRER2 '(FOO BAR) '(FOO ... BAR))
= #T
? (FILTRER2 '(FOO HUX BAR) '(FOO ... BAR))
= #T
? (FILTRER2 '(FOO HUX BAR WIX BAR) '(FOO ... BAR))
= #T
? (FILTRER2 '(FOO HUX BAR WIX BACH) '(FOO ... BAR))
= #F
? (FILTRER2
  '(FOO HUX BAR WIX BACH)
  '(FOO ... BAR ...))
= #T

Solution de l'exercice 19 :

;;; filtre ::= ( atome | ?- | ... . filtre )
(define (filtrer2 expression filtre)
  (if (pair? filtre)
      (cond ((equal? (car filtre) '?-)
             (and (pair? expression)
                  (filtrer2 (cdr expression) (cdr filtre)) ) )
            ((equal? (car filtre) '...)
             (or (filtrer2 expression (cdr filtre))
                 (and (pair? expression)
                      (filtrer2 (cdr expression) filtre) ) ) )
            (else
             (and (pair? expression)
                  (equal? (car expression) (car filtre))
                  (filtrer2 (cdr expression) (cdr filtre)) ) ) )
      (null? expression) ) )

Exercice 20 : On ne restreint plus maintenant les expressions à des listes linéaires de symboles, parallèlement les filtres pourront contenir eux-mêmes des sous-filtres. Concevoir donc une nouvelle fonction filtrer3 capable de filtrer des arbres binaires avec des trous ?- et des trous .... Par exemple:

? (FILTRER3 '(X (Y)) '((FOO ...) ?- (... BAR)))
= #F
? (FILTRER3
  '((FOO BAR) (FOO BAR) (FOO BAR))
  '((FOO ...) ?- (... BAR)))
= #T

Solution de l'exercice 20 :

;;; filtre ::= atome | ?- | ... | ( filtre . filtre )
(define (filtrer3 expression filtre)
  (define (filtrer3-liste expressions filtres)
    (if (pair? filtres)
        (if (equal? (car filtres) '...)
            (or (filtrer3-liste expressions (cdr filtres))
                (and (pair? expressions)
                     (filtrer3-liste (cdr expressions) filtres) ) )
            (and (pair? expressions)
                 (filtrer3 (car expressions) (car filtres))
                 (filtrer3-liste (cdr expressions) (cdr filtres)) ) )
        (equal? expressions filtres) ) )
  (or (equal? filtre '?-)
      (if (equal? filtre '...)
          (error 'filtrer3 "... ne peut survenir ici")
          (if (pair? filtre)
              (filtrer3-liste expression filtre)
              (equal? expression filtre) ) ) ) )