Site WWW de Laurent Bloch
Slogan du site

ISSN 2271-3905
Cliquez ici si vous voulez visiter mon autre site, orienté vers des sujets moins techniques.

Pour recevoir (au plus une fois par semaine) les nouveautés de ce site, indiquez ici votre adresse électronique :

Les programmes du manuel ISN traduits en Scheme
à ma façon
Article mis en ligne le 17 décembre 2014
dernière modification le 22 février 2024

par Laurent Bloch

Les programmes du manuel ISN traduits en Scheme (à ma façon)

L’association EPI (Enseignement public et informatique), par son groupe ITIC (Informatique et technologies de l’information et de la communication) qui réfléchit à la question depuis 1971, a réalisé un manuel destiné aux élèves qui prennent la spécialité ISN (informatique) en terminale (première version, avec les programmes en Java, suivie d’une seconde version avec les programmes en Python. Ces deux manuels sont disponibles en librairie ou en ligne librement consultables. Il y a aussi un livre du maître.

À l’instigation de Gilles Dowek, auteur principal de ce manuel, j’ai entrepris la traduction en Scheme des programmes d’exemples de ce livre. Ces programmes sont destinés à être publiés sur le site du manuel, mais comme il m’est apparu que le style fonctionnel inhérent à Scheme entrait assez mal dans le cadre Java-Python du livre, j’en donne ici une version adaptée assez librement, cependant que la version publiée sur le site de Gilles Dowek sera sans doute, après discussion, plus proche des modèles OCaml que j’ai traduits.

Les textes des programmes en Java, Python et les autres langages sont ici.

*Chapitre 1 - Bataille navale, taxes, fractions

Bataille navale :

  1. ;; Ces programmes sont sous licence CeCILL-B V1
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i BatailleNavale.scm
  4.  
  5. (define a 4)
  6. (define b 7)
  7.  
  8. (define (BatailleNavale)
  9.   (display "À vous de jouer, deux entiers : ")
  10.   (newline)
  11.   (let* ((x (read))
  12.          (y (read)))
  13.     (display (Tir x y))
  14.     (newline)))
  15.  
  16. (define (Tir x y)
  17.   (cond
  18.    ((and (= x a) (= y b))
  19.     "Coulé")
  20.    ((or (= x a) (= y b))
  21.     "En vue")
  22.    (else
  23.     "À l'eau")))
  24.  
  25. (BatailleNavale)

Télécharger

Taxes :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Taxes.scm
  4.  
  5. (define (Taxes)
  6.    (display "Quel est le prix hors taxes ?")
  7.    (newline)
  8.    (let ((ht (read)))
  9.       (display "Le prix toutes taxes comprises est ")
  10.       (display (TTC ht))
  11.       (newline)))
  12.  
  13. (define (TTC ht)
  14.   (+ ht (/ (* ht 19.6) 100)))
  15.  
  16. (Taxes)

Télécharger

Taux quelconque :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i TauxQuelconque.scm
  4.  
  5. (define (TauxQuelconque)
  6.    (display "Quel est le prix hors taxes ?")
  7.    (newline)
  8.    (let ((ht (read)))
  9.      (display "Quel est le taux de TVA ?")
  10.      (newline)
  11.      (let ((taux (read)))
  12.        (display "Le prix toutes taxes comprises est ")
  13.        (newline)
  14.        (display (TTC ht taux))
  15.        (newline))))
  16.  
  17. (define (TTC ht taux)
  18.   (+ ht (/ (* ht taux) 100)))
  19.  
  20. (TauxQuelconque)

Télécharger

Fraction :

  1. ;; Exécution en ligne de commande avec Bigloo :
  2. ;; $ bigloo -i Fraction.scm
  3.  
  4. (define (Fraction)
  5.    (let* ((a (read))
  6.           (b (read))
  7.           (c (read))
  8.           (d (read)))
  9.       (if (or (zero? b) (zero? d))
  10.           (display "Impossible d'avoir un dénominateur nul !")
  11.           (begin
  12.              (display (* a c))
  13.              (newline)
  14.              (display (* b d)) ))
  15.       (newline)))
  16.  
  17. (Fraction)

Télécharger

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i FractionAdd.scm
  4.  
  5. (define (FractionAdd)
  6.    (let* ((a (read))
  7.           (b (read))
  8.           (c (read))
  9.           (d (read)))
  10.       (if (or (zero? b) (zero? d))
  11.           (display "Impossible d'avoir un dénominateur nul !")
  12.           (begin
  13.              (display (+ (* a d) (* b c)))
  14.              (newline)
  15.              (display (* b d)) ))
  16.       (newline)))
  17.  
  18. (FractionAdd)

Télécharger

Second degré :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i SecondDegre.scm
  4.  
  5. (define (SecondDegreTest)
  6.    (let* ((a (read))
  7.           (b (read))
  8.           (c (read))
  9.           (delta (- (* b b) (* 4 a c))))
  10.       (if (zero? a)
  11.           (display "Pas une équation du second degré")
  12.           (let ((resultat (Calcul a b c)))
  13.              (case (length resultat)
  14.                 ((0)
  15.                  (display "Pas de racine !")
  16.                  (newline))
  17.                 ((1)
  18.                  (display "Une racine : ")
  19.                  (display resultat)
  20.                  (newline))
  21.                 ((2)
  22.                  (display "Deux racines, ")
  23.                  (display (car resultat))
  24.                  (display " et ")
  25.                  (display (cadr resultat))
  26.                  (newline))
  27.                 (else
  28.                  (display "erreur, trop de racines !"))
  29.                 )))))
  30.  
  31. (define (Calcul a b c)
  32.   (let ((delta (- (* b b) (* 4 a c))))
  33.       (cond ((< delta 0)
  34.              '())
  35.             ((zero? delta)
  36.              (list (/ (- b) (* 2 a))))
  37.             (else
  38.              (list (/ (- (sqrt delta) b) (* 2 a))
  39.                    (/ (- (+ (sqrt delta) b)) (* 2 a)))))))
  40.  
  41. (SecondDegreTest)

Télécharger

Poste :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Poste.scm
  4.  
  5. (define (Poste)
  6.   (display "Entrez type de lettre et poids, sur deux lignes : ")
  7.   (let* ((type (read-line))
  8.          (poids (read)))
  9.     (if (Prix type poids)
  10.         (display (Prix type poids))
  11.         (display "Pas au tarif !"))
  12.     (newline)))
  13.  
  14. (define (Prix type poids)
  15.   (cond ((string=? type "verte")
  16.          (cond
  17.           ((<= poids 20) 0.57)
  18.           ((<= poids 50) 0.95)
  19.           ((<= poids 100) 1.40)
  20.           (else #f)))
  21.         ((string=? type "prioritaire")
  22.          (cond
  23.           ((<= poids 20) 0.60)
  24.           ((<= poids 50) 1.00)
  25.           ((<= poids 100) 1.45)
  26.           (else #f)))
  27.         ((string=? type "ecopli")
  28.          (cond
  29.           ((<= poids 20) 0.55)
  30.           ((<= poids 50) 0.78)
  31.           ((<= poids 100) 1.00)
  32.           (else #f)))))
  33.  
  34. (Poste)

Télécharger

*Chapitre 2 - Température, calendrier, recherche de mot

Température, d’abord l’algorithme en pseudo-code :

puis le programme en Scheme :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Temperature-do.scm
  4.  
  5. (define (Moyenne observations)
  6.   (let ((nbJours (vector-length observations)))
  7.     (do ((jour 0 (+ jour 1))
  8.          (somme 0 (+ somme (vector-ref observations jour))))
  9.         ((= jour nbJours)
  10.          (/ somme nbJours)) )))
  11.  
  12. (define (Temperature)
  13.   (display "Entrez les valeurs, F à la fin : ")
  14.   (let boucle ((L '())
  15.                (val (read)))
  16.     (if (number? val)
  17.         (boucle (cons val L) (read))
  18.         (print (Moyenne (list->vector L))))))
  19.  
  20. (Temperature)

Télécharger

Calendrier :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Calendrier-do.scm
  4.  
  5. (define (bissextile? annee)
  6.   (or (and (zero? (modulo annee 4))
  7.            (not (zero? (modulo annee 100))))
  8.       (zero? (modulo annee 400))))
  9.  
  10. (define (nbJoursMois annee mois)
  11.   (if (= mois 2)
  12.       (if (bissextile? annee) 29 28)
  13.       (+ 30
  14.          (modulo
  15.           (+ mois (quotient mois 8))
  16.           2))))
  17.  
  18. (define (Calendrier)
  19.   (display "Année : ")
  20.   (let ((annee (read)))
  21.     (do ((mois 1 (+ 1 mois)))
  22.         ((> mois 12)
  23.          (newline))
  24.       (let ((nbj (nbJoursMois annee mois)))
  25.         (do ((jour 1 (+ jour 1)))
  26.             ((> jour nbj) (newline))
  27.           (display jour)
  28.           (display " / ")
  29.           (display mois)
  30.           (newline))))))
  31.  
  32. (Calendrier)

Télécharger

Logarithme :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Elog.scm
  4.  
  5. (define (Elog)
  6.    (let iter ((x (read))
  7.               (n 0))
  8.       (if (> x 1.)
  9.           (iter (/ x 2) (+ n 1))
  10.           (display n)))
  11.    (newline))
  12.  
  13. (Elog)

Télécharger

Oui ?

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Oui-do.scm
  4.  
  5. (define (Oui)
  6.    (let* ((s "oouui un ouui ou un non ce n'est pourtant pas la même chose ouui")
  7.           (resultat (Present? "oui" s)))
  8.       (if resultat
  9.           (display resultat)
  10.           (display "Pas de oui"))
  11.       (newline)))
  12.  
  13. (define (Present? mot texte)
  14.    (let* ((l-mot (string-length mot))
  15.           (l-texte (string-length texte))
  16.           (derniere-chance (- l-texte l-mot)))
  17.       (do ((n 0 (+ n 1)))
  18.           ((or (> n derniere-chance)
  19.                (string=?
  20.                   (substring texte n (+ n l-mot))
  21.                   mot))
  22.            (if (> n derniere-chance)
  23.                #f n)))))
  24.  
  25. (Oui)

Télécharger

Second degré :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i SecondDegreTest.scm
  4.  
  5. (define (SecondDegreTest)
  6.    (let* ((a (read))
  7.           (b (read))
  8.           (c (read))
  9.           (delta (- (* b b) (* 4 a c))))
  10.       (if (zero? a)
  11.           (display "Pas une équation du second degré")
  12.           (let ((resultat (Calcul a b c)))
  13.              (cond
  14.                 ((not resultat)
  15.                  (display "Pas de racine !")
  16.                  (newline))
  17.                 ((number? resultat)
  18.                  (display "Une racine : ")
  19.                  (display resultat)
  20.                  (newline))
  21.                 (else
  22.                  (display "Deux racines, ")
  23.                  (display (car resultat))
  24.                  (display " et ")
  25.                  (display (cdr resultat))
  26.                  (newline)))))))
  27.  
  28. (define (Calcul a b c)
  29.   (let ((delta (- (* b b) (* 4 a c))))
  30.       (cond ((< delta 0)
  31.              #f)
  32.             ((zero? delta)
  33.              (/ (- b) (* 2 a)))
  34.             (else
  35.              (cons (/ (- (sqrt delta) b) (* 2 a))
  36.                    (/ (- (+ (sqrt delta) b)) (* 2 a)))))))
  37.  
  38. (SecondDegreTest)

Télécharger

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Terminaison-do.scm
  4.  
  5. (define (Terminaison)
  6.    (let ((s 2)
  7.          (p #f))
  8.       (let boucle ()
  9.          (if (not p)
  10.              (begin
  11.                 (do ((i 1 (+ i 1)))
  12.                     ((>= i s))
  13.                     (let ((j (- s i)))
  14.                        (if (= (* i i)
  15.                               (* 25 j j))
  16.                            (begin
  17.                               (display i)
  18.                               (display " ")
  19.                               (display j)
  20.                               (newline)
  21.                               (set! p #t)))))
  22.                 (set! s (+ s 1))
  23.                 (boucle)) ))))
  24.  
  25. (Terminaison)

Télécharger

*Chapitre 3 - Newton, factorielle, répertoire, polynôme

Mesure principale :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i MesurePrincipale.scm
  4.  
  5. (define (MesurePrincipale)
  6.    (let* ((pi (* 4 (atan 1.0)))
  7.           (alpha (read))
  8.           (n (floor (/ alpha (* 2 pi))))
  9.           (principale (- alpha (* 2 n pi))))
  10.       (let ((principale
  11.                (if (> principale pi)
  12.                    (- principale (* 2 pi))
  13.                    principale)))
  14.          (display principale)
  15.          (newline))))
  16.  
  17. (MesurePrincipale)

Télécharger

Racine de 2 par la méthode de Newton :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i RacineDeDeux.scm
  4.  
  5. (define (RacineDeDeux)
  6.    (display "Entrez la précision désirée (puissance de 10) : ")
  7.    (let* ((n (read))
  8.           (epsilon (expt 10 (- n))))
  9.       (display (laRacine epsilon))
  10.       (newline)))
  11.  
  12. (define (laRacine epsilon)
  13.    (let boucle ((racine 1)
  14.                 (racineprec 2))
  15.       (if (> (abs (- racine racineprec))
  16.              epsilon)
  17.           (boucle
  18.              (/ 1 (+ 2 racineprec))
  19.              racine)
  20.           (+ racine 1))))
  21.  
  22. (RacineDeDeux)

Télécharger

Factorielle :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Factorielle-do.scm
  4.  
  5. (define (Factorielle)
  6.    (display "Entrez n : ")
  7.    (let ((n (read)))
  8.       (display (laFactorielle n))
  9.       (newline)))
  10.  
  11. (define (laFactorielle n)
  12.    (do ((i 1 (+ i 1))
  13.         (f 1 (* i f)))
  14.        ((> i n) f)))
  15.  
  16. (Factorielle)

Télécharger

Répertoire :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Repertoire.scm
  4.  
  5. (define (Repertoire)
  6.    (let* ((tailleRepertoire 10)
  7.           (nom (make-vector tailleRepertoire ""))
  8.           (tel (make-vector tailleRepertoire "")))
  9.       (vector-set! nom 0 "Alice")
  10.       (vector-set! tel 0 "0606060606")
  11.       (vector-set! nom 1 "Bob")
  12.       (vector-set! tel 1 "0606060607")
  13.       (vector-set! nom 2 "Charles")
  14.       (vector-set! tel 2 "0606060608")
  15.       (vector-set! nom 3 "Djamel")
  16.       (vector-set! tel 3 "0606060609")
  17.       (vector-set! nom 4 "Étienne")
  18.       (vector-set! tel 4 "0606060610")
  19.       (vector-set! nom 5 "Frédérique")
  20.       (vector-set! tel 5 "0606060611")
  21.       (vector-set! nom 6 "Guillaume")
  22.       (vector-set! tel 6 "0606060612")
  23.       (vector-set! nom 7 "Hector")
  24.       (vector-set! tel 7 "0606060613")
  25.       (vector-set! nom 8 "Isabelle")
  26.       (vector-set! tel 8 "0606060614")
  27.       (vector-set! nom 9 "Jérôme")
  28.       (vector-set! tel 9 "0606060615")
  29.       ;; Recherche du numéro associé au nom s
  30.       (display "Nom ? ")
  31.       (let ((s (read-line)))
  32.          (display (Recherche s nom tel))
  33.          (newline))))
  34.  
  35. (define (Recherche s nom tel)
  36.   (let ((tailleRepertoire (vector-length nom)))
  37.      (let boucle ((i 0))
  38.         (if (and (< i tailleRepertoire)
  39.                  (not (string=? s (vector-ref nom i))))
  40.             (boucle (+ i 1))
  41.             (if (< i tailleRepertoire)
  42.                 (vector-ref tel i)
  43.                 "Inconnu")))))
  44.  
  45. (Repertoire)

Télécharger

Calcul formel :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i CalculFormel.scm
  4.  
  5. (define (laValeur t x y) ; vecteur t des coefficients
  6.   (let ((degreMax (- (vector-length t) 1)))
  7.     (let boucle ((degre 0)
  8.                  (c 1))
  9.       (set! y (+ y (* (vector-ref t degre) c)))
  10.       (if (< degre degreMax)
  11.           (boucle (+ degre 1) (* c x))
  12.           y))))
  13.  
  14. (define (laDerivee t)
  15.   (let* ((longueur (vector-length t))
  16.          (u (make-vector longueur 0))
  17.          (degreMax (- longueur 1)))
  18.     (let boucle ((degre 0))
  19.       (if (= degre degreMax)
  20.           (vector-set! u degre 0)
  21.           (begin
  22.             (vector-set! u degre
  23.                          (* (vector-ref t (+ degre 1)) (+ degre 1)))
  24.             (boucle (+ degre 1)))))
  25.     u))
  26.  
  27. (define (AffichePolynome p)
  28.   (let ((degreMax (- (vector-length p) 1)))
  29.     (let boucle ((degre 0))
  30.       (display (vector-ref p degre))
  31.       (if (> degre 0)
  32.           (begin
  33.             (display " x")
  34.             (if (> degre 1)
  35.                 (begin
  36.                   (display "^")
  37.                   (display degre)))))
  38.       (if (< degre degreMax)
  39.           (begin
  40.             (display " + ")
  41.             (boucle (+ degre 1)))))))
  42.  
  43. (define (CalculFormel)
  44.    (let* ((degreMax 3)
  45.           (t (make-vector (+ degreMax 1) 0))
  46.           (degre 0))
  47.       (vector-set! t 3 2) ;; coefficients du
  48.       (vector-set! t 2 8) ;; polynôme dans
  49.       (vector-set! t 1 7) ;; un vecteur t
  50.       (vector-set! t 0 3)
  51.       ;; Affichage de la fonction
  52.       (AffichePolynome t)
  53.       (newline)
  54.       ;; Calcul et affichage de sa valeur
  55.       (let ((x 5)
  56.             (y 0))
  57.         (display (laValeur t x y))
  58.         (newline))
  59.       ;; Calcul de sa dérivée
  60.       (let ((u (laDerivee t)))
  61.         (AffichePolynome u)
  62.         (newline))))
  63.  
  64. (CalculFormel)

Télécharger

Initiales :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Initiales.scm
  4.  
  5. (define (AfficheInitiales)
  6.    (display "Nom ? ")
  7.    (let ((nom (read-line)))
  8.       (map display (Initiales nom))
  9.       (newline)))
  10.  
  11. (define (Initiales nom)
  12.    (if (> (string-length nom) 0)
  13.        (let ((avant-dernier (- (string-length nom) 2))
  14.              (premier (string-ref nom 0)))
  15.           (let boucle ((listeInitiales (list premier))
  16.                        (i 1))
  17.              (if (<= i avant-dernier)
  18.                  (if (char=? (string-ref nom i) #\space)
  19.                      (boucle
  20.                         (cons (string-ref nom (+ i 1))
  21.                            listeInitiales)
  22.                         (+ i 1))
  23.                      (boucle listeInitiales (+ i 1)))
  24.                  (reverse listeInitiales) )))
  25.        '()))

Télécharger

*Chapitre 4 - Horaire, comptage, division, aléa, pseudonyme, répertoire

Horaire :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Horaire.scm
  4.  
  5. (define (tirerUnTrait)
  6.    (newline)
  7.    (display "-----------------------------------------------")
  8.    (newline)
  9.    (newline))
  10.  
  11. (display "Le vol en direction de ")
  12. (display "Tokyo")
  13. (display " décollera à ")
  14. (display "9h00")
  15. (tirerUnTrait)
  16.  
  17. (display "Le vol en direction de ")
  18. (display "Sydney")
  19. (display " décollera à ")
  20. (display "9h30")
  21. (tirerUnTrait)
  22.  
  23. (display "Le vol en direction de ")
  24. (display "Toulouse")
  25. (display " décollera à ")
  26. (display "9h45")
  27. (tirerUnTrait)

Télécharger

Horaire encore :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Horaire2.scm
  4.  
  5. (define (tirerUnTrait)
  6.    (newline)
  7.    (display "-----------------------------------------------")
  8.    (newline)
  9.    (newline))
  10.  
  11. (define (annoncerUnVol vol horaire)
  12.    (display "Le vol en direction de ")
  13.    (display vol)
  14.    (display " décollera à ")
  15.    (display horaire)
  16.    (tirerUnTrait))
  17.  
  18. (annoncerUnVol "Tokyo" "9h00")
  19. (annoncerUnVol "Sydney" "9h30")
  20. (annoncerUnVol "Toulouse" "9h45")

Télécharger

Nombre de a :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i NombreDea-do.scm
  4.  
  5. (define (nombreDea chaine)
  6.    (let ((longueur (string-length chaine)))
  7.       (do ((i 0 (+ i 1))
  8.            (nombre 0
  9.               (if (char=? (string-ref chaine i) #\a)
  10.                   (+ 1 nombre)
  11.                   nombre)))
  12.           ((= i longueur) nombre))))
  13.  
  14. (display (nombreDea "abracadabra"))
  15. (newline)

Télécharger

Division décimale :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i DivisionDecimale.scm
  4.  
  5. (define (divisionDecimale dividende diviseur)
  6.    (if (zero? diviseur)
  7.        'infini
  8.        (/ dividende diviseur)))
  9.  
  10. (display (divisionDecimale 2 0))
  11. (newline)

Télécharger

Réinitialisation :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Reinitialise.scm
  4.  
  5. (define x 3)
  6.  
  7. (define (reinitialise)
  8.    (set! x 0))
  9.  
  10. (let ()
  11.    (display x) (newline)
  12.    (set! x 5)
  13.    (display x) (newline)
  14.    (reinitialise)
  15.    (display x) (newline)
  16.    (set! x 7)
  17.    (display x) (newline)
  18.    (reinitialise)
  19.    (display x) (newline)
  20.    (set! x 4)
  21.    (display x) (newline)
  22.    (reinitialise)
  23.    (display x))
  24.    
  25. (newline)

Télécharger

Globale :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Globale.scm
  4.  
  5. (define a 3)
  6.  
  7. (define (f x)
  8.    (display (* x 2))
  9.    (newline)
  10.    (set! a (* x 2)))
  11.  
  12. (set! a 3)
  13. (let ((n 4))
  14.    (f (+ a n)))

Télécharger

Générateur de nombres pseudo-aléatoires :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Generateur.scm
  4.  
  5. (define (origine graine periode)
  6.    (modulo graine periode))
  7.  
  8. ;; Cette fonction crée et renvoie un nombre
  9. ;; pseudo-aléatoire compris entre 0 et periode-1
  10.  
  11. (define (hasard graine periode)
  12.   (modulo (+ (* graine 15) 3) periode))
  13.  
  14. ;; Cette fonction affiche periode valeurs
  15. ;; pseudo-aléatoires
  16.  
  17. (define (Generateur)
  18.   (let ((graine 8)
  19.         (periode 7))
  20.      (let boucle ((i 1)
  21.                   (laGraine (origine graine periode)))
  22.         (let ((valeur (hasard laGraine periode)))
  23.            (display valeur) (newline)
  24.            (if (< i periode)
  25.                (boucle (+ i 1) valeur))))))
  26.  
  27. (Generateur)

Télécharger

Un pseudonyme convenable :

et en Scheme :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Pseudo.scm
  4.  
  5. (define (appartient lettre mot)
  6. ;; Dans cette fonction "lettre" est censé ne contenir
  7. ;; qu'un seul caractère. On vérifie si ce caractère
  8. ;; apparaît dans la chaîne "mot"
  9.    (let ((longueur-m (string-length mot)))
  10.       (do ((i 0 (+ i 1)))
  11.           ((or (= i longueur-m)
  12.                (char=?
  13.                   (string-ref mot i)
  14.                   lettre))
  15.            (not (= i longueur-m))))))
  16.  
  17. (define (BonPseudo? pseudo)
  18.    (let ((autorises "abcdefghijklmnopqrstuvwxyz")
  19.          (longueur-p (string-length pseudo)))
  20.       (do ((i 0 (+ i 1)))
  21.           ((or (= i longueur-p)
  22.                (not (appartient
  23.                        (string-ref pseudo i)
  24.                        autorises)))
  25.            (= i longueur-p)))))
  26.  
  27. (define (Pseudo)
  28.   ;; On redemande un pseudo tant qu'il n'est pas correct
  29.    (let boucle ((pseudoOK #f))
  30.       (if (not pseudoOK)
  31.           (begin
  32.              (display "Entrer votre pseudo : ")
  33.              (let ((pseudo (read-line)))
  34.                 (if (BonPseudo? pseudo)
  35.   ;; On vérifie que chaque caractère du pseudo est
  36.   ;; autorisé
  37.                     (display "OK")
  38.                     (boucle #f))))))
  39.    (newline))
  40.  
  41. (Pseudo)

Télécharger

Portée :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Portee.scm
  4.  
  5. (define z 0)
  6. (define y 0)
  7.  
  8. (define (v x)
  9.    (let ((u (* x x)))
  10.       (set! z x)
  11.       u))
  12.  
  13. (set! y 4)
  14. (let ((t (/ 1 y)))
  15.    (display (v t))
  16.    (newline))

Télécharger

Répertoire avec des procédures :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i RepertoireFonctions.scm
  4.  
  5. (define nb 0)
  6. (define nom (make-vector nb ""))
  7. (define tel (make-vector nb ""))
  8.  
  9. (define (initialise)
  10.    (set! nb 10)
  11.    (set! nom (make-vector nb ""))
  12.    (set! tel (make-vector nb ""))
  13.    (vector-set! nom 0 "Alice")
  14.    (vector-set! tel 0 "0606060606")
  15.    (vector-set! nom 1 "Bob")
  16.    (vector-set! tel 1 "0606060607")
  17.    (vector-set! nom 2 "Charles")
  18.    (vector-set! tel 2 "0606060608")
  19.    (vector-set! nom 3 "Djamel")
  20.    (vector-set! tel 3 "0606060609")
  21.    (vector-set! nom 4 "Étienne")
  22.    (vector-set! tel 4 "0606060610")
  23.    (vector-set! nom 5 "Frédérique")
  24.    (vector-set! tel 5 "0606060611")
  25.    (vector-set! nom 6 "Guillaume")
  26.    (vector-set! tel 6 "0606060612")
  27.    (vector-set! nom 7 "Hector")
  28.    (vector-set! tel 7 "0606060613")
  29.    (vector-set! nom 8 "Isabelle")
  30.    (vector-set! tel 8 "0606060614")
  31.    (vector-set! nom 9 "Jérôme")
  32.    (vector-set! tel 9 "0606060615") )
  33.  
  34. (define (recherche s)
  35.    (do ((i 0 (+ i 1)))
  36.        ((or (= i nb)
  37.             (string=? s (vector-ref nom i)))
  38.         (if (< i nb)
  39.             (vector-ref tel i)
  40.             "Inconnu"))))
  41.  
  42. (initialise)
  43. (let ((n (read-line)))
  44.    (display (recherche n))
  45.    (newline))

Télécharger

Échange (là les méthodes normales de Scheme avec des procédures butent sur le passage des arguments par valeur ; il faut soit, comme ici, définir une forme spéciale avec define-syntax, soit comme nous le verrons plus loin « envelopper » les valeurs à échanger dans un vecteur) :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Echange.scm
  4.  
  5. (define-syntax echange
  6.    (syntax-rules ()
  7.       ((echange x y)
  8.        (let ((z x))
  9.           (set! x y)
  10.           (set! y z)))))
  11.  
  12. (let ((a 4)
  13.       (b 7))
  14.    (echange a b)
  15.    (display a) (display " ") (display b)
  16.    (newline))

Télécharger

Par valeur :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i ParValeur.scm
  4.  
  5. (define i 0)
  6.  
  7. (define (h j)
  8.    (let ((j (+ j 1)))
  9.       (display i) (newline)
  10.       (display j) (newline)
  11.       (let ((k (+ j i)))
  12.          (set! i 5)
  13.          k)))
  14.  
  15. (let ((m 1))
  16.    (set! i 10)
  17.    (display m) (newline)
  18.    (let ((n (h m)))
  19.       (display m) (newline)
  20.       (display n) (newline)
  21.       (display i) (newline) ))

Télécharger

Échange en enveloppant les valeurs dans un vecteur d’une case :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i EchangeTableaux.scm
  4.  
  5. (define (echange x y)
  6.    (if (and (vector? x)
  7.             (vector? y)
  8.             (= (vector-length x) 1)
  9.             (= (vector-length y) 1))
  10.        (let ((z (vector-ref x 0)))
  11.           (vector-set! x 0 (vector-ref y 0))
  12.           (vector-set! y 0 z))
  13.        #f))
  14.  
  15. (let ((a (vector 4))
  16.       (b (vector 7)))
  17.    (echange a b)
  18.    (display (vector-ref a 0))
  19.    (display " ")
  20.    (display (vector-ref b 0))
  21.    (newline))

Télécharger

*Chapitre 5 - Horaire, puissance, quotient

Encore les horaires :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Horaire3.scm
  4.  
  5. (define (tirerUnTrait)                                          
  6.    (newline)
  7.    (display "-----------------------------------------------")
  8.    (newline)
  9.    (newline))
  10.  
  11. (define (annoncerUnVol vol horaire)
  12.    (display "Le vol en direction de ")
  13.    (display vol)
  14.    (display " décollera à ")
  15.    (display horaire)
  16.    (tirerUnTrait))
  17.  
  18. (annoncerUnVol "Tokyo" "9h00")
  19. (annoncerUnVol "Sydney" "9h30")
  20. (annoncerUnVol "Toulouse" "9h45")

Télécharger

Élever à la puissance :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Puissance.scm
  4.  
  5. (define (puissance n)
  6.    (if (zero? n)
  7.        1
  8.        (* 2 (puissance (- n 1)))))
  9.  
  10. (display (puissance 10))
  11. (newline)

Télécharger

Le quotient :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Quotient.scm
  4.  
  5. (define (monquotient dividende diviseur)
  6.    (if (< dividende diviseur)
  7.        0
  8.        (+ 1 (monquotient (- dividende diviseur) diviseur))))
  9.  
  10. (display (monquotient 17 3))
  11. (newline)

Télécharger

*Chapitre 11 - Répertoire

Nous nous proposons d’informatiser la consultation de notre répertoire téléphonique, enregistré comme suit dans un fichier :

Voici la procédure principale. Elle commence par compter les lignes du fichier pour en déduire la taille du répertoire : en effet, les vecteurs qui vont nous servir à enregistrer les noms et les numéros de téléphone sont de type rigide, comme exposé ci-dessus, il nous faut donc connaître leur taille à l’avance pour les créer, il ne sera plus possible de les agrandir ensuite. Puis elle invoque la procédure de construction de l’annuaire proprement dit dans deux vecteurs noms et tels, et enfin appelle la procédure qui demande à l’utilisateur d’entrer le nom recherché, soumis à la procédure de recherche dans l’annuaire :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; fichier repertoire.scm
  3.  
  4. (define (Repertoire fichier)
  5.    (let* ((tailleRepertoire (/ (compter-lignes fichier) 2))
  6.           (noms (make-vector tailleRepertoire ""))
  7.           (tels (make-vector tailleRepertoire "")))
  8.       (ConstruireRepertoire fichier tailleRepertoire noms tels)
  9.       (print "Entrez le nom, f si fini")
  10.       (do ((leNom "##" (symbol->string (read))))
  11.           ((string=? leNom "f"))
  12.           (if (not (string=? leNom "##"))
  13.               (begin    
  14.                  (print leNom " : " (Recherche leNom noms tels))
  15.                  (print "Entrez le nom, f si fini")) )) ))

Télécharger

Voici la procédure pour compter les lignes du fichier qui contient le répertoire (ici nous avons deux lignes par entrée dans le répertoire) :

  1. ;; fichier compter-lignes.scm
  2.  
  3. (define (compter-lignes fichier-repertoire)
  4.    (let ((ip (open-input-file fichier-repertoire)))
  5.       (let boucle ((n 0)
  6.                    (ligne (read-line ip)))
  7.          (if (eof-object? ligne)
  8.              (begin
  9.                 (close-input-port ip)
  10.                 n)
  11.              (boucle
  12.                 (+ n 1)
  13.                 (read-line ip))))))

Télécharger

Il nous faut d’abord charger le fichier en mémoire sous une forme propre à faciliter sa consultation ultérieure :

  1. ;; fichier repertoire-chargement.scm
  2.  
  3. (define (ConstruireRepertoire fichier tailleRepertoire noms tels)
  4.    (let ((ip (open-input-file fichier)))
  5.       (do ((i 0 (+ i 1)))
  6.           ((= i tailleRepertoire)
  7.            (close-input-port ip))
  8.           (vector-set! noms i (read-line ip))
  9.           (vector-set! tels i (read-line ip)))))

Télécharger

La procédure de recherche d’un nom dans le répertoire :

  1. ;; fichier repertoire-recherche.scm
  2.  
  3. ;; Recherche du numéro associé au nom
  4. (define (Recherche leNom noms tels)
  5.    (let ((tailleRepertoire (vector-length noms)))
  6.       (do ((i 0 (+ i 1)))
  7.           ((or (= i tailleRepertoire)
  8.                (string=? leNom (vector-ref noms i)))
  9.            (if (< i tailleRepertoire)
  10.                (vector-ref tels i)
  11.                "Inconnu")))))

Télécharger

Pour faire de ces programmes un module compilable il faut ajouter le fichier suivant :

  1. ;; fichier repertoire-main.scm
  2.  
  3. (module Repertoire
  4.    (include "repertoire.scm")
  5.    (include "repertoire-chargement.scm")
  6.    (include "repertoire-recherche.scm")
  7.    (include "compter-lignes.scm")
  8.    (main Init))
  9.  
  10. (define (Init Args)
  11.    (let ((fichier (cadr Args)))
  12.       (Repertoire fichier)))

Télécharger

On compilera et on exécutera ce programme par les commandes suivantes :

*Chapitre 12 - Des lettres au hasard

Des lettres au hasard :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Alea.scm
  4.  
  5. (do ((i 1 (+ i 1)))
  6.     ((> i 1000)
  7.      (newline))
  8.     (display (integer->char
  9.                 (+ (char->integer #\a)
  10.                    (random 26)))))

Télécharger

*Chapitre 18 - Additioneur binaire

Additioneur binaire :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i Addition.scm
  4.  
  5. (define (Init)
  6.    (let ((n (make-vector 10 #f)) ; opérande
  7.          (p (make-vector 10 #f))) ; opérande
  8.       (vector-set! n 0 #t)
  9.       (vector-set! n 1 #t)
  10.       (vector-set! n 2 #t)
  11.       (vector-set! p 1 #t)
  12.       (Addition n p)))
  13.  
  14. (define (Addition n p)
  15.    (let* ((longueur (vector-length n))
  16.           (r (make-vector (+ longueur 1) #t)) ; résultat
  17.           (c #f))                 ; retenue
  18.       (do ((i 0 (+ i 1)))
  19.           ((= i longueur) (AfficheCalcul n p r c))
  20.           (let ((a (vector-ref n i))
  21.                 (b (vector-ref p i)))
  22.              (vector-set! r i
  23.                 (or (and a (not b) (not c))
  24.                     (and (not a) b (not c))
  25.                     (and (not a) (not b) c)
  26.                     (and a b c)))
  27.              (set! c (or (and a b) (and b c) (and a c)))
  28.              (vector-set! r longueur c)))))
  29.  
  30. (define (AfficheCalcul n p r c)
  31.    (display " ")
  32.    (AfficheLigneCalcul n)
  33.    (display " ")
  34.    (AfficheLigneCalcul p)
  35.    (AfficheLigneCalcul r) )
  36.  
  37. (define (AfficheLigneCalcul la-ligne)
  38.    (let ((longueur (vector-length la-ligne)))
  39.       (do ((i 0 (+ i 1)))
  40.           ((= i longueur))
  41.           (if (vector-ref la-ligne (- longueur i 1))
  42.               (display "1")
  43.               (display "0"))))
  44.    (newline))
  45.  
  46. (Init)

Télécharger

*Chapitre 20 - Recherche dans un répertoire

**Recherche dichotomique dans un répertoire

Nous nous proposons d’informatiser la consultation de notre répertoire téléphonique, enregistré comme ci-dessus (pour le chapitre 11) dans un fichier.

Le répertoire, avec recherche dichotomique :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; fichier repertoire.scm
  3.  
  4. (define (Repertoire fichier)
  5.    (let* ((tailleRepertoire (/ (compter-lignes fichier) 2))
  6.           (noms (make-vector tailleRepertoire ""))
  7.           (tels (make-vector tailleRepertoire "")))
  8.       (ConstruireRepertoire fichier tailleRepertoire noms tels)
  9.       (print "Entrez le nom, f si fini")
  10.       (do ((leNom "##" (symbol->string (read))))
  11.           ((string=? leNom "f"))
  12.           (if (not (string=? leNom "##"))
  13.               (begin    
  14.                  (print leNom " : " (Recherche leNom noms tels))
  15.                  (print "Entrez le nom, f si fini")) )) ))

Télécharger

Voici la procédure pour compter les lignes du fichier qui contient le répertoire (ici nous avons deux lignes par entrée dans le répertoire) :

  1. ;; fichier compter-lignes.scm
  2.  
  3. (define (compter-lignes fichier-repertoire)
  4.    (let ((ip (open-input-file fichier-repertoire)))
  5.       (let boucle ((n 0)
  6.                    (ligne (read-line ip)))
  7.          (if (eof-object? ligne)
  8.              (begin
  9.                 (close-input-port ip)
  10.                 n)
  11.              (boucle
  12.                 (+ n 1)
  13.                 (read-line ip))))))

Télécharger

Il nous faut d’abord charger le fichier en mémoire sous une forme propre à faciliter sa consultation ultérieure :

  1. ;; fichier repertoire-chargement.scm
  2.  
  3. (define (ConstruireRepertoire fichier tailleRepertoire noms tels)
  4.    (let ((ip (open-input-file fichier)))
  5.       (do ((i 0 (+ i 1)))
  6.           ((= i tailleRepertoire)
  7.            (close-input-port ip))
  8.           (vector-set! noms i (read-line ip))
  9.           (vector-set! tels i (read-line ip)))))

Télécharger

Voici un programme de recherche dichotomique, plus efficace que celui du chapitre 11 :

  1. ;; fichier repertoire-dichot-recherche.scm
  2. ;; Recherche du numéro associé au nom leNom
  3.  
  4. (define (Recherche leNom noms tels)
  5.    (let ((tailleRepertoire (vector-length noms)))
  6.       (let boucle ((milieu (quotient tailleRepertoire 2))
  7.                    (inf 0)
  8.                    (sup (- tailleRepertoire 1)))
  9.          (cond
  10.             ((> inf sup)
  11.              #f)
  12.             ((string=? leNom (vector-ref noms milieu))
  13.              (vector-ref tels milieu))
  14.             ((string<? leNom (vector-ref noms milieu))
  15.              (boucle (quotient (+ inf sup) 2) inf (- milieu 1)))
  16.             ((string>? leNom (vector-ref noms milieu))
  17.              (boucle (quotient (+ inf sup) 2) (+ milieu 1) sup)) ))))

Télécharger

Pour faire de ces programmes un module compilable il faut ajouter le fichier suivant :

  1. ;; fichier repertoire-dichot-main.scm, compilé par la comande :
  2. ;; bigloo repertoire-dichot-main.scm -o repertoire-dichot
  3.  
  4.  
  5. (module Repertoire
  6.    (include "repertoire.scm")
  7.    (include "repertoire-chargement.scm")
  8.    (include "repertoire-dichot-recherche.scm")
  9.    (include "compter-lignes.scm")
  10.    (main Init))
  11.  
  12. (define (Init Args)
  13.    (let ((fichier (cadr Args)))
  14.       (Repertoire fichier)))

Télécharger

On compilera et on exécutera ce programme par les commandes suivantes :

**Recherche dans un répertoire, avec adressage associatif

Le programme de répertoire, compilé, avec adressage associatif (hash table). Voici le fichier principal repertoire-hash-main.scm :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Compilation :
  3. ;; $ bigloo repertoire-hash-main.scm -o repertoire-hash
  4. ;; Appel du programme compilé sous le nom Repertoire :
  5. ;; $ ./repertoire-hash repertoire.txt
  6. ;; (si le fichier de données se nomme "repertoire.txt")
  7.  
  8. (module Repertoire
  9.    (include "repertoire-hash.scm")
  10.    (include "repertoire-hash-chargement.scm")
  11.    (include "repertoire-hash-recherche.scm")
  12.    (include "compter-lignes.scm")
  13.    (main Init))
  14.  
  15. (define (Init Args)
  16.    (let ((fichier (cadr Args)))
  17.       (Repertoire fichier)))

Télécharger

  1. ;; fichier repertoire-hash.scm
  2.  
  3. (define (Repertoire fichier)
  4.    (let* ((tailleRepertoire (/ (compter-lignes fichier) 2))
  5.           (leRepertoire (make-vector tailleRepertoire '())))
  6.       (ConstruireRepertoire fichier leRepertoire)
  7.       (let boucle ()
  8.          (display "Nom ? ")
  9.          (let ((leNom (read-line)))
  10.             (if (> (string-length leNom) 0)
  11.                 (begin
  12.                    (print (Recherche leNom leRepertoire))
  13.                    (boucle)))))))

Télécharger

Voici la procédure pour compter les lignes du fichier qui contient le répertoire (ici nous avons deux lignes par entrée dans le répertoire) :

  1. ;; fichier compter-lignes.scm
  2.  
  3. (define (compter-lignes fichier-repertoire)
  4.    (let ((ip (open-input-file fichier-repertoire)))
  5.       (let boucle ((n 0)
  6.                    (ligne (read-line ip)))
  7.          (if (eof-object? ligne)
  8.              (begin
  9.                 (close-input-port ip)
  10.                 n)
  11.              (boucle
  12.                 (+ n 1)
  13.                 (read-line ip))))))

Télécharger

  1. ;; fichier repertoire-hash-chargement.scm
  2.  
  3. (define (ConstruireRepertoire fichier leRepertoire)
  4.   (let ((tailleRepertoire (vector-length leRepertoire))
  5.         (flux-entree (open-input-file fichier)))
  6.       (if (not (eof-object? (peek-char flux-entree)))
  7.           (let boucle ((nom (read-line flux-entree))
  8.                        (tel (read-line flux-entree)))
  9.              (let ((i (hash nom tailleRepertoire)))
  10.                 (vector-set! leRepertoire i
  11.                    (cons (cons nom tel) (vector-ref leRepertoire i)))
  12.                 (if (eof-object? (peek-char flux-entree))
  13.                     (close-input-port flux-entree)
  14.                     (boucle
  15.                        (read-line flux-entree)
  16.                        (read-line flux-entree))))))))

Télécharger

La fonction d’association :

  1. ;; fichier hash.scm
  2.  
  3. (define (hash nom n)
  4.    (remainder
  5.       (apply + (map char->integer (string->list nom)))
  6.       n))

Télécharger

  1. ;; fichier repertoire-hash-recherche.scm
  2.  
  3. ;; Recherche du numéro associé au nom
  4. (define (Recherche leNom leRepertoire)
  5.    (let* ((tailleRepertoire (vector-length leRepertoire))
  6.           (i (hash leNom tailleRepertoire))
  7.           (resultat (assoc leNom (vector-ref leRepertoire i))))
  8.       (if resultat
  9.           (cdr resultat)
  10.           "Inconnu")))

Télécharger

**Zéro d’une fonction

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i ZeroDUneFonction.scm
  4.  
  5. (define (Pi)
  6.    (let ((seuil (expt 10 -5))
  7.          (inf 2)
  8.          (sup 4))
  9.       (let boucle ((milieu (/ (+ inf sup) 2)))
  10.          (if (and (> (- sup inf) seuil)
  11.                   (> (abs (sin milieu)) seuil))
  12.              (begin
  13.                 (if (<= (* (sin inf) (sin milieu)) 0)
  14.                     (set! sup milieu)
  15.                     (set! inf milieu))
  16.                 (boucle (/ (+ inf sup) 2)))
  17.              (display milieu)))
  18.       (newline)))
  19.  
  20. (Pi)

Télécharger

*Chapitre 21 - Tri par sélection et par fusion

**Tri par sélection

Le principe du tri par sélection est le suivant : on met en bonne position l’élément numéro 1, c’est-à-dire le plus petit. Puis en met en bonne position l’élément suivant. Et ainsi de suite jusqu’au dernier. Par exemple, si l’on part d’un tableau dans l’état suivant :

On commence par rechercher, parmi les 12 valeurs, quel est le plus petit élément, et où il se trouve. On l’identifie en quatrième position (c’est le nombre 3), et on l’échange alors avec le premier élément (le nombre 45). Le tableau devient ainsi :

On recommence à chercher le plus petit élément, mais cette fois, seulement à partir du deuxième (puisque le premier est maintenant correct, on n’y touche plus). On le trouve en troisième position (c’est le nombre 12). On échange donc le deuxième avec le troisième :

On recommence à chercher le plus petit élément à partir du troisième (puisque les deux premiers sont maintenant bien placés), et on le place correctement, en l’échangeant, ce qui donnera in fine :

Nous aurons besoin d’un algorithme pour déterminer l’indice du plus petit élément d’un vecteur, à partir d’un certain indice i :

Voici l’algorithme de tri par sélection :

Soit en Scheme :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i TriSelection.scm
  4.  
  5. ;; initialisation d'un tableau avec des nombres aléatoires
  6.  
  7. (define (RandomInitialise V)
  8.   (let ((nbItems (vector-length V)))
  9.     (do ((item 0 (+ item 1)))
  10.         ((= item nbItems))
  11.       (vector-set! V item (random 1000)))))
  12.  
  13. ;; affichage d'un tableau
  14.  
  15. (define (AfficheTableau V)
  16.   (let ((nbItems (vector-length V)))
  17.     (do ((item 0 (+ item 1)))
  18.         ((= item nbItems))
  19.       (display (vector-ref V item))
  20.       (display " "))
  21.     (newline)))
  22.  
  23. ;; donner l'indice du plus petit élément de V :
  24. (define (MinR V i)
  25.    (let ((imin i)
  26.          (nbItems (vector-length V)))
  27.       (do ((j (+ i 1) (+ j 1)))
  28.           ((>= j nbItems)  imin)
  29.           (if (> (vector-ref V imin)
  30.                  (vector-ref V j))
  31.               (set! imin j)))))
  32.  
  33. ;; permuter deux éléments de V :
  34. (define (permute V i j)
  35.    (let ((temp (vector-ref V i)))
  36.       (vector-set! V i (vector-ref V j))
  37.       (vector-set! V j temp)))
  38.  
  39. (define (TriSelection)
  40.    (let* ((nbItems 16)
  41.           (V (make-vector nbItems 0)))
  42.  
  43.       (RandomInitialise V)
  44.       (AfficheTableau V)
  45.  
  46.       (do ((i 0 (+ i 1)))
  47.           ((= i nbItems) V)
  48.           (let ((posmini (MinR V i)))
  49.              (permute V i posmini)))
  50.  
  51.       (AfficheTableau V)
  52.       (newline)))
  53.  
  54. (TriSelection)

Télécharger

**Tri par fusion

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i TriFusion.scm
  4.  
  5. ;; initialisation d'un tableau avec des nombres aléatoires
  6.  
  7. (define (RandomInitialise items)
  8.   (let ((nbItems (vector-length items)))
  9.     (do ((item 0 (+ item 1)))
  10.         ((= item nbItems))
  11.       (vector-set! items item (random 1000)))))
  12.  
  13. ;; affichage d'un tableau
  14.  
  15. (define (AfficheTableau items)
  16.   (let ((nbItems (vector-length items)))
  17.     (do ((item 0 (+ item 1)))
  18.         ((= item nbItems))
  19.       (display (vector-ref items item))
  20.       (display " "))
  21.     (newline)))
  22.  
  23. (define (TriFusion)
  24.    (let* ((nbItems 16)
  25.           (items (make-vector nbItems 0))
  26.           (items1 (make-vector nbItems 0)))
  27. ;; initialisation du tableau avec des nombres aléatoires
  28.       (RandomInitialise items)
  29.  
  30. ;; affichage du tableau avant tri
  31.       (AfficheTableau items)
  32.  
  33.       (do ((taille 1 (* taille 2)))
  34.           ((> taille nbItems))
  35.           (if (< taille nbItems)
  36.               (let ((debut 0)
  37.                     (x 0)
  38.                     (y taille))
  39.                  (do ((i 0 (+ i 1)))
  40.                      ((= i nbItems))
  41.                      (if (or (and (< x (+ debut taille))
  42.                                   (< y (+ debut (* 2 taille)))
  43.                                   (< (vector-ref items x)
  44.                                      (vector-ref items y)))
  45.                              (= y (+ debut (* 2 taille))))
  46.                          (begin
  47.                             (vector-set! items1 i
  48.                                (vector-ref items x))
  49.                             (set! x (+ x 1)))
  50.                          (begin
  51.                             (vector-set! items1 i
  52.                                (vector-ref items y))
  53.                             (set! y (+ y 1))))
  54.                      (if (and (= x (+ debut taille))
  55.                               (= y (+ debut (* taille 2))))
  56.                          (begin
  57.                             (set! debut (+ debut (* taille 2)))
  58.                             (set! x debut)
  59.                             (set! y (+ debut taille)))))
  60.                  (do ((i 0 (+ i 1)))
  61.                      ((= i nbItems))
  62.                      (vector-set! items i
  63.                         (vector-ref items1 i)))) ))
  64.  
  65.       (AfficheTableau items)
  66.       (newline)))
  67.  
  68. (TriFusion)

Télécharger

Tri par fusion, récursif :

  1. ;; Ces programmes sont sous licence CeCILL-B V1.
  2. ;; Exécution en ligne de commande avec Bigloo :
  3. ;; $ bigloo -i TriFusion.scm
  4.  
  5. (define nbItems 16)
  6. (define items (make-vector nbItems 0))
  7.  
  8. ;; initialisation du tableau avec des nombres aléatoires
  9.  
  10. (define (RandomInitialise items)
  11.   (let ((nbItems (vector-length items)))
  12.     (do ((item 0 (+ item 1)))
  13.         ((= item nbItems))
  14.       (vector-set! items item (random 1000)))))
  15.  
  16. ;; affichage du tableau avant tri
  17.  
  18. (define (AfficheTableau items)
  19.   (let ((nbItems (vector-length items)))
  20.     (do ((item 0 (+ item 1)))
  21.         ((= item nbItems))
  22.       (display (vector-ref items item))
  23.       (display " "))
  24.     (newline)))
  25.  
  26. (define (fusion items debut milieu fin)
  27.   (let* ((nbItems (vector-length items))
  28.          (item1 debut)
  29.          (item2 milieu)
  30.          (temp (make-vector nbItems 0)))
  31.     (do ((item debut (+ item 1)))
  32.         ((= item fin))
  33.       (if (or (= item2 fin)
  34.               (and (< item1 milieu)
  35.                    (< (vector-ref items item1)
  36.                       (vector-ref items item2))))
  37.           (begin
  38.             (vector-set! temp item (vector-ref items item1))
  39.             (set! item1 (+ item1 1)))
  40.           (begin
  41.             (vector-set! temp item (vector-ref items item2))
  42.             (set! item2 (+ item2 1)))))
  43.     (do ((item debut (+ item 1)))
  44.         ((= item fin))
  45.       (vector-set! items item (vector-ref temp item)))))
  46.  
  47. (define (triFusion items debut fin)
  48.   (if (> (- fin debut) 1)
  49.       (let ((milieu (quotient (+ debut fin) 2)))
  50.         (triFusion items debut milieu)
  51.         (triFusion items milieu fin)
  52.         (fusion items debut milieu fin))))
  53.  
  54. (RandomInitialise items)
  55. (AfficheTableau items)
  56. (triFusion items 0 (vector-length items))
  57. (AfficheTableau items)

Télécharger