day 21 part 1, day 22

ncfavier · Dec 22, 2023 · d85a112 · d85a112
1 parent 40f062d
commit d85a112
Show file tree

Hide file tree

Showing 4 changed files with 62 additions and 3 deletions.
diff --git a/src/2023/Day15.hs b/src/2023/Day15.hs
@@ -9,9 +9,9 @@ format = (many (noneOf ",\n") `sepBy` ",") <* newline
 hash = foldl' (\n c -> ((n + ord c) * 17) `mod` 256) 0
 
 operation label "-" lenses = filter ((/= label) . fst) lenses
-operation label ('=':(read -> n)) lenses
-  | lens:_ <- holesOf @(->) (traversed.itraversed.index label) lenses = peek n lens
-  | otherwise = lenses ++ [(label, n)]
+operation label ('=':(read -> n)) lenses = fromMaybe
+  (lenses |> (label, n))
+  (failover (traversed.itraversed.index label) (const n) lenses)
 
 step arr (break (not . isAlpha) -> (label, op)) = arr & ix (hash label) %~ operation label op
 

diff --git a/src/2023/Day21.hs b/src/2023/Day21.hs
@@ -0,0 +1,14 @@
+module Day21 where
+
+import AOC
+
+import Data.Map qualified as M
+import Data.Set qualified as S
+
+main = do
+  grid <- makeGrid <$> readInput
+  let
+    start = head [p | (p, 'S') <- M.assocs grid]
+    neighbours = M.mapWithKey (\p _ -> S.fromList [n | d <- cardinal, let n = p + d, Just t' <- [grid M.!? n], t' /= '#']) grid
+    step ps = S.unions (S.map (neighbours M.!) ps)
+  print $ length $ nTimes step 64 (S.singleton start)
diff --git a/src/2023/Day22.hs b/src/2023/Day22.hs
@@ -0,0 +1,32 @@
+module Day22 where
+
+import AOC
+
+import Data.List.NonEmpty qualified as NE
+import Data.Map qualified as M
+import Data.Set qualified as S
+
+format = S.fromList <$> eachLine do brick <$> coords <* "~" <*> coords where
+  coords = (,,) <$> number <* "," <*> number <* "," <*> number
+  brick (a, b, c) (d, e, f) = ((min a d, max a d), (min b e, max b e), (min c f, max c f))
+
+(x, y, z) << (x', y', z') = overlap x x' && overlap y y' && (z <<< z') where
+  overlap a b = not $ a <<< b || b <<< a
+  (_, b) <<< (c, _) = b < c
+
+fall ground (x, y, (z, z')) = (x, y, (ground + 1, z' - z + ground + 1))
+
+main = do
+  bricks <- parseInput format
+  let
+    supportedBy = fmap fst $ löb $ bricks & M.fromSet \ b s ->
+      let
+        supportedBy = maximums [Arg z b' | (b', ~(_, (_, _, (_, z)))) <- M.assocs s, b' << b]
+        ground | Arg z _:_ <- supportedBy = z
+               | otherwise = 0
+      in ((\(Arg _ b) -> b) <$> supportedBy, fall ground b)
+    supportsTrans = bricks & M.fromSet \ b ->
+      howMany id $ M.delete b $ löb $ M.insert b (\_ -> True) $ supportedBy <&> \ bs s ->
+        notNull bs && all (s M.!) bs
+  print $ howMany (== 0) supportsTrans
+  print $ sum supportsTrans
diff --git a/src/AOC.hs b/src/AOC.hs
@@ -187,6 +187,16 @@ minimumOn = minimumBy . comparing
 maximumOn :: (Foldable t, Ord b) => (a -> b) -> t a -> a
 maximumOn = maximumBy . comparing
 
+minimums :: Ord a => [a] -> [a]
+minimums [] = []
+minimums xs = filter (== m) xs where
+  m = minimum xs
+
+maximums :: Ord a => [a] -> [a]
+maximums [] = []
+maximums xs = filter (== m) xs where
+  m = maximum xs
+
 sortDesc :: Ord a => [a] -> [a]
 sortDesc = sortBy (flip compare)
 
@@ -236,6 +246,9 @@ fromTo from to | from <= to = [from..to]
 alt :: (Foldable t, Alternative f) => t a -> f a
 alt = alaf Alt foldMap pure
 
+invGraph :: Ord a => Map a [a] -> Map a [a]
+invGraph m = Map.fromListWith (++) ([(v, [k]) | (k, vs) <- Map.assocs m, v <- vs] ++ [(k, []) | k <- Map.keys m])
+
 -- Functions and memoizing
 
 fixedPoint :: Eq a => (a -> a) -> a -> a