(* Réseau de coût minimal *)
                       
 type point == int ;;
 
 type connexion == point * point * int ;;
 
 type reseau == (point list ) * (connexion list) ;;

 let ex = ( [1;2;3;4;5],
            [(1,2,1);(1,3,1);(2,3,2);(2,4,1);(3,4,1);(4,5,2)] ) ;;
            
 let rec appartient x l = match l with
       |  []  -> false
       | t::r -> (x=t) or (appartient x r) ;;
       
 let rec taille l = match l with
       |  []  -> 0
       | _::r -> 1 + taille r ;;
       
 let rec cocycle q c = match c with
       |        []  -> [] 
       | (x,y,t)::r -> if ((appartient x q) && (not appartient y q)) or
                          ((appartient y q) && (not appartient x q)) 
                       then (x,y,t)::(cocycle q r)
                       else cocycle q r
 ;;

 let construire p c =                  (* version itérative avec références *)
    let  k = taille p - 1 in           (* utilisant la fonction taille      *)
    let pi = ref [hd p] and ci = ref [] in
    for i =1 to k do
      let (x,y,t) = hd (cocycle !pi c) in 
          if appartient x !pi then pi := y :: !pi else pi := x :: !pi;
          ci := (x,y,t) :: !ci ;
    done;
    (!pi, !ci) 
 ;;


 let construire p c =                 
    let  rec constr_aux pi ci =       (* fonction récursive locale *)
        let omega = cocycle pi c in
           if omega = [] then (pi, ci)  (* i = k *)
           else let (x,y,t) = hd(omega) in 
                   if appartient x pi 
                           then constr_aux (y::pi) ((x,y,t)::ci)
                           else constr_aux (x::pi) ((x,y,t)::ci)
    in constr_aux [hd p] []
 ;;

 (* Algorithme de Prim *)

 let rec inserer c l = match l with
         |        []  -> [c]
         | (x,y,t)::r -> let (a,b,t') = c in
                  if t' <= t then c::l else (x,y,t)::(inserer c r)
                  
 ;;
    
 let rec cocycle q c = match c with
       |        []  -> [] 
       | (x,y,t)::r -> if ((appartient x q) && (not appartient y q)) or
                           ((appartient y q) && (not appartient x q)) 
                        then inserer (x,y,t) (cocycle q r)
                        else cocycle q r
 ;;


 let construire p c =                 
    let  rec constr_aux pi ci =       (* fonction récursive locale *)
        let omega = cocycle pi c in
           if omega = [] then (pi, ci)  (* i = k *)
           else let (x,y,t) = hd(omega) in 
                   if appartient x pi 
                           then constr_aux (y::pi) ((x,y,t)::ci)
                           else constr_aux (x::pi) ((x,y,t)::ci)
    in constr_aux [hd p] []
 ;;
 
   construire (fst ex) (snd ex) ;;

 (* ------------------------------- FIN ------------------------------------*)