#lang racket

;;; sol12.rkt, [Faculte des Sciences de Nice, cours "Prog Scheme Avance" 2016]
;;; http://www.apmep.fr/IMG/pdf/16_Roy_Hamming.pdf

;;;***************** API sur les "streams" **********************
;;; On utilise les primitives delay et force de Racket.

(define sempty '())     ; en principe les flots sont infinis donc jamais vides ;-)

(define (sempty? S)
  (empty? (force S)))

(define-syntax scons
  (syntax-rules ()
    ((scons x S) (delay (cons x (delay S))))))          ; Julien propose (cons (delay x) (delay S))...

(define (scar S)
  (car (force S)))                                      ; Julien propose (force (car S))

(define (scdr S)
  (force (cdr (force S))))                              ; idem Julien

(define (sprint S . n)    ; n=10 si omis !
  (set! n (if (null? n) 10 (car n)))
  (printf "[")
  (for ([i (in-range n)])
    (printf "~a," (scar S))
    (set! S (scdr S)))
  (printf "...]\n"))

(define (sref S k)
  (if (= k 0)
      (scar S)
      (sref (scdr S) (- k 1))))

;;; ************ fin du Type Abstrait *********************

"Exo 12.1"

(define (sfilter pred S)        ; test dans l'exo 2
  (cond ((sempty? S) sempty)    ; <--- en principe inutile, les flots sont ici infinis !
        ((pred (scar S)) (scons (scar S) (sfilter pred (scdr S))))
        (else  (sfilter pred (scdr S)))))

"Exo 12.2"

(define (impairs-from a)
  (scons a (impairs-from (+ a 2))))

(define IMPAIR (impairs-from 1))
(printf "Flot IMPAIR : ")
(sprint IMPAIR)
(printf "Test de sfilter, le flot des impairs multiples de 5 : ")
(sprint (sfilter (lambda (n) (zero? (modulo n 5))) IMPAIR))

(define FACT
  (letrec ((facs-from (lambda (n last-fac)
                        (scons last-fac
                               (facs-from (+ n 1) (* n last-fac))))))
    (facs-from 1 1)))

(printf "Flot FACT : ")
(sprint FACT)

(define (rand n)
  (scons (random n) (rand n)))     ; une recurrence sans cas de base, youpi :-)

(printf "Flot (rand 100) : ")
(sprint (rand 100))

"Exo 12.3"

(define (smap f S)          ; faite en cours
  (scons (f (scar S)) (smap f (scdr S))))

(define (smap2 f S1 S2)     ; f est d'arite 2
  (scons (f (scar S1) (scar S2))
         (smap2 f (scdr S1) (scdr S2))))

(define (smapN f . LS)      ; LS est une liste de flots S1 ... Sk   <--   nombre variable d'arguments !
  (scons (apply f (map scar LS)) 
         (apply smapN (cons f (map scdr LS)))))

(printf "Test de smapN : ")
(sprint (smapN + FACT IMPAIR IMPAIR))

(define (s+ S1 S2)  ; addition terme a terme de deux flots
  (smap2 + S1 S2))

(define (s- S1 S2)  ; soustraction terme a terme de deux flots
  (smap2 - S1 S2))

(define (s* S1 S2)  ; produit terme a terme de deux flots
  (smap2 * S1 S2))

(define ONE (scons 1 ONE))
(printf "Flot ONE : ")
(sprint ONE)

(define DEUX (s+ ONE ONE))
(printf "Flot DEUX : ")
(sprint DEUX)

(define $IMPAIR (scons 1 (s+ IMPAIR DEUX)))
(printf "Flot $IMPAIR : ")
(sprint $IMPAIR)

(define INT (scons 0 (s+ INT ONE)))
(printf "Flot INT : ")
(sprint INT)

(define CARRES (smap2 list INT (s* INT INT)))
(printf "Flot CARRES : ")
(sprint CARRES)

"Exo 12.4"

(define $FACT 
  (scons 1 (s* $FACT (scdr INT))))              ; joli ?

(printf "Flot $FACT : ")
(sprint FACT)

(define FIBS
  (scons 0 (scons 1 (s+ (scdr FIBS) FIBS))))    ; encore plus joli !
(printf "Flot FIBS : ")
(sprint FIBS)

"Exo 12.5"

(define S (scons 1 (s+ S S)))   ; S = 1 + 2S
; pour resoudre a la main, on pose S = {a0, a1, a2, ...} et on ecrit les equations...
; a0 = 1, a1 = 2*a0 = 2, a2 = 2*a1=4, etc. d'ou le flot des puissances de 2
(printf "Flot S : ")
(sprint S)