Maze solving: Difference between revisions
Content added Content deleted
No edit summary |
(→{{header|Haskell}}: Adjusted some names to side-step the wiki formatting issue) |
||
| Line 1,608: | Line 1,608: | ||
<lang haskell>#!/usr/bin/runhaskell |
<lang haskell>#!/usr/bin/runhaskell |
||
import Data.Maybe |
import Data.Maybe (fromMaybe) |
||
-- given two points, returns the average of them |
-- given two points, returns the average of them |
||
average :: (Int, Int) -> (Int, Int) -> (Int, Int) |
average :: (Int, Int) -> (Int, Int) -> (Int, Int) |
||
average (x, y) ( |
average (x, y) (x_, y_) = ((x + x_) `div` 2, (y + y_) `div` 2) |
||
-- given a maze and a tuple of position and wall position, returns |
-- given a maze and a tuple of position and wall position, returns |
||
| Line 1,630: | Line 1,630: | ||
-- given a maze and a position, draw a '*' at that position in the maze |
-- given a maze and a position, draw a '*' at that position in the maze |
||
draw :: [String] -> (Int, Int) -> [String] |
draw :: [String] -> (Int, Int) -> [String] |
||
draw maze (x,y) = |
draw maze (x, y) = |
||
let row = maze !! y |
|||
in substitute maze y $ substitute row x '*' |
|||
-- given a maze, a previous position, and a list of tuples of potential |
-- given a maze, a previous position, and a list of tuples of potential |
||
-- new positions and their wall positions, returns the solved maze, or |
-- new positions and their wall positions, returns the solved maze, or |
||
-- None if it cannot be solved |
-- None if it cannot be solved |
||
tryMoves :: |
tryMoves :: [String] |
||
| ⚫ | |||
-> [((Int, Int), (Int, Int))] |
|||
-> Maybe [String] |
|||
tryMoves _ _ [] = Nothing |
tryMoves _ _ [] = Nothing |
||
tryMoves maze prevPos ((newPos,wallPos):more) = |
tryMoves maze prevPos ((newPos, wallPos):more) = |
||
case |
case solve_ maze newPos prevPos of |
||
Nothing -> tryMoves maze prevPos more |
|||
Just maze_ -> Just $ foldl draw maze_ [newPos, wallPos] |
|||
-- given a maze, a new position, and a previous position, returns |
-- given a maze, a new position, and a previous position, returns |
||
-- the solved maze, or None if it cannot be solved |
-- the solved maze, or None if it cannot be solved |
||
-- (assumes goal is upper-left corner of maze) |
-- (assumes goal is upper-left corner of maze) |
||
solve_ :: [String] -> (Int, Int) -> (Int, Int) -> Maybe [String] |
|||
solve_ maze (2, 1) _ = Just maze |
|||
solve_ maze pos@(x, y) prevPos = |
|||
let newPositions = [(x, y - 2), (x + 4, y), (x, y + 2), (x - 4, y)] |
let newPositions = [(x, y - 2), (x + 4, y), (x, y + 2), (x - 4, y)] |
||
notPrev |
notPrev pos_ = pos_ /= prevPos |
||
newPositions_ = filter notPrev newPositions |
|||
wallPositions = map (average pos) |
wallPositions = map (average pos) newPositions_ |
||
zipped = zip |
zipped = zip newPositions_ wallPositions |
||
legalMoves = filter (notBlocked maze) zipped |
legalMoves = filter (notBlocked maze) zipped |
||
in tryMoves maze pos legalMoves |
in tryMoves maze pos legalMoves |
||
| Line 1,660: | Line 1,664: | ||
-- (starts at lower right corner and goes to upper left corner) |
-- (starts at lower right corner and goes to upper left corner) |
||
solve :: [String] -> Maybe [String] |
solve :: [String] -> Maybe [String] |
||
solve maze = |
solve maze = solve_ (draw maze start) start (-1, -1) |
||
where |
|||
| ⚫ | |||
startx = length (head maze) - 3 |
|||
| ⚫ | |||
| ⚫ | |||
start = (startx, starty) |
|||
-- takes unsolved maze on standard input, prints solved maze on standard output |
-- takes unsolved maze on standard input, prints solved maze on standard output |
||
main = |
main = |
||
let main_ = unlines . fromMaybe ["can_t solve"] . solve . lines |
|||
in interact main_ |
|||
</lang> |
|||
{{out}} |
{{out}} |
||
<pre> |
<pre> |
||
+---+---+---+---+---+---+---+---+---+---+---+ |
+---+---+---+---+---+---+---+---+---+---+---+ |
||