http://www.roguebasin.com/index.php?title=Cellular_Automata_Method_for_Generating_Random_Cave-Like_Levels

cellular.hs

module Cellular where

import System.Random
import Data.List.Split
import Data.Maybe

isWall False = '.'
isWall True  = '#'

mapWithIndex :: (Enum a, Num a) => (a -> b -> c) -> [b] -> [c]
mapWithIndex f xs = zipWith f [0..] xs

iterateGrid grid = mapWithIndex (\y row -> mapWithIndex (\x column -> nextTileIteration (x,y) grid ) row) grid

width = 80
height = 25

sequenceToString :: [Bool] -> String
sequenceToString sequence = map isWall sequence

nextTileIteration (x,y) grid = isWall ( becomeWall ( countWall ( get3x3 (x,y) grid ) ) )

countWall block3x3 = foldl (\acc c -> if c == '#' then acc + 1 else acc) 0 block3x3

becomeWall wallCount | wallCount >= 5 = True
                     | otherwise      = False

infix 9 !?

xs !? n | n < 0     = Nothing
        | otherwise = listToMaybe (drop n xs)

fallbackLookup index fallback xs = fromMaybe fallback $ xs !? index

queryGrid :: (Int,Int) -> [String] -> Char
queryGrid (x,y) grid = fallbackLookup x '#' (fallbackLookup y (take width $ repeat '#') grid)

neighbors :: (Int,Int) -> [String] -> String
neighbors (x,y) grid = queryGrid (x + 1, y) grid :
                     queryGrid (x, y + 1) grid :
                     queryGrid (x + 1, y + 1) grid :
                     queryGrid (x - 1, y - 1) grid :
                     queryGrid (x + 1, y - 1) grid :
                     queryGrid (x - 1, y + 1) grid :
                     queryGrid (x, y - 1) grid :
                     queryGrid (x - 1, y) grid :
                     []

-- Get the given tile's value along with its neighbors' values
get3x3 (x,y) grid = (queryGrid (x,y) grid) : neighbors (x,y) grid

-- Given a StdGen, generate a random grid
generateGrid g = do
  let sequence = randomRs (True, False) g
  let mapSequence = sequenceToString sequence
  makeRect mapSequence

-- Given a list of lists (i.e. a grid) print each list as a line
printGrid = mapM_ putStrLn

-- Given a sequence of characters turn it into a grid of width * height
makeRect randomSequence = chunksOf width $ take (width * height) randomSequence

main = do
  g <- newStdGen
  let grid = generateGrid g
  printGrid $ (iterate iterateGrid grid) !! 4

cellular_test.hs

module CellularTest where

import Test.HUnit
import Cellular hiding (main)

startingMap :: [String]
startingMap = [".#.#..#..###.#.#...##.#..#.##..######.#.##.##.#.#.#..##....#.....##..####....#.#",
               ".###.###..#...###..#...#.#..#.#...##.#.##.#.####..#.........###.##..#.##.#.#.#.#",
               "###...##.##.#.###..#..######...#..###..###.##.###...##....##.###..###.#..#...#.#",
               "#######.#...#..##.##.#.#..#..####...##..###...##..#...####.##..#.#.#..####....##",
               "#.####.#..#....##..#..##.#...#..#.....###.#...##..######.##.##.#...#.##......##.",
               "#.##.#........#.###...#.####.#...#..#..#..##.###.####..###...#..##.#####...##..#",
               ".###.#.##..######..#.#..##.##..##.#.#.###..##..##..###.#.####..#.##.#.##...###..",
               "#.......#.#...###..#.######...#..##..#..#.###..#..#...#####.##.#.##..##.##....#.",
               "###.##.####..#..#####..#.####..#.#..##...###....######.##.###...#.#..##.#......#",
               "##.##..##...###...#.#..##.#....#....#####...##..##.##.##...##..##.#.#...##.#....",
               "######..##.#..#..#.###..#......##...#.##......#.#.####.##.....#.#.#..#.###..##..",
               "..##..##.#...###.#.#...##..#..##.##...###.#.#######.##.#....#.###.#####....#.#.#",
               "###...#.##...###.###...####.#.#..#....#.##...#.###..#...##..#.#.##.##.###.###..#",
               "#....#.#..#..###.#.#.#..#######.##..#..###.###.#.##..#########..#.##..#####.#..#",
               ".###.#.#.#..##.##.####.#.#.#.....###.#.#..#.###..##.#...##.#.##.#.##.#.###.#...#",
               "#...########.##.#####..##.#.##.##..#.#.#.#.#.#.#..##.###..##..####.##.#######...",
               "##.##...#..###..#..##...#.#.###......##...#.#.....##.....##...###....#.##.#.##..",
               ".####.##......##....#...##...#.#....#.###.#.#.....#.###.##.#.###.##.##.###..##..",
               "..###.#..###.####....#.##.###..#.#..#......##.#.###..###.##...#..##.#..######.#.",
               "...########.#.###.##..##..##..#.#####.#.#..##.########..##.#..#.#.....##...#...#",
               "#..#.##.##.##.#.##.#......###.#...#.#.#.######.#####..##....##...##...####.#..##",
               ".##.....##.###.#.#.#.##.#.##.####...##.###.#..###.#..##.#.#.##..##.##.###.#####.",
               ".#..#..#.##.#.#..#.##...#.##.#..##.###.####..###.#.#.#.##.#..#.####.#.#.#..##..#",
               "##..######.#..#.#.#..###.....#.#.#...#...##.#...#.#.###.#..####.####....###..#..",
               "#.#####.........###.#..#.#........#.##.##.....##.#..#....#..#.#.#....#.####.#.##"]

thirdIteration :: [String]
thirdIteration = ["#######################################################...######################",
                  "##################...#######..###################.........################...###",
                  "#########.....####....#####...........##########..........###############.....##",
                  "########.......###....#####............#########...#####################......##",
                  "#######........###....#####............#####..################...#######......##",
                  "######........####....######............####..###############....#######......##",
                  "####.........######..#######.............####..##############...########.......#",
                  "####.........###############..............###..##############...#########......#",
                  "####....#....##############..........##....#...#############....###..####......#",
                  "####...###...#############...........###.......###########......###..####.......",
                  "####...###...########..###...........####.....###########......###########......",
                  "####...##....#######...####...###.....###....#############....##############...#",
                  "###...###....#######...###########.....##...################################...#",
                  "####.#####..########....#########......##..#########..######################...#",
                  "#####################...#######........#...####..####.######################...#",
                  "####################....######........##...###....###########################...",
                  "##################......######..............##....##########.#################..",
                  "#################.......######..............##...##########...####...#########..",
                  "#################.......######.............###############.....##.....##########",
                  "##.###############.......#####.....###....###############.............##########",
                  "#...##############........#####....#####################..............##########",
                  "#....##############........#####...#####################.....######...##########",
                  "##...########...#####........###...######################..#########..##########",
                  "############....########......###.##############################################",
                  "#############..##########....###################################################"]

testIteration = TestCase $ assertEqual "iterate map" ((iterate iterateGrid startingMap) !! 4) thirdIteration

main = runTestTT $ TestList [testIteration]

output.txt

################################################################################
#.....###########################..###########...############################.##
#......#############...#########.....########....#################....######...#
#.......####....####.....#######......#######....#######.########......#####...#
#........#......####......######.......######....######...#######......####....#
##...............###......######........#####.....#####...#######.....#####....#
######....................#####.....................###..#######.....#####.....#
######...................######......................#########......######.....#
######..................#######...............###....#########.....#######.....#
######..............###########...............####...#########....########....##
#####..............############..............####....#########....#########...##
#####.............########.####.............#####....#########....##########...#
#####............#######....###........##..#######..##########.....##.#######...
#####.............#####.....####......#######################..........######...
#####..............####.....#####.....#####....#############...........######..#
#######............#####...######....######.....############...........#####...#
########..........############.......######.....#####..#####...........####...##
########.........############........#######...#####....#####...####....###.####
########.....################........##############.....#############.....######
########....#################.........#############......############.....######
#########..#################......##...##...#######.......###########.....######
########################.........###.........########......##########.....######
#######################.........####..........########.....##########.....######
#######################.......######..........##########...###########...#######
#####################################..#########################################