Maze solving: Difference between revisions
(→{{header|Icon}} and {{header|Unicon}}: marked start in red + write image of solution) |
|||
| Line 343: | Line 343: | ||
Solver(mz.maze) |
Solver(mz.maze) |
||
DisplayMazeSolution(mz) |
DisplayMazeSolution(mz) |
||
WriteImage(mz.filename ?:= (="maze-", "maze-solved-" || tab(0))) |
|||
until Event() == &lpress # wait |
until Event() == &lpress # wait |
||
close(mz.window) |
close(mz.window) |
||
| Line 376: | Line 377: | ||
&window := mz.window |
&window := mz.window |
||
maze := mz.maze |
maze := mz.maze |
||
Fg("blue") |
|||
WAttrib("dx="||(dxy:=BORDER+CELL/2),"dy="||dxy) |
WAttrib("dx="||(dxy:=BORDER+CELL/2),"dy="||dxy) |
||
every (r := 1 to *maze) & (c := 1 to *maze[1]) do |
every (r := 1 to *maze) & (c := 1 to *maze[1]) do { |
||
if fg ~=== "blue" then Fg(fg := "blue") |
|||
if iand(maze[r,c],START) > 0 then Fg(fg := "red") |
|||
if iand(maze[r,c],PATH) > 0 then |
if iand(maze[r,c],PATH) > 0 then |
||
FillCircle(x := CELL*(c-1),y := CELL*(r-1),rad := CELL/5) |
FillCircle(x := CELL*(c-1),y := CELL*(r-1),rad := CELL/5) |
||
} |
|||
return mz |
return mz |
||
end</lang> |
end</lang> |
||
Revision as of 15:56, 13 November 2011
You are encouraged to solve this task according to the task description, using any language you may know.
For a maze generated by this task, write a function that finds (and displays) the shortest path between two cells. Note that because these mazes are generated by the Depth-first search algorithm, they contain no circular paths, and a simple depth-first tree search can be used.
Ada
The maze is read from the standard input. The size of the maze is hardwired into the program (see the constants X_Size and Y_Size).
<lang Ada>with Ada.Text_IO;
procedure Maze_Solver is
X_Size: constant Natural := 45; Y_Size: constant Natural := 17;
subtype X_Range is Natural range 1 .. X_Size; subtype Y_Range is Natural range 1 .. Y_Size;
East: constant X_Range := 2; South: constant Y_Range := 1;
X_Start: constant X_Range := 3; -- start at the upper left Y_Start: constant Y_Range := 1; X_Finish: constant X_Range := X_Size-East; -- go to the lower right Y_Finish: constant Y_Range := Y_Size;
type Maze_Type is array (Y_Range) of String(X_Range);
function Solved(X: X_Range; Y: Y_Range) return Boolean is
begin
return (X = X_Finish) and (Y = Y_Finish);
end Solved;
procedure Output_Maze(M: Maze_Type; Message: String := "") is
begin
if Message /= "" then
Ada.Text_IO.Put_Line(Message);
end if;
for I in M'Range loop
Ada.Text_IO.Put_Line(M(I));
end loop;
end Output_Maze;
procedure Search(M: in out Maze_Type; X: X_Range; Y:Y_Range) is
begin
M(Y)(X) := '*';
if Solved(X, Y) then
Output_Maze(M, "Solution found!");
else
if Integer(Y)-South >= 1 and then M(Y-South)(X) = ' ' then
Search(M, X, Y-South);
end if;
if Integer(Y)+South <= Y_Size and then M(Y+South)(X) = ' ' then
Search(M, X, Y+South);
end if;
if Integer(X)-East >= 1 and then M(Y)(X-East) = ' ' then
Search(M, X-East, Y);
end if;
if Integer(Y)+East <= Y_Size and then M(Y)(X+East) = ' ' then
Search(M, X+East, Y);
end if;
end if;
M(Y)(X) := ' ';
end Search;
Maze: Maze_Type; X: X_Range := X_Start; Y: Y_Range := Y_Start;
begin
for I in 1 .. Y_Size loop
Maze(I) := Ada.Text_IO.Get_Line;
end loop;
Maze(Y_Start)(X_Start) := ' '; -- Start from
Maze(Y_Finish)(X_Finish) := ' '; -- Go_To
Output_Maze(Maze, "The Maze:");
Ada.Text_IO.New_Line;
Search(Maze, X, Y) ; -- Will output *all* Solutions.
-- If there is no output, there is no solution.
end Maze_Solver;</lang>
Example output (using a maze generated by the Ada implementation of the maze generation task as the input):
> ./maze_solver < maze.txt The Maze: +- -+---+---+---+---+---+---+---+---+---+---+ | | | + + +---+---+---+---+---+---+---+ + + | | | | | | + +---+---+ +---+ + +---+---+---+ + | | | | | | | +---+ +---+---+ +---+ + + +---+ + | | | | | | | + +---+ +---+---+ +---+ + + +---+ | | | | | | +---+---+ + +---+---+---+---+ +---+ + | | | | | | + + +---+---+ +---+ + +---+---+ + | | | | | + +---+ +---+---+---+---+---+---+---+ + | | | +---+---+---+---+---+---+---+---+---+---+- -+ Solution found! +-*-+---+---+---+---+---+---+---+---+---+---+ | * * * * * * * * * * * * * * * * * * * | | + + +---+---+---+---+---+---+---+ * + + | | | | * * * * * * * | | + +---+---+ +---+ + * +---+---+---+ + | | | | * | | | +---+ +---+---+ +---+ * + + +---+ + | | | * * * | | | | + +---+ +---+---+ * +---+ + + +---+ | | | * * * * * | | | +---+---+ + * +---+---+---+---+ +---+ + | | * * * | * * * | | | + + +---+---+ * +---+ * + * +---+---+ + | | | * * * * * | * * * * * * * | + +---+ +---+---+---+---+---+---+---+ * + | | * | +---+---+---+---+---+---+---+---+---+---+-*-+
C
See Maze generation for combined gen/solve code.
D
Basic define <lang d>import std.stdio, std.random ;
immutable string[] Tiles =
[" ","╞","╥","╔","╡","═", "╗","╦","╨","╚","║","╠","╝","╩","╣","╬"] ;
immutable string[] Paths =
[" "," "," ","┌"," ","─", "┐"," "," ","└","│"," ","┘"," "," "," "] ;
alias uint Room ; enum Open { EMPTY = 0U , EAST = 1, SOUTH = 2, WEST = 4, NORTH = 8,
EPATH = 16, SPATH = 32, WPATH = 64, NPATH = 128,
ENTRY = 256, EXIT = 512, Visited = 1024 }
struct Where {
immutable int x, y ;
Where opBinary(string op)(Where rhs) if (op=="+") {
return Where(x + rhs.x, y + rhs.y) ;
}
bool bounded(int w, int h) {
return (x >= 0 && y >= 0 && x < w && y < h) ;
}
bool bounded(Room[][] r) {
return (x >= 0 && y >= 0 && r.length > 0 && y < r.length && x < r[0].length ) ;
}
} struct Door { Open opening = Open.EMPTY ; Where where ; alias where this ; }
immutable Open[Open] Opposite ; immutable Where[Open] NeibrPos ;
static this() { // workarround for Associative Array init.
Opposite = [Open.EAST:Open.WEST, Open.SOUTH:Open.NORTH,
Open.WEST:Open.EAST, Open.NORTH:Open.SOUTH] ;
NeibrPos = [Open.EAST:Where( 1,0), Open.SOUTH:Where(0, 1),
Open.WEST:Where(-1,0), Open.NORTH:Where(0,-1)] ;
}
const AsPath = true ;
void connectTo(ref Room[][] r, Door d, bool asPath = false) {
auto s/*hift*/ = asPath ? 4 : 0 ;
r[d.y][d.x] |= (d.opening << s) ;
auto there = d.where + NeibrPos[d.opening] ;
if(there.bounded(r))
r[there.y][there.x] |= (Opposite[d.opening] << s) ;
} bool connected(ref Room[][] r, Door d) {
auto there = d.where + NeibrPos[d.opening] ;
return (r[ d.y][ d.x] & d.opening) && there.bounded(r) &&
(r[there.y][there.x] & Opposite[d.opening]) ;
}
void printMaze(Room[][] maze, bool showPath = false) {
foreach(row ; maze) {
foreach(cell;row)
if(showPath)
write(Paths[0xf & (cell >> 4)]) ;
else
write(Tiles[0xf & (cell)]) ;
writeln() ;
}
} </lang> Generate Maze: <lang d>Room[][] genMaze(uint w, uint h, ref Door entry = Door.init, ref Door exit = Door.init) {
Room[][] r = new Room[][](h, w) ; // default value = 0 means un-visited empty room
bool validDoor(Door d) {
if(d.where.bounded(w,h))
switch(d.opening) {
case Open.EAST : return (d.x == w - 1) ;
case Open.WEST : return (d.x == 0) ;
case Open.NORTH: return (d.y == 0) ;
case Open.SOUTH: return (d.y == h - 1) ;
}
return false ;
}
Door makeDoor() { // create door at random edge
switch([Open.EAST, Open.WEST, Open.NORTH, Open.SOUTH][uniform(0,4)]) {
case Open.EAST : return Door(Open.EAST , Where(w-1, uniform(0,h))) ;
case Open.WEST : return Door(Open.WEST , Where( 0, uniform(0,h))) ;
case Open.NORTH: return Door(Open.NORTH, Where(uniform(0,w), 0)) ;
case Open.SOUTH: return Door(Open.SOUTH, Where(uniform(0,w), h-1)) ;
}
}
Open[] neibrDir = NeibrPos.keys ;
// depth-first search algorithm to generate maze
void visit(Where here) {
r[here.y][here.x] |= Open.Visited ;
randomShuffle(neibrDir) ;
foreach(dir; neibrDir) {
auto there = here + NeibrPos[dir] ;
if(there.bounded(w,h)) // bounded?
if((r[there.y][there.x] & Open.Visited) == 0) { // un-visited?
connectTo(r, Door(dir, here)) ;
visit(there) ;
}
}
}
// make entry & exit doors if not provided or invalid
while(entry.opening == Open.EMPTY || entry.where == exit.where || !validDoor(entry))
entry = makeDoor() ;
while( exit.opening == Open.EMPTY || entry.where == exit.where || !validDoor(exit))
exit = makeDoor() ;
r[entry.y][entry.x] |= (entry.opening | Open.ENTRY) ;
r[ exit.y][ exit.x] |= ( exit.opening | Open.EXIT) ;
// generate maze starting from entry visit(entry.where) ;
return r ;
}</lang> Solver: <lang d>bool solveMaze(ref Room[][] r, Door entry, Door exit ) {
Open[] neibrDir = NeibrPos.keys ;
foreach(row ; r) // clear old path, if any
foreach(cell;row)
cell &= ~(Open.EPATH|Open.WPATH|Open.SPATH|Open.NPATH) ;
bool trace(Door here) {
if(here.where == exit.where) { // reach exit
r.connectTo(exit, AsPath) ;
return true ;
}
foreach(dir ; neibrDir) {
// here.opening is direction to enter the room@here
// _dir_ is direction to exit the room@here, which is opposite to there.opening
if( (dir != here.opening) && ((dir & r[here.y][here.x]) != 0)) { // path exist?
auto there = Door(Opposite[dir], here.where + NeibrPos[dir]) ;
if( there.bounded(r))
if(trace(there)) { // reach exit, use stack to trace back the path
r.connectTo(Door(dir, here.where), AsPath) ;
return true ;
}
}
}
return false ; // dead end
}
auto success = trace(entry) ;
if(success)
r.connectTo(entry, AsPath) ;
return success ;
}</lang> Sample run: <lang d>void main() {
Door entry, exit; auto maze = genMaze(40, 12, entry, exit) ;
printMaze(maze) ;
if(solveMaze(maze, entry, exit))
printMaze(maze, AsPath) ;
else
writeln("No solution!?") ;
}</lang> Output:)
╔═╗╞╗╔╡╔══╗╔╦╗╔═╗╞╗╔═══╦══╗╞╗╔═╗╔╦╗╚╗╞═╗ ╚╗╚═╝╠╗║╔╗╚╝║║║╞╩═╝╚╗╔═╝╔╗╠═╝╠╡╠╝╨╚╗╚═╦╝ ╔╝╔══╝╚╩╝╚╡╔╝║╠════╗║╚═╗║║║╔╗║╔╝╔══╩═╡╚╗ ╠╗║╔╗╔═╗╥╔╗║╥║╨╔╗╔╗║║╞╗║╨╚╝║╚╝║╥║╞╦╗╔╦╡║ ║╚╝╨╚╣╔╩╣║╚╝║╚╗║╚╝╚╣╚╦╝╚╗╔═╝╞╗║║╠╗║║║╚╗║ ╚═══╗╨╚╗║║╔╡╚╗╚╣╥╔╗╚╗╚╗╥║╚═╗╔╝║║║╚╝╨║╥║║ ╔═══╝╔═╣║╚╩═╗║╔╝╚╝╚═╝╔╝║╚═╗║╚╗║╠╝╔══╝║╚╝ ╚═╗╔═╝╞╝╚═╗╔╝║╚╗╔═╗╔╗║╞╬╗╥║╚╗║║╠╡╚══╗╚═╗ ╔═╝║╔╗╔═╗╔╝╚╗╚╦╝║╥╚╝╚╝╔╝╚╣╚╗║║║╨╔══╗╚╗╔╣ ╩══╝║╚╝╥╠╝╞╗║╥║╔╝╠╦╗╔╗╚═╗╚╗║║║╚═╝╔╡║╔╩╝╨ ╔╡╔╦╝╔═╣╚═╗║║╚╝║╞╝║║╨╠══╝╥║╠╝╠╗╞═╣╔╝╚══╗ ╚═╝╚═╝╞╝╞═╩╝╚══╩══╝╚═╝╞══╩╝╚═╝╚══╝╚════╝
┌──┐┌┐ ┌───┐ ┌─┐ └┐
┌┐│ └┘│ └┐┌─┘ │ │ └─┐
┌──┘└┘ ┌┘ │└─┐ ┌┐│┌┘ └┐
┌┐│ ┌┐│ │ │ │└┘│ ┌┐ │
│└┘ │└┘ └┐ └┐┌─┘ │ │└┐│
└───┐ │ └┐ │└─┐ │ │ ││
┌───┘ └──┐ ┌┘ └─┐│ │ ┌──┘ └┘
└─┐ ┌┘ ┌─┐┌┐│ │└┐ │ └──┐
┌─┘ └┐ │ └┘└┘ └┐│ │ ┌──┐└┐
┘ │ ┌┘ ││ └─┘ │┌┘
│ │ └┘ ┌┘└──┐
└──┘ └────┘
Icon and Unicon
The following code works with the solution from Maze Generation. Replace the main with this: <lang Icon>procedure main(A)
/mh := \A[1] | 12 /mw := \A[2] | 16 mz := DisplayMaze(GenerateMaze(mh,mw)) WriteImage(mz.filename) # save file WAttrib(mz.window,"canvas=normal") # show it until Event() == &lpress # wait for left mouse press Solver(mz.maze) DisplayMazeSolution(mz) WriteImage(mz.filename ?:= (="maze-", "maze-solved-" || tab(0))) until Event() == &lpress # wait close(mz.window)
end</lang>
And include this after the Generator and Display procedures. <lang Icon>procedure Solver(r,c) static maze,h,w,rd
if type(r) == "list" then { # ------------------- Top Level (r == maze)
h := *(maze := r) # height
w := *maze[1] # width
every r := 1 to h & c := 1 to w do # remove breadcrumbs
maze[r,c] := iand(maze[r,c],NORTH+EAST+SOUTH+WEST+START+FINISH)
every ((r := 1 | h) & (c := 1 to w)) | # search perimiter
((r := 1 to h) & (c := 1 | w)) do
if iand(maze[r,c],START) > 0 then break # until start found
Solver(r,c) # recurse through maze
return 1(.maze,maze := &null) # return maze and reset
}
else # ------------------- Recurse way through maze
if iand(x := maze[r,c],SEEN) = 0 then { # in bounds and not seen?
(iand(x,FINISH) > 0, maze[r,c] +:= PATH, return ) # at finish? - done!
maze[r,c] +:= SEEN # drop bread crumb
(iand(x,NORTH) > 0, Solver(r-1,c), maze[r,c] +:= PATH, return)
(iand(x,EAST) > 0, Solver(r,c+1), maze[r,c] +:= PATH, return)
(iand(x,SOUTH) > 0, Solver(r+1,c), maze[r,c] +:= PATH, return)
(iand(x,WEST) > 0, Solver(r,c-1), maze[r,c] +:= PATH, return)
}
end
procedure DisplayMazeSolution(mz) #: draw marked PATH &window := mz.window maze := mz.maze WAttrib("dx="||(dxy:=BORDER+CELL/2),"dy="||dxy) every (r := 1 to *maze) & (c := 1 to *maze[1]) do {
if fg ~=== "blue" then Fg(fg := "blue")
if iand(maze[r,c],START) > 0 then Fg(fg := "red")
if iand(maze[r,c],PATH) > 0 then
FillCircle(x := CELL*(c-1),y := CELL*(r-1),rad := CELL/5)
}
return mz end</lang>
J
<lang J> NB. source Dijkstra_equal_weights graph NB. NB. + +---+---+ NB. | 0 1 2 | (sample cell numbers) NB. +---+ + + NB. | 3 4 | 5 NB. +---+---+---+ NB. NB. graph =: 1;0 2 4;1 5;4;1 3;2 NB. The graph is a vector of boxed vectors of neighbors.
Dijkstra_equal_weights =: 4 : 0
dist =. previous =. #&_ n =. # graph =. y [ source =. x
dist =. 0 source } dist
Q =. 0
while. #Q do.
u =. {.Q
Q =. }.Q
if. _ = u{dist do. break. end.
for_v. >u{graph do.
if. -. v e. previous do.
alt =. >: u { dist
if. alt < v { dist do.
dist =. alt v } dist
previous =. u v } previous
if. v e. Q do.
echo 'belch'
else.
Q =. Q,v
end.
end.
end.
end.
end.
dist;previous
)
path =. 3 : 0
p =. <:#y
while. _ > {:p do.
p =. p,y{~{:p
end.
|.}:p
)
solve=:3 :0
NB. convert walls to graph
shape =. }.@$@:>
ew =. (,.&0 ,: 0&,.)@>@{. NB. east west doors
ns =. (, &0 ,: 0&, )@>@{:
cell_offsets =. 1 _1 1 _1 * 2 # 1 , {:@shape
cell_numbers =. i.@shape
neighbors =. (cell_numbers +"_ _1 cell_offsets *"_1 (ew , ns))y
graph =. (|:@(,/"_1) <@-."1 0 ,@i.@shape)neighbors NB. list of boxed neighbors
NB. solve it
path , > {: 0 Dijkstra_equal_weights graph
)
display=:3 :0 NB. Monadic display copied from maze generation task
size=. >.&$&>/y
text=. (}:1 3$~2*1+{:size)#"1":size$<' '
'hdoor vdoor'=. 2 4&*&.>&.> (#&,{@;&i./@$)&.> y
' ' (a:-.~0 1;0 2; 0 3;(2 1-~$text);(1 4&+&.> hdoor),,vdoor+&.>"0/2 1;2 2;2 3)} text
a=. display y
size=. >.&$&>/y
columns=. {: size
cells =. <"1(1 2&p.@<.@(%&columns) ,. 2 4&p.@(columns&|))x
'+' cells } a NB. exercise, replace cells with a gerund to draw arrows on the path.
)
4 (display~ solve)@maze 9
┌ ┬───┬───┬───┬───┬───┬───┬───┬───┐ │ + │ │ │ ├ ┼───┼ ┼ ┼ ┼───┼ ┼ ┼ ┤ │ + + │ │ │ │ │ ├───┼ ┼───┼───┼───┼───┼───┼ ┼───┤ │ │ + + + │ + + + │ │ ├ ┼───┼───┼ ┼ ┼───┼ ┼───┼───┤ │ + + │ + + + └───┴───┴───┴───┴───┴───┴───┴───┴───┘
</lang>
PicoLisp
<lang PicoLisp>(de shortestPath (Goal This Maze)
(let (Path NIL Best NIL Dir " > ")
(recur (This Path Dir)
(when (and This (not (: mark)))
(push 'Path (cons This Dir))
(if (== Goal This)
(unless (and Best (>= (length Path) (length Best)))
(setq Best Path) )
(=: mark T)
(recurse (: west) Path " > ")
(recurse (: east) Path " < ")
(recurse (: south) Path " \^ ")
(recurse (: north) Path " v ")
(=: mark NIL) ) ) )
(disp Maze 0
'((Fld) (if (asoq Fld Best) (cdr @) " ")) ) ) )</lang>
Using the maze produced in Maze generation#PicoLisp, this finds the shortest path from the top-left cell 'a8' to the bottom-right exit 'k1':
: (shortestPath 'a8 'k1 (maze 11 8))
+ +---+---+---+---+---+---+---+---+---+---+
8 | > > v | > v | |
+ + + + + + +---+ +---+---+ +
7 | | | > ^ | v | | | | |
+---+ +---+---+ + + +---+ + + +
6 | | | v | | | | |
+ +---+ +---+ +---+---+---+ + +---+
5 | | | > > > v | | |
+---+ +---+ +---+---+---+ +---+---+ +
4 | | | | | v | > > v |
+ +---+ +---+ +---+ + + +---+ +
3 | | | | | v | ^ < | v |
+ +---+---+ + + + + +---+ + +
2 | | | | | | v | > ^ | v |
+ + + +---+ + +---+ + +---+ +
1 | | | > ^ | >
+---+---+---+---+---+---+---+---+---+---+---+
a b c d e f g h i j k
Prolog
Works with SWI-Prolog and XPCE.
<lang Prolog>:- dynamic cell/2.
- - dynamic maze/3.
- - dynamic path/1.
maze_solve(Lig,Col) :- retractall(cell(_,_)), retractall(maze(_,_,_)), retractall(path(_)),
% initialisation of the neighbours of the cells forall(between(0, Lig, I), ( forall(between(0, Col, J), assert(maze(I, J, []))))),
% creation of the window of the maze new(D, window('Maze')), forall(between(0,Lig, I), (XL is 50, YL is I * 30 + 50, XR is Col * 30 + 50, new(L, line(XL, YL, XR, YL)), send(D, display, L))),
forall(between(0,Col, I), (XT is 50 + I * 30, YT is 50, YB is Lig * 30 + 50, new(L, line(XT, YT, XT, YB)), send(D, display, L))),
SX is Col * 30 + 100, SY is Lig * 30 + 100, send(D, size, new(_, size(SX, SY))), L0 is random(Lig), C0 is random(Col), assert(cell(L0, C0)), \+search(D, Lig, Col, L0, C0), send(D, open),
% we look for a path from cell(0, 0) to cell(Lig-1, Col-1) % creation of the entrance erase_line(D, -1, 0, 0, 0),
% creation of the exit Lig1 is Lig-1, Col1 is Col-1, erase_line(D, Lig1, Col1, Lig, Col1),
% seraching the path assert(path([[0, 0], [-1, 0]])), walk(Lig, Col), path(P), display_path(D, P).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% walk(Lig, Col) :- path([[L, C] | _R]), L is Lig - 1, C is Col - 1, retract(path(P)), assert(path([[Lig, C]|P])).
walk(Lig, Col) :- retract(path([[L, C] | R])), maze(L, C, Edge), member([L1, C1], Edge), \+member([L1, C1], R), assert(path([[L1,C1], [L, C] | R])), walk(Lig, Col).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% display_path(_, []).
display_path(D, [[L, C] | R]):- new(B, box(10,10)), send(B, fill_pattern, new(_, colour(@default, 0,0,0))), X is C * 30 + 60, Y is L * 30 + 60, send(D, display, B, point(X,Y)), display_path(D, R).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
search(D, Lig, Col, L, C) :-
Dir is random(4),
nextcell(Dir, Lig, Col, L, C, L1, C1),
assert(cell(L1,C1)),
assert(cur(L1,C1)),
retract(maze(L, C, Edge)), assert(maze(L, C, [[L1, C1] | Edge])), retract(maze(L1, C1, Edge1)), assert(maze(L1, C1, [[L, C] | Edge1])),
erase_line(D, L, C, L1, C1), search(D, Lig, Col, L1, C1).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% erase_line(D, L, C, L, C1) :- ( C < C1 -> C2 = C1; C2 = C), XT is C2 * 30 + 50, YT is L * 30 + 51, YR is (L+1) * 30 + 50, new(Line, line(XT, YT, XT, YR)), send(Line, colour, white), send(D, display, Line).
erase_line(D, L, C, L1, C) :- XT is 51 + C * 30, XR is 50 + (C + 1) * 30, ( L < L1 -> L2 is L1; L2 is L), YT is L2 * 30 + 50, new(Line, line(XT, YT, XR, YT)), send(Line, colour, white), send(D, display, Line).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
nextcell(Dir, Lig, Col, L, C, L1, C1) :-
next(Dir, Lig, Col, L, C, L1, C1);
( Dir1 is (Dir+3) mod 4,
next(Dir1, Lig, Col, L, C, L1, C1));
( Dir2 is (Dir+1) mod 4,
next(Dir2, Lig, Col, L, C, L1, C1));
( Dir3 is (Dir+2) mod 4,
next(Dir3, Lig, Col, L, C, L1, C1)).
% 0 => northward next(0, _Lig, _Col, L, C, L1, C) :- L > 0, L1 is L - 1, \+cell(L1, C).
% 1 => rightward next(1, _Lig, Col, L, C, L, C1) :- C < Col - 1, C1 is C + 1, \+cell(L, C1).
% 2 => southward next(2, Lig, _Col, L, C, L1, C) :- L < Lig - 1, L1 is L + 1, \+cell(L1, C).
% 3 => leftward next(2, _Lig, _Col, L, C, L, C1) :- C > 0, C1 is C - 1, \+cell(L, C1).
</lang>
output : 
PureBasic
<lang PureBasic>;code from the maze generation task is place here in its entirety before the rest of the code
Procedure displayMazePath(Array maze(2), List Path.POINT())
Protected x, y, vWall.s, hWall.s
Protected mazeWidth = ArraySize(maze(), 1), mazeHeight = ArraySize(maze(), 2)
Protected Dim mazeOutput.mazeOutput(mazeHeight)
Protected Dim mazeRow.mazeOutput(0)
Static pathChars.s = "@^>v<"
For y = 0 To mazeHeight
makeDisplayMazeRow(mazeRow(), maze(), y): mazeOutput(y) = mazeRow(0)
Next
If ListSize(path())
FirstElement(path())
Protected prevPath.POINT = path()
While NextElement(path())
x = path()\x - prevPath\x
y = path()\y - prevPath\y
Select x
Case -1: dirTaken = #dir_W
Case 1: dirTaken = #dir_E
Default
If y < 0
dirTaken = #dir_N
Else
dirTaken = #dir_S
EndIf
EndSelect
hWall = mazeOutput(prevPath\y)\hWall
mazeOutput(prevPath\y)\hWall = Left(hWall, prevPath\x * #cellDWidth + 2) + Mid(pathChars, dirTaken + 1, 1) + Right(hWall, Len(hWall) - (prevPath\x * #cellDWidth + 3))
prevPath = path()
Wend
hWall = mazeOutput(prevPath\y)\hWall
mazeOutput(prevPath\y)\hWall = Left(hWall, prevPath\x * #cellDWidth + 2) + Mid(pathChars, #dir_ID + 1, 1) + Right(hWall, Len(hWall) - (prevPath\x * #cellDWidth + 3))
For y = 0 To mazeHeight
PrintN(mazeOutput(y)\vWall): PrintN(mazeOutput(y)\hWall)
Next
EndIf
EndProcedure
Procedure solveMaze(Array maze(2), *start.POINT, *finish.POINT, List Path.POINT())
Protected mazeWidth = ArraySize(maze(), 1), mazeHeight = ArraySize(maze(), 2)
Dim visited(mazeWidth + 1, mazeHeight + 1) ;includes padding for easy border detection
Protected i
;mark outside border as already visited (off limits)
For i = 1 To mazeWidth
visited(i, 0) = #True: visited(i, mazeHeight + 1) = #True
Next
For i = 1 To mazeHeight
visited(0, i) = #True: visited(mazeWidth + 1, i) = #True
Next
Protected x = *start\x, y = *start\y, nextCellDir
visited(x + offset(#visited, #dir_ID)\x, y + offset(#visited, #dir_ID)\y) = #True
ClearList(path())
Repeat
If x = *finish\x And y = *finish\y
AddElement(path())
path()\x = x: path()\y = y
Break ;success
EndIf
nextCellDir = #firstDir - 1
For i = #firstDir To #numDirs
If Not visited(x + offset(#visited, i)\x, y + offset(#visited, i)\y)
If maze(x + offset(#wall, i)\x, y + offset(#wall, i)\y) & wallvalue(i) <> #Null
nextCellDir = i: Break ;exit for/next search
EndIf
EndIf
Next
If nextCellDir >= #firstDir
visited(x + offset(#visited, nextCellDir)\x, y + offset(#visited, nextCellDir)\y) = #True
AddElement(path())
path()\x = x: path()\y = y
x + offset(#maze, nextCellDir)\x: y + offset(#maze, nextCellDir)\y
ElseIf ListSize(path()) > 0
x = path()\x: y = path()\y
DeleteElement(path())
Else
Break
EndIf
ForEver
EndProcedure
- demonstration
If OpenConsole()
Define.POINT start, finish
start\x = Random(mazeWidth - 1): start\y = Random(mazeHeight - 1)
finish\x = Random(mazeWidth - 1): finish\y = Random(mazeHeight - 1)
NewList Path.POINT()
solveMaze(maze(), start, finish, path())
If ListSize(path()) > 0
PrintN("Solution found for path between (" + Str(start\x) + ", " + Str(start\y) + ") and (" + Str(finish\x) + ", " + Str(finish\y) + ")")
displayMazePath(maze(), path())
Else
PrintN("No solution found for path between (" + Str(start\x) + ", " + Str(start\y) + ") and (" + Str(finish\x) + ", " + Str(finish\y) + ")")
EndIf
Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
CloseConsole()
EndIf</lang> Using the maze produced in Maze generation#PureBasic, this additional code will find and display the path between two random maze cells. A working example requires combining the two code listings by placing the 'maze generation' code at the beginning of the 'maze solving' code.
Sample output:
Solution found for path between (3, 2) and (7, 1) +---+---+---+---+---+---+---+---+---+---+ | v < < < < | | v < < | + +---+---+---+ + + +---+ +---+ | > v | ^ | | v | @ | ^ < | +---+ +---+---+ + + + +---+ + | | v | > ^ | v | ^ | ^ | + + + +---+---+---+ + +---+ + | v < | | > ^ | > ^ | + +---+---+---+---+ +---+ + + + | v | | | | ^ | | + +---+ + +---+---+---+---+ +---+ | > > v | | > v | ^ < | +---+---+ +---+---+---+ + +---+ + | > > > > ^ | > > ^ | +---+---+---+---+---+---+---+---+---+---+
Python
<lang Python>
- python 3
def Dijkstra(Graph, source):
+ +---+---+
| 0 1 2 |
+---+ + +
| 3 4 | 5
+---+---+---+
>>> graph = ( # or ones on the diagonal
... (0,1,0,0,0,0,),
... (1,0,1,0,1,0,),
... (0,1,0,0,0,1,),
... (0,0,0,0,1,0,),
... (0,1,0,1,0,0,),
... (0,0,1,0,0,0,),
... )
...
>>> Dijkstra(graph, 0)
([0, 1, 2, 3, 2, 3], [1e+140, 0, 1, 4, 1, 2])
>>> display_solution([1e+140, 0, 1, 4, 1, 2])
5<2<1<0
# Graph[u][v] is the weight from u to v (however 0 means infinity)
infinity = float('infinity')
n = len(graph)
dist = [infinity]*n # Unknown distance function from source to v
previous = [infinity]*n # Previous node in optimal path from source
dist[source] = 0 # Distance from source to source
Q = list(range(n)) # All nodes in the graph are unoptimized - thus are in Q
while Q: # The main loop
u = min(Q, key=lambda n:dist[n]) # vertex in Q with smallest dist[]
Q.remove(u)
if dist[u] == infinity:
break # all remaining vertices are inaccessible from source
for v in range(n): # each neighbor v of u
if Graph[u][v] and (v in Q): # where v has not yet been visited
alt = dist[u] + Graph[u][v]
if alt < dist[v]: # Relax (u,v,a)
dist[v] = alt
previous[v] = u
return dist,previous
def display_solution(predecessor):
cell = len(predecessor)-1
while cell:
print(cell,end='<')
cell = predecessor[cell]
print(0)
</lang>
Tcl
This script assumes that the contents of the generation task have already been sourced. Note that the algorithm implemented here does not assume that the maze is free of circuits, and in the case that there are multiple routes, it finds the shortest one because it is a breadth-first search (by virtue of the queue variable being used as a queue).
<lang tcl>oo::define maze {
method solve {} {
### Initialization of visited matrix and location/path queue set visited [lrepeat $x [lrepeat $y 0]] set queue {0 0 {}}
### Loop to do the searching ### while 1 { # Check for running out of path; an error in maze construction if {[llength $queue] == 0} { error "cannot reach finish" } # Visit the next square from the queue set queue [lassign $queue cx cy path] if {[lindex $visited $cx $cy]} continue lset visited $cx $cy 1 lappend path $cx $cy # Check for reaching the goal if {$cx == $x-1 && $cy == $y-1} break # Add the square in each direction to the queue if a move there is legal foreach {dx dy} {0 1 1 0 0 -1 -1 0} { set nx [expr {$cx + $dx}]; set ny [expr {$cy + $dy}] if { $nx >= 0 && $nx < $x && $ny >= 0 && $ny < $y && ($dx && idx($verti, min($cx,$nx), $cy) || $dy && idx($horiz, $cx, min($cy,$ny))) } then { lappend queue $nx $ny $path } } }
### Loop to set up the path rendering ### # (-2,-2) is just a marker that isn't next to the maze at all, so # guaranteeing the use of the last 'else' clause foreach {cx cy} $path {nx ny} [concat [lrange $path 2 end] -2 -2] { if {$nx-$cx == 1} { lset content $cx $cy "v" } elseif {$nx-$cx == -1} { lset content $cx $cy "^" } elseif {$ny-$cy == -1} { lset content $cx $cy "<" } else { lset content $cx $cy ">" } }
### Return the path ### return $path
}
}
- Do the solution (we ignore the returned path here...)
m solve
- Print it out
puts [m view]</lang> Example output:
+ +---+---+---+---+---+---+---+---+---+---+ | v | | + +---+ +---+---+---+---+---+---+---+ + | v | | > v | > v | | | + + +---+ + + + + + +---+ + | v | > ^ | v | ^ | v | | | | + +---+ +---+ + + + +---+ +---+ | v | > ^ | v < | ^ | v | | | | + + +---+ +---+ + + +---+ + + | > ^ | v < | > ^ | v | | | +---+---+ +---+ +---+ +---+ +---+---+ | v < < | > ^ | v < | > > > v | + +---+---+ +---+ +---+ +---+---+ + | > v | ^ < | > > ^ | | v | +---+ +---+---+ +---+---+---+ + + + | > > > ^ | | > +---+---+---+---+---+---+---+---+---+---+---+