let print = Printf.printf;;
Sys.command "ocaml -version";;

type abr0 =
  | Leaf0
  | Node0 of (int * string * abr0 * abr0)
;;

type 'a abr =
    | Leaf
    | Node of 'a anode

and 'b anode = {
    key   : int;
    value : 'b;
    left  : 'b abr; (* pour toute clé [k] dans [left],  [k] < [key] *)
    right : 'b abr  (* pour toute clé [k] dans [right], [key] < [k] *)
}
;;

let rec nb_keys (a : 'a abr) : int =
    match a with
    | Leaf -> 0
    | Node n -> 1 + nb_keys n.left + nb_keys n.right
    (* | Node (key, value, left, right) -> 1 + nb_keys left + nb_keys right) *)
;;

let a1 = Node { key=1; value="un"; left=Leaf; right=Leaf } ;;
(* let a1 = Node (1,"un",Leaf,Leaf) *)

let a2 = Node { key=2; value="deux"; left=a1; right=Leaf } ;;

let rec trouve (a : 'a abr) (k : int) : 'a option =
    match a with
    | Leaf -> None
    | Node n when k = n.key -> Some n.value
    (* sinon on cherche à gauche ou à droite *)
    | Node n when k < n.key -> trouve n.left k
    | Node n -> trouve n.right k
;;

trouve a2 1;;
trouve a2 3;;

let rec trouve2 (a : 'a abr) (k : int) : 'a =
    match a with
    | Leaf -> failwith "Key not found"
    | Node n when k = n.key -> n.value
    (* sinon on cherche à gauche ou à droite *)
    | Node n when k < n.key -> trouve2 n.left k
    | Node n -> trouve2 n.right k
;;

trouve2 a2 1;;
trouve2 a2 3;;

let rec insertion (a : 'a abr) (k : int) (v : 'a) : 'a abr =
    match a with
    | Leaf ->
        Node { key=k; value=v; left=Leaf; right=Leaf }
    | Node n when k=n.key ->
        Node { n with value = v; key = k }
    | Node n when k < n.key ->
        Node { n with left  = insertion n.left  k v }
    | Node n ->
        Node { n with right = insertion n.right k v }
;;

trouve (insertion (insertion Leaf 2 "deux") 1 "un") 1;;
trouve (insertion (insertion Leaf 2 "deux") 1 "un") 2;;
trouve (insertion (insertion Leaf 2 "deux") 1 "un") 3;;

let rec minimum (a: 'a abr) : int * 'a =
    match a with
    | Leaf -> failwith "empty tree"
    | Node n when n.left = Leaf -> (n.key, n.value)
    | Node n -> minimum n.left
;;

minimum (insertion (insertion Leaf 2 "deux") 1 "un");;

let rec suppression (a: 'a abr) (k:int) : 'a abr =
    match a with
    | Leaf -> Leaf   (* rien a supprimer *)
    | Node n when k = n.key ->  (* trouvé ! *)
        if n.right = Leaf
        then n.left
        else
            let (k_min, v) = minimum n.right in
            Node { key = k_min; value = v; left = n.left; right = suppression n.right k_min }
    | Node n when k < n.key ->   (* à chercher à gauche *)
        Node { n with left  = suppression n.left  k }
    | Node n -> (* à chercher à droite *)
        Node { n with right = suppression n.right k }
;;

trouve (suppression (insertion (insertion Leaf 2 "deux") 1 "un") 1) 1 ;;

trouve (suppression (insertion (insertion Leaf 2 "deux") 1 "un") 1) 2 ;;

(* [decoupe a k] sépare l'arbre [a] en deux arbres [(a1, a2)]
   tels que l'union des clés-valeurs de [a1] et [a2] est égale à
   l'ensemble des clés-valeurs de [a] (privé de l'association
   liée à [k] si elle était présente dans [a]).
   Les clés de [a1] sont < à [k].
   Les clés de [a2] sont > à [k].
*)

let rec decoupe (a : 'a abr) (k : int) : ('a abr) * ('a abr) =
    match a with
    | Leaf -> (Leaf, Leaf)
    | Node n when k = n.key -> (n.left, n.right)
    | Node n when k < n.key ->
        let (left1, left2) = decoupe n.left k in
        (left1, Node { n with left = left2 })
    | Node n ->
        let (right1, right2) = decoupe n.right k in
        (Node { n with right = right1 }, right2)
;;

(* si une clé est présente dans les deux arbres, nous gardons celle de [a1] *)
let rec fusion (a1 : 'a abr) (a2 : 'a abr) : 'a abr =
    match a1 with
    | Leaf -> a2
    | Node n ->
        let (left2, right2) = decoupe a2 n.key in
        Node { n with left = fusion n.left left2; right = fusion n.right right2 }
;;

let a1 = insertion (insertion Leaf 2 "deux") 1 "un" ;;

let a2 = insertion (insertion Leaf 2 "two") 3 "trois" ;;

trouve (fusion a1 a2) 1;;
trouve (fusion a1 a2) 2;;
trouve (fusion a1 a2) 3;;
trouve (fusion a1 a2) 4;;

type 'a heap = E | T of int * 'a * ('a heap) * ('a heap)

let rank : 'a heap -> int = function
    | E -> 0
    | T (r, _, _, _) -> r
;;

let make (x : 'a) (a : 'a heap) (b : 'a heap) =
    let ra = rank a
    and rb = rank b in
    if ra >= rb then
        T (rb + 1, x, a, b)
    else
        T (ra + 1, x, b, a)
;;

let empty : 'a heap = E
;;

let is_empty : 'a heap -> bool = function
    | E -> true
    | T _ -> false
;;

let rec merge (h1 : 'a heap) (h2 : 'a heap) : 'a heap =
    match h1, h2 with
    | E, h | h, E ->
        h
    | T (_, x, a1, b1), T (_, y, a2, b2) ->
        if x <= y then
            make x a1 (merge b1 h2)
        else
            make y a2 (merge h1 b2)
;;

let insert (x : 'a) (h : 'a heap) : 'a heap =
    merge (T (1, x, E, E)) h
;;

exception Empty;;

let mini : 'a heap -> 'a = function
    | E -> raise Empty
    | T (_, x, _, _) -> x
;;

let extract_min : 'a heap -> ('a * 'a heap) = function
    | E -> raise Empty
    | T (_, x, a, b) -> x, merge a b
;;

let tripartas (a : 'a array) : 'a array =
    let n = Array.length a in
    let tas = ref empty in
    for i = 0 to n - 1 do
        tas := insert a.(i) !tas
    done;
    let a2 = Array.make n (-1) in
    for i = 0 to n - 1 do
        let m, t = extract_min !tas in
        a2.(i) <- m;
        tas := t;
    done;
    a2
;;

tripartas [| 10; 3; 4; 1; 2; 7; 8; 5; 9; 6 |] ;;

type arbre = int array;;

type arbre_tournoi = {
    mutable n : int;
    a : arbre
};;

let arbre_test = {
    n = 7;
    a = [|1; 2; 3; 4; 5; 6; 7|]
}

let arbre_test2 = {
    n = 6;
    a = [|2; 1; 3; 4; 5; 6; -1; -1|]
}

let capacite (an : arbre_tournoi) : int =
    Array.length an.a
;;

let nb_element (an : arbre_tournoi) : int =
    let n = an.n
    and m = Array.length an.a in
    assert (n <= m);
    n
;;

capacite arbre_test;;
nb_element arbre_test;;

capacite arbre_test2;;
nb_element arbre_test2;;

let a_racine (an : arbre_tournoi) : bool =
    an.n > 0
;;

let est_racine = (=) 0 ;;

let racine (an : arbre_tournoi) : int * int =
    if 0 >= an.n then failwith "Pas de racine";
    (0, an.a.(0))
;;

racine arbre_test;;

let a_noeud (an : arbre_tournoi) (i : int) : bool =
    an.n > i
;;

let noeud (an : arbre_tournoi) (i : int) : int * int =
    if i >= an.n then failwith (Printf.sprintf "Pas de noeud i = %i and an.n = %i" i an.n);
    (i, an.a.(i))
;;

let valeur (an : arbre_tournoi) (i : int) : int =
    snd (noeud an i)
;;

noeud arbre_test 0;;

let a_gauche (an : arbre_tournoi) (i : int) : bool =
    an.n > 2*i + 1
;;

let gauche (an : arbre_tournoi) (i : int) : int * int =
    if 2*i + 1 >= an.n then failwith (Printf.sprintf "Pas de fils gauche i = %i, 2*i+1 = %i and an.n = %i" i (2*i+1) an.n);
    (2*i + 1, an.a.(2*i + 1))
;;

gauche arbre_test 0;;

let a_droite (an : arbre_tournoi) (i : int) : bool =
    an.n > 2*i + 2
;;

let droite (an : arbre_tournoi) (i : int) : int * int =
    if 2*i + 2 >= an.n then failwith (Printf.sprintf "Pas de fils droit i = %i, 2i+2=%i and an.n = %i" i (2*i+2) an.n);
    (2*i + 2, an.a.(2*i + 2))
;;

droite arbre_test 0;;

let i, _ = droite arbre_test 0 in
droite arbre_test i;;

let rec min_sous_arbre (an : arbre_tournoi) (i : int) : int =
    match (a_gauche an i, a_droite an i) with
    | (false, false) -> max_int
    | (true, false) ->
        let g, vg = gauche an i in
        min vg (min_sous_arbre an g)
    | (false, true) ->
        let d, vd = droite an i in
        min vd (min_sous_arbre an d)
    | (true, true) ->
        let g, vg = gauche an i in
        let d, vd = droite an i in
        min (min vg vd) (min (min_sous_arbre an g) (min_sous_arbre an d))
;;

arbre_test;;
min_sous_arbre arbre_test 0;;

let est_tournoi (an : arbre_tournoi) : bool =
    let rec depuis (i : int) : bool =
        (* cet arbre *)
        let _, vr = noeud an i in
        let min_v = min_sous_arbre an i in
        let res = ref (vr < min_v) in
        (* sous-arbres *)
        if !res && a_gauche an i then
            res := !res && depuis (fst (gauche an i));
        if !res && a_droite an i then
            res := !res && depuis (fst (droite an i));
        !res
    in
    depuis 0
;;

est_tournoi arbre_test;;

arbre_test2;;
est_tournoi arbre_test2;;

let parent (an : arbre_tournoi) (i : int) =
    noeud an ((i - 1) / 2)
;;

let fils_gauche = gauche;;
let fils_droite = droite;;

arbre_test;;

noeud arbre_test 1;;
parent arbre_test 1;;
noeud arbre_test 2;;
parent arbre_test 2;;

noeud arbre_test 4;;
parent arbre_test 4;;
gauche arbre_test 1;;
droite arbre_test 1;; (* 4 *)

noeud arbre_test 5;;
parent arbre_test 5;;
gauche arbre_test 2;; (* 5 *)
droite arbre_test 2;;

let echange (a : 'a array) (i : int) (j : int) : unit =
    let vi, vj = a.(i), a.(j) in
    a.(i) <- vj;
    a.(j) <- vi;
;;

let double_capacite (an : arbre_tournoi) : arbre_tournoi =
    let c = capacite an in
    let a2 = Array.make (2 * c) (-1) in
    for i = 0 to an.n - 1 do
        a2.(i) <- an.a.(i)
    done;
    { n = an.n; a = a2 }
;;

let percolation_haute (an : arbre_tournoi) (i : int) : unit =
    let i = ref i in
    let p = ref (fst (parent an !i)) in
    (* Printf.printf "\nStart:\ni = %i, p = %i%!" !i !p; flush_all(); *)
    while ((valeur an !p) > (valeur an !i)) do
        echange an.a !i !p;
        i := !p;
        p := fst (parent an !i);
        (* Printf.printf "\ni = %i, p = %i%!" !i !p; flush_all(); *)
    done;
;;

let rec insertion (an : arbre_tournoi) (x : int) : arbre_tournoi =
    let n, c = an.n, capacite an in
    if n == c then begin
        let an2 = double_capacite an in
        insertion an2 x
    end else begin
        let an2 = { n = n + 1; a = Array.copy an.a } in
        an2.a.(n) <- x;
        percolation_haute an2 n;
        an2
    end
;;

let arbre_test = {
    n = 7;
    a = [|1; 2; 3; 4; 5; 6; 7; -1|]
};;

let a2 = insertion arbre_test (-40);;
arbre_test;;

(* on le voit doubler ! *)
insertion a2 (-20);;

let arbre_test = {
    n = 7;
    a = [|1; 2; 3; 4; 5; 6; 7; -1; -1; -1; -1|]
};;

insertion (insertion (insertion arbre_test (-40)) (-20)) (-10);;

let creation (a : 'a array) : arbre_tournoi =
    let n = Array.length a in
    let avide = Array.make n (-1) in
    let an = ref {n = 0; a = avide} in
    for i = 0 to n - 1 do
        an := insertion !an a.(i)
    done;
    !an
;;

let arbre_test3 = creation [|20; 1; 3; 5; 7|];;

est_tournoi arbre_test3;;

let sorted (a : 'a array) : 'a array =
    let a2 = Array.copy a in
    Array.sort Pervasives.compare a2;
    a2
;;

(sorted arbre_test3.a) == (arbre_test3.a);;

let indice_min_fils (an : arbre_tournoi) (i : int) : int =
    let g = ref i and d = ref i in
    if a_gauche an i then
        g := fst (fils_gauche an i);
    if a_droite an i then
        d := fst (fils_droite an i);
    if (valeur an !g) < (valeur an !d)
    then !g
    else !d
;;

let percolation_basse (an : arbre_tournoi) (i : int) : unit =
    let i = ref i in
    let f = ref (indice_min_fils an !i) in
    while ((valeur an !f) < (valeur an !i)) do
        echange an.a !i !f;
        i := !f;
        f := indice_min_fils an !i;
    done;
;;

let extraire_min (an : arbre_tournoi) : (int * arbre_tournoi) =
    let an = { an with a = Array.copy an.a } in
    if a_gauche an 0 then begin
        let m = an.a.(0) in
        an.n <- an.n - 1;
        echange an.a 0 an.n;
        an.a.(an.n) <- (-1);
        percolation_basse an 0;
        m, an
    end
    else
        (snd (racine an)), { n = 0; a = [||] };
;;

let a = creation [|20; 1; 3; 5; 7|];;
let m, a = extraire_min a;;
let m, a = extraire_min a;;
let m, a = extraire_min a;;
let m, a = extraire_min a;;
let m, a = extraire_min a;;

let tripartas (a : 'a array) : 'a array =
    let n = Array.length a in
    let avide = Array.make n (-1) in
    let an = ref (creation a) in
    for i = 0 to n - 1 do
        let m, an2 = extraire_min !an in
        avide.(i) <- m;
        an := an2;
    done;
    avide
;;

let array1 = [| 10; 3; 4; 1; 2; 7; 8; 5; 9; 6 |] ;;
let array2 = tripartas array1;;
assert ((sorted array2) = array2);;

type representant = Aucun | Element of int;; (* [int option] pourrait suffire *)

type unionfind = representant array;;

let create_uf (n : int) : unionfind =
    Array.make n Aucun
;;

let makeset (uf : unionfind) (i : int) : unit =
    if uf.(i) = Aucun then
        uf.(i) <- Element i
    else
        failwith "Element deja present"
;;

let union (uf : unionfind) (i : int) (j : int) : unit =
    let n = Array.length uf in
    if (uf.(i) = Aucun || uf.(j) = Aucun) then
        failwith "Element absent";
    for k = 0 to (n - 1) do
        if uf.(k) = Element j then
            uf.(j) <- Element i
    done
;;

(* très facile *)
let find (uf : unionfind) (i : int) : int =
    match uf.(i) with
    | Aucun -> failwith "Element absent"
    | Element i -> i
;;

let uf_test = create_uf 6;;
for i = 0 to 5 do
    makeset uf_test i
done;;

uf_test;;

find uf_test 5;;
union uf_test 1 2;;

uf_test;;
union uf_test 2 5;;

uf_test;;
find uf_test 0;;

uf_test;;
find uf_test 1;;

uf_test;;
find uf_test 1 = find uf_test 5;;
find uf_test 1 = find uf_test 4;;

type position = Aucun | Racine | Fils of int;;

type unionfind = position array;;

let create_uf (n : int) : unionfind =
    Array.make n Aucun
;;

let makeset (uf : unionfind) (i : int) : unit =
    if uf.(i) = Aucun then
        uf.(i) <- Racine  (* i devient son propre représentant *)
    else
        failwith "Element deja present"
;;

let rec find (uf : unionfind) (i : int) : int =
    match uf.(i) with
    | Aucun -> failwith "Element absent"
    | Fils j ->
        let racine = find uf j in
        uf.(i) <- Fils racine; (* modifie la forêt !  *)
        racine
    | Racine -> i              (* la racine est le représentant *)
;;

let union (uf : unionfind) (i : int) (j : int) : unit =
    if (uf.(i) = Aucun || uf.(j) = Aucun) then
        failwith "Element absent"
    else
        (* choix arbitraire de préférer la racine de i,
           on devrait préférer celle de l'arbre le plus petit pour "écraser" la forêt.
           Cf. Papadimitriou ou Cormen (ou Wikipédia).
        *)
        let racinei = find uf i in
        uf.(racinei) <- Fils j
;;

let uf_test = create_uf 6;;
for i = 0 to 5 do
    makeset uf_test i
done;;

uf_test;;

find uf_test 5;;
union uf_test 1 2;;

uf_test;;
union uf_test 2 5;;

uf_test;;
find uf_test 0;;

uf_test;;
find uf_test 1;;

uf_test;;
find uf_test 1 = find uf_test 5;;
find uf_test 1 = find uf_test 4;;

type poids = int;;

type arete = Absent | Present of poids;;
type graphe_matrix = arete array array;;

type graphe_list = ((int * poids) list) array;;

let taille_graphe = Array.length;; (* nb sommets *)

let liste_aretes (gl : graphe_list) =
    let resultat = ref [] in
    let n = taille_graphe gl in
    let rec traitement_liste (i : int) = function (* c'est un List.iter... *)
        | [] -> ()
        | (j, p) :: q -> begin
            resultat := (i, j, p) :: !resultat;
            traitement_liste i q
        end
    in
    for i = 0 to (n - 1) do               (* c'est un Array.iter *)
        traitement_liste i gl.(i)
    done;
    !resultat
;;

let graphe_test : graphe_list =
  [| [(1, 11); (2, 2); (3, 1)];
     [(2, 7)];
     [];
     [(4, 5)];
     [(1, 1)]
  |]
;;

liste_aretes graphe_test;;

let kruskal (gl : graphe_list) =
    let aretes = liste_aretes gl in
    let aretes = List.sort (
        fun (_, _, x) -> fun (_, _, y) -> x - y
    ) aretes in
    let n = taille_graphe gl in
    let uf = create_uf n in
    let result = ref [] in  (* difficle de faire sans référence ici... *)
    let traitement_arete (i, j, p) =
        if not (find uf i = find uf j) then begin
            result := (i, j, p) :: !result;
            union uf i j
        end
    in
    for i = 0 to (n - 1) do
        makeset uf i
    done;
    List.iter traitement_arete aretes;
    !result
;;

kruskal graphe_test;;