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
  2. import Control.Comonad
  3. import Control.Comonad.Store
  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 = "#"
  50.   show Dead = "."
  51.  
  52. cell :: Bool -> Cell
  53. cell True = Alive
  54. cell False = Dead
  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
  90.     ( Vec.fromTuple (Dead, Dead, Alive)
  91.     , Vec.fromTuple (Alive, Alive, Alive)
  92.     , Vec.fromTuple (Dead, Dead, Dead)
  93.     )
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top