(** Arbre couvrant minimal **)

(* Préliminaires : types et divers utilitaire *)

(* Une arête est un triplet contenant les deux extrémités et le poids. *)
type arete = Edge of int*int*int;;
type graphe = { Sommets: int list; Aretes: arete list };;

(* Trie la liste d'arêtes par ordre de poids croissant *)
let tri_aretes l_aretes =
  sort__sort
    (fun (Edge(_,_,a)) (Edge(_,_,b)) -> a <= b)
    l_aretes
;;

(* Calcule le poids d'un graphe *)
let poids g =
  let rec aux = function
    | [] -> 0
    |(Edge(_,_,p))::q -> p + aux q
  in aux (g.Aretes)
;;

(* Tirage aléatoire d'un élément d'une liste *)
random__init (int_of_float (sys__time()));;
let rnd_elt l =
  let rec nth i l = match l,i with
    | _,0 -> raise Not_found
    | [],_ -> raise Not_found
    | t::_,1 -> t
    | _::q,_ -> nth (i-1) q
  in nth (random__int (list_length l)+1) l
;;

(* Choix de l'arête de poids minimum reliant un ensemble de sommets à un autre sommet du graphe. On
   travaille sur une liste d'arêtes triée par ordre de poids croissant : c'est pour ça que l'on
   s'arête à la première arête trouvée. On renvoie comme résultat l'arête. *)
let rec cherche_areteP sommets = function
  | [] -> failwith "Graphe non connexe"
  | (Edge(x,y,_) as a)::q ->
     let tmpx = mem x sommets and tmpy = mem y sommets in
       if ((tmpx && (not tmpy)) || ((not tmpx) && tmpy))
       then a
       else cherche_areteP sommets q
;;

(** Recherche de l'arbre couvrant minimal par l'algorithme de Prim **)
let spanningtree_Prim g =
  let rec aux sommets aretes spantree = function
    | [] -> { Sommets = sommets; Aretes = spantree }
    | reste ->
        let (Edge(x,y,_) as a) = cherche_areteP sommets aretes
        in aux (union sommets [x;y]) aretes (a::spantree) (subtract reste [x;y])
(*
  in let sorted_aretes = tri_aretes g.Aretes
  in match sorted_aretes with
    | [] -> failwith "Pas d'arête !"
    | (Edge(x,y,_) as a)::q -> aux [x;y] q [] (subtract (g.Sommets) [x;y])
*)
  in let deb = rnd_elt g.Sommets
  in aux [deb] (tri_aretes g.Aretes) [] (subtract (g.Sommets) [deb])
;;


(* Fusion par l'arête a de deux graphes disjoints g1 et g2 d'une forêt *)
let rec fusion foret g1 g2 a =
  let newforet = subtract foret [g1; g2]
  in { Sommets = union g1.Sommets g2.Sommets; Aretes = a::(union g1.Aretes g2.Aretes) }::newforet;;

(* Explosion d'un graphe en l'ensemble des sous-graphes élémentaires *)
let explose g = map (function x -> {Sommets=[x]; Aretes=[]}) g.Sommets;;

(* Recherche parmi une forêt de l'arbre auquel appartient x *)
let rec cherche_arbre x = function
  | [] -> failwith "Boulette !"
  | g::q ->
      if (mem x g.Sommets)
      then g
      else cherche_arbre x q
;;

(* Recherche de l'arête de poids minimal reliant deux arbres d'une forêt. On travaille toujours sur
   une liste d'arêtes triée par ordre de poids croissant. *)
let rec cherche_areteK foret = function
  | [] -> failwith "Graphe non connexe"
  | (Edge(x,y,_) as a)::q ->
      let a_x = cherche_arbre x foret and a_y = cherche_arbre y foret in
        if (a_x <> a_y)
        then (a_x, a_y, a)
        else cherche_areteK foret q
;;

(** Recherche de l'arbre couvrant minimal par l'algorithme de Kruskal **)
let spanningtree_Kruskal g =
  let rec aux ssgraphes aretes = match ssgraphes with
    | [] -> failwith "Boulette !"
    | [spantree] -> spantree
    | _ ->
        let (g1, g2, a) = cherche_areteK ssgraphes aretes
        in aux (fusion ssgraphes g1 g2 a) aretes
  in aux (explose g) (tri_aretes g.Aretes);;

(* Exemple : graphe de l'énoncé *)
let exemple = {
  Sommets = [1;2;3;4;5;6;7;8];
  Aretes = [Edge(1,2,10); Edge(1,3, 8); Edge(3,2, 6);
            Edge(5,2,23); Edge(1,6,26); Edge(4,3,25);
            Edge(4,5,35); Edge(4,6,24); Edge(5,8,27);
            Edge(8,7,12); Edge(7,6,28) ]
};;
spanningtree_Prim exemple;;
spanningtree_Kruskal exemple;;

(* Exemple emprunté à L. Cheno *)
let exemple_cheno = {
  Sommets = [1;2;3;4;5;6;7;8;9];
  Aretes = [Edge(1,2,2); Edge(1,3,1); Edge(2,3,2); Edge(2,4,3);
            Edge(3,4,2); Edge(3,5,1); Edge(4,5,1); Edge(4,6,2);
            Edge(5,6,1); Edge(6,7,1); Edge(5,7,1); Edge(7,9,2);
            Edge(1,8,1); Edge(8,3,1); Edge(7,8,2); Edge(8,9,2)]
};;
spanningtree_Prim exemple_cheno;;
spanningtree_Kruskal exemple_cheno;;