(* Construction d'un labyrinthe parfait, en utilisant union-find *)

open Graphics
open Uf (* programme 72 page 298 *)

let n = 30 (* labyrinthe n * n *)
let () = Random.self_init ()

let size = 600                (* on dessine dans une fenêtre 600x600 *)
let gr i = (size - 2) * i / n (* la colonne/ligne de i-ième case *)

(* on dessine un labyrinthe où toutes les cases sont séparées par un mur *)
let () =
  open_graph (Printf.sprintf " %dx%d" size size);
  set_line_width 2;
  set_color black;
  for i = 0 to n do
    moveto (gr i) 0; lineto (gr i) size;
    moveto 0 (gr i); lineto size (gr i);
  done;
  set_color white

(* initialement, chaque case du labyrinthe est isolée *)
let u = create (n * n)

(* deux cases adjacentes le sont horizontalement (H) ou verticalement (V) *)
type edge_kind = H | V

(* on construit le tableau de toutes les liaisons possibles entre deux cases *)
let edges =
  let l = ref [] in
  for i = 0 to n-1 do for j = 0 to n-1 do
    if i < n-1 then l := (i, j, V) :: !l;
    if j < n-1 then l := (i, j, H) :: !l;
  done; done;
  Array.of_list !l

(* on la mélange avec un mélange de Knuth (voir exercice 2.11) *)
let () =
  for j = Array.length edges - 1 downto 1 do
    let k = Random.int (j+1) in
    let t = edges.(j) in edges.(j) <- edges.(k); edges.(k) <- t
  done

(* on considère toutes les liaisons, une à une, et pour chaque liaison
   dont les deux cases ne sont pas encore dans la même classe
   d'équivalence on supprime le mur qui les sépare (en le redessinant en
   blanc) et on réunion les deux classes avec union. *)
let () =
  let f (i, j, hv) =
    let k = i * n + j in
    let k' = if hv = H then k + 1 else k + n in (* la case adjacente *)
    if find u k <> find u k' then begin
      if hv = H then begin
        moveto (gr (j+1)) (gr i); lineto (gr (j+1)) (gr (i+1))
      end else begin
        moveto (gr j) (gr (i+1)); lineto (gr (j+1)) (gr (i+1))
      end;
      union u k k';
    end
  in
  Array.iter f edges

let () = ignore (read_key ())

This document was generated using caml2html