Day 22

day22/Commons.hs

@@ -0,0 +1,59 @@
+module Commons where
+
+import Data.List.Utils (split)
+import GHC.IO.Handle (isEOF)
+import qualified Data.Map.Strict as M
+
+
+data Cube = Cube { z :: Int, y :: Int, x :: Int } deriving (Eq, Ord, Show)
+type Brick = [Cube]
+type Snapshot = M.Map (Int, Int, Int) Brick
+
+
+parseBrick :: [Int] -> [Int] -> Brick
+parseBrick [x1, y1, z1] [x2, y2, z2] = Cube {x = x1, y = y1, z = z1}:
+  if x1 < x2 then parseBrick [x1 + 1, y1, z1] [x2, y2, z2]
+  else if x1 > x2 then parseBrick [x1, y1, z1] [x2 + 1, y2, z2]
+  else if y1 < y2 then parseBrick [x1, y1 + 1, z1] [x2, y2, z2]
+  else if y1 > y2 then parseBrick [x1, y1, z1] [x2, y2 + 1, z2]
+  else if z1 < z2 then parseBrick [x1, y1, z1 + 1] [x2, y2, z2]
+  else if z1 > z2 then parseBrick [x1, y1, z1] [x2, y2, z2 + 1]
+  else []
+
+parseLine :: String -> [((Int, Int, Int), Brick)]
+parseLine line = let (start: end: _) = split "~" line
+                     parsedStart = map read $ split "," start
+                     parsedEnd = map read $ split "," end
+                     brick = parseBrick parsedStart parsedEnd
+                 in map (\ c -> ((z c, y c, x c), brick)) brick
+
+parseSnapshot :: [((Int, Int, Int), Brick)] -> IO Snapshot
+parseSnapshot otherBricks = do done <- isEOF
+                               if done
+                                  then return $ M.fromList otherBricks
+                                  else do line <- getLine
+                                          let brick = parseLine line
+                                          parseSnapshot (otherBricks ++ brick)
+
+parse :: IO Snapshot
+parse = parseSnapshot []
+
+
+getFalling :: Snapshot -> [((Int, Int, Int), Brick)]
+getFalling s = M.toList $ M.filter (\ b ->
+  let minZ = foldl (\ mz c -> min mz (z c)) maxBound b
+  in foldl (\ r c -> r && minZ > 1 && M.notMember (minZ - 1, y c, x c) s) True b) s
+
+getFell :: Snapshot -> [((Int, Int, Int), Brick)] -> [((Int, Int, Int), Brick)]
+getFell s = map (\ ((zk, yk, xk), v) ->
+  ((zk - 1, yk, xk), map (\ c -> Cube {z = z c - 1, y = y c, x = x c}) v))
+
+getPostFall :: Snapshot -> [((Int, Int, Int), Brick)] -> [((Int, Int, Int), Brick)] -> Snapshot
+getPostFall s falling fell = M.union (M.difference s $ M.fromList falling) (M.fromList fell)
+
+fall :: Snapshot -> Snapshot
+fall s =
+  let falling = getFalling s
+      fell = getFell s falling
+  in if null falling then s
+     else fall $ getPostFall s falling fell