W = 所有墙
T = {}
number_of_components = N*N
while number_of_components > 1
(u, v) = W.pop
if component(u) != component(v)
T << (u, v)
merge component(u) and component(v)
rand :: Random a => (a, a) -> STRef s StdGen -> ST s a rand range g = do (a, g') <- liftM (randomR range) $ readSTRef g a <$ writeSTRef g g'
maze :: Int -> Int -> StdGen -> ST s Maze maze w h gen = do let mk = newArray ((0,0), (w-1,h-1)) :: Bool -> ST s (STArray s (Int, Int) Bool) visited <- mk False right <- mk True bottom <- mk True gen <- newSTRef gen let walk 1 (x,y) = return () walk c u@(x,y) = do writeArray visited u True let ns = [(x-1,y) | x > 0] ++ [(x+1,y) | x+1 < w] ++ [(x,y-1) | y > 0] ++ [(x,y+1) | y+1 < h] :: [(Int,Int)] i <- rand (0, length ns - 1) gen let v@(x', y') = ns !! i wall = if x == x' then bottom else right g = (min x x', min y y') hasWall <- readArray wall g seen <- readArray visited v if seen then walk c v else writeArray wall g False >> walk (c-1) v (,) <$> rand (0, w-1) gen <*> rand (0, h-1) gen >>= walk (w*h) Maze <$> freeze right <*> freeze bottom
maze :: Int -> Int -> StdGen -> ST s Maze maze w h gen = do let mk = newArray ((0,0), (w-1,h-1)) :: Bool -> ST s (STArray s (Int, Int) Bool) visited <- mk False right <- mk True bottom <- mk True gen <- newSTRef gen let walk 1 gen (x,y) = return () walk c gen u@(x,y) = do writeArray visited u True let ns = [(x-1,y) | x > 0] ++ [(x+1,y) | x+1 < w] ++ [(x,y-1) | y > 0] ++ [(x,y+1) | y+1 < h] :: [(Int,Int)] i <- rand (0, length ns - 1) gen let v@(x', y') = ns !! i wall = if x == x' then bottom else right g = (min x x', min y y') hasWall <- readArray wall g seen <- readArray visited v if seen then walk c gen v else writeArray wall g False >> walk (c-1) gen v (,) <$> rand (0, w-1) gen <*> rand (0, h-1) gen >>= walk (w*h) gen Maze <$> freeze right <*> freeze bottom
printMaze :: Maze -> IO () printMaze (Maze right bottom) = do putStrLn $ concat (replicate (maxX + 1) "._") ++ "." forM_ [0..maxY] $ \y -> do putStr "|" forM_ [0..maxX] $ \x -> do putStr $ if bottom ! (x, y) then"_"else" " putStr $ if right ! (x, y) then"|"else"." putChar '\n' where (maxX, maxY) = snd $ bounds right
main = getStdGen >>= stToIO . maze 1213 >>= printMaze
maze :: Int -> Int -> StdGen -> ST s Maze maze width height gen = do visited <- mazeArray False rWalls <- mazeArray True bWalls <- mazeArray True gen <- newSTRef gen liftM2 (,) (rand (0, maxX) gen) (rand (0, maxY) gen) >>= visit gen visited rWalls bWalls liftM2 Maze (freeze rWalls) (freeze bWalls) where visit gen visited rWalls bWalls here = do writeArray visited here True 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 $ do removeWall here there visit gen visited rWalls bWalls there where removeWall (x1, y1) (x2, y2) = writeArray (if x1 == x2 then bWalls else rWalls) (min x1 x2, min y1 y2) False
neighbors (x, y) = (if x == 0then [] else [(x - 1, y )]) ++ (if x == maxX then [] else [(x + 1, y )]) ++ (if y == 0then [] else [(x, y - 1)]) ++ (if y == maxY then [] else [(x, y + 1)])
maxX = width - 1 maxY = height - 1
mazeArray = newArray ((0, 0), (maxX, maxY)) :: Bool -> ST s (STArray s (Int, Int) Bool)
let eller m n = let l = Array.create (n+1) 0in let r = Array.create (n+1) 0in for i = 0to n-1do print_string "._"; l.(i) <- i; r.(i) <- i done; l.(n) <- n-1; print_string ".\n|"; for y = 0to m-2do for x = 0to n-1do let w = l.(x+1) in let pat1 = if x <> w && Random.int3 <> 0thenbegin r.(w) <- r.(x); l.(r.(w)) <- w; r.(x) <- x+1; l.(x+1) <- x; '.' endelse '|' in let pat0 = if x <> l.(x) && Random.int3 <> 0thenbegin l.(r.(x)) <- l.(x); r.(l.(x)) <- r.(x); l.(x) <- x; r.(x) <- x; '_' endelse ' ' in print_char pat0; print_char pat1 done; print_string "\n|" done;
for x = 0to n-1do let w = l.(x+1) in let pat1 = if x <> w && (x == l.(x) || Random.int3 <> 0) thenbegin r.(w) <- r.(x); l.(r.(w)) <- w; r.(x) <- x+1; l.(x+1) <- x; '.' endelse '|' in l.(r.(x)) <- l.(x); r.(l.(x)) <- r.(x); l.(x) <- x; r.(x) <- x; print_char '_'; print_char pat1 done;;
