Day 13: Claw Contraption

README.md

@@ -17,3 +17,4 @@ Development occurs in language-specific directories:
 |[Day10.hs](hs/src/Day10.hs)|[Day10.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day10.kt)|[day10.py](py/aoc2024/day10.py)|[day10.rs](rs/src/day10.rs)|
 |[Day11.hs](hs/src/Day11.hs)|[Day11.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day11.kt)|[day11.py](py/aoc2024/day11.py)|[day11.rs](rs/src/day11.rs)|
 |[Day12.hs](hs/src/Day12.hs)|[Day12.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day12.kt)|[day12.py](py/aoc2024/day12.py)||
+|[Day13.hs](hs/src/Day13.hs)||||

hs/aoc2024.cabal

@@ -25,6 +25,7 @@ library
     Day10
     Day11
     Day12
+    Day13
     Day2
     Day3
     Day4
@@ -75,6 +76,7 @@ test-suite aoc2024-test
     Day10Spec
     Day11Spec
     Day12Spec
+    Day13Spec
     Day1Spec
     Day2Spec
     Day3Spec

hs/app/Main.hs

@@ -11,6 +11,7 @@ import Day1 qualified (part1, part2)
 import Day10 qualified (part1, part2)
 import Day11 qualified (part1, part2)
 import Day12 qualified (part1, part2)
+import Day13 qualified (part1, part2)
 import Day2 qualified (part1, part2)
 import Day3 qualified (part1, part2)
 import Day4 qualified (part1, part2)
@@ -54,3 +55,4 @@ main = do
   run 10 print [Day10.part1, Day10.part2]
   run 11 (either fail print) [Day11.part1, Day11.part2]
   run 12 print [Day12.part1, Day12.part2]
+  run 13 (either (fail . errorBundlePretty) print) [Day13.part1, Day13.part2]

hs/bench/Main.hs

@@ -10,6 +10,7 @@ import Day1 qualified (part1, part2)
 import Day10 qualified (part1, part2)
 import Day11 qualified (part1, part2)
 import Day12 qualified (part1, part2)
+import Day13 qualified (part1, part2)
 import Day2 qualified (part1, part2)
 import Day3 qualified (part1, part2)
 import Day4 qualified (part1, part2)
@@ -106,5 +107,11 @@ main =
           "Day 12"
           [ bench "part 1" $ nf Day12.part1 input,
             bench "part 2" $ nf Day12.part2 input
+          ],
+      env (getDayInput 13) $ \input ->
+        bgroup
+          "Day 13"
+          [ bench "part 1" $ nf Day13.part1 input,
+            bench "part 2" $ nf Day13.part2 input
           ]
     ]

hs/src/Day12.hs

@@ -61,7 +61,5 @@ part2 = solve $ \points ->
       ok (a, b) (c, d) = abs (c - a) <= 1 && b == d
    in sum
         [ countConsecutive $ first snd <$> edges
-        | edges <-
-            groupBy ((==) `on` fst . fst) horizontalEdges
-              ++ groupBy ((==) `on` fst . fst) verticalEdges
+        | edges <- [horizontalEdges, verticalEdges] >>= groupBy ((==) `on` fst . fst)
         ]

hs/src/Day13.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- Module:         Day13
+-- Description:    <https://adventofcode.com/2024/day/13 Day 13: Claw Contraption>
+module Day13 (part1, part2) where
+
+import Data.Maybe (mapMaybe)
+import Data.String (IsString)
+import Data.Text (Text)
+import Data.Void (Void)
+import Text.Megaparsec (MonadParsec, ParseErrorBundle, Stream (Token, Tokens), parse, sepEndBy)
+import Text.Megaparsec.Char (newline, string)
+import Text.Megaparsec.Char.Lexer qualified as L (decimal)
+
+parser :: (MonadParsec e s m, IsString (Tokens s), Token s ~ Char, Num a) => m [(a, a, a, a, a, a)]
+parser =
+  flip sepEndBy newline $
+    (,,,,,)
+      <$> (string "Button A: X+" *> L.decimal)
+      <*> (string ", Y+" *> L.decimal <* newline)
+      <*> (string "Button B: X+" *> L.decimal)
+      <*> (string ", Y+" *> L.decimal <* newline)
+      <*> (string "Prize: X=" *> L.decimal)
+      <*> (string ", Y=" *> L.decimal <* newline)
+
+solve :: (Integral a) => (a, a, a, a, a, a) -> Maybe a
+solve (ax, ay, bx, by_, x, y)
+  | (a, 0) <- (x * by_ - y * bx) `divMod` (ax * by_ - bx * ay),
+    (b, 0) <- (x * ay - y * ax) `divMod` (ay * bx - by_ * ax) =
+      Just $ 3 * a + b
+solve _ = Nothing
+
+part1 :: Text -> Either (ParseErrorBundle Text Void) Int
+part1 input = sum . mapMaybe solve <$> parse parser "" input
+
+part2 :: Text -> Either (ParseErrorBundle Text Void) Int
+part2 input = sum . mapMaybe solve' <$> parse parser "" input
+  where
+    solve' (ax, ay, bx, by_, x, y) = solve (ax, ay, bx, by_, x + 10000000000000, y + 10000000000000)

hs/test/Day13Spec.hs

@@ -0,0 +1,34 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Day13Spec (spec) where
+
+import Data.Text (Text)
+import Data.Text qualified as T (unlines)
+import Day13 (part1)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+example :: Text
+example =
+  T.unlines
+    [ "Button A: X+94, Y+34",
+      "Button B: X+22, Y+67",
+      "Prize: X=8400, Y=5400",
+      "",
+      "Button A: X+26, Y+66",
+      "Button B: X+67, Y+21",
+      "Prize: X=12748, Y=12176",
+      "",
+      "Button A: X+17, Y+86",
+      "Button B: X+84, Y+37",
+      "Prize: X=7870, Y=6450",
+      "",
+      "Button A: X+69, Y+23",
+      "Button B: X+27, Y+71",
+      "Prize: X=18641, Y=10279"
+    ]
+
+spec :: Spec
+spec = do
+  describe "part 1" $ do
+    it "examples" $ do
+      part1 example `shouldBe` Right 480