Day 3: Gear Ratios

README.md

@@ -7,3 +7,4 @@ Development occurs in language-specific directories:
 |--:|--:|--:|--:|
 |[Day1.hs](hs/src/Day1.hs)|[Day1.kt](kt/aoc2023-lib/src/commonMain/kotlin/com/github/ephemient/aoc2023/Day1.kt)|[day1.py](py/aoc2023/day1.py)|[day1.rs](rs/src/day1.rs)|
 |[Day2.hs](hs/src/Day2.hs)|[Day2.kt](kt/aoc2023-lib/src/commonMain/kotlin/com/github/ephemient/aoc2023/Day2.kt)|[day2.py](py/aoc2023/day2.py)|[day2.rs](rs/src/day2.rs)|
+|[Day3.hs](hs/src/Day3.hs)|[Day3.kt](kt/aoc2023-lib/src/commonMain/kotlin/com/github/ephemient/aoc2023/Day3.kt)|||

hs/aoc2023.cabal

@@ -22,7 +22,8 @@ extra-source-files: README.md
 library
     exposed-modules:
         Day1,
-        Day2
+        Day2,
+        Day3
 
     -- Modules included in this library but not exported.
     -- other-modules:
@@ -33,7 +34,8 @@ library
         base ^>=4.17.2.0,
         containers ^>=0.6.7,
         megaparsec ^>=9.6.1,
-        text ^>=2.0.1
+        text ^>=2.0.1,
+        vector ^>=0.13.1.0
     hs-source-dirs:   src
     default-language: GHC2021
 
@@ -65,7 +67,8 @@ test-suite aoc2023-test
     main-is:          Main.hs
     other-modules:
         Day1Spec,
-        Day2Spec
+        Day2Spec,
+        Day3Spec
     build-depends:
         aoc2023,
         base ^>=4.17.2.0,

hs/app/Main.hs

@@ -3,6 +3,7 @@ module Main (main) where
 
 import qualified Day1 (part1, part2)
 import qualified Day2 (part1, part2)
+import qualified Day3 (part1, part2)
 
 import Control.Monad (ap, when)
 import Data.Foldable (find)
@@ -34,3 +35,4 @@ main :: IO ()
 main = do
     run 1 print [Day1.part1, Day1.part2]
     run 2 (either (fail . errorBundlePretty) print) [Day2.part1, Day2.part2]
+    run 3 print [Day3.part1, Day3.part2]

hs/bench/Main.hs

@@ -7,6 +7,7 @@ import Data.Text (Text)
 import qualified Data.Text.IO as TIO (readFile)
 import qualified Day1 (part1, part2)
 import qualified Day2 (part1, part2)
+import qualified Day3 (part1, part2)
 import System.Environment (lookupEnv)
 import System.FilePath (combine)
 
@@ -25,4 +26,8 @@ main = defaultMain
       [ bench "part 1" $ nf Day2.part1 input
       , bench "part 2" $ nf Day2.part2 input
       ]
+  , env (getDayInput 3) $ \input -> bgroup "Day 3"
+      [ bench "part 1" $ nf Day3.part1 input
+      , bench "part 2" $ nf Day3.part2 input
+      ]
   ]

hs/src/Day3.hs

@@ -0,0 +1,39 @@
+{-|
+Module:         Day3
+Description:    <https://adventofcode.com/2023/day/3 Day 3: Gear Ratios>
+-}
+module Day3 (part1, part2) where
+
+import Control.Arrow (second)
+import Data.Char (isDigit, isSpace)
+import qualified Data.Map as Map (elems, fromListWith)
+import Data.Text (Text)
+import qualified Data.Text as T (break, index, length, lines, span)
+import qualified Data.Text.Read as T (decimal)
+import qualified Data.Vector as V ((!), fromList, length)
+
+parts :: Text -> [((Int, Int), Int)]
+parts input =
+  [ ((x, y'), number)
+  | y <- [0..V.length lines - 1]
+  , ((x0, x1), number) <- numbers 0 $ lines V.! y
+  , y' <- [max 0 $ y - 1..min (V.length lines - 1) $ y + 1]
+  , let line = lines V.! y'
+  , x <- [max 0 $ x0 - 1..min (T.length line - 1) x1]
+  , let c = T.index line x
+  , not $ c == '.' || isSpace c || isDigit c
+  ] where
+    lines = V.fromList $ T.lines input
+    numbers acc t
+      | (leading, t') <- T.break isDigit t
+      , Right (number, trailing) <- T.decimal t'
+      = let acc' = acc + T.length t - T.length trailing
+         in ((acc + T.length leading, acc'), number) : numbers acc' trailing
+      | otherwise = []
+
+part1 :: Text -> Int
+part1 = sum . map snd . parts
+
+part2 :: Text -> Int
+part2 = sum . map product . filter ((== 2) . length) .
+    Map.elems . Map.fromListWith (++) . map (second (:[])) . parts

hs/test/Day3Spec.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Day3Spec (spec) where
+
+import Data.Text (Text)
+import qualified Data.Text as T (unlines)
+import Day3 (part1, part2)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+example :: Text
+example = T.unlines
+  [ "467..114.."
+  , "...*......"
+  , "..35..633."
+  , "......#..."
+  , "617*......"
+  , ".....+.58."
+  , "..592....."
+  , "......755."
+  , "...$.*...."
+  , ".664.598.."
+  ]
+
+spec :: Spec
+spec = do
+    describe "part 1" $ do
+        it "examples" $ do
+            part1 example `shouldBe` 4361
+    describe "part 2" $ do
+        it "examples" $ do
+            part2 example `shouldBe` 467835