Maze solving: Difference between revisions

From Rosetta Code
Content added Content deleted
m (→‎{{header|Tcl}}: whitespace)
m (→‎{{header|Tcl}}: add version requirement)
Line 47: Line 47:


=={{header|Tcl}}==
=={{header|Tcl}}==
{{works with|Tcl|8.6}}
This script assumes that the contents of the [[Maze generation#Tcl|generation task]] have already been <code>source</code>d. 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 <tt>queue</tt> variable being used as a queue).
This script assumes that the contents of the [[Maze generation#Tcl|generation task]] have already been <code>source</code>d. 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 <tt>queue</tt> variable being used as a queue).
<lang tcl>oo::define maze {
<lang tcl>oo::define maze {

Revision as of 18:36, 22 December 2010

Task
Maze solving
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.

PicoLisp

<lang PicoLisp>(de shortestPath (This Goal Maze)

  (let (Path NIL  Best NIL)
     (recur (This Path)
        (when (and This (not (: mark)))
           (push 'Path This)
           (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)
              (=: mark NIL) ) ) )
     (disp Maze 0
        '((This) (if (memq This Best) " # " "   ")) ) ) )</lang>

Using the maze produced in Maze generation#PicoLisp, this finds the shortest path from the top-left cell 'a12' to the bottom-righ exit 'p1':

: (shortestPath 'a8 'k1 (maze 11 8))
   +   +---+---+---+---+---+---+---+---+---+---+
 8 | #   #   # | #   # |                       |
   +   +   +   +   +   +   +---+   +---+---+   +
 7 |   |   | #   # | # |   |       |       |   |
   +---+   +---+---+   +   +   +---+   +   +   +
 6 |   |       |     # |   |           |   |   |
   +   +---+   +---+   +---+---+---+   +   +---+
 5 |       |       | #   #   #   # |   |       |
   +---+   +---+   +---+---+---+   +---+---+   +
 4 |   |       |       |       | # | #   #   # |
   +   +---+   +---+   +---+   +   +   +---+   +
 3 |       |       |   |       | # | #   # | # |
   +   +---+---+   +   +   +   +   +---+   +   +
 2 |       |       |   |   |   | # | #   # | # |
   +   +   +   +---+   +   +---+   +   +---+   +
 1 |   |               |         #   # |     #
   +---+---+---+---+---+---+---+---+---+---+---+
     a   b   c   d   e   f   g   h   i   j   k

Tcl

Works with: Tcl version 8.6

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 {} {

set visited [lrepeat $x [lrepeat $y 0]] set queue {0 0 {}} while 1 { if {[llength $queue] == 0} { error "cannot reach finish" } set queue [lassign $queue cx cy path] lset visited $cx $cy 1 lappend path $cx $cy if {$cx == $x-1 && $cy == $y-1} break foreach {dx dy} {0 1 1 0 0 -1 -1 0} { if { [set nx [expr {$cx + $dx}]] >= 0 && $nx < $x && [set ny [expr {$cy + $dy}]] >= 0 && $ny < $y && !idx($visited, $nx, $ny) && ($dx && idx($verti, min($cx,$nx), $cy) || $dy && idx($horiz, $cx, min($cy,$ny))) } then { lappend queue $nx $ny $path } } } 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 $path

   }

}

  1. Do the solution (we ignore the returned path here...)

m solve

  1. 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 |
+---+   +---+---+   +---+---+---+   +   +   +
|     >   >   >   ^ |               |     >  
+---+---+---+---+---+---+---+---+---+---+---+