-
Notifications
You must be signed in to change notification settings - Fork 5
/
Day21.hs
69 lines (56 loc) · 1.95 KB
/
Day21.hs
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
{-# LANGUAGE RankNTypes #-}
module AOC2017.Day21 (day21a, day21b) where
import AOC2017.Types (Challenge)
import AOC2017.Util ((!!!), strip)
import Data.List (transpose)
import Data.List.Split (chunksOf, splitOn)
import qualified Data.Map as M
type Grid = [[Bool]]
type Rules = M.Map Grid Grid
-- | Split a grid into a grid of subgrids
splitGrid :: Int -> Grid -> [[Grid]]
splitGrid n = transpose
. map (map transpose . chunksOf n . transpose)
. chunksOf n
-- | Join a grid of subgrids into a grid
joinGrid :: [[Grid]] -> Grid
joinGrid = transpose . concatMap (transpose . concat)
step :: Rules -> Grid -> Grid
step r g = joinGrid . (map . map) (r M.!) . splitGrid n $ g
where
n | length g `mod` 2 == 0 = 2
| length g `mod` 3 == 0 = 3
| otherwise = error "hello there"
day21 :: Int -> Rules -> Int
day21 n r = length . filter id . concat
$ iterate (step r) grid0 !!! n
where
grid0 = map (== '#') <$> [".#.","..#","###"]
day21a :: Challenge
day21a = show . day21 5 . parse
day21b :: Challenge
day21b = show . day21 18 . parse
-- | All 8 symmetries (elements of D8)
--
-- Generated by r, r^2, r^3, r^4, and flip times all of those
--
-- Thanks to https://en.wikipedia.org/wiki/Dihedral_group_of_order_8
symmetries :: Grid -> [Grid]
symmetries g = do
r <- take 4 (iterate rot90 g) -- from the four rotations
[r, mirror r] -- ... include the rotation plus its flip
where
-- rotate 90 degrees
rot90 = map reverse . transpose
-- flip
mirror = reverse
parse :: String -> Rules
parse = M.unions . map (M.fromList . parseLine) . lines
where
parseLine :: String -> [(Grid, Grid)]
parseLine (map(splitOn "/".strip).splitOn"=>"->[xs,ys]) =
[ (g, gridOut) | g <- symmetries gridIn ]
where
gridIn = fmap (== '#') <$> xs
gridOut = fmap (== '#') <$> ys
parseLine _ = error "No parse"