Game of Life in Haskell

又叫cellular automation，详见matchworld的介绍：
http://mathworld.wolfram.com/Life.html

module GameOfLife (initWorld, evolve, Cell, Board, Location, World)
where

import Data.List

-- Data types to be used represent the world state in the Game of Life
-- -------------------------------------------------------------------

-- Type used to denote a single cell on the board
--
-- * The value `True' represents live cells

type Cell = Bool

-- Representation of the board on which the Game of Life unfolds
--
-- * Each sublist represents a column of the board
--
-- * The cell represented by the the first element of the first column is
--   located at the lower left corner of the board when displayed

type Board = [[Cell]]

-- The type used to index the board in the Game of Life
--
-- * The location "(0, 0)" represents the lower left corner of the board (ie,
--   the origin of the world)

type Location = (Int, Int)

-- Representation of the world
--
-- * The location determines the index of top right corner of the board (ie,
--   the corner opposite of the origin); indicies for the board can range from
--   "(0,0)" up to that location.

type World = (Location, Board)

-- The main functions
-- ------------------

-- Initialise the world from a string
--
-- * The character '*' represents live cells
--
-- * The characeter '.' represents dead cells
--
-- * Each row of the board is terminated by a newline
--
-- initWorld ".*./n.*./n***/n" 
--   => 
-- ((2,2),[[True,False,False],[True,True,True],[True,False,False]])
--
-- We shall call this "worldExample" in the following comments.
--

initWorld :: String -> World
initWorld s = (getLocation(getBoard s), getBoard s)

-- Given a world in the game, produce the next state of the world
--
-- evolve ((2,2),[[True,False,False],[True,True,True],[True,False,False]])
--  =>
-- ((2,2),[[True,False,False],[True,False,False],[True,False,False]])

evolve :: World -> World
evolve w = (l,b)
    where l = fst w
          b = getMatrix l (evolveToList w)

-- Some auxilliary functions for computing new world states
-- --------------------------------------------------------

-- Given a game world and a location, yield the liveness at that location
--
-- getCell worldExample (0,1) => False
-- getCell worldExample (1,1) => True
-- getCell worldExample (5,5) => *** Exception: Cell (5,5) is out of bounds
--

getCell :: World -> Location -> Cell
getCell w (x,y) = 
    if isOutOfBound w (x,y)
        then error ("Cell " ++ show (x,y) ++ " is out of bounds")
        else ((snd w)!!x)!!y

-- Update a location in the world with the given liveness
--
-- setCell worldExample (0,0) False 
--  =>
-- ((2,2),[[False,False,False],[True,True,True],[True,False,False]])
-- setCell worldExample (3,4) True 
--   => 
-- *** Exception: Cell (3,4) is out of bounds
--

setCell :: World -> Location -> Cell -> World
setCell (l,b) (x,y) c = 
    if isOutOfBound (l,b) (x,y)
        then error ("Cell " ++ show (x,y) ++ " is out of bounds")
        else (l,
        (take x b)++((take y (b!!x))++c:(drop (y+1) (b!!x))):(drop (x+1) b))

-- Compute the next-generation state for the cell at the given location
-- 
-- evolveCell worldExample (1,1) => False
-- evolveCell worldExample (2,0) => True

evolveCell :: World -> Location -> Cell
evolveCell w (x,y) 
    | chkNeighbor w (x,y) > 3 || 
      chkNeighbor w (x,y) < 2                               = False
    | chkNeighbor w (x,y) == 2 && (not (mygetCell w (x,y))) = False
    | chkNeighbor w (x,y) == 3 && (not (mygetCell w (x,y))) = True
    | otherwise = True

showWorld :: World -> String
showWorld (_, board) =
  unlines (map (map toChar) board')
  where
    board' = reverse (transpose board)
    toChar True = '*'
    toChar False ='.'

{-=======================self-defined functions=============================-}

-- create board from string
getBoard :: String -> Board
getBoard s = transpose (reverse (map (map toBool) (lines(s))))
	where toBool '*' = True
	      toBool '.' = False

-- then retrieve the location index from the board
getLocation :: Board -> Location
getLocation b = (length b - 1, (maximum(map length(b))) - 1)

--other than throw exception, assuming board surrounded by dead cells
isOutOfBound :: World -> Location -> Bool
isOutOfBound ((a,b),_) (x,y) = if x>=0 && x<=a && 
                                  y>=0 && y<=b then False
                                               else True

-- same as above, omit the exception
mygetCell :: World -> Location -> Cell
mygetCell w (x,y) | isOutOfBound w (x,y) = False
                  | otherwise            = ((snd w)!!x)!!y

-- clockwise, never fail
chkNeighbor :: World -> Location -> Int
chkNeighbor w (x,y) = length (filter (==True)
    [mygetCell w (x+1,y),  mygetCell w (x+1,y+1),mygetCell w (x,y+1),
     mygetCell w (x-1,y+1),mygetCell w (x-1,y),  mygetCell w (x-1,y-1),
     mygetCell w (x,y-1),  mygetCell w (x+1,y-1)])

-- create the 2-d matrix from the 1-d array
getMatrix :: Location -> [Cell] -> Board
getMatrix (x,y) c | c==[] =[]
                  | otherwise =take (y+1) c:getMatrix (x,y) (drop (y+1) c)

-- create the new world, but it's an 1-d array                  
evolveToList :: World -> [Cell]
evolveToList ((xs,ys),b) = 
               map (evolveCell ((xs,ys),b)) [(x,y)| x<-[0..xs],y<-[0..ys]]

-- for testing, can indicate the generation want to get.
epoch :: World -> Int -> World
epoch w i | i < 0  = error "negative epoch, seeking parent? :)"
          | i == 0 = w
          | i == 1 = evolve w
          | otherwise = epoch (evolve w) (i-1)

很久以前的东西，一直都忘记发出来，现在自己都看不太懂了，语法都忘记光啦：（