type mazeBlock = { walkable : bool; isFinish : bool; visited : bool; prevCoordinate : int * int } let isInBounds (x, y) (xbound, ybound) = (x >= 0) && (x < xbound) && (y >= 0) && (y < ybound) let dimensionPair (someArray: 'a array array) = (Array.length someArray, Array.length someArray.(0)) let targetForVisitation (currentX, currentY) (neighborX, neighborY) (theGrid: mazeBlock array array) (theQueue: (int * int) Queue.t) = let (xbound, ybound) = dimensionPair theGrid in if isInBounds (neighborX, neighborY) (xbound, ybound) then let neighborBlock = theGrid.(neighborX).(neighborY) in if neighborBlock.walkable && (not neighborBlock.visited) then let isFinish2 = neighborBlock.isFinish in begin Queue.add (neighborX, neighborY) theQueue; theGrid.(neighborX).(neighborY) <- {walkable = true; isFinish = isFinish2; visited = false; prevCoordinate = (currentX, currentY)} end; (theGrid, theQueue) else (theGrid, theQueue) else (theGrid, theQueue) let targetAll4Directions (currentX, currentY) (grid: mazeBlock array array) (queue: (int * int) Queue.t) = let (grid1, queue1) = targetForVisitation (currentX, currentY) (currentX + 1, currentY) grid queue in let (grid2, queue2) = targetForVisitation (currentX, currentY) (currentX - 1, currentY) grid1 queue1 in let (grid3, queue3) = targetForVisitation (currentX, currentY) (currentX, currentY - 1) grid2 queue2 in let (grid4, queue4) = targetForVisitation (currentX, currentY) (currentX, currentY + 1) grid3 queue3 in (grid4, queue4) let assembleTrail (mazeGrid: mazeBlock array array) currentXY = let rec assembleHelper (theGrid: mazeBlock array array) (thisX, thisY) trailList = match (thisX, thisY) with | (-1, -1) -> trailList | _ -> assembleHelper theGrid (theGrid.(thisX).(thisY).prevCoordinate) ((thisX, thisY) :: trailList) in assembleHelper mazeGrid currentXY [] let rec mazeSolverLoop (mazeGrid: mazeBlock array array) (bfsQueue: (int * int) Queue.t) = if Queue.is_empty bfsQueue then [] else let (currentX, currentY) = (Queue.take bfsQueue) in if mazeGrid.(currentX).(currentY).isFinish then assembleTrail mazeGrid (currentX, currentY) else let isFinish1 = mazeGrid.(currentX).(currentY).isFinish in let prevCoordinate1 = mazeGrid.(currentX).(currentY).prevCoordinate in mazeGrid.(currentX).(currentY) <- {walkable = true; isFinish = isFinish1; visited = true; prevCoordinate = prevCoordinate1}; let (modifiedMazeGrid, modifiedQueue) = targetAll4Directions (currentX, currentY) mazeGrid bfsQueue in mazeSolverLoop modifiedMazeGrid modifiedQueue let solveMaze (startX, startY) (mazeGrid: mazeBlock array array) = let xybounds = dimensionPair mazeGrid in if (not (isInBounds (startX, startY) xybounds) || not mazeGrid.(startX).(startY).walkable) then [] else let newQueue = Queue.create () in Queue.add (startX, startY) newQueue; mazeSolverLoop mazeGrid newQueue let convertToMaze (numArray: int array array) : mazeBlock array array = Array.map (fun arr -> (Array.map (fun i -> {walkable = (i == 0); isFinish = false; visited = false; prevCoordinate = (-1, -1)}) arr)) numArray let solveThisMaze (startX, startY) (finishX, finishY) numArray = let xybounds = dimensionPair numArray in let theMaze = convertToMaze numArray in let finishInBounds = isInBounds (finishX, finishY) xybounds in let finishReachable = theMaze.(finishX).(finishY).walkable in if finishInBounds then if finishReachable then begin theMaze.(finishX).(finishY) <- {walkable = true; isFinish = true; visited = false; prevCoordinate = (-1, -1)} end; if (finishInBounds) then if finishReachable then solveMaze (startX, startY) theMaze else [] else [] let print_tuple_list tupleList = let print_tuple (x, y) = print_endline ((string_of_int x) ^ ", " ^ (string_of_int y)) in List.iter (fun x -> print_tuple x) tupleList (* 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|]|];; solveThisMaze (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|]|];; solveThisMaze (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|]; |];; solveThisMaze (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|]|];; solveThisMaze (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 (solveThisMaze (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 (solveThisMaze (0,0) (15,15) big16emptyarr) ;; test1 (); test2 ();