Name:
Anonymous
2007-09-08 12:44
ID:fuIqtYYp
import qualified Data.Map as M
type Location = (Int,Int)
main = renderloop [(1,2),(2,3),(3,1),(3,2),(3,3)]
where renderloop = mapM_ (\v -> render 20 v >> getLine) . iterate count
count :: [Location] -> [Location]
count locs = M.keys live ++ [v| v <-locs, M.member v still]
where neighborCount = foldl foldFun M.empty . concatMap allNeighbors
(live,still) = M.partition (== 3) . M.filter (`elem` [2,3]) . neighborCount $ locs
foldFun :: M.Map Location Int -> Location -> M.Map Location Int
foldFun map loc = M.insertWith (+) loc 1 map
allNeighbors :: Location -> [Location]
allNeighbors (x,y) = [(nx,ny) | nx <- [x+1,x-1,x], ny <- [y+1,y-1,y], (x,y) /= (nx,ny) ]
render size locs = mapM_ (putStrLn . makeRow locs size) (reverse [0..size])
makeRow locs wid r = map (\x -> if x `elem` inds then '#' else '.') [0..wid]
where inds = [j | (p,j) <- locs, p == r]
:)
Name:
Anonymous
2007-09-08 16:52
ID:rgB/27LD
(defun init-board (board)
(dolist (coord (quote ((1 . 2) (2 . 3) (3 . 1) (3 . 2) (3 . 3))) board)
(setf (aref board (car coord) (cdr coord)) (quote @))))
(defun count-life (board &aux (size (array-dimensions board)))
(let ((counts (make-array size :initial-element 0)))
(dotimes (y (first size) counts)
(dotimes (x (second size))
(dolist (c- (loop for xd from -1 to 1
nconc (loop for yd from -1 to 1
unless (= xd 0 yd)
collect (cons (+ x xd) (+ y yd)))))
(when (eql (quote @) (handler-case (aref board (car c-) (cdr c-)) (error)))
(incf (aref counts x y))))))))
(defun iterate-life (board &aux (size (array-dimensions board)) (counts (count-life board)))
(dotimes (y (first size) board)
(dotimes (x (second size))
(let ((count (aref counts x y)))
(setf (aref board x y)
(if (or (= 3 count) (and (eql (quote @) (aref board x y)) (= 2 count))) (quote @) (quote _)))))))
(defun main (&optional (board (init-board (make-array (quote (20 20)) :initial-element (quote _)))))
(print board) (sleep 0.1) (main (iterate-life board)))