• API
• FAQ
• Tools
• Archive
SHARE
TWEET # life kcsmnt0  Feb 13th, 2020 143 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. import Control.Applicative
4. import Data.Finite
5. import Data.Foldable
6. import Data.Maybe
7. import qualified Data.Vector.Sized as Vec
8. import Data.Vector.Sized (Vector)
9. import GHC.TypeNats
10.
11. type Index x y = (Finite x, Finite y)
12. type KnownSize x y = (KnownNat x, KnownNat y)
13.
14. newtype Grid x y a = Grid { grid :: Vector x (Vector y a) }
15.   deriving Functor
16.
17. instance (Show a, KnownSize x y) => Show (Grid x y a) where
18.   show = unlines . map unwords . map toList . toList . grid . fmap show
19.
20. inc :: KnownNat n => Finite n -> Maybe (Finite n)
21. inc = strengthen . shift
22.
23. dec :: KnownNat n => Finite n -> Maybe (Finite n)
24. dec = unshift . weaken
25.
26. neighboringCells :: KnownSize x y => Index x y -> [Index x y]
27. neighboringCells (i,j) =
28.   catMaybes \$ map (uncurry (liftA2 (,)))
29.     [ (dec i,  dec j),  (dec i, Just j), (dec i,  inc j)
30.     , (Just i, dec j),                   (Just i, inc j)
31.     , (inc i,  dec j),  (inc i, Just j), (inc i,  inc j)
32.     ]
33.
34. everywhere :: KnownSize x y => Grid x y (Index x y)
35. everywhere = Grid \$ Vec.generate \$ \i -> Vec.generate \$ \j -> (i,j)
36.
37. type ComonadGrid x y w = (ComonadStore (Index x y) w, KnownSize x y)
38.
39. neighbors :: ComonadGrid x y w => w a -> [a]
40. neighbors = experiment neighboringCells
41.
42. retrieve :: ComonadGrid x y w => w a -> Grid x y a
43. retrieve = experiment (const everywhere)
44.
45. data Cell = Alive | Dead
46.   deriving Eq
47.
48. instance Show Cell where
49.   show Alive = "#"
51.
52. cell :: Bool -> Cell
53. cell True = Alive
55.
56. alive :: Cell -> Bool
57. alive = (Alive ==)
58.
59. population :: ComonadGrid x y w => w Cell -> Int
60. population = length . filter alive . neighbors
61.
62. rule :: ComonadGrid x y w => w Cell -> Cell
63. rule w =
64.   case extract w of
65.     Alive -> cell (population w `elem` [2,3])
66.     Dead -> cell (population w == 3)
67.
68. index :: Grid x y a -> Index x y -> a
69. index (Grid g) = uncurry (Vec.index . Vec.index g)
70.
71. type GridStore x y = Store (Index x y)
72.
73. gridStore :: Grid x y a -> GridStore x y a
74. gridStore g = store (index g) (error "nowhere")
75.
76. underGrid ::
77.   KnownSize x y =>
78.   (GridStore x y a -> GridStore x y b) ->
79.   Grid x y a -> Grid x y b
80. underGrid f = retrieve . f . gridStore
81.
82. generate :: KnownSize x y => (GridStore x y a -> a) -> Grid x y a -> [Grid x y a]
83. generate = iterate . underGrid . extend
84.
85. generations :: KnownSize x y => Grid x y Cell -> [Grid x y Cell]
86. generations = generate rule
87.
88. test =
89.   Grid \$ Vec.fromTuple