type maze_block = {
}
let is_in_bounds (x, y) (xbound, ybound) = (x >= 0) && (x < xbound) && (y >= 0) && (y < ybound)
let access_grid
(grid
: 'a
array array) (x, y
) = grid
.(x
).(y
)
let mutate_grid
(grid
: 'a
array array) (x, y
) (new_elem
: 'a
) = begin grid
.(x
).(y
) <- new_elem
; () end
let xybounds = dimensions grid in
if not (is_in_bounds neighborXY xybounds) then (grid, q)
else let neighbor_block = access_grid grid neighborXY in
if neighbor_block.visited || (not neighbor_block.walkable) then (grid, q)
else
begin
mutate_grid grid neighborXY {neighbor_block with prev_coordinate = currentXY};
(grid, q)
end
let target_all_4directions
(currentX, currentY
) (grid
: maze_block
array array) (q
: (int * int) Queue.t
) = let (grid1, q1) = target_for_visitation (currentX, currentY) (currentX + 1, currentY) grid q in
let (grid2, q2) = target_for_visitation (currentX, currentY) (currentX - 1, currentY) grid1 q1 in
let (grid3, q3) = target_for_visitation (currentX, currentY) (currentX, currentY - 1) grid2 q2 in
let (grid4, q4) = target_for_visitation (currentX, currentY) (currentX, currentY + 1) grid3 q3 in
(grid4, q4)
let assemble_trail
(maze_grid
: maze_block
array array) currentXY
= let rec assemble_helper
(grid
: maze_block
array array) (thisX, thisY
) trailList
= match (thisX, thisY
) with | (-1, -1) -> trailList
| _ -> assemble_helper grid (grid.(thisX).(thisY).prev_coordinate) ((thisX, thisY) :: trailList)
in
assemble_helper maze_grid currentXY []
if Queue.is_empty q
then [] else let currentXY
= (Queue.take q
) in let current_block = access_grid maze_grid currentXY in
if current_block.is_finish then assemble_trail maze_grid currentXY
else let (modified_maze_grid, modified_queue) = target_all_4directions currentXY maze_grid q in
begin
mutate_grid maze_grid currentXY {current_block with visited = true};
maze_solver_loop modified_maze_grid modified_queue
end
let solve_maze startXY
(maze_grid
: maze_block
array array) = let xybounds = dimensions maze_grid in
let start_block = access_grid maze_grid startXY in
if (not (is_in_bounds startXY xybounds) || not start_block.walkable)
then []
else let new_queue
= Queue.create
() in begin
Queue.add startXY new_queue
; maze_solver_loop maze_grid new_queue
end
Array.map
(fun arr
-> (Array.map
(fun i
-> {walkable
= (i
== 0); is_finish
= false; visited
= false; prev_coordinate
= (-1,
-1)}) arr
)) num_array
let solve_this_maze startXY finishXY num_array =
let xybounds = dimensions num_array in
let maze = convert_to_maze num_array in
let finish_in_bounds = is_in_bounds finishXY xybounds in
if not finish_in_bounds then []
else
let finish_block = access_grid maze finishXY in
let finish_reachable = finish_block.walkable in
if finish_reachable then
begin
mutate_grid maze finishXY {finish_block with is_finish = true};
solve_maze startXY maze
end
else []
let print_tuple_list tuple_list =
in List.iter
(fun x
-> print_tuple x
) tuple_list
(*
how to test run:
start ocaml REPL
#use "WhateverFolder/mazeSolver2.ml";;
let arr = [|[|0;0;0;0;0|]; [|1;1;1;1;0|]; [|0;0;0;0;0|]; [|0;1;1;1;1|]; [|0;0;0;0;0|]|];;
solve_this_maze (0,0) (4,4) arr;;
let arr2 = [|[|1;1;1;1;1;1;0|];[|0;0;0;0;0;0;0|];[|1;1;1;1;1;1;0|];[|0;0;0;0;0;0;0|];[|0;1;1;1;1;1;1|];[|0;0;0;0;0;0;0|];[|1;1;1;0;1;1;1|];[|0;0;0;0;0;0;0|];[|0;1;1;1;1;1;0|]|];;
solve_this_maze (1,0) (8,6) arr2;;
let big16emptyarr = [|[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
|];;
solve_this_maze (0,0) (15,15) big16emptyarr;;
let big32emptyarr = [|[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|]|];;
solve_this_maze (0,0) (31,31) big32emptyarr;;
*)
let test1 () = let arr = [|[|1;1;1;1;1;1;0|];[|0;0;0;0;0;0;0|];[|1;1;1;1;1;1;0|];[|0;0;0;0;0;0;0|];[|0;1;1;1;1;1;1|];[|0;0;0;0;0;0;0|];[|1;1;1;0;1;1;1|];[|0;0;0;0;0;0;0|];[|0;1;1;1;1;1;0|]|] in
print_tuple_list (solve_this_maze (1,0) (8,6) arr)
let test2 () = let big16emptyarr = [|[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
[|0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0|];
|] in
print_tuple_list (solve_this_maze (0,0) (15,15) big16emptyarr)
;;
test1 ();
test2 ();