Ninety Nine Lisp Problems (30 answered)

ninety-nine-lisp-problems.lisp

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Quatre-vingts-dix-neuf problèmes en LISP     ;
; KEDJI Komlan Akpédjé <eric_kedji@yahoo.fr>   ;
; Inspiré de 'Ninety-nine Lisp Problems',      ;
; lui-même inspiré d'une liste de problèmes    ;
; en Prolog par werner.hett@hti.bfh.ch         ;
; Les étoiles après les numéros de problèmes   ;
; indiquent le niveau de difficulté.           ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Manipulation de listes                          ;
;                                                 ;
; Ces exercices peut être résolus plus            ;
; élégamment avec mapcar/filter/foldr/foldl, mais ;
; le but est juste de se familiariser avec les    ;
; listes.                                         ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; P01 (*) Trouver la dernière cellule d'une liste.
; 	Exemple:
;	* (my-last '(a b c d))
;	(d)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; La dernière cellule d'une liste à 1|0 élément est la liste elle même.
; La dernière cellule d'une liste à plus d'un élément est identique à
; la dernière cellule de son cdr
(defun my-last (liste)
  (if (or (null liste)
          (null (rest liste)))
      liste
      (my-last (rest liste))))

;(my-last '(a b c d))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; P02 (*) Trouver l'avant dernière cellule d'une liste.
; 	Exemple:
; 	* (my-but-last '(a b c d))
; 	(c d)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun my-but-last (liste)
  (if (or (null liste)
          (null (rest liste))
          (null (cddr liste)))
      liste
      (my-but-last (rest liste))))

;(my-but-last '(a b c d))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P03 (*) Trouver le Kieme élément d'une liste.
; 	Le premier élément de la liste porte le numéro 1
; 	Exemple:
; 	* (element-at '(a b c d e) 3)
; 	c
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; L'élément à la position 1 dans une liste est le car
; L'élément à la position k dans une liste est à la position k-1
; dans son cdr
(defun element-at (liste numero)
  (if (= 1 numero)
      (first liste)
      (element-at (rest liste) (- numero 1))))

;(element-at '(a b c d e) 3)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P04 (*) Trouver le nombre d'éléments d'une liste.
;         * (number-of-elements '(1 2 3 4))
;           4
;         * (number-of-elements '(1 (2 3) 4))
;           3
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun number-of-elements (liste)
  (if (null  liste)
      0
      (+ 1 (number-of-elements (rest liste)))))

;(number-of-elements '(a b h j (k t) l l j))

; Version iterative (c'est une technique générale pour
; transformer la récursivité non-terminale en récusivité
; terminale (tail-recursion))
;   Au lieu de laisser les appels récursifs construire le résultat,
;   on accumule explicitement le résultat dans un paramètre.
;   Tout comme les boucles classiques dans les langages impératifs.

(defun number-of-elements2 (liste)
  (defun noe-iter (reste-liste count)
    (if (null reste-liste)
        count
        (noe-iter (rest reste-liste) (+ 1 count))))
  (noe-iter liste 0))

;(number-of-elements2 '(a b (c ge f) d e))

; compter le nombre d'atomes (au sens du predicat atom,
; ie les éléments qui ne sont pas des paires)
; * (number-of-atoms '(1 (2 3) 4)
;   4
; * (number-of-atoms '(1 (2 . 3) 4)
;   4
; * (number-of-atoms '(1 2 3 (4 5 6 . 7) 8))
;   8
(defun number-of-atoms (liste)
  (if (null liste)
      0
      (let ((tete (first liste))
            (queue (rest liste)))
        (+ (if (atom tete)
               1
               (number-of-atoms tete))
           (if (and (atom queue) (not (null queue))) ; dotted pair: (a . b)
               1
               (number-of-atoms (rest liste)))))))

;(number-of-atoms '(a b h j (k t) l l (e (e) (a b) j))) ; => 13
;(number-of-atoms '(1 2 (3 4 . 5) 6)) ; => 6

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P05 (*) Inverser l'ordre des éléments d'une liste.
;         * (my-reverse '(1 2 3))
;           (3 2 1)
;         * (my-reverse '(1 (2 3) 4))
;           (4 (2 3) 1)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun my-reverse (liste)
  (if (null liste)
      nil
      (append (my-reverse (rest liste))
              (list (first liste)))))

; par accumulation
;  - copier en tête de la liste source
;  - coller en tête de la liste cible
(defun my-reverse2 (liste)
  (defun mr-iter (reste-liste result)
    (if (null reste-liste)
        result
        (mr-iter (rest reste-liste)
                 (cons (first reste-liste) result))))
  (mr-iter liste nil))

;(my-reverse '(s ff k h (k l) l t))
;(my-reverse2 '(s ff k h (k l) l t))

; deep-reverse: inverser l'ordre dans les sous-listes
; aussi (récursivement). Toutes les listes sont garanties
; se terminer par nil (listp renvoie true pour (a . b)) 
; * (deep-reverse '(a (b c) d))
;   (d (c b) a)

(defun deep-reverse (liste)
  (cond
    ((null liste) nil)
    ((null (rest liste))
     (if (atom (first liste))
         liste
         (list (deep-reverse (first liste)))))
    (t (append (deep-reverse (rest liste))
               (deep-reverse (list (first liste)))))))

;(deep-reverse '(1 2 (3 4) 5 (6 (7 8 (9)) 10) 11))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P06 (*) Déterminer si une liste est palindrome.
; 	Un palindrome peut être lu aussi bien d'avant en arrière que
;       d'arrière en avant, comme (x a m a x).
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun is-palindrome (liste)
  (equal liste (reverse liste)))

;(is-palindrome '(x (a b) a m a (a b) x))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P07 (**) Aplatir une structure de listes imbriquées.
; 	Transformer une liste, contenant potentiellement des listes
;       comme éléments en une liste 'plate', en remplaçant chaque
;       liste par ses éléments (récursivement).
; 
; 	Exemple:
; 	* (my-flatten '(a (b (c d) e)))
; 	(a b c d e)
; 
; 	Indication: Utiliser les fonctions prédéfinies list et append.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun my-flatten (liste)
  (if (null liste)
      nil
      (append (if (listp (first liste))
                  (my-flatten (first liste))
                  (list (first liste)))
              (my-flatten (rest liste)))))

;(my-flatten '(a (b (c d) e)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P08 (**) Eliminer les répétitions consécutives dans une liste.
; 	Si une liste contient des éléments répétés (consécutifs),
;       les remplacer par une seule copie. L'ordre des éléments
;       ne doit pas être modifié.
; 
; 	Exemple:
; 	* (compress '(a a a a b c c a a d e e e e))
; 	(a b c a d e)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun compress (liste)
  (cond ((null liste) nil)
    ((null (rest liste)) liste)
    (t (let ((compressed-rest (compress (rest liste))))
         (if (equal (first liste) (first compressed-cdr))
             compressed-cdr
             (cons (first liste) compressed-cdr))))))

;(compress '(a a a a b (c c) (c c) (a b) (a b) a a d e e e e))

; Version itérative

(defun iterative-compress (liste)
  (defun ic-helper (reste-liste reversed-result)
    (if (null reste-liste)
        reversed-result
        (if (equal (first reste-liste) (first reversed-result))
            (ic-helper (rest reste-liste) reversed-result)
            (ic-helper (rest reste-liste)
                    (cons (first reste-liste) reversed-result)))))
  (reverse (ic-helper (rest liste) (list (first liste)))))

;(iterative-compress '(a a a a b (c c) (a b) (a b) a a d e e e e))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P09 (**) Regrouper les répétitions consécutives d'éléments d'une
;          liste en des sous-listes.
; 
; 	Exemple:
; 	* (pack '(a a a a b c c a a d e e e e))
; 	((a a a a) (b) (c c) (a a) (d) (e e e e))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun pack (liste)
  (if (null liste)
      (list liste)                            ; cas trivial
      (let ((packed-rest (pack (rest liste))))
        (cond
          ((null (first packed-cdr))          ; packed-rest provient du cas trivial
           (list (list (first liste))))
          ((equal (first liste)               ; même élément: ajout à la sous-liste
                  (caar packed-cdr))
           (cons (cons (first liste)
                       (first packed-cdr))
                 (rest packed-cdr)))
          (t (cons (list (first liste))       ; nouvel élément: nouvelle sous-liste
                   packed-cdr))))))

;(pack '(a a a a b c c a a d e (e) (e) e))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P10 (*) Compression d'une liste par `run-length encoding'
; 	Utiliser le résultat du problème P09 to implémenter la
;       technique de compression de données connue sous le nom
;       de run-length encoding. Les répétitions consécutives
;       d'éléments sont codés en listes de la forme (N E), où
;       N est le nombre de répétitions de l'élément E.
; 
; 	Exemple:
; 	* (encode '(a a a a b c c a a d e e e e))
; 	((4 a) (1 b) (2 c) (2 a) (1 d)(4 e))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun encode (liste)
  (defun encode-helper (packed-liste)
    (if (null packed-liste)
        nil
        (cons (list (length (first packed-liste))
                    (caar packed-liste))
              (encode-helper (rest packed-liste)))))
  (encode-helper (pack liste)))


;(encode '(a a a a b c c a a d e e e e))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P11 (*) Amélioration de run-length encoding.
; 	Modifier le résultat du problème P10, de  telle sorte que les
;       éléments non dupliqués soient tout simplement copiés. Seuls les
;       éléments dupliqués sont mis sous la forme (N E).
; 
; 	Exemple:
; 	* (encode-modified '(a a a a b c c a a d e e e e))
; 	((4 a) b (2 c) (2 a) d (4 e))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun encode-modified (liste)
  (defun simplify (encoded-liste)
    (if (null encoded-liste)
        nil
        (cons (if (= 1 (caar encoded-liste))
                  (cadar encoded-liste)
                  (first encoded-liste))
              (simplify (rest encoded-liste)))))
  (simplify (encode liste)))

;(encode-modified '(a a a a b c c a a d e e e e))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P12 (**) Decoder une liste compressée par run-length encoding.
; 	Etant donné une liste compressée comme spécifié dans le
;       le problème P11,  retrouver la liste originale.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun decode-rl (encoded-list)
  (defun expand (element count)
    (if (= count 0)
        nil
        (cons element
              (expand element (- count 1)))))
  (cond ((null encoded-list) nil)
    ((atom (first encoded-list))
     (append (list (first encoded-list))
             (decode-rl (rest encoded-list))))
    (t (append (expand (cadar encoded-list)
                       (caar encoded-list))				
               (decode-rl (rest encoded-list))))))

;(decode-rl (encode-modified '(a a a a b c c a a d e e e e)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P13 (**) Compression d'une liste par run-length encoding
;          (solution directe).
; 	Implémenter directement la compression par run-length encoding.
;   En d'autres mots, ne pas créer explicitement les sous-listes
;   contenant les répétitions, comme dans le problème P09, mais juste
;   compter le nombre de répétition. Simplifier la liste résultante
;   comme dans le problème P11, en remplaçant (1 X) par X.
; 
; 	Exemple:
; 	* (encode-direct '(a a a a b c c a a d e e e e))
; 	((4 a) b (2 c) (2 a) d (4 e))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun encode-direct (list-to-encode)
  (defun simplify (liste)
    (if (null liste)
        nil
        (cons (if (= 1 (caar liste))
                  (cadar liste)
                  (first liste))
              (simplify (rest liste)))))
  (defun temp-encode-direct (liste)
    (if (null liste)
        nil                                                      ; cas trivial
        (let ((encoded-rest (temp-encode-direct (rest liste))))
          (cond
            ((null encoded-cdr) (list (list 1
                                            (first liste))))     ; liste à un seul élément
            ((equal (first liste)
                    (cadar encoded-cdr))
             (cons (list (+ 1 (caar encoded-cdr))                ; ajout d'élément répété
                         (first liste))
                   (rest encoded-cdr)))
            (t (cons (list 1                                     ; nouvelle sous-liste
                           (first liste))
                     encoded-cdr))))))
  (simplify (temp-encode-direct list-to-encode)))

;(encode-direct '(a a a a b c c a a d e e e e))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
; 
; P14 (*) Dupliquer chaque élément d'une liste.
; 	Exemple:
; 	* (dupli '(a b c c d))
; 	(a a b b c c c c d d)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun dupli (liste)
  (if (null liste)
      nil
      (append (list (first liste)
                    (first liste))
              (dupli (rest liste)))))

;(dupli '(a b c c d))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P15 (**) Répliquer chaque élément d'une liste un nombre donné de fois.
; 	Exemple:
; 	* (repli '(a b c) 3)
; 	(a a a b b b c c c)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun repli (liste count)
  (defun replicate-element (element how-many)
    (if (= how-many 0)
        nil
        (cons element
              (replicate-element element
                                 (- how-many 1)))))
  (if (null liste)
      nil
      (append (replicate-element (first liste)
                                 count)
              (repli (rest liste)
                     count))))

;(repli '(a b c) 9)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P16 (**) Suprimer chaque Nième élément d'une liste.
; 	Exemple:
; 	* (drop '(a b c d e f g h i k) 3)
; 	(a b d e g h k)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun drop (liste position)
  (defun drop-helper (temp-list temp-position)
    (cond ((null temp-list) nil)
      ((= 1 temp-position) (drop-helper (rest temp-list)
                                        position))
      (t (cons (first temp-list)
               (drop-helper (rest temp-list)
                            (- temp-position 1))))))
  (drop-helper liste position))

;(drop '(a b c d e f g h i k) 3)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P17 (*) Découper une liste en deux sous listes; la longueur de
;         la première sous-liste est donnée.
; 	N'utiliser aucun prédicat prédéfini.
; 
; 	Exemple:
; 	* (split '(a b c d e f g h i k) 3)
; 	((a b c) (d e f g h i k))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun split (liste first-part-length)
  (if (= 0 first-part-length)
      (list nil liste)
      (let ((splited-rest (split (rest liste)
                                (- first-part-length 1))))
        (list (cons (first liste)
                    (first splited-cdr))
              (cadr splited-cdr)))))

;(split '(a b c d e f g h i k) 3)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P18 (**) Extraire une sous-liste d'une liste.
; 	Etant donné deux indices, I et K, la sous-liste est la liste
;       contenant les éléments entre le Iième et le Kième élément
;       (les deux limites incluses). Compter à partir de 1.
; 
; 	Exemple:
; 	* (slice '(a b c d e f g h i k) 3 7)
; 	(c d e f g)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun slice (liste start stop)
  (first (split (cadr (split liste
                             (- start 1)))
                (+ 1
                   (- stop start)))))

;(slice '(a b c d e f g h i k) 3 7)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P19 (**) Effectuer une rotation de liste de N positions vers la gauche.
;
; 	Exemples:
; 	* (rotate '(a b c d e f g h) 3)
; 	(d e f g h a b c)
; 
; 	* (rotate '(a b c d e f g h) -2)
; 	(g h a b c d e f)
; 
; 	Indication: Utiliser les fonctions prédéfinies length et append,
;       et le résultat du problème P17.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun rotate (liste arg)
  (if (null liste)
      nil
      (let ((splited-liste (split liste
                                  (mod arg
                                       (length liste)))))
        (append (cadr splited-liste)
                (first splited-liste)))))

;(rotate '(a b c d e f g h) 3)
;(rotate '(a b c d e f g h) -2)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P20 (*) Supprimer le Kième élément d'une liste.
;
; 	Exemple:
; 	* (remove-at '(a b c d) 2)
; 	(A C D)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun remove-at (liste place)
  (if (= 1 place)
      (rest liste)
      (cons (first liste)
            (remove-at (rest liste)
                       (- place 1)))))

;(remove-at '(a b c d) 2)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P21 (*) Inserer un élément à la Kième position dans une liste.
;
; 	Exemple:
; 	* (insert-at 'alfa '(a b c d) 2)
; 	(a alfa b c d)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun insert-at (element liste place)
  (if (= 1 place)
      (cons element liste)
      (cons (first liste)
            (insert-at element
                       (rest liste)
                       (- place 1)))))

;(insert-at 'alfa '(a b c d) 2)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P22 (*) Créer une liste contenant tous les entiers dans un 
;         intervalle donné.
;
; 	Exemple:
; 	* (range 4 9)
; 	(4 5 6 7 8 9)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun range (start stop)
  (if (= start stop)
      (list stop)
      (cons start
            (range (+ start 1)
                   stop))))

;(range 4 9)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P23 (**) Extraire un nombre donné d'éléments d'une liste, de façon
;          aléatoire.
; 	Exemple:
; 	* (rnd-select '(a b c d e f g h) 3)
; 	(e d a)
; 
; 	Indication: Utiliser le générateur de nombres aléatoires
;       prédéfini et la solution du problème P20.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; cette solution suppose que votre implémentation contient
; la procédure (random n) qui retourne un entier aléatoire
; k tel que 0 <= k <= n-1.

(defun rnd-select (liste how-many)
  (defun my-random (n) (+ 1 (random n))) ; 1 <= nombre aléatoire <= n
  (if (= 0 how-many)
      nil
      (let ((place (my-random (length liste))))
        (cons (element-at liste place)
              (rnd-select (remove-at liste place)
                          (- how-many 1))))))

;(rnd-select '(a b c d e f g h) 3)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P24 (*) Loto: Sélectionner N différents nombres aléatoires
;         dans l'ensemble 1..M.
; 	Exemple:
; 	* (lotto-select 6 49)
; 	(23 1 17 33 21 37)
; 
; 	Indication: Combiner les solutions aux problèmes P22 et P23.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun lotto-select (how-many upper-bound)
  (rnd-select (range 1 upper-bound)
              how-many))

;(lotto-select 6 49)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 
; P25 (*) Générer une permutation aléatoire des éléments d'une liste.
; 	Exemple:
; 	* (rnd-permu '(a b c d e f))
; 	(b a d c e f)
; 
; 	Indication: Utiliser la solution du problème P23.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun rnd-permu (liste)
  (rnd-select liste
              (length liste)))

;(rnd-permu '(a b c d e f))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; P26 (**) Générer les différentes combinaisons de K objets distincts
;          choisis dans une liste de N objets.
;
;       De combien de façons peut-on former un commité de 3 personnes,
;       choisies dans un groupe de 12 personnes?
;       On sait tous qu'il y a C(12,3) = 220 possibilités (C(N,K) est
;       le fameux coefficient du binôme). Pour des mathématiciens purs,
;       le nombre de possibilités est à lui seul interessant. Ce que
;       nous voulons, nous, c'est lister toutes les possibilités.
;
; 	Exemple:
; 	* (combination 3 '(a b c d e f))
; 	((a b c) (a b d) (a b e) ... )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; il y a deux types de listes à k éléments:
; - ceux qui ne contiennent pas le car
; - ceux qui contiennent le car
; ces derniers sont obtenus en ajoutant le first à toutes
; les listes à k-1 éléments générés à partir du cdr.

(defun combinaison (k liste)
  (defun add-element (x liste)
    (if (null liste)
        '()
        (cons (cons x (first liste))
              (add-element x (rest liste)))))
  (cond
    ((or (= 0 k) (> k (length liste))) '())
    ((= k (length liste)) (list liste))
    (t (append (combinaison k (rest liste))
               (add-element (first liste)
                            (combinaison (- k 1) (rest liste)))))))

; (combinaison 3 '(a b c d e f))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; P27 (**) Grouper les éléments d'un ensemble en des sous-ensembles
;          disjoints.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; 	a) De combien de façons un groupe de 9 personnes peut-il
; travailler en sous-groupes de 2, 3 et 4 personnes?. Ecrire une
; fonction qui génère toutes les possibilités et les retourne dans
; une liste.
; 	Exemple:
; 	* (groups234 '(aldo beat carla david evi flip gary hugo ida))
; 	( ( (aldo beat) (carla david evi) (flip gary hugo ida) )
; 	... )

(defun groups234 (liste)
  
  (defun add-3-and-4-groups (pairs)
    (if (null pairs)
        '()
        (append (add-group (first pairs)
                           (let ((remaining-seven-elements (complementary (first pairs) liste)))
                             (complement-all (combinaison 3 remaining-seven-elements)
                                             remaining-seven-elements)))
                (add-3-and-4-groups (rest pairs)))))
                     
  (defun add-group (group partition)
    (if (null partition)
        '()
        (cons (cons group (first partition))
              (add-group group (rest partition)))))
  
  (defun complementary (subset set)
    (defun drop-element (e set)
      (cond ((null set) '())
            ((equal e (first set)) (rest set))
            (t (cons (first set) (drop-element e (rest set))))))
    (cond ((null subset) set)
          ((member (first subset) set)
           (complementary (rest subset) (drop-element (first subset) set)))
          (t (complementary (rest subset) set))))
  
  (defun complement-all (combinations set)
    (if (null combinations)
        '()
        (let ((subset (first combinations)))
          (cons (list subset
                      (complementary subset set))
                (complement-all (rest combinations) set)))))
  
  (add-3-and-4-groups (combinaison 2 liste)))

; (groups234 '(aldo beat carla david evi flip gary hugo ida))

; la solution précédente est affreusement moche. Seulement, la
; rendre jolie, c'est résoubre le b-). En général, tenter de résoudre
; directement des cas particuliers donne des solutions lourdes. Ne
; vous torturez pas à comprendre cette solution: ça ne vous apprendra
; pas grande chose.

; 	b) Généraliser la procédure précédente de manière à pouvoir
; spécifier une liste de tailles. Il est garanti que toutes les tailles
; sont positives et que leur somme est égale à la longueur de la liste.
; 
; 	Exemple:
; 	* (group '(aldo beat carla david evi flip gary hugo ida) '(2 2 5))
; 	( ( (aldo beat) (carla david) (evi flip gary hugo ida) )
; 	... )
; 
; 	Noter qu'on ne veut pas des permutations des membre d'un sous-groupe.
; En d'autres mots, ((aldo beat) ...) est identique à ((beat aldo) ...).
; Cependant, on fait la distinction entre ((aldo beat) (carla david) ...) et
; ((carla david) (aldo beat) ...).
; 
; 	Vous pouvez vous renseigner sur ce problème dans un document sur
; l'arithmétique, sous le nom "coéfficients du multinôme"

(defun group (liste tailles)
  (defun group-helper (set sizes)
    (if (null (rest sizes))
        (list (list  set))
        (add-subsets (combinaison (first sizes) set)
                     set
                     (rest sizes))))
  
  ; pour une liste de tailles (2 3 4) par exemple, prendre un doublet
  ; (ie un élément de subsets), demander à group-helper de construire
  ; une partition en utilisant comme set le complémentaire du doublet
  ; et comme liste de tailles (3 4), et ajouter le doublet concerné
  ; en début de chaque groupe de cette partition.
  (defun add-subsets (subsets set sizes)
    (if (null subsets)
        '()
        (let* ((subset (first subsets))
               (complementary-of-subset (complementary subset set)))
          (append (add-subgroup subset
                              (group-helper complementary-of-subset
                                            sizes))
                (add-subsets (rest subsets)
                             set
                             sizes)))))
  
  ; une partition etant donnée, ajouter un sous-groupe à chacun de ses
  ; éléments. ie
  ; (add-subgroup (elle lui) (((luc jean) (chris pierre)) ...))
  ; -> (((elle lui) (luc jean) (chris pierre)) ...)
  (defun add-subgroup (subgroup partition)
    (if (null partition)
        '()
        (cons (cons subgroup (first partition))
              (add-subgroup subgroup (rest partition)))))
  
  ; la complémentation de la théorie des ensembles 
  (defun complementary (subset set)
    (defun drop-element (e set)
      (cond ((null set) '())
            ((equal e (first set)) (rest set))
            (t (cons (first set) (drop-element e (rest set))))))
    (cond ((null subset) set)
          ((member (first subset) set)
           (complementary (rest subset) (drop-element (first subset) set)))
          (t (complementary (rest subset) set))))
  
  (group-helper liste tailles))

; (group '(aldo beat carla david evi flip gary hugo ida) '(2 2 5))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; P28 (**) Tri d'une liste sur la base de la longueur de ses
; sous-listes.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; 	a) On suppose que les éléments de la liste sont eux-mêmes des
; listes. L'objectif est de trier les éléments suivant leur tailles.
; Par exemple, les plus courtes listes d'abord, les plus longues listes
; ensuite; ou vice-versa.
; 
; 	Exemple:
; 	* (lsort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
; 	((o) (d e) (d e) (m n) (a b c) (f g h) (i j k l))

(defun lsort (liste)
  (defun insert-element (element sorted-list)
    (cond ((null sorted-list)
           (list element))
          ((<= (length element) (length (first sorted-list)))
           (cons element sorted-list))
          (t (cons (first sorted-list)
                      (insert-element element (rest sorted-list))))))
  (defun lsort-helper (liste)
    (if (null liste)
        '()
        (let ((sorted-cdr (lsort (rest liste))))
          (insert-element (first liste) sorted-cdr))))
  (lsort-helper liste))

; (lsort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))

; 	b) On suppose, une fois de plus, que les éléments de la liste
; sont eux-mêmes des listes. Seulement, cette fois-ci, on désire trier
; les éléments suivant leur fréquence. Par exemple, si l'ordre est
; ascendant, les listes avec des longueurs rares sont placées au début,
; celles ayant des longueurs plus féquentes suivent, ...
;
; 	Exemple:
; 	* (lfsort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
; 	((i j k l) (o) (a b c) (f g h) (d e) (d e) (m n))
;
;       Noter que dans l'exemple ci-dessus, les deux premières listes
; dans le résultat sont de longueur 4 et 1; chacune des deux longueurs
; apparaît une seule fois. La troisième et la quatrième liste sont de
; longueur 3 qui apparaît deux fois (il y a deux listes qui ont cette
; longueur). Et enfin, les trois dernières listes sont de longueur 2.
; C'est la longueur la plus fréquente.

(defun lfsort (liste)
  ; on réutilise la procédure pack du problème 9, on redéfinissant
  ; l'égalité d'éléments comme étant l'égalitant des longueurs
  ; (les éléments sont des listes)
  (defun pack (liste)
  (if (null liste)
      (list liste)
      (let ((packed-cdr (pack (rest liste))))
        (cond ((null (first packed-cdr))
               (list (list (first liste))))
              ((equal (length (first liste))
                       (length (caar packed-cdr)))
               (cons (cons (first liste)
                           (first packed-cdr))
                     (rest packed-cdr)))
              (t (cons (list (first liste))
                          packed-cdr))))))
  
  ; procédure inverse de pack: (expand (pack liste)) ==> liste
  (defun expand (liste)
    (if (null liste)
        '()
        (append (first liste)
                (expand (rest liste)))))
  
  (expand (lsort (pack (lsort liste)))))              ; c'est pas joli ça?

; (lfsort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
 
; Last modified: Saturday, 1st December 2007