Merge pull request #57 from ephemient/hs/day7

README.md

@@ -11,3 +11,4 @@ Development occurs in language-specific directories:
 |[Day4.hs](hs/src/Day4.hs)|[Day4.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day4.kt)|[day4.py](py/aoc2024/day4.py)|[day4.rs](rs/src/day4.rs)|
 |[Day5.hs](hs/src/Day5.hs)|[Day5.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day5.kt)|[day5.py](py/aoc2024/day5.py)|[day5.rs](rs/src/day5.rs)|
 |[Day6.hs](hs/src/Day6.hs)|[Day6.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day6.kt)|[day6.py](py/aoc2024/day6.py)|[day6.rs](rs/src/day6.rs)|
+|[Day7.hs](hs/src/Day7.hs)||||

hs/aoc2024.cabal

@@ -27,6 +27,7 @@ library
     Day4
     Day5
     Day6
+    Day7
 
   other-modules:
     Common
@@ -71,6 +72,7 @@ test-suite aoc2024-test
     Day4Spec
     Day5Spec
     Day6Spec
+    Day7Spec
 
   build-depends:
     aoc2024,

hs/app/Main.hs

@@ -13,6 +13,7 @@ import Day3 qualified (part1, part2)
 import Day4 qualified (part1, part2)
 import Day5 qualified (part1, part2)
 import Day6 qualified (part1, part2)
+import Day7 qualified (part1, part2)
 import System.Environment (getArgs, lookupEnv)
 import System.FilePath (combine)
 import Text.Megaparsec (errorBundlePretty)
@@ -42,3 +43,4 @@ main = do
   run 4 print [Day4.part1, Day4.part2]
   run 5 (either (fail . errorBundlePretty) print) [Day5.part1, Day5.part2]
   run 6 print [Day6.part1, Day6.part2]
+  run 7 (either fail print) [Day7.part1, Day7.part2]

hs/bench/Main.hs

@@ -12,6 +12,7 @@ import Day3 qualified (part1, part2)
 import Day4 qualified (part1, part2)
 import Day5 qualified (part1, part2)
 import Day6 qualified (part1, part2)
+import Day7 qualified (part1, part2)
 import System.Environment.Blank (getEnv, setEnv, unsetEnv)
 import System.FilePath (combine)
 
@@ -64,5 +65,11 @@ main =
           "Day 6"
           [ bench "part 1" $ nf Day6.part1 input,
             bench "part 2" $ nf Day6.part2 input
+          ],
+      env (getDayInput 7) $ \input ->
+        bgroup
+          "Day 7"
+          [ bench "part 1" $ nf Day7.part1 input,
+            bench "part 2" $ nf Day7.part2 input
           ]
     ]

hs/src/Day7.hs

@@ -0,0 +1,36 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- Module:         Day7
+-- Description:    <https://adventofcode.com/2024/day/7 Day 7: Bridge Repair>
+module Day7 (part1, part2) where
+
+import Common (readEntire, readSome)
+import Control.Monad (ap)
+import Control.Parallel.Strategies (parMap, rseq)
+import Data.List.NonEmpty (NonEmpty ((:|)))
+import Data.Text (Text)
+import Data.Text qualified as T (lines, stripPrefix)
+import Data.Text.Read (Reader)
+import Data.Text.Read qualified as T (decimal)
+
+parseLine :: (Integral a) => Reader (a, NonEmpty a)
+parseLine line = do
+  (lhs, line') <- T.decimal line
+  (rhs, line'') <- maybe (Left "") (readSome T.decimal) $ T.stripPrefix ": " line'
+  pure ((lhs, rhs), line'')
+
+parFilter :: (a -> Bool) -> [a] -> [a]
+parFilter f = fmap fst . filter snd . (zip `ap` parMap rseq f)
+
+solve :: (Integral a) => (a -> a -> [a]) -> Text -> Either String a
+solve op input = sum . map fst . parFilter f <$> mapM (readEntire parseLine) (T.lines input)
+  where
+    f (lhs, r0 :| []) = lhs == r0
+    f (lhs, r0 :| r1 : rhs) = or [r2 <= lhs && f (lhs, r2 :| rhs) | r2 <- r0 `op` r1]
+
+part1 :: Text -> Either String Int
+part1 = solve $ \a b -> [a + b, a * b]
+
+part2 :: Text -> Either String Int
+part2 = solve $ \a b -> [a + b, a * b, read $ show a ++ show b]

hs/test/Day7Spec.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Day7Spec (spec) where
+
+import Data.Text (Text)
+import Data.Text qualified as T (unlines)
+import Day7 (part1, part2)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+example :: Text
+example =
+  T.unlines
+    [ "190: 10 19",
+      "3267: 81 40 27",
+      "83: 17 5",
+      "156: 15 6",
+      "7290: 6 8 6 15",
+      "161011: 16 10 13",
+      "192: 17 8 14",
+      "21037: 9 7 18 13",
+      "292: 11 6 16 20"
+    ]
+
+spec :: Spec
+spec = do
+  describe "part 1" $ do
+    it "examples" $ do
+      part1 example `shouldBe` Right 3749
+  describe "part 2" $ do
+    it "examples" $ do
+      part2 example `shouldBe` Right 11387