Maze generation: Difference between revisions
Content added Content deleted
(Added Fōrmulæ) |
(→{{header|Haskell}}: Specified imports, applied hlint hindent, simplified a Boolean chain with 'bool') |
||
Line 3,504: | Line 3,504: | ||
{-# LANGUAGE TypeFamilies #-} |
{-# LANGUAGE TypeFamilies #-} |
||
⚫ | |||
⚫ | |||
⚫ | |||
import Data.Array.ST |
import Data.Array.ST |
||
(STArray, freeze, newArray, readArray, writeArray) |
|||
import Data.STRef |
|||
import Data.STRef (STRef, newSTRef, readSTRef, writeSTRef) |
|||
import System.Random |
|||
import System.Random (Random(..), getStdGen, StdGen) |
|||
⚫ | |||
⚫ | |||
import Data.Array (Array, (!), bounds) |
|||
⚫ | |||
rand |
|||
⚫ | |||
:: Random a |
|||
⚫ | |||
rand range gen = do |
rand range gen = do |
||
(a, g) <- randomR range <$> readSTRef gen |
|||
gen `writeSTRef` g |
|||
return a |
|||
data Maze = Maze |
data Maze = Maze |
||
{ rightWalls, belowWalls :: Array (Int, Int) Bool |
|||
} |
|||
maze :: Int -> Int -> StdGen -> ST s Maze |
maze :: Int -> Int -> StdGen -> ST s Maze |
||
maze width height gen = do |
maze width height gen = do |
||
visited <- mazeArray False |
|||
rWalls <- mazeArray True |
|||
bWalls <- mazeArray True |
|||
gen <- newSTRef gen |
|||
(,) <$> rand (0, maxX) gen <*> rand (0, maxY) gen >>= |
|||
visit gen visited rWalls bWalls |
|||
Maze <$> freeze rWalls <*> freeze bWalls |
|||
where |
|||
visit gen visited rWalls bWalls here = do |
|||
writeArray visited here True |
|||
let ns = neighbors here |
|||
let ns = neighbors here |
|||
i <- rand (0, length ns - 1) gen |
|||
forM_ (ns !! i : take i ns ++ drop (i + 1) ns) $ |
|||
\there -> do |
|||
seen <- readArray visited there |
|||
unless seen $ |
|||
visit gen visited rWalls bWalls there |
|||
do removeWall here there |
|||
visit gen visited rWalls bWalls there |
|||
where |
|||
⚫ | |||
removeWall (x1, y1) (x2, y2) = |
|||
⚫ | |||
neighbors (x, y) = |
|||
bool [(x - 1, y)] [] (0 == x) ++ |
|||
bool [(x + 1, y)] [] (maxX == x) ++ |
|||
( |
bool [(x, y - 1)] [] (0 == y) ++ bool [(x, y + 1)] [] (maxY == y) |
||
maxX = width - 1 |
|||
(if y == maxY then [] else [(x, y + 1)]) |
|||
maxY = height - 1 |
|||
mazeArray = |
|||
maxY |
newArray ((0, 0), (maxX, maxY)) :: Bool -> ST s (STArray s (Int, Int) Bool) |
||
mazeArray = newArray ((0, 0), (maxX, maxY)) |
|||
:: Bool -> ST s (STArray s (Int, Int) Bool) |
|||
printMaze :: Maze -> IO () |
printMaze :: Maze -> IO () |
||
printMaze (Maze rWalls bWalls) = do |
printMaze (Maze rWalls bWalls) = do |
||
putStrLn $ '+' : concat (replicate (maxX + 1) "---+") |
|||
forM_ [0 .. maxY] $ |
|||
\y -> do |
|||
putStr "|" |
|||
⚫ | |||
forM_ [0 .. maxX] $ |
|||
\x -> do |
|||
putStr $ if rWalls ! (x, y) then "|" else " " |
|||
putStr " " |
|||
putStr $ bool " " "|" (rWalls ! (x, y)) |
|||
putStrLn "" |
|||
⚫ | |||
putStr $ if bWalls ! (x, y) then "---" else " " |
|||
\x -> do |
|||
putStr "+" |
|||
putStr $ bool " " "---" (bWalls ! (x, y)) |
|||
putStrLn "+" |
|||
where |
|||
maxX = fst (snd $ bounds rWalls) |
|||
maxY = snd (snd $ bounds rWalls) |
|||
main :: IO () |
|||
main = getStdGen >>= stToIO . maze 11 8 >>= printMaze</lang> |
main = getStdGen >>= stToIO . maze 11 8 >>= printMaze</lang> |
||
{{out|Sample output}} |
{{out|Sample output}} |