#lang racket ;;; streams.rkt -- Code pour la section 17.4.4 (implementation des flots en Scheme strict) ;;; Livre PCPS : "Premiers Cours de Programmation avec Scheme" (Ellipses ed.) ;;; Langage determine par le source ;;; On utilise les delay et force de Racket. ;;; L'implementation proposee ici n'est pas standard dans la litterature. Elle essaye de ;;; simplifier la SRFI-41 en conservant un bon comportement pour le probleme "even-odd"... ;;; Cf la partie 'Rationale' de http://srfi.schemers.org/srfi-41/srfi-41.html ;;; Tout travail serieux utilisera eventuellement la SRFI-41, le présent fichier n'ayant qu'un but pedagogique ! (provide stream-null stream-null? stream-cons stream-car stream-cdr stream-take stream-ref stream-filter stream-map stream-print poly->serie serie+ serie* int-serie neg-serie inv-serie NAT FIBS) (printf "Module streams.rkt : stream-null (stream-null? s) (stream-cons x s) (stream-car s) (stream-ref s k) (stream-cdr s) (stream-take k s) (stream-filter pred s) (stream-map f s ...) (stream-print s [n]) (poly->serie L) (serie+ S1 S2) (serie* S1 S2) (int-serie S) (neg-serie S) (inv-serie S) NAT FIBS\n") (define test? #t) (define-syntax stream-cons (syntax-rules () ((stream-cons obj s) (delay (cons obj (delay s)))))) ; non standard (define stream-null (delay '())) ; le flot vide (define (stream-null? s) ; le reconnaisseur de flot vide (null? (force s))) (define s (stream-cons 1 (stream-cons 2 (stream-cons 3 stream-null)))) (define (stream-car s) (car (force s))) (define (stream-cdr s) (force (cdr (force s)))) (define (ints-from n) (stream-cons n (ints-from (+ n 1)))) (define NAT (ints-from 0)) (when test? (printf "NAT = ~a\n" NAT)) (define (stream-ref s k) ; EXO ! (cond ((stream-null? s) (error "Element inexistant")) ((zero? k) (stream-car s)) (else (stream-ref (stream-cdr s) (- k 1))))) (when test? (printf "(stream-ref NAT 1000) --> ~a\n" (stream-ref NAT 1000))) ; on compte a partir de 0... (define (stream-take n s) (if (= n 0) '() (cons (stream-car s) (stream-take (- n 1) (stream-cdr s))))) (when test? (printf "(stream-take 5 NAT) --> ~a\n" (stream-take 5 NAT))) (define (stream-print s . n) ; s est un flot infini (set! n (if (null? n) 15 (car n))) (printf "<") (for-each (lambda (x) (printf "~a, " x)) (stream-take n s)) (printf "...>\n")) (when test? (printf "Le flot des entiers naturels : ") (stream-print NAT)) (define (stream-map f . Ls) ; Ls est une liste de flots (if (or (null? Ls) (stream-null? (car Ls))) stream-null (stream-cons (apply f (map stream-car Ls)) (apply stream-map (cons f (map stream-cdr Ls)))))) (when test? (printf "Le flot des nombres pairs : ") (stream-print (stream-map (lambda (x) (* x 2)) NAT))) (define FIBS (stream-cons 0 (stream-cons 1 (stream-map + FIBS (stream-cdr FIBS))))) (when test? (printf "Le flot des nombres de Fibonacci : ") (stream-print FIBS)) (define (stream-filter pred? s) (cond ((stream-null? s) s) ((pred? (stream-car s)) (stream-cons (stream-car s) (stream-filter pred? (stream-cdr s)))) (else (stream-filter pred? (stream-cdr s))))) (when test? (printf "Le flot des nombres impairs avec stream-filter : ") (stream-print (stream-filter odd? NAT))) (define ERATO (let ((int>=2 (ints-from 2))) (define (crible S) (let ((p (stream-car S))) (stream-cons p (crible (stream-filter (lambda (n) (not (zero? (modulo n p)))) (stream-cdr S)))))) (crible int>=2))) (when test? (printf "Le flot des nombres premiers avec Eratosthenes :\nERATO = ") (stream-print ERATO)) ;;; Series formelles (define ZERO (stream-cons 0 ZERO)) ; la serie nulle ! (define (poly->serie L) ; L est la liste des coeffs d'un polynome en puissances croissantes (define (copy L) (if (null? L) ZERO (stream-cons (car L) (copy (cdr L))))) (copy L)) (define (serie+ S1 S2) ; addition terme a terme de deux series formelles infinies (stream-cons (+ (stream-car S1) (stream-car S2)) (serie+ (stream-cdr S1) (stream-cdr S2)))) (when test? (printf "Addition de deux series : NAT + NAT = ") (stream-print (serie+ NAT NAT))) (define (serie* S1 S2) ; produit de deux series formelles infinies (stream-cons (* (stream-car S1) (stream-car S2)) (serie+ (stream-map (lambda (x) (* x (stream-car S1))) (stream-cdr S2)) (serie* (stream-cdr S1) S2)))) (when test? (printf "Produit de deux series : NAT * NAT = ") (stream-print (serie* NAT NAT))) (define (int-serie s) ; integration d'une serie formelle (define (aux s i) (if (null? s) s (stream-cons (/ (stream-car s) i) (aux (stream-cdr s) (+ i 1))))) (aux s 1)) (when test? (define EXPO (stream-cons 1 (int-serie EXPO))) ; la serie exponentielle en une ligne ! (printf "La serie exponentielle par auto-integration :\nEXPO = ") (stream-print EXPO 8)) (define (neg-serie S) ; la serie opposee (stream-map - S)) (define (inv-serie S) ; on suppose S = 1 + R et on calcule 1/S (stream-cons 1 (neg-serie (serie* (stream-cdr S) (inv-serie S))))) (when test? (printf "Developpement en serie de 1/(1-x) : ") (stream-print (inv-serie (poly->serie '(1 -1))))) (printf "Et tous ces developpements sont calcules sans aucune derivee !!!\n")