Info_MPSI/MP/JALLAT_kurska.ml

type 'a poids = Poids of 'a | Infini;;

let g = [|
  [|Infini; Poids(9); Infini; Poids(5); Infini; Infini; Infini|];
  [|Poids(7); Infini; Poids(8); Poids(9); Poids(7); Infini; Infini|];
  [|Infini; Poids(8); Infini; Infini; Poids(5); Infini; Infini|];
  [|Poids(5); Poids(9); Infini; Infini; Poids(15); Poids(6); Infini|];
  [|Infini; Poids(7); Poids(5); Poids(15); Infini; Poids(8); Poids(9)|];
  [|Infini; Infini; Infini; Poids(6); Poids(8); Infini; Poids(11)|];
  [|Infini; Infini; Infini; Infini; Poids(9); Poids(11); Infini|];
|];;

let rec insere i x l =
  match l with
  | [] -> [i]
  | t::q -> if x > t then i :: l else t :: (insere i x q)
;;

let liste_triee_arrete w =
  let l = ref [] and n = Array.length w.(0) in
  for i = 0 to n - 2 do
    for j = i + 1 to (n - 1) do
      if w.(i).(j) <> Infini then
        match w.(i).(j) with
        | Poids(p) -> l := insere (i, j) p !l
        | Infini -> ()
      else ()
    done;
  done;
  !l
;;

let n = Array.length g.(0);;
let composantes = Array.make n 0;;

let aretes = liste_triee_arrete g;;

let aux i j t =
  let ci = composantes.(i) and cj = composantes.(j) in
  match ci = cj with
  | true -> ()
  | false ->
    t := (i, j) :: !t;
    for k = 0 to n - 1 do
      if composantes.(k) = cj then composantes.(k) <- ci;
    done
;;

let rec kaux1 w aretes t =
  match aretes with
  | [] -> t
  | a::aq -> let (i, j) = a in aux i j t; kaux1 w aq t
;;

let kruskal1 w =
  let aretes = liste_triee_arrete w in
  let t = ref [] in
  kaux1 w aretes t;
  !t
;;

(* Seconde partie *)
(*une fonction chemin w u v, qui renvoie true s'il existe un chemin entre u et v*)
let chemin w u v =
  let n = Array.length w in
  let rec aux i =
    match i = n with
    | true -> false
    | false ->
        match w.(u).(i) with
        | Infini -> aux (i+1)
        | Poids(p) ->
            match w.(i).(v) with
            | Infini -> aux (i+1)
            | Poids(q) -> true
  in aux 0
;;


let kruskal2 w =
  let n = Array.length w in
  let rec aux i =
    match i = n with
    | true -> []
    | false ->
        match w.(i) with
        | [] -> aux (i+1)
        | t::q ->
            match chemin w t i with
            | true -> (t, i) :: (aux (i+1))
            | false -> aux (i+1)
  in aux 0
;;