Tarjan - Labyrinthe

(* Modules, Graphiques, Aléatoire... *)

Sys.interactive := false;
Topdirs.dir_directory (Sys.getenv "OCAML_TOPLEVEL_PATH");

#use "topfind"
#require "graphics"
#require "archimedes"
#require "jupyter-archimedes";;

let draw vp x1 y1 x2 y2 = (* vp: viewport *)
    (* Les coordonnées sont dans [0; 1] quelle que soit la taille de l'image *)
    let path = A.Path.make () in
    A.Path.move_to path ~x:x1 ~y:y1;
    A.Path.line_to path ~x:x2 ~y:y2;
    A.Viewport.stroke vp `Orthonormal path;;
    
Random.self_init ()

- : unit = ()

- : unit = ()
- : unit = ()

Module Archimedes loaded and aliased as A.

val draw : A.Viewport.t -> float -> float -> float -> float -> unit = <fun>

- : unit = ()

Union-Find et Labyrinthe

(* Union-Find : Tarjan *)

let make_union_find n = 
  Array.init n (fun x -> x)

let rec find x uf =
  if uf.(x) <> x then uf.(x) <- find uf.(x) uf;
  uf.(x)

let union x y uf =
  uf.(find x uf) <- find y uf

val make_union_find : int -> int array = <fun>

val find : int -> int array -> int = <fun>

val union : int -> int -> int array -> unit = <fun>

(* Tous les murs possibles *)

let creer_murs n =
  let m = Array.make (2*n*(n-1)) (0, 0, 0, 0) in
  for i = 0 to (n-1) do
    for j = 0 to (n-2) do
      m.(i*(n-1)+j) <- (i, j, i, j+1)
    done
  done;
  for i = 0 to (n-2) do
    for j = 0 to (n-1) do
      m.(n*(n-1)+i*n+j) <- (i, j, i+1, j)
    done
  done;
  m

val creer_murs : int -> (int * int * int * int) array = <fun>

(* Mélange de Fisher-Yates *)

let shuffle_fisher_yates t =
  for i = Array.length t - 1 downto 1 do
    let j = Random.int (i+1) and x = t.(i) in
    t.(i) <- t.(j); t.(j) <- x
  done

val shuffle_fisher_yates : 'a array -> unit = <fun>

(* Création et affichage du Labyrinthe *)

let labyrinthe n =

  let murs = creer_murs n and uf = make_union_find (n*n) in
  shuffle_fisher_yates murs;     (* Mélange pour prendre les murs dans un ordre aléatoire *)

  let vp = A.init ~w:750. ~h:750. ["jupyter"] in           (* Taille de l'image en pixels *)
  let norm x = (float_of_int x) /. (float_of_int (2*n)) in     (* Coordonnées dans [0; 1] *)
  let draw_ok x1 y1 x2 y2 = draw vp (norm x1) (norm y1) (norm x2) (norm y2) in
  
  for i = 0 to Array.length murs - 1 do
    let x1, y1, x2, y2 = murs.(i) in let salle1, salle2 = x1*n+y1, x2*n+y2 in
    if find salle1 uf <> find salle2 uf then union salle1 salle2 uf
    else (if x1 = x2                           (* on affiche directement *)
          then draw_ok (2*x1) (y1+y2+1) (2*x2+2) (y1+y2+1) (* horizontal *)
          else draw_ok (x1+x2+1) (2*y1) (x1+x2+1) (2*y1+2) (* vertical   *)
         )
    done;
    
  A.close vp

val labyrinthe : int -> unit = <fun>

labyrinthe 100

- : unit = ()