(* Cours numero 2: les types de donnees *)

(* enregistrements *)

type complex = {im: float; re: float};;

let zc = {re=0.;im=0.};;

let addc = fun {im=a; re=b} {im=c; re=d} -> 
           {im=a+.c; re=b+.d};;

(* Types sommes *)

(* constructeurs constants *)

type colors = Blue | Red | Green;;

let perm = function Blue -> Red
           |        Red -> Green
           |        Green -> Blue;;

(* constructeurs avec parametres *)

type num = Entier of int | Flottant of float;;

let addnum = 
    function (Entier a, Entier b) -> Entier (a+b)
    |        (Entier a, Flottant b) -> Flottant (float a+.b);;

type intlist = Nil | Cons of int * intlist;;

(* listes d'entiers *)

let rec append = 
    function (Nil,l)  -> l
    |        (Cons(a,r), l) -> Cons(a, append (r,l));;

(* pouvoir des types recursifs: un programme qui diverge *)

type d = Plie of (d->d);;

let plie = fun f -> Plie f;;
let deplie = fun (Plie f) -> f;;

let delta = (deplie x) x;;

let boom = delta (plie delta);;   (* tapez ctrl-c ! *)

(* types POLYMORPHES: listes et operations sur listes *)

type 'a list = Nil | Cons of 'a * 'a list;;

let rec append = 
        function (Nil,l)  -> l
        |        (Cons(a,r), l) -> Cons(a, append (r,l));;

let rec list_hom f e = 
        function Nil -> e
        | Cons(a,l)  -> f a (list_hom f e l);;

(* exemples de homomorphismes *)

let length = list_hom (fun x y -> y+1) 0;;

let reverse = list_hom (fun x y -> append (y,(Cons(x,Nil)))) Nil;;

let filter p = list_hom 
               (fun x l -> if p x then Cons(x,l) else l) Nil;;

(* les listes sont aussi predefinies!!! *)

open List;;

[];;

1::[];;

[1];;

[1;2;3;4];;


let rec list_hom f e = 
        function [] -> e
        | a::l  -> f a (list_hom f e l);;

let filter p = list_hom (fun x l -> if p x then x::l else l) [];;

(* on peut aussi l'ecrire directement : *)

let rec filter p = 
        function [] -> []
        |    (a::r) -> if p a then a::(filter p r)
                              else (filter p r);;

filter (fun x -> x mod 2 =0) [1;2;3;4;5;6];;

(* les TRI sur les listes *)

(* quicksort *)

let rec partition p = 
        function []   -> [],[]
        |      (a::r) -> let (l1,l2) = partition p r
                         in if p a then ((a::l1),l2)
                                   else (l1,(a::l2));;

partition (fun x -> x mod 2 =0) [1;2;3;4;5;6];;

let rec qsort cmp = 
        function []   -> []
        |  (a::r) -> let (p,g) = partition (fun x -> cmp a x) r
                     in (qsort cmp p)@[a]@(qsort cmp g);;

qsort (fun x y -> x < y) [1;4;3;2;9;5;10];; 

qsort (fun x y -> x > y) [1;4;3;2;9;5;10];; 

(* mergesort *)

let rec partition_merge = 
        function []      -> [],[]
        |    [a]         -> [a],[] 
        |   (a::(b::r))  -> let (l1,l2) = partition_merge r
                            in (a::l1),(b::l2);;

partition_merge [1;2;3;4;5;6;7;8;9];; 

let rec merge cmp = 
        function (a::r,b::s) -> if cmp a b 
                                then a::(merge cmp (r, (b::s)))
                                else b::(merge cmp ((a::r), s))
        |        ([],l) -> l
        |        (l,[]) -> l;;

let rec mergesort cmp = 
        function [] -> []
        |        [a] -> [a] (* necessaire pour la terminaison *)
        |         l -> let (l1,l2) = partition_merge l
                       in merge cmp (mergesort cmp l1,
                                     mergesort cmp l2);;

mergesort (fun x y -> x > y) [1;4;3;2;9;5;10];; 
mergesort (fun x y -> x < y) [1;4;3;2;9;5;10];; 

(* les arbres binaires *)

type 'a arbre = Empty | Node of 'a arbre *'a*'a arbre;;

(* parcours d'arbre *)

let rec infixe = 
     function Empty           -> []
     |        (Node(ag,i,ad)) -> (infixe ag)@[i]@(infixe ad);;

let rec prefixe = 
     function Empty           -> []
     |        (Node(ag,i,ad)) -> [i]@(prefixe ag)@(prefixe ad);;

let rec postfixe = 
     function Empty           -> []
     |        (Node(ag,i,ad)) -> (postfixe ag)@(postfixe ad)@[i];;

(* homomorphismes *)

let rec hom_tree f e =
        function Empty    -> e
        | (Node(ag,i,ad)) -> f (hom_tree f e ag) i 
                               (hom_tree f e ad);; 

(* exemples *)

let maptree f = hom_tree (fun g i d -> Node(g,f i,d)) Empty;;

maptree (fun x -> x+1) 
        (Node(Node(Empty,3,Empty),4,Node(Empty,5,Empty)));;

let hauteur = hom_tree (fun g i d -> 1+(max g d)) 0;;

hauteur (Node(Node(Empty,3,Empty),4,Node(Empty,5,Empty)));;

let taille = hom_tree  (fun g i d -> 1+g+d) 0;;

taille (Node(Node(Empty,3,Empty),4,Node(Empty,5,Empty)));;

let miroir = hom_tree (fun g i d -> Node(d,i,g)) Empty;;

miroir (Node(Node(Empty,3,Empty),4,Node(Empty,5,Empty)));;

(* parcours infixe generalises, pliages *)

let rec plie_droite f e =
        function Empty  -> e
        | (Node(g,i,d)) -> plie_droite 
                              f 
                              (f (plie_droite f e g) i)
                              d;;

let infixe a = plie_droite (fun l x -> x::l) [] a;;

infixe (Node(Node(Empty,3,Empty),4,Node(Empty,5,Empty)));;