Jump to content

Maze solving: Difference between revisions

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

edits

Cookies help us deliver our services. By using our services, you agree to our use of cookies.