1 files changed, 64 insertions, 0 deletions
diff --git a/2020/17a.hs b/2020/17a.hs
new file mode 100644
index 0000000..d888379
--- /dev/null
+++ b/2020/17a.hs
@@ -0,0 +1,64 @@
+module Day17A where
+
+import System.Environment (getArgs)
+import Text.Printf
+import qualified Data.Map.Strict as Map
+
+-- Types
+type Coord = (Int, Int, Int);
+type ActiveMap = Map.Map Coord Bool
+
+-- Add two coords
+addCoord :: Coord -> Coord -> Coord
+addCoord (x, y, z) (x', y', z') = (x + x', y + y', z + z')
+
+-- The range of cubes that need to be simulated.
+consideredRange :: ActiveMap -> (Coord, Coord)
+consideredRange m = (addCoord (Map.foldrWithKey (compCoord min) (0, 0, 0) m) (-1, -1, -1),
+                     addCoord (Map.foldrWithKey (compCoord max) (0, 0, 0) m) (1, 1, 1))
+    where compCoord f (x', y', z') _ (x, y, z) = (f x' x, f y' y, f z' z)
+
+-- The neighbours of the given cube
+neighbours :: Coord -> [Coord]
+neighbours (x, y, z) = [(x', y', z') | x' <- [x-1..x+1],
+                                       y' <- [y-1..y+1],
+                                       z' <- [z-1..z+1],
+                                       x' /= x || y' /= y || z' /= z]
+
+-- Simulate the cube at the given coord
+simulateCube :: ActiveMap -> Coord -> Bool
+simulateCube m c | s && n `elem` [2..3] = True
+                 | n == 3 = True
+                 | otherwise = False
+      where s = Map.findWithDefault False c m
+            n = length $ filter (== True) $ map (\x -> Map.findWithDefault False x m) (neighbours c)
+
+-- Run one cycle of simulation
+runCycle :: ActiveMap -> ActiveMap
+runCycle m = foldr (\(k, v) m' -> Map.insert k v m') m changes -- Run all changes simultaneously
+      where ((lx, ly, lz), (hx, hy, hz)) = consideredRange m
+            changes = [((x, y, z), simulateCube m (x, y, z)) | x <- [lx..hx], y <- [ly..hy], z <- [lz..hz]]
+
+-- Parse the input
+parseInput :: String -> ActiveMap
+parseInput xs = foldr (\c m -> Map.insert c True m) Map.empty coords
+      where ls = zip (lines xs) [0..]
+            coords = concatMap (\(hs, y) -> [(x, y, 0) | ('#', x) <- zip hs [0..]]) ls
+
+-- Read and parse given filename
+parseFromFile :: String -> IO ActiveMap
+parseFromFile s = do 
+                   contents <- readFile s;
+                   return $ parseInput contents;
+
+-- runghc 17a.hs inputs/day17
+main :: IO ()
+main = do 
+        args <- getArgs;
+        i <- parseFromFile (head args);
+
+        let final = foldr (\_ m -> runCycle m) i [1..6];
+
+        printf "Answer = %d\n" (Map.size $ Map.filter (== True) final) :: IO ();
+
+        return ();