day 18 (ft. failed 16 and 17)

16-a.hs

@@ -0,0 +1,71 @@
+{-# LANGUAGE TupleSections #-}
+
+import Common
+import AStar
+import Data.List.Split (splitOn)
+import Data.Maybe (catMaybes)
+import Data.List (find, maximumBy)
+import GHC.Data.Maybe (fromJust)
+import GHC.Utils.Misc (sndOf3)
+
+data Valve = Valve {
+  valveName :: String,
+  valveFlowRate :: Int,
+  valveLeadsTo :: [String],
+  valveOpen :: Bool
+}
+  deriving (Show, Eq)
+
+-- disgusting, but works
+parse :: String -> Valve
+parse s = Valve name flowRate leadsTo False
+  where
+    leadsTo = map trim $ splitOn "," $ unwords $ drop 9 w
+    name = w !! 1
+    flowRate = read $ init $ (!! 1) $ splitOn "=" $ w !! 4
+    w = words s
+
+startLocation = "AA"
+totalMinutes = 30
+
+findValve :: [Valve] -> String -> Valve
+findValve valves s = fromJust $ find ((== s) . valveName) valves
+
+calculateValvesBuildup :: [Valve] -> Int
+calculateValvesBuildup = sum . map valveFlowRate . filter valveOpen
+
+openValve :: [Valve] -> String -> [Valve]
+openValve valves name = map (\v -> if valveName v == name then Valve (valveName v) (valveFlowRate v) (valveLeadsTo v) True else v) valves
+
+pathfindValve :: [Valve] -> String -> String -> (Int, [String])
+pathfindValve valves a b = fromJust $ astarSearch a (== b) (map (, 1000) . valveLeadsTo . findValve valves) (const 0)
+
+getValveScore :: [Valve] -> String -> Int -> Valve -> (Valve, Int, [String])
+getValveScore valves pos minutes valve = (valve, (totalMinutes - approxMinutes) * flowRate, path)
+  where
+    flowRate = valveFlowRate valve
+    approxMinutes = minutes + length path
+    path = snd $ pathfindValve valves pos (valveName valve)
+
+go :: [Valve] -> Int -> String -> Int -> Int
+go valves minutes pos pressure
+  | minutes > 30 = pressure
+  | null valveScores = go valves (minutes + 1) pos (pressure + calculateValvesBuildup valves)
+  | otherwise = maximum $ trace (map sndOf3 valveScores) $ map goTo maxValves
+  where
+    goTo :: (Valve, Int, [String]) -> Int
+    goTo (valve, _, path) = go newValves (minutes + 1) newPosition (pressure + calculateValvesBuildup valves)
+      where
+        newPosition = if name == pos then pos else path !! 1
+        newValves = if name == pos then openValve valves name else valves
+        name = valveName valve
+
+    maxValves = filter (\(_, score, _) -> score == maxScore) valveScores
+    (_, maxScore, _) = maximumBy (\a b -> sndOf3 a `compare` sndOf3 b) valveScores
+    valveScores = map (getValveScore valves pos minutes) $ filter (\v -> valveFlowRate v > 0 && not (valveOpen v)) valves
+
+main = interact $
+  show
+  . (\valves -> go valves 0 startLocation 0)
+  . map parse
+  . lines

17-a.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+import Data.Int
+import Data.Word
+import Data.Bits
+
+type Line = Int8
+type TetrisBoard = [Line]
+
+po2 :: forall a. (Bits a, Num a) => Int -> a
+po2 = shiftL (1 :: a)
+po2b :: forall a. (Bits a, Num a) => Bool -> Int -> a
+po2b b = if b then po2 else const 0
+
+fromRow :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8
+fromRow a b c d e f g = foldl1 (.|.) $ zipWith po2b [a, b, c, d, e, f, g] [0..]
+
+fromRowList :: [Bool] -> Word8
+fromRowList [a, b, c, d, e, f, g] = fromRow a b c d e f g
+fromRowList _ = undefined
+
+minos = [
+  [
+    "####"
+  ],
+  [
+    ".#.",
+    "###",
+    ".#."
+  ],
+  [
+    "..#",
+    "..#",
+    "###"
+  ],
+  [
+    "#",
+    "#",
+    "#",
+    "#"
+  ],
+  [
+    "##",
+    "##"
+  ]]
+

18-a.hs

@@ -0,0 +1,18 @@
+import Common
+import Data.List.Split (splitOn)
+
+parse :: String -> [Pos3]
+parse = map ((\[x, y, z] -> (x, y, z)) . map read . splitOn ",") . lines
+
+getAdjacentPos3 :: Pos3 -> [Pos3]
+getAdjacentPos3 pos = map (add3 pos) pos3Permutations
+pos3Permutations :: [Pos3]
+pos3Permutations = [(1, 0, 0), (0, 1, 0), (0, 0, 1), (-1, 0, 0), (0, -1, 0), (0, 0, -1)]
+
+surfaceArea :: [Pos3] -> Pos3 -> Int
+surfaceArea positions pos = (6 -) $ count (`elem` positions) $ getAdjacentPos3 pos
+
+main = interact $
+  show
+  . (\cubes -> sum $ map (surfaceArea cubes) cubes)
+  . parse

18-b.hs

@@ -0,0 +1,37 @@
+import Common
+import Data.List.Split (splitOn)
+import GHC.Utils.Misc (fstOf3, thdOf3, sndOf3)
+
+parse :: String -> [Pos3]
+parse = map ((\[x, y, z] -> (x, y, z)) . map read . splitOn ",") . lines
+
+getAdjacentPos3 :: Pos3 -> [Pos3]
+getAdjacentPos3 pos = map (add3 pos) pos3Permutations
+pos3Permutations :: [Pos3]
+pos3Permutations = [(1, 0, 0), (0, 1, 0), (0, 0, 1), (-1, 0, 0), (0, -1, 0), (0, 0, -1)]
+
+surfaceArea :: [Pos3] -> [Pos3] -> Pos3 -> Int
+surfaceArea positions air pos = count (\pos -> (pos `elem` air) && notElem pos positions) $ getAdjacentPos3 pos
+
+getAirCells :: [Pos3] -> [Pos3]
+getAirCells positions = getAirCells' [] (minX - 1, minY - 1, minZ - 1)
+  where
+    minX = minimum $ map fstOf3 positions
+    maxX = maximum $ map fstOf3 positions
+    minY = minimum $ map sndOf3 positions
+    maxY = maximum $ map sndOf3 positions
+    minZ = minimum $ map thdOf3 positions
+    maxZ = maximum $ map thdOf3 positions
+
+    inBounds (x, y, z) = x >= (minX - 1) && y >= (minY - 1) && z >= (minZ - 1) && x <= (maxX + 1) && y <= (maxY + 1) && z <= (maxZ + 1)
+
+    getAirCells' :: [Pos3] -> Pos3 -> [Pos3]
+    getAirCells' visited pos = (foldl getAirCells' (pos : (visited ++ adjacent)) adjacent)
+      where
+        validPos pos = inBounds pos && notElem pos visited && notElem pos positions
+        adjacent = filter validPos $ getAdjacentPos3 pos
+
+main = interact $
+  show
+  . (\cubes -> sum $ map (surfaceArea cubes (getAirCells cubes)) cubes)
+  . parse

Common.hs

@@ -4,8 +4,27 @@ module Common where
 import Data.List (findIndex, elemIndex)
 import GHC.IO (unsafePerformIO)
 import Control.DeepSeq (deepseq)
+import Data.Char (isSpace)
 
 type Pos = (Int, Int)
+
+addPos :: Pos -> Pos -> Pos
+addPos (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)
+
+subPos :: Pos -> Pos -> Pos
+subPos (x1, y1) (x2, y2) = (x1 - x2, y1 - y2)
+
+taxicabDist :: Pos -> Pos -> Int
+taxicabDist (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)
+
+taxicabDist3 :: Pos3 -> Pos3 -> Int
+taxicabDist3 (x1, y1, z1) (x2, y2, z2) = abs (x1 - x2) + abs (y1 - y2) + abs (z1 - z2)
+
+type Pos3 = (Int, Int, Int)
+
+add3 :: Pos3 -> Pos3 -> Pos3
+add3 (x1, y1, z1) (x2, y2, z2) = (x1 + x2, y1 + y2, z1 + z2)
+
 type Grid a = [[a]]
 
 (!!!) :: Grid a -> Pos -> a
@@ -25,15 +44,6 @@ gridWidth = length . head
 gridHeight :: Grid a -> Int
 gridHeight = length
 
-taxicabDist :: Pos -> Pos -> Int
-taxicabDist (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2)
-
-addPos :: Pos -> Pos -> Pos
-addPos (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)
-
-subPos :: Pos -> Pos -> Pos
-subPos (x1, y1) (x2, y2) = (x1 - x2, y1 - y2)
-
 {-# NOINLINE debug #-}
 debug :: Show a => a -> ()
 debug = unsafePerformIO . print
@@ -42,4 +52,7 @@ trace :: Show b => b -> a -> a
 trace s = deepseq (debug s)
 
 count :: (a -> Bool) -> [a] -> Int
-count f = length . filter f
+count f = length . filter f
+
+trim :: String -> String
+trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace