(* Union-Find avec les optimisations : union par rang, compression de chemin *)

type unionfind = { pere:int array; rang:int array }

let creeUF (n:int) : unionfind = { pere = Array.make n (-1); rang = Array.make n 0 };;

let rec findRC (uf:unionfind) (x:int) =
  if uf.pere.(x) = -1 then x else 
    begin
    let racine = findRC uf uf.pere.(x) 
    in 
    uf.pere.(x) <- racine; racine
    end;;

let unionRC (uf:unionfind) (x:int) (y:int) =
    let rx = findRC uf x in
    let ry = findRC uf y in
    if (rx != ry) then begin
      if uf.rang.(rx) > uf.rang.(ry) then
        uf.pere.(ry) <- rx (* rang inchangé *)
      else if uf.rang.(rx) < uf.rang.(ry) then 
        uf.pere.(rx) <- ry (* rang inchangé *)
      else begin uf.pere.(rx) <- ry; uf.rang.(ry) <- uf.rang.(ry) + 1 end
    end
  ;;


(* Labyrinthe *)

type sommet = (int*int)

type arete = (sommet*sommet)

let genereAretes n m =
  let aretes = ref [] in
  for i = 0 to n-1 do (* aretes horizontales *)
    for j = 0 to m-2 do
      aretes := ((i,j),(i,j+1))::!aretes
    done
  done;
  for j = 0 to m-1 do (* aretes horizontales *)
    for i = 0 to n-2 do
      aretes := ((i,j),(i+1,j))::!aretes
    done
  done;
  Array.of_list !aretes;;

let afficheAretes (la:arete array) n m = 
  let cote = 10 in
  let s = " " ^ (string_of_int ((m - 1) * cote + 3)) ^ "x" ^ (string_of_int ((n - 1) * cote + 3)) in
  Graphics.open_graph s;
  Graphics.set_window_title "Labyrinthe";
  let affiche ((a,b),(c,d)) =
    Graphics.moveto (b * cote + 1) (a * cote + 1);
    Graphics.lineto (d * cote + 1) (c * cote + 1) 
  in 
  Array.iter affiche la
;;

let permutKnuth tab = 
  for i = 1 to Array.length tab - 1 do
    let j = Random.int (i+1) in 
    let tmp = tab.(i) in
    tab.(i) <- tab.(j); tab.(j) <- tmp
  done; tab

let genereLaby n m =
  let aretes = permutKnuth (genereAretes n m) in
  let uf = creeUF (n * m) in
  let aretes_laby = ref [] in
  for i = 0 to Array.length aretes - 1 do
    let ((a,b), (c,d)) = aretes.(i) in
    let n1 = a * m + b in 
    let n2 = c * m + d in
    if findRC uf n1 <> findRC uf n2 then begin
      unionRC uf n1 n2; aretes_laby := aretes.(i) :: !aretes_laby
    end
  done;
  Array.of_list !aretes_laby;;


(* afficheAretes (genereAretes 4 6) 4 6;; *)

afficheAretes (genereLaby 50 100) 50 100;;

let _ = Graphics.read_key ();;