;; The first three lines of this file were inserted by DrRacket. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-advanced-reader.ss" "lang")((modname sol6) (read-case-sensitive #t) (teachpacks ((lib "valrose.rkt" "installed-teachpacks"))) (htdp-settings #(#t write mixed-fraction #t #t none #f ((lib "valrose.rkt" "installed-teachpacks")) #f)))
;;; sol6.rkt, PF1, Printemps 2017
;;; Etudiant Niveau Avancé + teachpack valrose.rkt

"***************************** TD6 *****************************"

"Exo 6.1 - RAPPEL : tri par insertion polymorphe"
; "polymorphe" signifie ici que la fonction de tri n'est pas limitee aux nombres, ni 
; a un ordre precis. Ce dernier est choisi via la relation d'ordre rel? : E x E --> boolean
; https://fr.wikipedia.org/wiki/Relation_d%27ordre

(define (tri-ins L rel?)        ; rel? est une relation d'ordre, par exemple <=
  (if (empty? L) 
      L
      (insertion (first L) (tri-ins (rest L) rel?) rel?)))    ; cout en O(n^2) : quadratique !

(define (insertion x LT rel?)   ; LT est triee suivant rel?
  (cond ((empty? LT) (list x))
        ((rel? x (first LT)) (cons x LT))
        (else (cons (first LT) (insertion x (rest LT) rel?)))))

(show (insertion 8 '(1 3 5 10 12) <=))
(show (tri-ins '(5 2 4 1 3 2 5) <=))
(show (tri-ins '(5 2 4 1 3 2 5) >=))
(define CARTES '((valet trefle) (dame coeur) (7 pique) (8 trefle) (as pique)))
(printf "Montrez comment lors d'un examen vous pourriez trier une telle main de poker :
d'abord par la couleur (trefle < carreau < coeur < pique), ensuite par la hauteur !...\n")
(printf "CARTES : ~a\n" CARTES)
;(show (tri-ins CARTES (lambda (carte1 carte2) (error "Oops, not yet done !"))))

"Exo 6.2 - Recurrence"

(define ($range start end step)    ; range est une fonction primitive ! On suppose step > 0
  (if (>= start end)
      empty                        ; empty ou '()
      (cons start ($range (+ start step) end step))))

(check-expect ($range 10 20 2) (range 10 20 2))    ; comme en Python...

(define (nomul3-slow n)            ; liste des entiers de [0,n] non multiples de n
  (cond ((= n 0) empty)
        ((zero? (modulo n 3)) (nomul3-slow (- n 1)))
        (else (append (nomul3-slow (- n 1)) (list n)))))     ; mauvais : cout quadratique O(n^2)

(check-expect (nomul3-slow 10) '(1 2 4 5 7 8 10)) 

; Le fautif est append, avec l'idee saugrenue d'ajouter un element a droite ! Dans l'univers
; des listes Scheme, on s'efforce toujours d'AJOUTER LES ELEMENTS A GAUCHE avec cons (c'est
; l'inverse avec Python). On va donc remplacer append par cons en inversant le sens de parcours...

(define (nomul3-better n)              ; n entier naturel
  (local [(define (from i)             ; les non multiples de 3 dans [i,n], a partir de i
            (cond ((> i n) empty)
                  ((zero? (modulo i 3)) (from (+ i 1)))   ; cons ajoute a gauche !
                  (else (cons i (from (+ i 1))))))]
    (from 0)))                       ; je pars de 0 cette fois, cout = O(n)

(check-expect (nomul3-better 10) '(1 2 4 5 7 8 10))

; Enfin, on peut eviter le modulo inutile en observant que pour travailler sur les non
; multiples de 3 : on part de 1 puis on avance de 1, de 2, de 1, de 2, etc. Comment faire ?
; Par exemple en introduisant un argument supplementaire qui vaudra 1 ou 2 :

(define (nomul3-best n)
  ; on introduit step qui vaut 1 ou 2 alternativement
  (local [(define (avance a step)    ; recurrence sur a
            (cond ((> a n) empty)
                  ((= step 1) (cons a (avance (+ a 1) 2)))
                  (else (cons a (avance (+ a 2) 1)))))]
    (avance 1 1)))    ; je pars de 1 et je suis pret a avancer de 1

(check-expect (nomul3-best 10) '(1 2 4 5 7 8 10))

"Exo 6.3"

(define (card L)                     ; le nombre d'elements distincts de L, cout en O(n^2)
  (cond ((empty? L) 0)
        ((member? (first L) (rest L)) (card (rest L)))    ; (member? x L) <==> "x in L" en Python
        (else (+ 1 (card (rest L)))))) 

(check-expect (card '(a b c b b a d d)) 4)
(check-expect (card (build-list 10000 (lambda (i) (random 5)))) 5)   ; je m'amuse, hein :-)

; compactage des elements egaux

(define (compacter L)           ; on pourrait le faire en une seule fonction, mais bon...
  (if (empty? L)
      L
      ($insertion (first L) (compacter (rest L)))))  ; exactement le code de tri-ins !!!!

(define ($insertion x LC)                  ; LC = Liste de Couples
  (if (empty? LC)
      (list (list x 1))                    ; on a bien dit une liste de couples
      (local [(define c (first LC)) (define y (first c))]  ; on plonge dans les sous-listes
        (if (equal? x y)
            (cons (list x (+ 1 (second c))) (rest LC))
            (cons c ($insertion x (rest LC)))))))

(show ($insertion 'a '((b 2) (a 5) (c 1))))
(show ($insertion 'd '((b 2) (a 5) (c 1))))

(show (compacter '(a a a a a b b a c c c c a a a c)))   ; ((c 5) (a 9) (b 2))

; Un check-expect est delicat a rediger car l'ordre de la liste resultat n'est pas
; specifie ! Il faudrait donc programmer un testeur d'egalite "a l'ordre pres" de deux listes
; dont tous les elements sont distincts. Une "egalite au sens des ensembles", quoi. Let's go :

(define (ens=? L1 L2)            ; egalite de deux listes sans repetitions a l'ordre pres
  (and (inclus? L1 L2) (inclus? L2 L1)))      ; une double inclusion, comme en algebre :-)

; Il y aurait bien la solution de trier, mais si les elements ne sont pas tous de meme type ?...

(define (inclus? L1 L2)          ; tous les elements de L1 sont-ils bien dans L2 ?
  (or (empty? L1)                ; style booleen pur, plus joli qu'un cond...
      (and (member (first L1) L2)
           (inclus? (rest L1) L2))))

(check-expect (inclus? '(c b) '(a b c)) #t)
(check-expect (inclus? '(a d) '(a b c)) #f)

(check-expect (ens=? (compacter '(a a a a a b b a c c c c a a a c))
                     '((a 9) (b 2) (c 5)))    ; a l'ordre pres !
              #t)

"******************************* TP6 ****************************"

"Exo 6.1 - Moyenne d'une liste de nombres"

(define (somme L)
  (if (null? L)
      0
      (+ (first L) (somme (rest L)))))        ; HR == (somme (rest L))

(check-expect (somme '(6 3 1 8 2)) 20)

(define (moyenne L)                           ; on suppose L non vide bien entendu
  (exact->inexact (/ (somme L) (length L))))  ; ne rendez pas une fraction !

(show (moyenne '(6 3 1 8 1)))                 ; en 2 passages sur la liste :-(

(define (moyenne-bis L)             ; en un seul passage sur L sans utiliser length
  (local [(define (som&long L)      ; retourne deux resultats sous la forme (somme longueur)
            (if (empty? L)
                (list 0 0)          ; ou bien '(0 0)
                (local [(define HR (som&long (rest L)))]   ; HR = hypothese de recurrence = (s n)
                  (list (+ (first L) (first HR)) (+ 1 (second HR))))))]
    (local [(define SL (som&long L))]     ; ne pas faire de recalcul de (som&long L)
      (exact->inexact (/ (first SL) (second SL))))))

(show (moyenne-bis '(6 3 1 8 1)))

"Exo 6.2 - Utilisation de la primitive (build-list n (lambda (i) ...))" 

(define (entiers n)           ; n >= 0 entier
  (build-list (+ n 1) identity))           ; identity = (lambda (i) i) est une primitive

(check-expect (entiers 6) '(0 1 2 3 4 5 6))

(define (intervalle a b)      ; a <= b entiers
  (build-list (+ b (- a) 1) (lambda (i) (+ a i))))

(check-expect (intervalle -2 7) '(-2 -1 0 1 2 3 4 5 6 7))

"Exo 6.3 - Complexite d'un tri"

(define (Lrandom n max)       ; bien pratique pour tester des algos sur les listes !
  (build-list n (lambda (i) (random (+ max 1)))))

(show (Lrandom 10 100))

; tri-ins est defini plus haut

(define L2000 (build-list 2000 (lambda (i) (random 100))))
(define L4000 (build-list 4000 (lambda (i) (random 100))))
(printf "Le temps de calcul est (cpu-time) - (gc-time), ok ?\n")
(printf "tri-ins sur L2000 : ")
(time (void (tri-ins L2000 <=)))      ; void pour jeter le resultat du tri
(printf "tri-ins sur L4000 : ")
(time (void (tri-ins L4000 <=)))
(printf "Le temps de L4000 devrait etre environ 4 fois le temps de L2000...\n")
(printf "Regardons maintenant le tri primitif RAPIDE de Racket (sort L rel?) en O(n log n):\n")
(printf "sort sur L2000 : ")
(time (void (sort L2000 <=)))
(printf "sort sur L4000 : ")
(time (void (sort L4000 <=)))

"Exo 6.4 - sous-liste, hasard"

(define (que-les-impairs L)
  (cond ((empty? L) L)
        ((odd? (first L)) (cons (first L) (que-les-impairs (rest L))))   ; donc cout O(n)
        (else (que-les-impairs (rest L)))))

(check-expect (que-les-impairs '(7 4 6 3 9 12 21 8 1)) '(7 3 9 21 1))

(define (hasard L)      ; tirage d'un element au hasard dans la liste L
  (list-ref L (random (length L))))        ; cout O(n) a cause de list-ref 

(show (hasard '(a b c d)))
(show (hasard '(a b c d)))

"Exo 6.5 - Ensembles non ordonnes - IMPORTANT"
; Maths : un ENSEMBLE est une "collection" d'elements distincts non numerotes, en vrac.
; Nous n'implementons ici que quelques operations de la theorie des ensembles, occupez-vous
; peut-etre des autres avant l'examen ?

(define (liste->ens L)     ; elimination des repetitions dans une liste L (ressemble a card)
  (cond ((empty? L) empty)
        ((member (first L) (rest L)) (liste->ens (rest L)))
        (else (cons (first L) (liste->ens (rest L))))))

(show (liste->ens '(a b c b b c d a)))    ; (b c d a) par exemple (a l'ordre pres)
(check-expect (ens=? (liste->ens '(a b c b b c d a))     ; ens=? est fait plus haut
                     '(a b c d))
              #t)

(define (union E F)        ; ensemble x ensemble --> ensemble, les matheux notent E U F
  (cond ((empty? E) F)
        ((member (first E) F) (union (rest E) F))
        (else (cons (first E) (union (rest E) F)))))

(show (union '(a b c) '(b c d)))   ; maths : {a,b,c} U {b,c,d} = {a,b,c,d}

(define (difference E F)   ; ensemble x ensemble --> ensemble, les matheux notent E - F
  (cond ((empty? E) empty)
        ((member (first E) F) (difference (rest E) F))
        (else (cons (first E) (difference (rest E) F)))))

(show (difference '(a b c d) '(c d e f)))   ; maths : {a,b,c,d} - {c,d,e,f} = {a,b}

(define (produit E1 E2)    ; ensemble x ensemble --> ensemble, les matheux notent E x F
  (if (empty? E1)
      empty
      (append (produit (rest E1) E2)
              (produit-avec (first E1) E2))))

(define (produit-avec x E)    ; la liste des (x y) avec y dans E
  (if (empty? E)
      empty
      (cons (list x (first E)) (produit-avec x (rest E)))))

(show (produit-avec 3 '(4 5 6)))
(show (produit '(a b c) '(1 2)))    ; maths : {a,b,c} x {1,2} = {(a,1),(b,1),(c,1),(a,2),(b,2),(c,2)}

"Exo 6.6 - fonction a deux resultats, cf aussi TP6_exo1c"

(define (parite L)   ; separer L en pairs et impairs
  (if (empty? L)
      (list empty empty)
      (local [(define HR (parite (rest L)))]     ; HR = (L1 L2), cf exo 4 du TP6, meme strategie !
        (if (even? (first L))
            (list (cons (first L) (first HR)) (second HR))
            (list (first HR) (cons (first L) (second HR)))))))

(check-expect (parite '(7 4 6 3 9 12 21 8 1)) '((4 6 12 8) (7 3 9 21 1)))
(show (parite '(7 4 6 3 9 12 21 8 1)))

; Entrainez-vous sur les ANIMATIONS DONT LE MONDE EST UNE LISTE ! Exemple ci-dessous
; de ce que l'on nomme un SYSTEME DE PARTICULES :

(define (anim-liste)
  (local [(define FOND (rectangle 200 200 'solid "yellow"))
          ; une part(icule) est une balle de couleur en (x,y) bougeant au hasard, et d'image img
          (define-struct part (x y img))
          (define (random-part)
            (make-part 100 100
                       (circle (+ 10 (random 10)) 'solid (hasard '("red" "blue" "green" "maroon" "black")))))
          (define (bouger p)    ; particule --> particule
            (local [(match-define (part x y img) p)]         ; mieux que [(define x (part-x p)) etc.]
              (make-part (+ x (random 5) -2) (+ y (random 5) -2) img)))
          ; le monde est une liste L de 10 particules
          (define INIT (build-list 10 (lambda (i) (random-part))))
          ; la fonction suivant fait bouger un peu au hasard chaque particule
          (define (suivant L)       ; monde --> monde
            (if (empty? L)
                L
                (cons (bouger (first L)) (suivant (rest L)))))
          ; la fonction dessiner dessine les 10 particules dans le fond
          (define (dessiner L)
            (if (empty? L)
                FOND
                (local [(match-define (part x y img) (first L))]    ; la premiere particule
                  (place-image img x y (dessiner (rest L))))))
          ; la fonction final? detecte si une particule sort du canvas et stoppe alors l'animation
          (define (final? L)
            (if (empty? L)
                #f
                (local [(match-define (part x y img) (first L))]
                  (or (< x 0) (> x 200) (< y 0) (> y 200) (final? (rest L))))))]
    (big-bang INIT
              (on-tick suivant)
              (on-draw dessiner)
              (stop-when final?)
              (name "Particules"))))

(show (anim-liste))
(printf "\nEt finalement : ")