diff --git a/collects/tests/lazy/lang.rkt b/collects/tests/lazy/lang.rkt index 6d579363d4..e710270a64 100644 --- a/collects/tests/lazy/lang.rkt +++ b/collects/tests/lazy/lang.rkt @@ -80,9 +80,95 @@ (! (a? (d 1 2))) => false )) +; Lazy Racket examples from Premiers cours de programmation avec Scheme (Roy) +(define (pcps-tests) + ;; Definitions -------------------------------------------------------------- + (define (f x y) x) + (define (fac n) + (if (= n 0) 1 (* n (fac (- n 1))))) + (define (new-if test p q) + (cond (test p) + (else q))) + (define fibs (cons 0 (cons 1 (map + fibs (cdr fibs))))) + #;(define ($list-ref L k) + (let loop ((k (force k)) (L (force L))) + (if (= k 0) + (car L) + (loop (- k 1) (cdr (force L)))))) + (define L2 (cons 2 (map add1 L2))) + (define (rayer n L) ; L prive des multiples de n + (filter (lambda (x) (not (= 0 (modulo x n)))) L)) + (define (crible L) + (cons (car L) (crible (rayer (car L) (cdr L))))) + (define PREMS (crible L2)) ; primes + (define ZERO (cons 0 ZERO)) ; le flot infini <0,0,0,0,...> + (define (poly->serie L) ; L = coeffs en puissances croissantes + (define (copy L) + (if (null? L) + ZERO ; padding à droite par des 0 + (cons (car L) (copy (cdr L))))) + (copy L)) + (define (int-serie S) ; integration terme a terme + (define (aux S i) + (cons (/ (car S) i) (aux (cdr S) (+ i 1)))) + (aux S 1)) + (define EXPO (cons 1 (int-serie EXPO))) + (define SIN (cons 0 (int-serie COS))) + (define COS (cons 1 (map - (int-serie SIN)))) + (define (ints-from n) + (cons n (ints-from (+ n 1)))) + (define NAT (ints-from 0)) + (define UN (cons 1 UN)) + (define nats (cons 0 (map + nats UN))) + (define QUATRE (filter (lambda (x) (zero? (modulo x 4))) NAT)) + (define (melanger F1 F2) ; F1 et F2 infinis strictement croissants + (cond ((< (car F1) (car F2)) (cons (car F1) (melanger (cdr F1) F2))) + ((> (car F1) (car F2)) (cons (car F2) (melanger F1 (cdr F2)))) + (else (cons (car F1) (melanger (cdr F1) (cdr F2)))))) + (define (zoom x F) + (cons (* (car F) x) (zoom x (cdr F)))) + (define PAIR (zoom 2 NAT)) + (define (hamming) + (define h (cons 1 (melanger (zoom 2 h) (melanger (zoom 3 h) (zoom 5 h))))) + h) + (define h (hamming)) + (define FACT (cons 1 (map * FACT (cdr NAT)))) + (define (entrelacer s1 s2) + (cons (car s1) (entrelacer s2 (cdr s1)))) + (define F (entrelacer NAT F)) + ;; Tests -------------------------------------------------------------------- + (test + (!! (fac 5)) => 120 + (!! (new-if (= 1 2) (/ 1 0) 3)) => 3 + (!! (take 20 PREMS)) => + '(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71) + (!! (list-ref PREMS 999)) => 7919 + (!! (apply + (take 100 PREMS))) => 24133 + (!! (take 10 (poly->serie '(1 2 3)))) => '(1 2 3 0 0 0 0 0 0 0) + (!! (take 10 EXPO)) => + '(1 1 1/2 1/6 1/24 1/120 1/720 1/5040 1/40320 1/362880) + (!! (take 8 SIN)) => '(0 1 0 -1/6 0 1/120 0 -1/5040) + (!! (take 8 COS)) => '(1 0 -1/2 0 1/24 0 -1/720 0) + (!! (take 10 (ints-from 5))) => '(5 6 7 8 9 10 11 12 13 14) + (!! (take 10 NAT)) => '(0 1 2 3 4 5 6 7 8 9) + (!! (take 10 UN)) => '(1 1 1 1 1 1 1 1 1 1) + (!! (take 10 nats)) => '(0 1 2 3 4 5 6 7 8 9) + (!! (take 10 QUATRE)) => '(0 4 8 12 16 20 24 28 32 36) + (!! (take 10 (melanger NAT QUATRE))) => '(0 1 2 3 4 5 6 7 8 9) + (!! (take 10 PAIR)) => '(0 2 4 6 8 10 12 14 16 18) + (!! (take 30 h)) => + '(1 2 3 4 5 6 8 9 10 12 15 16 18 20 24 25 27 30 32 36 40 45 48 50 54 60 64 72 75 80) + (!! (list-ref h 10000)) => 288555831593533440 + (!! (take 10 FACT)) => '(1 1 2 6 24 120 720 5040 40320 362880) + (!! (take 10 (entrelacer NAT PAIR))) => '(0 0 1 2 2 4 3 6 4 8) + (!! (take 10 F)) => '(0 0 1 0 2 1 3 0 4 2) + ) + ) + (provide lang-tests) (define (lang-tests) (! (begin (basic-tests) (list-tests) (take-tests) - (misc-tests)))) + (misc-tests) + (pcps-tests))))