eldridge.cam
Advent of Code solutions
1{-# LANGUAGE FlexibleInstances #-}
2import Control.Monad
3import Data.Maybe
4
5tile :: Char -> Bool
6tile '#' = True
7tile '.' = False
8
9update :: Int -> Bool -> Bool
10update 2 True = True
11update 3 _ = True
12update _ _ = False
13
14class Remake i where
15 remake :: i -> i
16instance Remake Bool where
17 remake = const False
18instance (Functor f, Remake i) => Remake (f i) where
19 remake = fmap remake
20
21class Expand e where
22 expand :: e -> e
23instance (Remake e, Expand e) => Expand [e] where
24 expand e = remake (head a) : a ++ [remake (last a)]
25 where a = fmap expand e
26instance Expand Bool where
27 expand = id
28
29(!?) :: [a] -> Int -> Maybe a
30(!?) l x | x < 0 = Nothing
31(!?) l x | x >= length l = Nothing
32(!?) l x = Just (l !! x)
33
34cycleOnce :: [[[[Bool]]]] -> [[[[Bool]]]]
35cycleOnce state = run (expand state)
36
37neighbours :: [[[[Bool]]]] -> (Int, Int, Int, Int) -> Int
38neighbours space (x, y, z, w) = count [space !? ww >>= (!? zz) >>= (!? yy) >>= (!? xx) | xx <- [x-1..x+1],
39 yy <- [y-1..y+1],
40 zz <- [z-1..z+1],
41 ww <- [w-1..w+1],
42 xx /= x || yy /= y || zz /= z || ww /= w]
43 where count = length . filter id . catMaybes
44
45run :: [[[[Bool]]]] -> [[[[Bool]]]]
46run hyperspace = [[[[next (x, y, z, w) value | (x, value) <- [0..] `zip` row]
47 | (y, row) <- [0..] `zip` plane]
48 | (z, plane) <- [0..] `zip` space]
49 | (w, space) <- [0..] `zip` hyperspace]
50 where
51 next :: (Int, Int, Int, Int) -> Bool -> Bool
52 next = update . neighbours hyperspace
53
54cycles :: Int -> [[[[Bool]]]] -> [[[[Bool]]]]
55cycles 0 state = state
56cycles n state = cycles (n - 1) $ cycleOnce state
57
58main :: IO ()
59main = do
60 contents <- fmap (fmap tile) . lines <$> getContents
61 print . length . filter id . join . join . join $ cycles 6 [[contents]]