maze.md

Maze Generator & Solver

This program creates and solves mazes. Mazes will be like that:

maze.ml

(* CONST *)

let scale = 10;;
let width = 2;;
let half_width = width / 2;;
let color_change_speed = 5;;
let n = 50;;


(* DATA STRUCTURES *)

let set_create size =
    Hashtbl.create size
let set_add s x =
    Hashtbl.add s x true
let set_remove s x =
    Hashtbl.remove s x
let set_mem s x =
    Hashtbl.mem s x

let create_union_find size =
    Array.make size (-1)
let rec find uf x =
    if uf.(x) < 0 then x
    else find uf uf.(x)
let union uf a b =
    let a = find uf a in
    let b = find uf b in
    if uf.(a) < uf.(b) then
        uf.(b) <- a
    else if uf.(a) = uf.(b) then (
        uf.(b) <- uf.(b) - 1;
        uf.(a) <- b
    ) else
        uf.(a) <- b


(* UTILS *)

let int_of_x_y (x, y) =
    x + n * y
let x_y_of_int i =
    let x = i mod n in
    let y = i / n in
    (x, y)


(* GRAPHIC SHORTCUTS *)

let draw_wall a b =
    let xa, ya = x_y_of_int a in
    let xb, yb = x_y_of_int b in
    let max_x = max xa xb in
    let max_y = max ya yb in
    if xa = xb then (
        Graphics.fill_rect (xa * scale - half_width) (max_y * scale - half_width) (scale + width) width
    ) else if ya = yb then (
        Graphics.fill_rect (max_x * scale - half_width) (ya * scale - half_width) width (scale + width)
    ) else (
        failwith "Error in draw_wall"
    )

let rgb_of_dist d =
    let r = ref 255 in
    let g = ref 0 in
    let b = ref 0 in
    let moving = ref 0 in
    for i = 0 to d do
        match !moving mod 6 with
        | 0 -> if !g < 255 then incr g else incr moving
        | 1 -> if !r > 0 then decr r else incr moving
        | 2 -> if !b < 255 then incr b else incr moving
        | 3 -> if !g > 0 then decr g else incr moving
        | 4 -> if !r < 255 then incr r else incr moving
        | 5 -> if !b > 0 then decr b else incr moving
        | _ -> failwith "Error in rgb_of_dist"
    done;
    (!r, !g, !b)

let set_color_of_dist d =
    let r, g, b = rgb_of_dist (d * color_change_speed) in
    let c = Graphics.rgb r g b in
    Graphics.set_color c

let draw_square a dist =
    set_color_of_dist dist;
    let x, y = x_y_of_int a in
    Graphics.fill_rect (x * scale + half_width) (y * scale + half_width) (scale - width) (scale - width)


(* MAIN *)

let init_maze () =
    let walls = set_create (n * n) in
    for x = 0 to n - 1 do
        for y = 0 to n - 1 do
            if x < n - 1 then
                set_add walls (int_of_x_y (x, y), int_of_x_y (x + 1, y));
            if y < n - 1 then
                set_add walls (int_of_x_y (x, y), int_of_x_y (x, y + 1));
        done;
    done;
    walls

let generate_maze () =
    let walls = init_maze () in
    let blocks = create_union_find (n * n) in
    let nb_blocks = ref (n * n) in
    Random.self_init ();
    while !nb_blocks > 1 do
        let a = Random.int (n * n) in
        let xa, ya = x_y_of_int a in
        let xb, yb = ref xa, ref ya in
        let rec aux () =
            let side = Random.int (4) in
            match side with
                | 0 when ya < n - 1 -> incr yb
                | 1 when xa < n - 1 -> incr xb
                | 2 when ya > 0 -> decr yb
                | 3 when xa > 0 -> decr xb
                | _ -> aux ();
        in aux ();
        let b = int_of_x_y (!xb, !yb) in
        if find blocks a <> find blocks b && set_mem walls (a, b) then (
            set_remove walls (a, b);
            union blocks a b;
            decr nb_blocks
        )
    done;
    walls

let draw_maze walls =
    let seq = Hashtbl.to_seq_keys walls in
    let list = List.of_seq seq in
    Graphics.set_color Graphics.black;
    let rec aux list =
        match list with
        | [] -> ()
        | h :: t ->
            let (a, b) = h in
            draw_wall a b;
            aux t
    in
    aux list

let reachable a walls =
    let xa, ya = x_y_of_int a in
    let possible_x_y = List.filter (fun (x, y) -> x >= 0 && x < n && y >= 0 && y < n) [(xa - 1, ya); (xa + 1, ya); (xa, ya - 1); (xa, ya + 1)] in
    let possible = List.map (fun (x, y) -> int_of_x_y (x, y)) possible_x_y in
    let reachable_list = List.filter (fun b -> not (set_mem walls (a, b)) && not (set_mem walls (b, a))) possible in
    Array.of_list (reachable_list)

let solve_maze walls =
    let distances = Array.make (n * n) (-1) in
    distances.(0) <- 0;
    let q = Queue.create () in
    Queue.add 0 q;
    while not (Queue.is_empty q) do
        let a = Queue.pop q in
        let reach = reachable a walls in
        for i = 0 to Array.length reach - 1 do
            let b = reach.(i) in
            if distances.(b) = -1 then (
                distances.(b) <- distances.(a) + 1;
                Queue.add b q
            )
        done;
    done;
    distances

let color_maze distances =
    for i = 0 to Array.length distances - 1 do
        draw_square i distances.(i)
    done

let color_sol distances walls =
    let goal = int_of_x_y (n - 1, n - 1) in
    let a = ref goal in
    draw_square !a distances.(!a);
    while !a <> 0 do
        let reach = reachable !a walls in
        let found = ref false in
        let i = ref 0 in
        while not !found && !i < Array.length reach do
            let b = reach.(!i) in
            if distances.(b) = distances.(!a) - 1 then (
                draw_square b distances.(b);
                a := b;
                found := true
            ) else
                incr i
        done;
    done


let () =
    let walls = generate_maze () in
    print_endline "Maze generated";
    Graphics.open_graph "";
    Graphics.set_window_title (Printf.sprintf "Maze %dx%d: %dpx x %dpx" n n (scale * n) (scale * n));
    Graphics.resize_window (scale * n) (scale * n);
    draw_maze walls;
    print_endline "Maze drawn";
    let distances = solve_maze walls in
    print_endline "Distances computed";
    color_sol distances walls;
    (* color_maze distances; *)  (* To color the whole maze *)
    print_endline "Solution drawn";
    while true do
        ()
    done