(* Plein de tris différents *)


(* Rend une liste de n nombres aléatoires *)
random__init 1978;;
let rec liste_aléat = function 
  |0 -> []
  |n -> (random__int 10000)::(liste_aléat (n-1))
;;

(* Tri par insertion d'une liste *)
let rec insert_ds_liste_triée x liste = match liste with
  |[] -> [x]
  |t::q -> if x <= t then x::liste else t::(insert_ds_liste_triée x q)
;;

let rec tri_insert = function
  |[] -> []
  |[a] -> [a]
  |t::q -> insert_ds_liste_triée t (tri_insert q)
;;

(* Tri par tas ou Heapsort *)
type 'a Tas =
  |Rien
  |Noeud of 'a * 'a Tas * 'a Tas
;;

(*
let test = Noeud(7,
                 Noeud(4,
                       Noeud(5, Rien, Rien),
                       Noeud(3, Rien, Rien)
                      ),
                 Noeud(8,
                       Noeud(9, Rien, Rien),
                       Noeud(12,Rien,Rien)
                      )
                );;
*)

let racine = function
  |Rien -> failwith "Tas vide"
  |Noeud (x, _, _) -> x
;;

let rec enlever = function
  |Rien -> Rien
  |Noeud(x, Rien, fd) -> fd
  |Noeud(x, fg, Rien) -> fg
  |Noeud(_, fg, fd) -> let x = racine fg and y = racine fd in
	   if x < y
	   then Noeud(x, enlever fg, fd)
	   else Noeud(y, fg, enlever fd)
;;

let rec ajouter y = function
  |Rien -> Noeud(y, Rien, Rien)
  |Noeud (x, fg, fd) -> 
     if x < y 
	  then Noeud(x, fd, ajouter y fg)
	  else Noeud(y, fd, ajouter x fg)
;;

let rec list_to_heap liste untas = match liste with
  |[] -> untas
  |t::q -> list_to_heap q (ajouter t untas)
;;

let rec heap_to_list = function
  |Rien -> []
  |tas  -> (racine tas)::(heap_to_list (enlever tas))
;;

let heapsort liste = heap_to_list (list_to_heap liste Rien);;

(* mergesort (2 versions différentes) *)
(* Partie commune : la fusion des listes triées *)
let rec fusion l1 l2 = match (l1,l2) with
  |[], _ -> l2
  |_, [] -> l1
  |t1::q1, t2::q2 -> if t1 < t2 then t1::(fusion q1 l2) else t2::(fusion l1 q2)
;;

(* Met la liste sous forme d'une liste de listes à un élément *)
let explose liste = map (fun t->[t]) liste;;

let mergesort1 liste =
  let rec aux1 result = function
    |[] -> aux2 result
    |[a] -> aux2 (a::result)
    |a::b::q -> aux1 ((fusion a b)::result) q
  and aux2 = function
    |[] -> []
    |[a] -> [a]
    |_ as l -> aux2 (aux1 [] l)
  in try hd (aux1 [] (explose liste)) with Empty -> []
;;

(* Une autre vision du tri fusion : Aho-Ullmann page 85 *)
let rec egrem = function
  |[] -> ([], [])
  |[a] -> ([a], [])
  |(a::b::z) -> let (u,v) = egrem z in (a::u, b::v)
;;

let rec mergesort2 = function
  |[] -> []
  |[a] -> [a]
  |_ as l -> let (x,y) = egrem l in fusion (mergesort2 x) (mergesort2 y)
;;

(* QuickSort d'une liste (plus facile qu'avec les tableaux) *)
let rec separe pivot list (inf, egal, sup) = match list with
  |[]	-> inf, egal, sup
  |t::q -> 
     if t = pivot 
	  then separe pivot q (inf, t::egal, sup)
     else
       if t < pivot
       then separe pivot q (t::inf, egal, sup)
	    else separe pivot q (inf, egal, t::sup)
;;

let rec quicksort liste = match liste with
  |[]	-> []
  |t::q -> let (inf, egal, sup) = separe t liste ([], [], [])
	 in (quicksort inf)@egal@(quicksort sup)
;;

(* Une petite comparaison !! *)
let liste = liste_aléat 10000 and temp = ref 0.;;

temp := sys__time();
tri_insert liste; print_string "Tri par insertion : ";
print_float (sys__time()-. !temp); print_string " s\n"; temp := sys__time();
heapsort liste;   print_string "Tri par tas       : ";
print_float (sys__time()-. !temp); print_string " s\n"; temp := sys__time();
mergesort1 liste; print_string "Tri fusion (#1)   : ";
print_float (sys__time()-. !temp); print_string " s\n"; temp := sys__time();
mergesort2 liste; print_string "Tri fusion (#2)   : ";
print_float (sys__time()-. !temp); print_string " s\n"; temp := sys__time();
quicksort liste;  print_string "Tri rapide        : ";
print_float (sys__time()-. !temp); print_string " s\n"; temp := sys__time();;