From ecf8c1f7b7aee2a4f27ba95eec81192a7bbf154b Mon Sep 17 00:00:00 2001
From: Joscha <joscha@plugh.de>
Date: Fri, 18 Dec 2020 17:02:03 +0000
Subject: [PATCH] [hs] Solve 2020_17 part 1

---
 hs/src/Aoc/Y2020.hs     |  2 ++
 hs/src/Aoc/Y2020/D17.hs | 57 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 59 insertions(+)
 create mode 100644 hs/src/Aoc/Y2020/D17.hs

diff --git a/hs/src/Aoc/Y2020.hs b/hs/src/Aoc/Y2020.hs
index e9936f5..264f9cd 100644
--- a/hs/src/Aoc/Y2020.hs
+++ b/hs/src/Aoc/Y2020.hs
@@ -19,6 +19,7 @@ import qualified Aoc.Y2020.D13 as D13
 import qualified Aoc.Y2020.D14 as D14
 import qualified Aoc.Y2020.D15 as D15
 import qualified Aoc.Y2020.D16 as D16
+import qualified Aoc.Y2020.D17 as D17
 import qualified Aoc.Y2020.D18 as D18
 
 year :: Year
@@ -39,5 +40,6 @@ year = Year 2020
   , (14, D14.day)
   , (15, D15.day)
   , (16, D16.day)
+  , (17, D17.day)
   , (18, D18.day)
   ]
diff --git a/hs/src/Aoc/Y2020/D17.hs b/hs/src/Aoc/Y2020/D17.hs
new file mode 100644
index 0000000..4d76a0c
--- /dev/null
+++ b/hs/src/Aoc/Y2020/D17.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections     #-}
+
+module Aoc.Y2020.D17
+  ( day
+  ) where
+
+import qualified Data.Set  as Set
+
+import           Aoc.Day
+import           Aoc.Parse
+
+parser :: Parser [[Bool]]
+parser = manyLines $ many $ (False <$ char '.') <|> (True <$ char '#')
+
+type Pos = (Int, Int, Int)
+type World = Set.Set Pos
+
+newWorld :: [[Bool]] -> World
+newWorld
+  = Set.fromList
+  . map fst
+  . filter snd
+  . concat
+  . zipWith (\y -> zipWith (\x -> ((x, y, 0),)) [0..]) [0..]
+
+vicinity :: Pos -> [Pos]
+vicinity (x, y, z) = (,,) <$> [x - 1, x, x + 1] <*> [y - 1, y, y + 1] <*> [z - 1, z, z + 1]
+
+neighbours :: Pos -> [Pos]
+neighbours p = [p2 | p2 <- vicinity p, p2 /= p]
+
+interesting :: World -> Set.Set Pos
+interesting w = Set.fromList $ vicinity =<< Set.toList w
+
+alive :: Bool -> Int -> Bool
+alive True  2 = True
+alive True  3 = True
+alive False 3 = True
+alive _     _ = False
+
+step :: World -> World
+step w = Set.filter go $ interesting w
+  where
+    go p = alive (p `Set.member` w) (length $ filter (`Set.member` w) $ neighbours p)
+
+steps :: World -> World
+steps = foldr (.) id $ replicate 6 step
+
+solver :: [[Bool]] -> IO ()
+solver slice = do
+  putStrLn ">> Part 1"
+  let world = newWorld slice
+  print $ Set.size $ steps world
+
+day :: Day
+day = dayParse parser solver