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 Control.Monad
import Control.Monad.ST
import Data.Array
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 Control.Monad (forM_, unless)
import Control.Monad.ST (ST, stToIO)
import Data.Array (Array, (!), bounds)
import Data.Bool (bool)


rand
rand :: Random a => (a, a) -> STRef s StdGen -> ST s a
:: Random a
=> (a, a) -> STRef s StdGen -> ST s a
rand range gen = do
rand range gen = do
(a, g) <- liftM (randomR range) $ readSTRef gen
(a, g) <- randomR range <$> readSTRef gen
gen `writeSTRef` g
gen `writeSTRef` g
return a
return a


data Maze = Maze {rightWalls, belowWalls :: Array (Int, Int) Bool}
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
visited <- mazeArray False
rWalls <- mazeArray True
rWalls <- mazeArray True
bWalls <- mazeArray True
bWalls <- mazeArray True
gen <- newSTRef gen
gen <- newSTRef gen
liftM2 (,) (rand (0, maxX) gen) (rand (0, maxY) gen) >>=
(,) <$> rand (0, maxX) gen <*> rand (0, maxY) gen >>=
visit gen visited rWalls bWalls
visit gen visited rWalls bWalls
liftM2 Maze (freeze rWalls) (freeze bWalls)
Maze <$> freeze rWalls <*> freeze bWalls
where
where visit gen visited rWalls bWalls here = do
visit gen visited rWalls bWalls here = do
writeArray visited here True
writeArray visited here True
let ns = neighbors here
i <- rand (0, length ns - 1) gen
let ns = neighbors here
forM_ (ns !! i : take i ns ++ drop (i + 1) ns) $ \there -> do
i <- rand (0, length ns - 1) gen
seen <- readArray visited there
forM_ (ns !! i : take i ns ++ drop (i + 1) ns) $
unless seen $ do
\there -> do
removeWall here there
seen <- readArray visited there
unless seen $
visit gen visited rWalls bWalls there
where removeWall (x1, y1) (x2, y2) = writeArray
do removeWall here there
(if x1 == x2 then bWalls else rWalls)
visit gen visited rWalls bWalls there
where
(min x1 x2, min y1 y2)
False
removeWall (x1, y1) (x2, y2) =
writeArray (bool rWalls bWalls (x1 == x2)) (min x1 x2, min y1 y2) False

neighbors (x, y) =
neighbors (x, y) =
(if x == 0 then [] else [(x - 1, y )]) ++
bool [(x - 1, y)] [] (0 == x) ++
(if x == maxX then [] else [(x + 1, y )]) ++
bool [(x + 1, y)] [] (maxX == x) ++
(if y == 0 then [] else [(x, y - 1)]) ++
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

maxX = width - 1
mazeArray =
maxY = height - 1
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) "---+")
putStrLn $ '+' : concat (replicate (maxX + 1) "---+")
forM_ [0 .. maxY] $ \y -> do
forM_ [0 .. maxY] $
putStr "|"
\y -> do
putStr "|"
forM_ [0 .. maxX] $ \x -> do
putStr " "
forM_ [0 .. maxX] $
\x -> do
putStr $ if rWalls ! (x, y) then "|" else " "
putStrLn ""
putStr " "
forM_ [0 .. maxX] $ \x -> do
putStr $ bool " " "|" (rWalls ! (x, y))
putStr "+"
putStrLn ""
forM_ [0 .. maxX] $
putStr $ if bWalls ! (x, y) then "---" else " "
putStrLn "+"
\x -> do
where maxX = fst (snd $ bounds rWalls)
putStr "+"
maxY = snd (snd $ bounds rWalls)
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}}