1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ViewPatterns #-}
module Main where
import qualified Data.Array.Unboxed as A
import Data.List (delete)
import qualified Data.Ix as Ix
import Data.Ix (Ix)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Word (Word8)
import Input
generate :: Ix i => (i, i) -> (i -> e) -> A.Array i e
generate r f = A.array r [(i, f i) | i <- Ix.range r]
(!?) :: Ix i => A.Array i e -> i -> Maybe e
arr !? i | Ix.inRange (A.bounds arr) i = Just (arr A.! i)
| otherwise = Nothing
class Ix i => Coordinate i where
expand1 :: (i, i) -> (i, i)
neighbourhood :: i -> [i]
instance Coordinate () where
expand1 = id
neighbourhood = pure
instance Coordinate i => Coordinate (i, Int) where
expand1 ((idx1, i1), (idx2, i2)) =
let (idx1', idx2') = expand1 (idx1, idx2)
in ((idx1', i1 - 1), (idx2', i2 + 1))
neighbourhood (idx, i) = [(idx', i + di) | idx' <- neighbourhood idx, di <- [-1..1]]
newtype Board i = Board (A.Array i Word8)
deriving (Show)
fromInput :: [String] -> Board (((), Int), Int)
fromInput lns =
let w = length (head lns)
h = length lns
in Board (A.array ((((), 0), 0), (((), w - 1), h - 1))
[((((), x), y), b2w (c == '#')) | (y, row) <- zip [0..] lns, (x, c) <- zip [0..] row])
where b2w = fromIntegral . fromEnum :: Bool -> Word8
backpermute :: (Ix i, Ix j) => (j, j) -> (j -> i) -> Board i -> Board j
backpermute r f (Board arr) = Board (generate r (\j -> arr A.! f j))
addDimension :: Coordinate i => Board i -> Board (i, Int)
addDimension (Board arr@(A.bounds -> (i, j))) = backpermute ((i, 0), (j, 0)) fst (Board arr)
evolve :: Coordinate i => Board i -> Board i
evolve (Board prev) = Board vec
where vec = generate (expand1 (A.bounds prev))
(\index ->
let cell = fromMaybe 0 (prev !? index)
nb = sum (catMaybes (map (prev !?) (delete index (neighbourhood index))))
in if (cell /= 0 && nb == 2) || nb == 3 then 1 else 0)
numActive :: Ix i => Board i -> Int
numActive (Board arr) = sum (map fromIntegral (A.elems arr))
main :: IO ()
main = do
bd2 <- fromInput <$> getInput 17
let bd3 = addDimension bd2
bd4 = addDimension bd3
print (numActive (iterate evolve bd3 !! 6))
print (numActive (iterate evolve bd4 !! 6))
|
