Cellular automata

cellularautomata.hs

#!/usr/bin/env stack
-- stack script --resolver lts-10.5
{-# LANGUAGE DeriveFunctor #-}

import Data.List
import Control.Comonad
import System.Random
import System.Environment

data Zipper a = Zipper [a] a [a]
  deriving (Functor)

left, right :: Zipper a -> Zipper a
left (Zipper (l:ls) x rs) = Zipper ls l (x:rs)
right (Zipper ls x (r:rs)) = Zipper (x:ls) r rs

instance Comonad Zipper where
  extract (Zipper _ x _) = x
  duplicate u = Zipper (tail $ iterate left u) u (tail $ iterate right u)

digits :: Int -> [Int]
digits n = take 8 $ unfoldr (\k -> Just (k `mod` 2, k `div` 2)) n

rule :: Int -> (Int,Int,Int) -> Int
rule ruleNumber (a,b,c) = (digits ruleNumber) !! (a*4 + b*2 + c)

applyRule :: Int -> Zipper Int -> Zipper Int
applyRule ruleNumber z = extend f z
  where f (Zipper (l:ls) x (r:rs)) = rule ruleNumber (l,x,r)

extractWidth :: Int -> Zipper a -> [a]
extractWidth n u =
  (reverse . tail . take n . fmap extract $ iterate left u) ++
  (take n . fmap extract $ iterate right u)

printCA :: [Int] -> IO ()
printCA l =
  putStrLn $ concatMap (\k -> if k==0 then " " else "█") l

randomZipper :: (RandomGen g) => g -> Zipper Int
randomZipper g =
  let l = randomRs (0,1) g
      r:rs = randomRs (0,1) g
  in Zipper l r rs

main :: IO ()
main = do
  r <- read . head <$> getArgs
  --let z = Zipper (repeat 0) 1 (repeat 0)
  g <- newStdGen
  let z = randomZipper g
  --print $ extractWidth 5 z
  mapM_ printCA . take 40 . fmap (extractWidth 50) $ iterate (applyRule r) z