par Laurent Bloch
- Chapitre 1 - Bataille navale, taxes, fractions
- Chapitre 2 - Température, calendrier, recherche de mot
- Chapitre 3 - Newton, factorielle, répertoire, polynôme
- Chapitre 4 - Horaire, comptage, division, aléa, pseudonyme, répertoire
- Chapitre 5 - Horaire, puissance, quotient
- Chapitre 11 - Répertoire
- Chapitre 12 - Des lettres au hasard
- Chapitre 18 - Additioneur binaire
- Chapitre 20 - Recherche dans un répertoire
- Chapitre 21 - Tri par sélection et par fusion
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 :
- ;; Ces programmes sont sous licence CeCILL-B V1
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i BatailleNavale.scm
- (define a 4)
- (define b 7)
- (define (BatailleNavale)
- (display "À vous de jouer, deux entiers : ")
- (newline)
- (let* ((x (read))
- (y (read)))
- (display (Tir x y))
- (newline)))
- (define (Tir x y)
- (cond
- ((and (= x a) (= y b))
- "Coulé")
- ((or (= x a) (= y b))
- "En vue")
- (else
- "À l'eau")))
- (BatailleNavale)
Taxes :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Taxes.scm
- (define (Taxes)
- (display "Quel est le prix hors taxes ?")
- (newline)
- (let ((ht (read)))
- (display "Le prix toutes taxes comprises est ")
- (display (TTC ht))
- (newline)))
- (define (TTC ht)
- (+ ht (/ (* ht 19.6) 100)))
- (Taxes)
Taux quelconque :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i TauxQuelconque.scm
- (define (TauxQuelconque)
- (display "Quel est le prix hors taxes ?")
- (newline)
- (let ((ht (read)))
- (display "Quel est le taux de TVA ?")
- (newline)
- (let ((taux (read)))
- (display "Le prix toutes taxes comprises est ")
- (newline)
- (display (TTC ht taux))
- (newline))))
- (define (TTC ht taux)
- (+ ht (/ (* ht taux) 100)))
- (TauxQuelconque)
Fraction :
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Fraction.scm
- (define (Fraction)
- (let* ((a (read))
- (b (read))
- (c (read))
- (d (read)))
- (if (or (zero? b) (zero? d))
- (display "Impossible d'avoir un dénominateur nul !")
- (begin
- (display (* a c))
- (newline)
- (display (* b d)) ))
- (newline)))
- (Fraction)
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i FractionAdd.scm
- (define (FractionAdd)
- (let* ((a (read))
- (b (read))
- (c (read))
- (d (read)))
- (if (or (zero? b) (zero? d))
- (display "Impossible d'avoir un dénominateur nul !")
- (begin
- (display (+ (* a d) (* b c)))
- (newline)
- (display (* b d)) ))
- (newline)))
- (FractionAdd)
Second degré :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i SecondDegre.scm
- (define (SecondDegre)
- (display "Entrez les coefficients a, b et c : ")
- (let* ((a (read))
- (b (read))
- (c (read))
- (resultat (Calcul a b c)))
- (cond ((not resultat)
- (display "Pas de racine !")
- (newline))
- ((number? resultat)
- (display "Une racine : ")
- (display resultat)
- (newline))
- (else
- (display "Deux racines, ")
- (display (car resultat))
- (display " et ")
- (display (cdr resultat))
- (newline)))))
- (define (Calcul a b c)
- (let ((delta (- (* b b) (* 4 a c))))
- (cond ((< delta 0)
- #f)
- ((zero? delta)
- (/ (- b) (* 2 a)))
- (else
- (cons (/ (- (sqrt delta) b) (* 2 a))
- (/ (- (+ (sqrt delta) b)) (* 2 a)))))))
- (SecondDegre)
Poste :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Poste.scm
- (define (Poste)
- (display "Entrez type de lettre et poids, sur deux lignes : ")
- (let* ((type (read-line))
- (poids (read)))
- (if (Prix type poids)
- (display (Prix type poids))
- (display "Pas au tarif !"))
- (newline)))
- (define (Prix type poids)
- (cond ((string=? type "verte")
- (cond
- ((<= poids 20) 0.57)
- ((<= poids 50) 0.95)
- ((<= poids 100) 1.40)
- (else #f)))
- ((string=? type "prioritaire")
- (cond
- ((<= poids 20) 0.60)
- ((<= poids 50) 1.00)
- ((<= poids 100) 1.45)
- (else #f)))
- ((string=? type "ecopli")
- (cond
- ((<= poids 20) 0.55)
- ((<= poids 50) 0.78)
- ((<= poids 100) 1.00)
- (else #f)))))
- (Poste)
Chapitre 2 - Température, calendrier, recherche de mot
Température, d’abord l’algorithme en pseudo-code :
puis le programme en Scheme :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Temperature-do.scm
- (define (Moyenne observations)
- (let ((nbJours (vector-length observations)))
- (do ((jour 0 (+ jour 1))
- (somme 0 (+ somme (vector-ref observations jour))))
- ((= jour nbJours)
- (/ somme nbJours)) )))
- (define (Temperature)
- (display "Entrez les valeurs, F à la fin : ")
- (let boucle ((L '())
- (val (read)))
- (if (number? val)
- (boucle (cons val L) (read))
- (print (Moyenne (list->vector L))))))
- (Temperature)
Calendrier :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Calendrier-do.scm
- (define (bissextile? annee)
- (or (and (zero? (modulo annee 4))
- (not (zero? (modulo annee 100))))
- (zero? (modulo annee 400))))
- (define (nbJoursMois annee mois)
- (if (= mois 2)
- (if (bissextile? annee) 29 28)
- (+ 30
- (modulo
- (+ mois (quotient mois 8))
- 2))))
- (define (Calendrier)
- (display "Année : ")
- (let ((annee (read)))
- (do ((mois 1 (+ 1 mois)))
- ((> mois 12)
- (newline))
- (let ((nbj (nbJoursMois annee mois)))
- (do ((jour 1 (+ jour 1)))
- ((> jour nbj) (newline))
- (display jour)
- (display " / ")
- (display mois)
- (newline))))))
- (Calendrier)
Logarithme :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Elog.scm
- (define (Elog)
- (let iter ((x (read))
- (n 0))
- (if (> x 1.)
- (iter (/ x 2) (+ n 1))
- (display n)))
- (newline))
- (Elog)
Oui ?
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Oui-do.scm
- (define (Oui)
- (let* ((s "oouui un ouui ou un non ce n'est pourtant pas la même chose ouui")
- (resultat (Present? "oui" s)))
- (if resultat
- (display resultat)
- (display "Pas de oui"))
- (newline)))
- (define (Present? mot texte)
- (let* ((l-mot (string-length mot))
- (l-texte (string-length texte))
- (derniere-chance (- l-texte l-mot)))
- (do ((n 0 (+ n 1)))
- ((or (> n derniere-chance)
- (string=?
- (substring texte n (+ n l-mot))
- mot))
- (if (> n derniere-chance)
- #f n)))))
- (Oui)
Second degré :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i SecondDegreTest.scm
- (define (SecondDegreTest)
- (let* ((a (read))
- (b (read))
- (c (read))
- (delta (- (* b b) (* 4 a c))))
- (if (zero? a)
- (display "Pas une équation du second degré")
- (let ((resultat (Calcul a b c)))
- (cond
- ((not resultat)
- (display "Pas de racine !")
- (newline))
- ((number? resultat)
- (display "Une racine : ")
- (display resultat)
- (newline))
- (else
- (display "Deux racines, ")
- (display (car resultat))
- (display " et ")
- (display (cdr resultat))
- (newline)))))))
- (define (Calcul a b c)
- (let ((delta (- (* b b) (* 4 a c))))
- (cond ((< delta 0)
- #f)
- ((zero? delta)
- (/ (- b) (* 2 a)))
- (else
- (cons (/ (- (sqrt delta) b) (* 2 a))
- (/ (- (+ (sqrt delta) b)) (* 2 a)))))))
- (SecondDegreTest)
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Terminaison-do.scm
- (define (Terminaison)
- (let ((s 2)
- (p #f))
- (let boucle ()
- (if (not p)
- (begin
- (do ((i 1 (+ i 1)))
- ((>= i s))
- (let ((j (- s i)))
- (if (= (* i i)
- (* 25 j j))
- (begin
- (display i)
- (display " ")
- (display j)
- (newline)
- (set! p #t)))))
- (set! s (+ s 1))
- (boucle)) ))))
- (Terminaison)
Chapitre 3 - Newton, factorielle, répertoire, polynôme
Mesure principale :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i MesurePrincipale.scm
- (define (MesurePrincipale)
- (let* ((pi (* 4 (atan 1.0)))
- (alpha (read))
- (n (floor (/ alpha (* 2 pi))))
- (principale (- alpha (* 2 n pi))))
- (let ((principale
- (if (> principale pi)
- (- principale (* 2 pi))
- principale)))
- (display principale)
- (newline))))
- (MesurePrincipale)
Racine de 2 par la méthode de Newton :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i RacineDeDeux.scm
- (define (RacineDeDeux)
- (display "Entrez la précision désirée (puissance de 10) : ")
- (let* ((n (read))
- (epsilon (expt 10 (- n))))
- (display (laRacine epsilon))
- (newline)))
- (define (laRacine epsilon)
- (let boucle ((racine 1)
- (racineprec 2))
- (if (> (abs (- racine racineprec))
- epsilon)
- (boucle
- (/ 1 (+ 2 racineprec))
- racine)
- (+ racine 1))))
- (RacineDeDeux)
Factorielle :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Factorielle-do.scm
- (define (Factorielle)
- (display "Entrez n : ")
- (let ((n (read)))
- (display (laFactorielle n))
- (newline)))
- (define (laFactorielle n)
- (do ((i 1 (+ i 1))
- (f 1 (* i f)))
- ((> i n) f)))
- (Factorielle)
Répertoire :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Repertoire.scm
- (define (Repertoire)
- (let* ((tailleRepertoire 10)
- (nom (make-vector tailleRepertoire ""))
- (tel (make-vector tailleRepertoire "")))
- (vector-set! nom 0 "Alice")
- (vector-set! tel 0 "0606060606")
- (vector-set! nom 1 "Bob")
- (vector-set! tel 1 "0606060607")
- (vector-set! nom 2 "Charles")
- (vector-set! tel 2 "0606060608")
- (vector-set! nom 3 "Djamel")
- (vector-set! tel 3 "0606060609")
- (vector-set! nom 4 "Étienne")
- (vector-set! tel 4 "0606060610")
- (vector-set! nom 5 "Frédérique")
- (vector-set! tel 5 "0606060611")
- (vector-set! nom 6 "Guillaume")
- (vector-set! tel 6 "0606060612")
- (vector-set! nom 7 "Hector")
- (vector-set! tel 7 "0606060613")
- (vector-set! nom 8 "Isabelle")
- (vector-set! tel 8 "0606060614")
- (vector-set! nom 9 "Jérôme")
- (vector-set! tel 9 "0606060615")
- ;; Recherche du numéro associé au nom s
- (display "Nom ? ")
- (let ((s (read-line)))
- (display (Recherche s nom tel))
- (newline))))
- (define (Recherche s nom tel)
- (let ((tailleRepertoire (vector-length nom)))
- (let boucle ((i 0))
- (if (and (< i tailleRepertoire)
- (not (string=? s (vector-ref nom i))))
- (boucle (+ i 1))
- (if (< i tailleRepertoire)
- (vector-ref tel i)
- "Inconnu")))))
- (Repertoire)
Calcul formel :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i CalculFormel.scm
- (define (laValeur t x y) ; vecteur t des coefficients
- (let ((degreMax (- (vector-length t) 1)))
- (let boucle ((degre 0)
- (c 1))
- (set! y (+ y (* (vector-ref t degre) c)))
- (if (< degre degreMax)
- (boucle (+ degre 1) (* c x))
- y))))
- (define (laDerivee t)
- (let* ((longueur (vector-length t))
- (u (make-vector longueur 0))
- (degreMax (- longueur 1)))
- (let boucle ((degre 0))
- (if (= degre degreMax)
- (vector-set! u degre 0)
- (begin
- (vector-set! u degre
- (* (vector-ref t (+ degre 1)) (+ degre 1)))
- (boucle (+ degre 1)))))
- u))
- (define (AffichePolynome p)
- (let ((degreMax (- (vector-length p) 1)))
- (let boucle ((degre 0))
- (display (vector-ref p degre))
- (if (> degre 0)
- (begin
- (display " x")
- (if (> degre 1)
- (begin
- (display "^")
- (display degre)))))
- (if (< degre degreMax)
- (begin
- (display " + ")
- (boucle (+ degre 1)))))))
- (define (CalculFormel)
- (let* ((degreMax 3)
- (t (make-vector (+ degreMax 1) 0))
- (degre 0))
- (vector-set! t 3 2) ;; coefficients du
- (vector-set! t 2 8) ;; polynôme dans
- (vector-set! t 1 7) ;; un vecteur t
- (vector-set! t 0 3)
- ;; Affichage de la fonction
- (AffichePolynome t)
- (newline)
- ;; Calcul et affichage de sa valeur
- (let ((x 5)
- (y 0))
- (display (laValeur t x y))
- (newline))
- ;; Calcul de sa dérivée
- (let ((u (laDerivee t)))
- (AffichePolynome u)
- (newline))))
- (CalculFormel)
Initiales :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Initiales.scm
- (define (AfficheInitiales)
- (display "Nom ? ")
- (let ((nom (read-line)))
- (map display (Initiales nom))
- (newline)))
- (define (Initiales nom)
- (if (> (string-length nom) 0)
- (let ((avant-dernier (- (string-length nom) 2))
- (premier (string-ref nom 0)))
- (let boucle ((listeInitiales (list premier))
- (i 1))
- (if (<= i avant-dernier)
- (if (char=? (string-ref nom i) #\space)
- (boucle
- (cons (string-ref nom (+ i 1))
- listeInitiales)
- (+ i 1))
- (boucle listeInitiales (+ i 1)))
- (reverse listeInitiales) )))
- '()))
Chapitre 4 - Horaire, comptage, division, aléa, pseudonyme, répertoire
Horaire :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Horaire.scm
- (define (tirerUnTrait)
- (newline)
- (display "-----------------------------------------------")
- (newline)
- (newline))
- (display "Le vol en direction de ")
- (display "Tokyo")
- (display " décollera à ")
- (display "9h00")
- (tirerUnTrait)
- (display "Le vol en direction de ")
- (display "Sydney")
- (display " décollera à ")
- (display "9h30")
- (tirerUnTrait)
- (display "Le vol en direction de ")
- (display "Toulouse")
- (display " décollera à ")
- (display "9h45")
- (tirerUnTrait)
Horaire encore :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Horaire2.scm
- (define (tirerUnTrait)
- (newline)
- (display "-----------------------------------------------")
- (newline)
- (newline))
- (define (annoncerUnVol vol horaire)
- (display "Le vol en direction de ")
- (display vol)
- (display " décollera à ")
- (display horaire)
- (tirerUnTrait))
- (annoncerUnVol "Tokyo" "9h00")
- (annoncerUnVol "Sydney" "9h30")
- (annoncerUnVol "Toulouse" "9h45")
Nombre de a :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i NombreDea-do.scm
- (define (nombreDea chaine)
- (let ((longueur (string-length chaine)))
- (do ((i 0 (+ i 1))
- (nombre 0
- (if (char=? (string-ref chaine i) #\a)
- (+ 1 nombre)
- nombre)))
- ((= i longueur) nombre))))
- (display (nombreDea "abracadabra"))
- (newline)
Division décimale :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i DivisionDecimale.scm
- (define (divisionDecimale dividende diviseur)
- (if (zero? diviseur)
- 'infini
- (/ dividende diviseur)))
- (display (divisionDecimale 2 0))
- (newline)
Réinitialisation :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Reinitialise.scm
- (define x 3)
- (define (reinitialise)
- (set! x 0))
- (let ()
- (display x) (newline)
- (set! x 5)
- (display x) (newline)
- (reinitialise)
- (display x) (newline)
- (set! x 7)
- (display x) (newline)
- (reinitialise)
- (display x) (newline)
- (set! x 4)
- (display x) (newline)
- (reinitialise)
- (display x))
- (newline)
Globale :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Globale.scm
- (define a 3)
- (define (f x)
- (display (* x 2))
- (newline)
- (set! a (* x 2)))
- (set! a 3)
- (let ((n 4))
- (f (+ a n)))
Générateur de nombres pseudo-aléatoires :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Generateur.scm
- (define (origine graine periode)
- (modulo graine periode))
- ;; Cette fonction crée et renvoie un nombre
- ;; pseudo-aléatoire compris entre 0 et periode-1
- (define (hasard graine periode)
- (modulo (+ (* graine 15) 3) periode))
- ;; Cette fonction affiche periode valeurs
- ;; pseudo-aléatoires
- (define (Generateur)
- (let ((graine 8)
- (periode 7))
- (let boucle ((i 1)
- (laGraine (origine graine periode)))
- (let ((valeur (hasard laGraine periode)))
- (display valeur) (newline)
- (if (< i periode)
- (boucle (+ i 1) valeur))))))
- (Generateur)
Un pseudonyme convenable :
et en Scheme :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Pseudo.scm
- (define (appartient lettre mot)
- ;; Dans cette fonction "lettre" est censé ne contenir
- ;; qu'un seul caractère. On vérifie si ce caractère
- ;; apparaît dans la chaîne "mot"
- (let ((longueur-m (string-length mot)))
- (do ((i 0 (+ i 1)))
- ((or (= i longueur-m)
- (char=?
- (string-ref mot i)
- lettre))
- (not (= i longueur-m))))))
- (define (BonPseudo? pseudo)
- (let ((autorises "abcdefghijklmnopqrstuvwxyz")
- (longueur-p (string-length pseudo)))
- (do ((i 0 (+ i 1)))
- ((or (= i longueur-p)
- (not (appartient
- (string-ref pseudo i)
- autorises)))
- (= i longueur-p)))))
- (define (Pseudo)
- ;; On redemande un pseudo tant qu'il n'est pas correct
- (let boucle ((pseudoOK #f))
- (if (not pseudoOK)
- (begin
- (display "Entrer votre pseudo : ")
- (let ((pseudo (read-line)))
- (if (BonPseudo? pseudo)
- ;; On vérifie que chaque caractère du pseudo est
- ;; autorisé
- (display "OK")
- (boucle #f))))))
- (newline))
- (Pseudo)
Portée :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Portee.scm
- (define z 0)
- (define y 0)
- (define (v x)
- (let ((u (* x x)))
- (set! z x)
- u))
- (set! y 4)
- (let ((t (/ 1 y)))
- (display (v t))
- (newline))
Répertoire avec des procédures :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i RepertoireFonctions.scm
- (define nb 0)
- (define nom (make-vector nb ""))
- (define tel (make-vector nb ""))
- (define (initialise)
- (set! nb 10)
- (set! nom (make-vector nb ""))
- (set! tel (make-vector nb ""))
- (vector-set! nom 0 "Alice")
- (vector-set! tel 0 "0606060606")
- (vector-set! nom 1 "Bob")
- (vector-set! tel 1 "0606060607")
- (vector-set! nom 2 "Charles")
- (vector-set! tel 2 "0606060608")
- (vector-set! nom 3 "Djamel")
- (vector-set! tel 3 "0606060609")
- (vector-set! nom 4 "Étienne")
- (vector-set! tel 4 "0606060610")
- (vector-set! nom 5 "Frédérique")
- (vector-set! tel 5 "0606060611")
- (vector-set! nom 6 "Guillaume")
- (vector-set! tel 6 "0606060612")
- (vector-set! nom 7 "Hector")
- (vector-set! tel 7 "0606060613")
- (vector-set! nom 8 "Isabelle")
- (vector-set! tel 8 "0606060614")
- (vector-set! nom 9 "Jérôme")
- (vector-set! tel 9 "0606060615") )
- (define (recherche s)
- (do ((i 0 (+ i 1)))
- ((or (= i nb)
- (string=? s (vector-ref nom i)))
- (if (< i nb)
- (vector-ref tel i)
- "Inconnu"))))
- (initialise)
- (let ((n (read-line)))
- (display (recherche n))
- (newline))
É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) :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Echange.scm
- (define-syntax echange
- (syntax-rules ()
- ((echange x y)
- (let ((z x))
- (set! x y)
- (set! y z)))))
- (let ((a 4)
- (b 7))
- (echange a b)
- (display a) (display " ") (display b)
- (newline))
Par valeur :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i ParValeur.scm
- (define i 0)
- (define (h j)
- (let ((j (+ j 1)))
- (display i) (newline)
- (display j) (newline)
- (let ((k (+ j i)))
- (set! i 5)
- k)))
- (let ((m 1))
- (set! i 10)
- (display m) (newline)
- (let ((n (h m)))
- (display m) (newline)
- (display n) (newline)
- (display i) (newline) ))
Échange en enveloppant les valeurs dans un vecteur d’une case :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i EchangeTableaux.scm
- (define (echange x y)
- (if (and (vector? x)
- (vector? y)
- (= (vector-length x) 1)
- (= (vector-length y) 1))
- (let ((z (vector-ref x 0)))
- (vector-set! x 0 (vector-ref y 0))
- (vector-set! y 0 z))
- #f))
- (let ((a (vector 4))
- (b (vector 7)))
- (echange a b)
- (display (vector-ref a 0))
- (display " ")
- (display (vector-ref b 0))
- (newline))
Chapitre 5 - Horaire, puissance, quotient
Encore les horaires :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Horaire3.scm
- (define (tirerUnTrait)
- (newline)
- (display "-----------------------------------------------")
- (newline)
- (newline))
- (define (annoncerUnVol vol horaire)
- (display "Le vol en direction de ")
- (display vol)
- (display " décollera à ")
- (display horaire)
- (tirerUnTrait))
- (annoncerUnVol "Tokyo" "9h00")
- (annoncerUnVol "Sydney" "9h30")
- (annoncerUnVol "Toulouse" "9h45")
Élever à la puissance :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Puissance.scm
- (define (puissance n)
- (if (zero? n)
- 1
- (* 2 (puissance (- n 1)))))
- (display (puissance 10))
- (newline)
Le quotient :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Quotient.scm
- (define (monquotient dividende diviseur)
- (if (< dividende diviseur)
- 0
- (+ 1 (monquotient (- dividende diviseur) diviseur))))
- (display (monquotient 17 3))
- (newline)
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 :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; fichier repertoire.scm
- (define (Repertoire fichier)
- (let* ((tailleRepertoire (/ (compter-lignes fichier) 2))
- (noms (make-vector tailleRepertoire ""))
- (tels (make-vector tailleRepertoire "")))
- (ConstruireRepertoire fichier tailleRepertoire noms tels)
- (print "Entrez le nom, f si fini")
- (do ((leNom "##" (symbol->string (read))))
- ((string=? leNom "f"))
- (if (not (string=? leNom "##"))
- (begin
- (print leNom " : " (Recherche leNom noms tels))
- (print "Entrez le nom, f si fini")) )) ))
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) :
- ;; fichier compter-lignes.scm
- (define (compter-lignes fichier-repertoire)
- (let ((ip (open-input-file fichier-repertoire)))
- (let boucle ((n 0)
- (ligne (read-line ip)))
- (if (eof-object? ligne)
- (begin
- (close-input-port ip)
- n)
- (boucle
- (+ n 1)
- (read-line ip))))))
Il nous faut d’abord charger le fichier en mémoire sous une forme propre à faciliter sa consultation ultérieure :
- ;; fichier repertoire-chargement.scm
- (define (ConstruireRepertoire fichier tailleRepertoire noms tels)
- (let ((ip (open-input-file fichier)))
- (do ((i 0 (+ i 1)))
- ((= i tailleRepertoire)
- (close-input-port ip))
- (vector-set! noms i (read-line ip))
- (vector-set! tels i (read-line ip)))))
La procédure de recherche d’un nom dans le répertoire :
- ;; fichier repertoire-recherche.scm
- ;; Recherche du numéro associé au nom
- (define (Recherche leNom noms tels)
- (let ((tailleRepertoire (vector-length noms)))
- (do ((i 0 (+ i 1)))
- ((or (= i tailleRepertoire)
- (string=? leNom (vector-ref noms i)))
- (if (< i tailleRepertoire)
- (vector-ref tels i)
- "Inconnu")))))
Pour faire de ces programmes un module compilable il faut ajouter le fichier suivant :
- ;; fichier repertoire-main.scm
- (module Repertoire
- (include "repertoire.scm")
- (include "repertoire-chargement.scm")
- (include "repertoire-recherche.scm")
- (include "compter-lignes.scm")
- (main Init))
- (define (Init Args)
- (let ((fichier (cadr Args)))
- (Repertoire fichier)))
On compilera et on exécutera ce programme par les commandes suivantes :
Chapitre 12 - Des lettres au hasard
Des lettres au hasard :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Alea.scm
- (do ((i 1 (+ i 1)))
- ((> i 1000)
- (newline))
- (display (integer->char
- (+ (char->integer #\a)
- (random 26)))))
Chapitre 18 - Additioneur binaire
Additioneur binaire :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i Addition.scm
- (define (Init)
- (let ((n (make-vector 10 #f)) ; opérande
- (p (make-vector 10 #f))) ; opérande
- (vector-set! n 0 #t)
- (vector-set! n 1 #t)
- (vector-set! n 2 #t)
- (vector-set! p 1 #t)
- (Addition n p)))
- (define (Addition n p)
- (let* ((longueur (vector-length n))
- (r (make-vector (+ longueur 1) #t)) ; résultat
- (c #f)) ; retenue
- (do ((i 0 (+ i 1)))
- ((= i longueur) (AfficheCalcul n p r c))
- (let ((a (vector-ref n i))
- (b (vector-ref p i)))
- (vector-set! r i
- (or (and a (not b) (not c))
- (and (not a) b (not c))
- (and (not a) (not b) c)
- (and a b c)))
- (set! c (or (and a b) (and b c) (and a c)))
- (vector-set! r longueur c)))))
- (define (AfficheCalcul n p r c)
- (display " ")
- (AfficheLigneCalcul n)
- (display " ")
- (AfficheLigneCalcul p)
- (AfficheLigneCalcul r) )
- (define (AfficheLigneCalcul la-ligne)
- (let ((longueur (vector-length la-ligne)))
- (do ((i 0 (+ i 1)))
- ((= i longueur))
- (if (vector-ref la-ligne (- longueur i 1))
- (display "1")
- (display "0"))))
- (newline))
- (Init)
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 :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; fichier repertoire.scm
- (define (Repertoire fichier)
- (let* ((tailleRepertoire (/ (compter-lignes fichier) 2))
- (noms (make-vector tailleRepertoire ""))
- (tels (make-vector tailleRepertoire "")))
- (ConstruireRepertoire fichier tailleRepertoire noms tels)
- (print "Entrez le nom, f si fini")
- (do ((leNom "##" (symbol->string (read))))
- ((string=? leNom "f"))
- (if (not (string=? leNom "##"))
- (begin
- (print leNom " : " (Recherche leNom noms tels))
- (print "Entrez le nom, f si fini")) )) ))
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) :
- ;; fichier compter-lignes.scm
- (define (compter-lignes fichier-repertoire)
- (let ((ip (open-input-file fichier-repertoire)))
- (let boucle ((n 0)
- (ligne (read-line ip)))
- (if (eof-object? ligne)
- (begin
- (close-input-port ip)
- n)
- (boucle
- (+ n 1)
- (read-line ip))))))
Il nous faut d’abord charger le fichier en mémoire sous une forme propre à faciliter sa consultation ultérieure :
- ;; fichier repertoire-chargement.scm
- (define (ConstruireRepertoire fichier tailleRepertoire noms tels)
- (let ((ip (open-input-file fichier)))
- (do ((i 0 (+ i 1)))
- ((= i tailleRepertoire)
- (close-input-port ip))
- (vector-set! noms i (read-line ip))
- (vector-set! tels i (read-line ip)))))
Voici un programme de recherche dichotomique, plus efficace que celui du chapitre 11 :
- ;; fichier repertoire-dichot-recherche.scm
- ;; Recherche du numéro associé au nom leNom
- (define (Recherche leNom noms tels)
- (let ((tailleRepertoire (vector-length noms)))
- (let boucle ((milieu (quotient tailleRepertoire 2))
- (inf 0)
- (sup (- tailleRepertoire 1)))
- (cond
- ((> inf sup)
- #f)
- ((string=? leNom (vector-ref noms milieu))
- (vector-ref tels milieu))
- ((string<? leNom (vector-ref noms milieu))
- (boucle (quotient (+ inf sup) 2) inf (- milieu 1)))
- ((string>? leNom (vector-ref noms milieu))
- (boucle (quotient (+ inf sup) 2) (+ milieu 1) sup)) ))))
Pour faire de ces programmes un module compilable il faut ajouter le fichier suivant :
- ;; fichier repertoire-dichot-main.scm, compilé par la comande :
- ;; bigloo repertoire-dichot-main.scm -o repertoire-dichot
- (module Repertoire
- (include "repertoire.scm")
- (include "repertoire-chargement.scm")
- (include "repertoire-dichot-recherche.scm")
- (include "compter-lignes.scm")
- (main Init))
- (define (Init Args)
- (let ((fichier (cadr Args)))
- (Repertoire fichier)))
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
:
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Compilation :
- ;; $ bigloo repertoire-hash-main.scm -o repertoire-hash
- ;; Appel du programme compilé sous le nom Repertoire :
- ;; $ ./repertoire-hash repertoire.txt
- ;; (si le fichier de données se nomme "repertoire.txt")
- (module Repertoire
- (include "repertoire-hash.scm")
- (include "repertoire-hash-chargement.scm")
- (include "repertoire-hash-recherche.scm")
- (include "compter-lignes.scm")
- (main Init))
- (define (Init Args)
- (let ((fichier (cadr Args)))
- (Repertoire fichier)))
- ;; fichier repertoire-hash.scm
- (define (Repertoire fichier)
- (let* ((tailleRepertoire (/ (compter-lignes fichier) 2))
- (leRepertoire (make-vector tailleRepertoire '())))
- (ConstruireRepertoire fichier leRepertoire)
- (let boucle ()
- (display "Nom ? ")
- (let ((leNom (read-line)))
- (if (> (string-length leNom) 0)
- (begin
- (print (Recherche leNom leRepertoire))
- (boucle)))))))
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) :
- ;; fichier compter-lignes.scm
- (define (compter-lignes fichier-repertoire)
- (let ((ip (open-input-file fichier-repertoire)))
- (let boucle ((n 0)
- (ligne (read-line ip)))
- (if (eof-object? ligne)
- (begin
- (close-input-port ip)
- n)
- (boucle
- (+ n 1)
- (read-line ip))))))
- ;; fichier repertoire-hash-chargement.scm
- (define (ConstruireRepertoire fichier leRepertoire)
- (let ((tailleRepertoire (vector-length leRepertoire))
- (flux-entree (open-input-file fichier)))
- (if (not (eof-object? (peek-char flux-entree)))
- (let boucle ((nom (read-line flux-entree))
- (tel (read-line flux-entree)))
- (let ((i (hash nom tailleRepertoire)))
- (vector-set! leRepertoire i
- (cons (cons nom tel) (vector-ref leRepertoire i)))
- (if (eof-object? (peek-char flux-entree))
- (close-input-port flux-entree)
- (boucle
- (read-line flux-entree)
- (read-line flux-entree))))))))
La fonction d’association :
- ;; fichier hash.scm
- (define (hash nom n)
- (remainder
- (apply + (map char->integer (string->list nom)))
- n))
- ;; fichier repertoire-hash-recherche.scm
- ;; Recherche du numéro associé au nom
- (define (Recherche leNom leRepertoire)
- (let* ((tailleRepertoire (vector-length leRepertoire))
- (i (hash leNom tailleRepertoire))
- (resultat (assoc leNom (vector-ref leRepertoire i))))
- (if resultat
- (cdr resultat)
- "Inconnu")))
Zéro d’une fonction
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i ZeroDUneFonction.scm
- (define (Pi)
- (let ((seuil (expt 10 -5))
- (inf 2)
- (sup 4))
- (let boucle ((milieu (/ (+ inf sup) 2)))
- (if (and (> (- sup inf) seuil)
- (> (abs (sin milieu)) seuil))
- (begin
- (if (<= (* (sin inf) (sin milieu)) 0)
- (set! sup milieu)
- (set! inf milieu))
- (boucle (/ (+ inf sup) 2)))
- (display milieu)))
- (newline)))
- (Pi)
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 :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i TriSelection.scm
- ;; initialisation d'un tableau avec des nombres aléatoires
- (define (RandomInitialise V)
- (let ((nbItems (vector-length V)))
- (do ((item 0 (+ item 1)))
- ((= item nbItems))
- (vector-set! V item (random 1000)))))
- ;; affichage d'un tableau
- (define (AfficheTableau V)
- (let ((nbItems (vector-length V)))
- (do ((item 0 (+ item 1)))
- ((= item nbItems))
- (display (vector-ref V item))
- (display " "))
- (newline)))
- ;; donner l'indice du plus petit élément de V :
- (define (MinR V i)
- (let ((imin i)
- (nbItems (vector-length V)))
- (do ((j (+ i 1) (+ j 1)))
- ((>= j nbItems) imin)
- (if (> (vector-ref V imin)
- (vector-ref V j))
- (set! imin j)))))
- ;; permuter deux éléments de V :
- (define (permute V i j)
- (let ((temp (vector-ref V i)))
- (vector-set! V i (vector-ref V j))
- (vector-set! V j temp)))
- (define (TriSelection)
- (let* ((nbItems 16)
- (V (make-vector nbItems 0)))
- (RandomInitialise V)
- (AfficheTableau V)
- (do ((i 0 (+ i 1)))
- ((= i nbItems) V)
- (let ((posmini (MinR V i)))
- (permute V i posmini)))
- (AfficheTableau V)
- (newline)))
- (TriSelection)
Tri par fusion
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i TriFusion.scm
- ;; initialisation d'un tableau avec des nombres aléatoires
- (define (RandomInitialise items)
- (let ((nbItems (vector-length items)))
- (do ((item 0 (+ item 1)))
- ((= item nbItems))
- (vector-set! items item (random 1000)))))
- ;; affichage d'un tableau
- (define (AfficheTableau items)
- (let ((nbItems (vector-length items)))
- (do ((item 0 (+ item 1)))
- ((= item nbItems))
- (display (vector-ref items item))
- (display " "))
- (newline)))
- (define (TriFusion)
- (let* ((nbItems 16)
- (items (make-vector nbItems 0))
- (items1 (make-vector nbItems 0)))
- ;; initialisation du tableau avec des nombres aléatoires
- (RandomInitialise items)
- ;; affichage du tableau avant tri
- (AfficheTableau items)
- (do ((taille 1 (* taille 2)))
- ((> taille nbItems))
- (if (< taille nbItems)
- (let ((debut 0)
- (x 0)
- (y taille))
- (do ((i 0 (+ i 1)))
- ((= i nbItems))
- (if (or (and (< x (+ debut taille))
- (< y (+ debut (* 2 taille)))
- (< (vector-ref items x)
- (vector-ref items y)))
- (= y (+ debut (* 2 taille))))
- (begin
- (vector-set! items1 i
- (vector-ref items x))
- (set! x (+ x 1)))
- (begin
- (vector-set! items1 i
- (vector-ref items y))
- (set! y (+ y 1))))
- (if (and (= x (+ debut taille))
- (= y (+ debut (* taille 2))))
- (begin
- (set! debut (+ debut (* taille 2)))
- (set! x debut)
- (set! y (+ debut taille)))))
- (do ((i 0 (+ i 1)))
- ((= i nbItems))
- (vector-set! items i
- (vector-ref items1 i)))) ))
- (AfficheTableau items)
- (newline)))
- (TriFusion)
Tri par fusion, récursif :
- ;; Ces programmes sont sous licence CeCILL-B V1.
- ;; Exécution en ligne de commande avec Bigloo :
- ;; $ bigloo -i TriFusion.scm
- (define nbItems 16)
- (define items (make-vector nbItems 0))
- ;; initialisation du tableau avec des nombres aléatoires
- (define (RandomInitialise items)
- (let ((nbItems (vector-length items)))
- (do ((item 0 (+ item 1)))
- ((= item nbItems))
- (vector-set! items item (random 1000)))))
- ;; affichage du tableau avant tri
- (define (AfficheTableau items)
- (let ((nbItems (vector-length items)))
- (do ((item 0 (+ item 1)))
- ((= item nbItems))
- (display (vector-ref items item))
- (display " "))
- (newline)))
- (define (fusion items debut milieu fin)
- (let* ((nbItems (vector-length items))
- (item1 debut)
- (item2 milieu)
- (temp (make-vector nbItems 0)))
- (do ((item debut (+ item 1)))
- ((= item fin))
- (if (or (= item2 fin)
- (and (< item1 milieu)
- (< (vector-ref items item1)
- (vector-ref items item2))))
- (begin
- (vector-set! temp item (vector-ref items item1))
- (set! item1 (+ item1 1)))
- (begin
- (vector-set! temp item (vector-ref items item2))
- (set! item2 (+ item2 1)))))
- (do ((item debut (+ item 1)))
- ((= item fin))
- (vector-set! items item (vector-ref temp item)))))
- (define (triFusion items debut fin)
- (if (> (- fin debut) 1)
- (let ((milieu (quotient (+ debut fin) 2)))
- (triFusion items debut milieu)
- (triFusion items milieu fin)
- (fusion items debut milieu fin))))
- (RandomInitialise items)
- (AfficheTableau items)
- (triFusion items 0 (vector-length items))
- (AfficheTableau items)