From 0d3100b1523321a142067b40b2d906c7b307598b Mon Sep 17 00:00:00 2001
From: Xiretza <xiretza@xiretza.xyz>
Date: Sat, 19 Dec 2020 13:13:13 +0100
Subject: [PATCH] 2020 day17/haskell: add solution

---
 2020/README.md           |  2 +-
 2020/data/day17.expected |  2 ++
 2020/data/day17.input    |  8 ++++++++
 2020/day17/day17.hs      | 40 ++++++++++++++++++++++++++++++++++++++++
 4 files changed, 51 insertions(+), 1 deletion(-)
 create mode 100644 2020/data/day17.expected
 create mode 100644 2020/data/day17.input
 create mode 100644 2020/day17/day17.hs

diff --git a/2020/README.md b/2020/README.md
index 0a2a538..38b5c08 100644
--- a/2020/README.md
+++ b/2020/README.md
@@ -22,7 +22,7 @@ https://adventofcode.com/2020/
 |14 |        |  `**`   |      |
 |15 |  `**`  |         |      |
 |16 |        |  `**`   |      |
-|17 |        |         |      |
+|17 |        |  `**`   |      |
 |18 |        |  `**`   |      |
 |19 |        |  `**`   |      |
 
diff --git a/2020/data/day17.expected b/2020/data/day17.expected
new file mode 100644
index 0000000..44e48f7
--- /dev/null
+++ b/2020/data/day17.expected
@@ -0,0 +1,2 @@
+359
+2228
diff --git a/2020/data/day17.input b/2020/data/day17.input
new file mode 100644
index 0000000..0c25bb3
--- /dev/null
+++ b/2020/data/day17.input
@@ -0,0 +1,8 @@
+.##..#.#
+#...##.#
+##...#.#
+.##.##..
+...#.#.#
+.##.#..#
+...#..##
+###..##.
diff --git a/2020/day17/day17.hs b/2020/day17/day17.hs
new file mode 100644
index 0000000..59c35a1
--- /dev/null
+++ b/2020/day17/day17.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, DataKinds #-}
+
+module Day17 where
+
+import AoC
+
+import Data.List
+import Data.Vector.Sized (Vector)
+import qualified Data.Vector.Sized as V
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Set (Set)
+import qualified Data.Set as S
+
+class Index i where
+    neighbours :: i -> [i]
+    addIndex :: i -> i -> i
+
+instance (Num a, Eq a) => Index (Vector n a) where
+    neighbours i = filter (/= i) . V.mapM (flip map [-1, 0, 1] . (+)) $ i
+    addIndex = V.zipWith (+)
+
+counts :: Ord a => [a] -> Map a Int
+counts = M.fromList . map (\xs -> (head xs, length xs)) . group . sort
+
+neighbourCounts :: (Index i, Ord i) => Set i -> Map i Int
+neighbourCounts = counts . concatMap neighbours . S.elems
+
+update :: (Index i, Ord i) => (Int -> Bool) -> (Int -> Bool) -> Set i -> Set i
+update create destroy old = M.keysSet $ M.filterWithKey shouldLive $ M.fromSet (flip (M.findWithDefault 0) nCounts) indices
+    where nCounts = neighbourCounts old
+          indices = S.union old $ M.keysSet nCounts
+          shouldLive ix n = if S.notMember ix old then create n else not $ destroy n
+
+run6 :: (Index i, Ord i) => Set i -> Int
+run6 = S.size . (!! 6) . iterate (update (==3) (`notElem` [2, 3]))
+
+main = runAoC (toIndices . lines) (run6 . S.fromList . map extendIndex) (run6 . S.fromList . map (extendIndex . extendIndex))
+    where toIndices input = [V.fromTuple (row, col) :: Vector 2 Int | (row, line) <- zip [0..] input, (col, '#') <- zip [0..] line]
+          extendIndex = V.cons 0