Le langage Scheme (2)

1. Le langage Scheme (2) Un langage de programmation fonctionnelle

2. Entrees / Sorties • read – retourne une entrée du clavier > (read) 234 ; entrée de l’utilisateur 234 ; valeur retournee par la fonction > (read) "hello world" "hello world" • display – affiche son parametre sur ecran > (display "hello world") hello world > (display (+ 2 3)) 5 • newline – affiche une nouvelle ligne

3. Entrees / Sorties • Definir une fonction qui lit un nombre (si ce n’est pas un nombre, elle continue de demander un nombre): > (define (ask-number) (display "Entrez un nombre: ") (let ((n (read))) (if (number? n) n (ask-number)))) > (ask-number) Entrez un nombre: a Entrez un nombre: (5 6) Entrez un nombre: “mais pourquoi ?" Entrez un nombre: 12 12

4. Entrees / Sorties • Une fonction qui lit un entier, fait appel a fact(ortielle) et affiche le resultat: (define (fact-interactive) (display "Entrez un entier: ") (let ((n (read))) (display “La factorielle de ") (display n) (display " est ") (display (fact n)) (newline))) > (fact-interactive) Entrez un entier: 4 La factorielle de 4 est 24

5. Port d’entrée (let ((p (open-input-file "myfile.ss")))  (let f ((x (read p)))    (if (eof-object? x)        (begin          (close-input-port p)          '())        (cons x (f (read p))))))

6. Appel avec un port d’entrée (call-with-input-file "myfile.ss"  (lambda (p)    (let f ((x (read p)))      (if (eof-object? x)          '()          (cons x (f (read p)))))))

7. Définition équivalente (define call-with-input-file  (lambda (filename proc)    (let ((p (open-input-file filename)))      (let ((v (proc p)))        (close-input-port p)        v))))

8. Imprimer une liste (let ((p (open-output-file "myfile.ss")))  (let f ((ls list-to-be-printed))    (if (not (null? ls))        (begin          (write (car ls) p)          (newline p)          (f (cdr ls)))))  (close-output-port p))

9. Ou encore (call-with-output-file "myfile.ss"  (lambda (p)    (let f ((ls list-to-be-printed))      (if (not (null? ls))          (begin            (write (car ls) p)            (newline p)            (f (cdr ls)))))))

10. Définition équivalente (define call-with-output-file  (lambda (filename proc)    (let ((p (open-output-file filename)))      (let ((v (proc p)))        (close-output-port p)        v))))

11. Attribuer des valeurs à des variables avec set! • Cette fonction permet d’attribuer une valeur à une variable (set! nombre (+ 3 4)) (set! nombre (+ 1 nombre)) En SCHEME, les fonctions dont le nom se termine par ! sont des fonctions qui modifient la valeur de l'un des arguments (opérations destructives).

12. Exemple (define light-switch (let ((lit #f)) (lambda () (set! lit (not lit)) (if lit 'on 'off)))) Encapsulation de la variable lit dans la définition de light-switch

13. Exemple impératif (define secondesImp (lambda (h m s) (let ((sh 0) (sm 0) (total 0)) (set! sh (* 60 (* 60 h))) (set! sm (* 60 m)) (set! total (+ s (+ sh sm))) total)))

14. Exemple plus fonctionnel (define secondes (lambda (h m s) (let ((sh (* 60 (* 60 h))) (sm (* 60 m)) ((+ s (+ sh sm))))))

15. Pile en Schemeversion impérative (define empiler (lambda (element) (set! PILE (cons element PILE)))) (define (top) (vide? `()) (else (car PILE))) (define PILE ‘()) (define(vide?) (null? PILE)) (definedepiler (lambda () (let (( res (car PILE))) (set! PILE (cdr PILE)) res )))

16. Vecteurs en Scheme • Les vecteurs en Scheme sont des structures hétérogènes qui permettent d’accéder aux différents éléments en utilisant un index. • Requière moins de mémoire • Les éléments sont accédés en temps constant (make-vector k ) ; afin de créer un vecteur de k éléments (make-vector k init ) ; dont les éléments sont initialisés à init (vector? obj ) '#( element_0 ... element_k-1 ) ; afin de déclarer un vecteur constant Ex: '#(0 (2 2 2 2) "Anna")

17. Vecteurs en Scheme • Constructeurs and accesseurs > (define v (vector 1 (+ 1 2))) #(1 3) > (vector ‘a ‘b ‘c) #(a b c) > (vector-ref v 0) 1 > (vector-length v) 2 > (vector-set! v 3 10) 2 • L’index commence à 0.

18. vector-set! (let ((v (vector 'a 'b 'c 'd 'e)))  (vector-set! v 2 'x) v)   #(a b x d e) (define vector-fill!  (lambda (v x)    (let ((n (vector-length v)))      (do ((i 0 (+ i 1)))          ((= i n))        (vector-set! v i x))))) (let ((v (vector 1 2 3)))  (vector-fill! v 0) v)   #(0 0 0)

19. conversion de listes à vecteurs (define vector->list  (lambda (s)    (do ((i (- (vector-length s) 1) (- i 1))         (ls '() (cons (vector-ref s i) ls)))        ((< i 0) ls)))) (vector->list '#(a b c))   (a b c) (let ((v '#(1 2 3 4 5)))  (apply * (vector->list v)))   120 (list->vector L) (vector->list L)

20. Exemple (let ((v '#(1 2 3 4 5)))  (let ((ls (vector->list v)))    (list->vector (map * ls ls))))   #(1 4 9 16 25)

21. Exemple (define vector-sum (lambda (vec) (let ((size (vector-length vec)) (position 0) (total 0)) (do () ((= position size) total) (set! total (+ total (vector-ref vec position))) (set! position (+ position 1)))))) (define vector-sum (lambda (vec) (do ((remaining (vector-length vec) (- remaining 1)) (total 0 (+ total (vector-ref vec (- remaining 1))))) ((zero? remaining) total))))

22. Tri des vecteurs et des listes (quick-sort  '#(3 4 2 1 2 5) <)   #(1 2 2 3 4 5) (merge-sort '(0.5 1.2 1.1) >)   (1.2 1.1 0.5) On doit avoir: (and (test x y) (test y x)) #f Voyons maintenant le tri fusion de listes…

23. Extraire une sous-liste (define (sub L start stop ctr) ; extract elements start to stop into a list (cond ( (null? L) L) ( (< ctr start) (sub (cdr L) start stop (+ ctr 1))) ( (> ctr stop) '() ) (else (cons (car L) (sub (cdr L) start stop (+ ctr 1))) ) ) )

24. Diviser une liste en deux (define (split L) ; split the list in half: ; returns ((first half)(second half)) (let ((len (length L))) (cond ((= len 0) (list L L) ) ((= len 1) (list L '() )) (else (list (sub L 1 (/ len 2) 1)(sub L (+(/ len 2)1) len 1) ) ) ) ) )

25. Fusion de 2 listes triées (define (mergelists L M) ; assume L and M are sorted lists (cond ( (null? L) M) ( (null? M) L) ( (< (car L)(car M)) (cons (car L) (mergelists (cdr L)M))) (else (cons (car M) (mergelists L (cdr M)))) ) )

26. Tri fusion (define (mergesort L) (cond ((null? L) '()) ((= 1 (length L)) L) ((= 2 (length L)) (mergelists (list (car L))(cdr L))) (else (mergelists (mergesort (car (split L)) ) (mergesort (car (cdr (split L))) ) )) ) )

27. quicksort (define (qsort e) (if (or (null? e) (<= (length e) 1)) e (let loop ((left null) (right null) (pivot (car e)) (rest (cdr e))) ; named let (if (null? rest) (append (append (qsort left) (list pivot)) (qsort right)) (if (<= (car rest) pivot) (loop (append left (list (car rest))) right pivot (cdr rest)) (loop left (append right (list (car rest))) pivot (cdr rest)))

28. Les arbres • Un arbre binaire peut être représentée avec des listes imbriquées a / \ b c / \ d e (a b (c d e)) ou (a (b () ()) (c (d () ()) (e () ())) ou (a b.(c d.e))

29. arbre? (define tree? (lambda (t) (cond ((not (list? t)) #f) ((null? t) #t) ((not (= (length t) 3)) #f) ((not (tree? (cadr t))) #f) ((not (tree? (caddr t))) #f) (else #t) ) ) ) (tree? '(73 (31 (5 () ()) ()) (101 (83 () (97 () ())) ()))) (tree? '(73 (31 (5 () ()) ()) (101 (83 () (97 () () ())) ()))) (tree? '(73 (31 (5 () ()) ()) (101 (83 () (97 ())) ())))

30. Parcours inordre (define inorder (lambda (t) (define do-inorder (lambda (t) (if (null? t) () (append (inorder (cadr t)) (cons (car t) (do-inorder (caddr t)))) ) ) ) (if (not (tree? t)) (list 'not-a-tree t) (do-inorder t) ) ) ) (inorder '(73 (31 (5 () ()) ()) (101 (83 () (97 () ())) ())))

31. recherche (define search (lambda (x t) (define do-search (lambda (x t) (cond ((null? t) #f) ((equal? x (car t)) #t) ((precedes? x (car t)) (do-search x (cadr t))) ((precedes? (car t) x) (do-search x (caddr t))) (else #f) ) ) ) (if (not (tree? t)) (list 'not-a-tree t) (do-search x t) ) ) ) (define precedes? (lambda (x y) (< x y))) (search 83 '(73 (31 (5 () ()) ()) (101 (83 () (97 () ())) ()))) (search 84 '(73 (31 (5 () ()) ()) (101 (83 () (97 () ())) ())))

32. Recherche dans un arbre (define (tree-search tree value) (cond ((null? tree) #f) ((equal? value (car tree)) #t) ((< value (car tree)) (tree-search (cadr tree) value)) (else (tree-search (caddr tree) value)))) Au lieu de <, on pourrait utiliser precedent? (define precedent? (lambda (x y) (< x y)))

33. Insertion dans une liste (define(tree-insert tree value) (cond ((null? tree)(list value '() '())) ((< value (car tree)) (list (car tree)(tree-insert (cadr tree) value) (caddr tree))) (else (list (car tree)(cadr tree) (tree-insert (caddr tree) value)))))

34. Détruire un nœud de l’arbre (define delete (lambda (x t) (if (not (tree? t)) (list 'not-a-tree t) (do-delete x t) ) ) )

35. Détruire la racine d’un arbre (define do-delete (lambda (x t) (cond ((null? t) ()) ((and (equal? x (car t)) (null? (cadr t))) (caddr t)) ((and (equal? x (car t)) (null? (caddr t))) (cadr t)) ((equal? x (car t)) (let ((r (removemax (cadr t)))) (list (cdr r) (car r) (caddr t)) )) ((precedes? x (car t)) (list (car t) (do-delete x (cadr t)) (caddr t))) ((precedes? (car t) x) (list (car t) (cadr t) (do-delete x (caddr t)))) (else t) ) ) )

36. Détruire un nœud de l’arbre (define removemax (lambda (t) (cond ((null? (caddr t)) (cons (cadr t) (car t))) (else (let ((r (removemax (caddr t)))) (cons (list (car t) (cadr t) (car r)) (cdr r)) )) ) ) )

37. Décompte du nombre d’éléments dans un arbre - Représentation sans les ( ) (define (nsymbols tree) (if (list? tree) (+ (nsymbols (car tree)) (nsymbols (cdr tree))) (if (symbol? tree) 1 0) ) ) > (nsymbols '(+ a (* b c))) 5

38. Avec récursivité terminale (define (nsymbols tree) (nsymbolsb tree 0)) (define (nsymbolsb tree n) (if (list? tree) (nsymbolsb (cdr tree) (nsymbolsb (car tree) n)) (+ n (if (symbol? tree) 1 0)) ) )

39. D’arbre à liste (define (tree->list tree) (reverse (tree->list2 tree '()))) (define (tree->list2 tree lst) (if (list? tree) (tree->list2 (cdr tree) (tree->list2 (car tree) lst)) (if (null? tree) lst (cons tree lst) ) ) )

40. Évaluation différée • Ou évaluation paresseuse, consiste à ne pas évaluer immédiatement une expression (delay exp) ; retourne une ‘promesse’ d’évaluation (force promesse) ; force l’évaluation promise

41. Exemple (define (produit x y) (if (negative? x) (* x x) (* x (force y)))) (produit v (delay (sqrt v)))

42. Avec les listes • Dans certains cas, il est possible d’obtenir un résultat sans avoir à évaluer tous les éléments d’une liste. (define (suite n1 n2 N) (if (zero? N) () (cons (+ n1 n2) (suite n2 (+ n1 n2) (- N 1))))) (suite 0 1 10) (1 2 3 5 8 13 21 34 55 89)

43. Exemple sans delay (define (membre nbre L) (cond ((null? L) ()) ((< nbre (car L)) ()) ((= nbre (car L)) nbre) (#T (membre nbre (cdr L))))) (membre 15 (suite 0 1 200)) ; tous les éléments sont examinés! nil

44. Exemple avec delay (define (suite n1 n2 N) (if (zero? N) () (cons (+ n1 n2) (delay (suite n2 (+ n1 n2) (- N 1)))))) (define (membre nbre L) (let ((premier (car L))) (cond ((null? L) ()) ((< nbre premier) ()) ((= nbre premier) nbre) (#T (membre nbre (force (cdr L)))))))

45. Tours de Hanoi (define (dohanoi n to from using) (if (> n 0) (begin (dohanoi (- n 1) using from to) (display "move ") (display from) (display " --> ") (display to) (newline) (dohanoi (- n 1) to using from) ) ) ) (define (hanoi n) (dohanoi n 3 1 2) )

46. Tic Tac Toe (define start ‘((1 2 3) (4 5 6) (7 8 9) (1 4 7) (2 5 8) (3 6 9) (1 5 9) (3 5 7))) X joue: ((X 2 3) (4 5 6) (7 8 9) (X 4 7) (2 5 8) (3 6 9) (X 5 9) (3 5 7)) O joue: ((X 2 3) (4 5 6) (7 O 9) (X 4 7) (2 5 O) (3 6 9) (X 5 9) (3 5 7))

47. Tic Tac Toe La substitution: (define subst (lambda (new old l) (cond ((null? l) (quote ())) ((atom? (car l)) (cond ((eq? (car l) old) (cons new (subst new old (cdr l)))) (else (cons (car l) (subst new old (cdr l)))))) (else (cons (subst new old (car l)) (subst new old (cdr l)))))))

48. Tic Tac Toe Egalité de tous les éléments d’une liste? (define (all-equal? list) (cond ((null? list) `()) ((null? (cdr list)) (car list)) ((equal? (car list) (cadr list)) (all-equal? (cdr list))) (else #f)))

49. Tic Tac Toe (define (play board player position) (subst player position board)) (define (winner board) (map all-equal? board))

50. Tic Tac Toe (define (number-of-member x list) (cond ((null? list) 0) ((equal? x (car list)) (+ 1 (number-of-member x (cdr list)))) (else (number-of-member x (cdr list))))