Ticket #3334: Cell.hs

File Cell.hs, 888 bytes (added by crutcher, 5 years ago)

Program which triggered this

Line 
1import Control.Applicative
2import Control.Parallel.Strategies
3import Data.List
4
5type CellState a = [a]
6
7type Transition a = (a, a, a) -> a
8
9type Border a = (a, a)
10
11type BorderFunction a = CellState a -> Border a
12
13evolve :: Transition a -> Border a -> CellState a -> CellState a
14evolve tf (leftBorder, rightBorder) cs = map tf neighborhoods
15  where
16  neighborhoods = zip3 cs' (tail cs') (tail $ tail cs')
17  cs' = leftBorder : cs ++ [rightBorder]
18
19evolveBorders :: Transition a -> BorderFunction a -> CellState a -> CellState a
20evolveBorders tf bf cs = evolve tf (bf cs) cs
21
22mirror :: BorderFunction a
23mirror cs = (last cs, head cs)
24
25rotateLeft :: Transition a
26rotateLeft (_, _, r) = r
27
28rotateRight :: Transition a
29rotateRight (l, _, _) = l
30
31
32main = do
33  let s0 = [1..1000]
34  let step = evolveBorders rotateLeft mirror
35  let ss = iterate step s0
36  print (head $ ss !! 10001) -- expect "2"
37