;; 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 sol9) (read-case-sensitive #t) (teachpacks ((lib "valrose.rkt" "installed-teachpacks"))) (htdp-settings #(#t write repeating-decimal #t #t none #f ((lib "valrose.rkt" "installed-teachpacks")) #f)))
;;; sol9.rkt, PF1, Printemps 2017
;;; Etudiant Niveau Avancé + teachpack valrose.rkt
(require net/sendurl)

"******************************* TD9 ****************************"

"Exo 1"
"Le type abstrait vec2d"

; Version avec des listes a deux elements

(define (vec2d x y)
  (list x y))

(define (xcor v)
  (first v))

(define (ycor v)
  (second v))

(define (vec2d? obj)    ; obj est de type quelconque
  (and (list? obj)
       (= (length obj) 2)
       (real? (first obj))
       (real? (second obj))))

(printf "Le type abstrait : vec2d, xcor, ycor, vec2d?, est disponible.\n")

#|
"Version avec des structures"        

(define-struct VECT2D (x y))

(define (vec2d x y)
  (make-VECT2D x y))

(define (xcor v)
  (VECT2D-x v))

(define (ycor v)
  (VECT2D-y v))

(define (vec2d? obj) 
  (VECT2D? obj))
|#

"--------- Programmation avec le type abstrait ----------"

(define u (vec2d 0 1))
(define v (vec2d 3 2))
(show u)
(show v)
(show (xcor u))
(show (ycor u))
(show (vec2d? u))
(show (vec2d? 2016))

(define (vec2d->string v)
  (format "<~a,~a>" (xcor v) (ycor v)))    ; surtout pas first au lieu de xcor !

(printf "u = ~a et v = ~a\n" (vec2d->string u) (vec2d->string v))

(define (vec+ v1 v2)
  (vec2d (+ (xcor v1) (xcor v2))           ; surtout pas list au lieu de vec2d ! 
         (+ (ycor v1) (ycor v2))))

(printf "donc u + v --> ~a\n" (vec2d->string (vec+ u v)))

; etc. Voir TD.
; La norme "derive du produit scalaire" : norme(v) = sqrt(v . v)
; Le produit scalaire peut aussi deriver de la norme (verifiez-le...)
; La fin dans l'exo 9.4 (matheux only) !

"Exo 2"

(define (sigma5 a f s fini?)         ; sigma4 rendu iteratif !
  (local [(define (iter a acc)
            (if (fini? a)
                acc
                (iter (s a) (+ acc (f a)))))]
    (iter a 0)))

(show (sigma5 10 sqr (lambda (x) (+ x 2)) (lambda (x) (> x 20))))  ; 10^2 + 12^2 + ... + 20^2

; Exemple : calcul exact de S = 1/1 + 1/3 + 1/5 + ... + 1/99
(define S (sigma5 1 / (lambda (a) (+ a 2)) (lambda (a) (> a 99))))
(show S)

#|
def sigma5(a,f,s,fini) :     # en Python...
    acc = 0
    while not fini(a) :
        (a,acc) = (s(a),acc+f(a))
    return acc

# calcul exact de S = 1/1 + 1/3 + 1/5 + ... + 1/99
from fractions import Fraction
S = sigma5(1,lambda a : Fraction(1,a),lambda a : a+2,lambda a : a > 99)
print('S =',S)
|#

; Faisons abstraction de l'operation binaire + et de son neutre 0 :

(define (accumulation op e a f s fini?)   ; op operation binaire de neutre e
  (local [(define (iter a acc)
            (if (fini? a)
                acc
                (iter (s a) (op acc (f a)))))]
    (iter a e)))

; accumulation permet de calculer des series numeriques, des listes, des images, ou autres :
(show (accumulation + 0 10 sqr (lambda (a) (+ a 2)) (lambda (a) (> a 20))))    ; 10^2 + 12^2 + ... + 20^2
(show (accumulation * 1 10 log (lambda (a) (+ a 2)) (lambda (a) (> a 50))))    ; log(10) * log(12) * ... * log(50)
(show (accumulation (lambda (x y) (list x)) empty 10 identity add1 (lambda (a) (> a 30))))   ; un trou noir :-)
(show (accumulation beside empty-image 10 (lambda (r) (circle r 'outline "blue")) (lambda (r) (+ r 3)) (lambda (r) (> r 60))))

(define (intervalle-bug a b)
  (accumulation (lambda (acc x) (cons x acc)) empty a identity add1 (lambda (a) (> a b))))

(show (intervalle-bug 10 20))       ; zut, a l'envers ! On aurait du envelopper par un reverse...

(define (intervalle a b)            ; ...mais mieux : on inverse le sens de parcours !
  (accumulation (lambda (acc x) (cons x acc)) empty b identity sub1 (lambda (b) (< b a))))

(show (intervalle 10 20))

"Exo 3"

; un autre exemple de reduce (qui se nomme en realite foldr en Racket) :
(define (somcarres L)
  (reduce (lambda (x r) (+ (sqr x) r)) 0 L))   ; x represente le first de L, et r represente le resultat sur le reste (HR)

(show (somcarres '(3 2 4 1)))

; application de foldr au tri par insertion :

(define (insertion x LT)     ; pour rappel, LT est triee en croissant
  (cond ((empty? LT) (list x))
        ((<= x (first LT)) (cons x LT))
        (else (cons (first LT) (insertion x (rest LT))))))

(show (insertion 5 '(1 3 7 9)))

(define (tri-ins L)
  (reduce insertion empty L))    ; un tri en "one-liner", cool !

(show (tri-ins '(3 9 5 1 7)))

; question d). Lire le livre de cours aux §8.10.2 et §8.10.3
; Le 'foldr' de Racket se nomme aussi 'reduce' d'apres Lisp (comme dans le MOOC)
; cf l'algorithme 'MapReduce' de Google :
;(send-url "http://static.googleusercontent.com/media/research.google.com/fr//archive/mapreduce-osdi04.pdf")
; Brian Harvey l'a decrit dans son cours Scheme à Berkeley (notez au passage qu'il utilise un Scheme STk
; qui provient de Nice !) :
;(send-url "https://archive.org/details/ucberkeley_webcast_OVbHFr6SG_8")
; Enfin, une etudiante de Berkeley a produit un rapport sur l'utilisation pedagogique de bandes
; dessinees pour enseigner Scheme, avec a la fin des planches sur MapReduce :
;(send-url "http://digitalassets.lib.berkeley.edu/techreports/ucb/text/EECS-2009-79.pdf")

; N.B. reduce est souvent utilisable dans la fonction 'dessiner' d'un systeme de particules, tout comme
; map est souvent utilisee dans la fonction 'suivant' (lorsque le nombre de particules ne change pas)
; et tout comme andmap et ormap sont souvent utilises dans la fonction final?

; Par exemple la fonction dessiner suivante d'un canon cracheur de billes :

;  (define (dessiner L)
;    (if (empty? L)
;        FOND
;       (local [(define b (first L))]
;         (place-image BILLE (bille-x b) (bille-y b) (dessiner (rest L))))))

; pourrait se coder en une ligne avec reduce (il faut une certaine habitude...) :

;  (define (dessiner L)
;    (reduce (lambda (b r) (place-image BILLE (bille-x b) (bille-y b) r)) FOND L))

"Exo 9.4"
; Pour (rot v alpha), le plus simple si l'on ne connait pas par coeur l'expression analytique
; d'une rotation vectorielle plane, est de passer en complexes. En effet, faire tourner un
; vecteur v d'affixe complexe z d'un angle alpha revient a multiplier z par (exp (* +i alpha)).
; Ensuite on separe partie reelle et partie imaginaire. Mieux que les matrices !!!

(define (rot v alpha)      ; version cool qui passe par les complexes !
  (local [(define z (make-rectangular (xcor v) (ycor v)))   ; l'affixe complexe z=x+yi du vecteur v
          (define zr (* z (exp (* +i alpha))))]             ; l'affixe zr du resultat
    (vec2d (real-part zr) (imag-part zr))))                 ; et hop, on rebascule en reel ! 

(printf "La rotation du vecteur ~a d'angle pi/2 est ~a\n"
        (vec2d->string u) (vec2d->string (rot u (/ pi 2))))

; La "curryfication" consiste a transformer une fonction d'arite 2 rotation en une fonction d'arite 1 c-rotation :

(define (rotation alpha)     ; real --> procedure
  (lambda (v) (rot v alpha)))

; du coup on peut definir "la rotation r d'angle pi/2" en tant que fonction :

(define r (rotation (/ pi 2)))
(show (r u))     ; la rotation d'angle pi/2 appliquee au vecteur u

; Pour calculer w = (proj v1 v2), le vecteur projete orthogonal de v1 sur v2, on exprime que w est
; colineaire a v2, et que le vecteur w - v1 est orthogonal a v2. Une ligne de calcul, et hop !

(define (proj v1 v2)        ; le vecteur projection orthogonale de v1 sur v2
  (error "Just do it NOW !"))

;(printf "La projection du vecteur ~a sur le vecteur ~a est ~a\n"
;        (vec2d->string v) (vec2d->string u) (vec2d->string (proj u v)))

"******************************* TP9 *******************************"

"Exo 1"

(define (fac n)
  (apply * (build-list n add1)))    ; le style APL :-)

(check-expect (fac 5) 120)

(define ($exp x n)   ; approximation de l'exponentielle de x avec n termes dans la serie
  (local [(define xi (exact->inexact x))]
    (apply + (build-list n (lambda (k) (/ (expt xi k) (fac k)))))))

(printf "L'approximation de e avec 16 termes donne ~a au lieu de ~a\n" ($exp 1 16) e)

(define (gregory n)     ; http://en.wikipedia.org/wiki/Leibniz_formula_for_pi
  (* 4 (apply + (build-list n (lambda (k) (/ (expt -1 k) (+ (* 2 k) #i1)))))))  ; calcul inexact !

(show (gregory 10))
(show (gregory 50000))    ; 50000 termes !

(define (integrale f a b n)    ; a la Riemann, il y a de meilleures methodes d'integration...
  (local [(define h (exact->inexact (/ (- b a) n)))]   ; le pas d'integration sur [a,b]
    (* h (apply + (build-list n (lambda (i) (f (+ a (* i h)))))))))

(show (integrale identity 0 1 500))
(show (integrale sin 0 pi 100))
(printf "Calcul de pi comme aire d'un cercle de rayon 1 : pi = ~a\n"
        (* 2 (integrale (lambda (x) (sqrt (- 1 (* x x)))) -1 1 10000)))

"Exo 2"

(define ($vec+ v1 v2)   ; v1 et v2 vecteurs de meme dimensions, mais pas de type abstrait...
  (map + v1 v2))

(show ($vec+ '(1 2 3) '(4 5 6)))

(define ($ext* k v)
  (map (lambda (x) (* k x)) v))     ; composante a composante

(show ($ext* 2 '(1 2 3)))

(define ($prodscal v1 v2)
  (apply + (map * v1 v2)))

(show ($prodscal '(3 1 2 -1) '(1 1 -3 1)))

"Exo 3"

(define (filter1 pred? L)     ; les elements de L verifiant pred?, version recursive enveloppee
  (cond ((empty? L) L)
        ((pred? (first L)) (cons (first L) (filter1 pred? (rest L))))
        (else (filter1 pred? (rest L)))))

(define (filter2 pred? L)     ; idem, version iterative
  (local [(define (iter L acc)
            (cond ((empty? L) (reverse acc))
                  ((pred? (first L)) (iter (rest L) (cons (first L) acc)))
                  (else (iter (rest L) acc))))]
    (iter L empty)))

(define (filter3 pred? L)     ; idem, version ordre superieur !!!
  (reduce (lambda (x r) (if (pred? x) (cons x r) r)) empty L))

(check-expect (filter1 odd? '(1 2 3 4 5 6 7 8 9)) '(1 3 5 7 9))
(show (filter1 (lambda (x) (> x 10)) '(5 12 78 9 33 1)))
(check-expect (filter2 odd? '(1 2 3 4 5 6 7 8 9)) '(1 3 5 7 9))
(show (filter2 (lambda (x) (> x 10)) '(5 12 78 9 33 1)))
(check-expect (filter3 odd? '(1 2 3 4 5 6 7 8 9)) '(1 3 5 7 9))
(show (filter3 (lambda (x) (> x 10)) '(5 12 78 9 33 1)))

"Exo 4"

(define (maxListe L)    ; version ordre superieur !
  (apply max L))        ; (apply f (list a b c d)) <==> (f a b c d)

(show (maxListe '(5 7 2 8 3 4)))

"Exo 5"
; (andmap p? L) determines whether p? holds for all items of L
; (ormap p? L)  determines whether p? holds for at least one item of L

(define ($andmap p? L)
  (if (empty? L)
      #t
      (and (p? (first L)) ($andmap p? (rest L)))))     ; iterative (and n'est PAS une enveloppe !)

(show ($andmap (lambda (x) (< x 3)) '(6 7 8 1 5)))     ; sont-ils tous < 3 ?

(define ($ormap p? L)
  (if (empty? L)
      #f
      (or (p? (first L)) ($ormap p? (rest L)))))

(show ($ormap (lambda (x) (< x 3)) '(6 7 8 1 5)))     ; en existe-t-il un qui soit < 3 ?

;;; andmap et ormap permettent souvent de coder simplement la fonction final? davec un
;;; système de particules...