Merge pull request #76 from ephemient/hs/day10

README.md

@@ -14,3 +14,4 @@ Development occurs in language-specific directories:
 |[Day7.hs](hs/src/Day7.hs)|[Day7.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day7.kt)|[day7.py](py/aoc2024/day7.py)|[day7.rs](rs/src/day7.rs)|
 |[Day8.hs](hs/src/Day8.hs)|[Day8.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day8.kt)|[day8.py](py/aoc2024/day8.py)|[day8.rs](rs/src/day8.rs)|
 |[Day9.hs](hs/src/Day9.hs)|[Day9.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day9.kt)|[day9.py](py/aoc2024/day9.py)|[day9.rs](rs/src/day9.rs)|
+|[Day10.hs](hs/src/Day10.hs)||||

hs/aoc2024.cabal

@@ -22,6 +22,7 @@ library
   hs-source-dirs: src
   exposed-modules:
     Day1
+    Day10
     Day2
     Day3
     Day4
@@ -69,6 +70,7 @@ test-suite aoc2024-test
   hs-source-dirs: test
   main-is: Main.hs
   other-modules:
+    Day10Spec
     Day1Spec
     Day2Spec
     Day3Spec

hs/app/Main.hs

@@ -8,6 +8,7 @@ import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Data.Text.IO qualified as TIO (readFile)
 import Day1 qualified (part1, part2)
+import Day10 qualified (part1, part2)
 import Day2 qualified (part1, part2)
 import Day3 qualified (part1, part2)
 import Day4 qualified (part1, part2)
@@ -48,3 +49,4 @@ main = do
   run 7 (either fail print) [Day7.part1, Day7.part2]
   run 8 print [Day8.part1, Day8.part2]
   run 9 print [Day9.part1, Day9.part2]
+  run 10 print [Day10.part1, Day10.part2]

hs/bench/Main.hs

@@ -7,6 +7,7 @@ import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import Data.Text.IO qualified as TIO (readFile)
 import Day1 qualified (part1, part2)
+import Day10 qualified (part1, part2)
 import Day2 qualified (part1, part2)
 import Day3 qualified (part1, part2)
 import Day4 qualified (part1, part2)
@@ -85,5 +86,11 @@ main =
           "Day 9"
           [ bench "part 1" $ nf Day9.part1 input,
             bench "part 2" $ nf Day9.part2 input
+          ],
+      env (getDayInput 10) $ \input ->
+        bgroup
+          "Day 10"
+          [ bench "part 1" $ nf Day10.part1 input,
+            bench "part 2" $ nf Day10.part2 input
           ]
     ]

hs/src/Day10.hs

@@ -0,0 +1,46 @@
+-- |
+-- Module:         Day10
+-- Description:    <https://adventofcode.com/2024/day/10 Day 10: Hoof It>
+module Day10 (part1, part2) where
+
+import Data.Char (digitToInt, isDigit)
+import Data.IntMap qualified as IntMap (findWithDefault, fromListWith)
+import Data.List.NonEmpty (NonEmpty ((:|)))
+import Data.Map (Map)
+import Data.Map qualified as Map (elems, fromListWith, fromSet, toList)
+import Data.Monoid (Sum (Sum, getSum))
+import Data.Set (Set)
+import Data.Set qualified as Set (empty, member, singleton, size)
+import Data.Text (Text)
+import Data.Text qualified as T (lines, unpack)
+
+parse :: Text -> NonEmpty (Set (Int, Int))
+parse input = IntMap.findWithDefault Set.empty `flip` elevations <$> 0 :| [1 .. 9]
+  where
+    elevations =
+      IntMap.fromListWith (<>) $
+        [ (digitToInt c, Set.singleton (y, x))
+        | (y, line) <- zip [0 ..] $ T.lines input,
+          (x, c) <- zip [0 ..] $ T.unpack line,
+          isDigit c
+        ]
+
+adj :: (Int, Int) -> [(Int, Int)]
+adj (y, x) = [(y - 1, x), (y, x - 1), (y, x + 1), (y + 1, x)]
+
+bfs :: (Semigroup a) => ((Int, Int) -> a) -> NonEmpty (Set (Int, Int)) -> Map (Int, Int) a
+bfs start (zero :| elevations) = foldl bfs' (Map.fromSet start zero) elevations
+  where
+    bfs' acc points =
+      Map.fromListWith (<>) $
+        [ (q, m)
+        | (p, m) <- Map.toList acc,
+          q <- adj p,
+          q `Set.member` points
+        ]
+
+part1 :: Text -> Int
+part1 input = sum $ Set.size <$> bfs Set.singleton (parse input)
+
+part2 :: Text -> Int
+part2 input = getSum $ mconcat $ Map.elems $ bfs (const $ Sum 1) (parse input)

hs/test/Day10Spec.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Day10Spec (spec) where
+
+import Data.Text (Text)
+import Data.Text qualified as T (unlines)
+import Day10 (part1, part2)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+example :: Text
+example =
+  T.unlines
+    [ "89010123",
+      "78121874",
+      "87430965",
+      "96549874",
+      "45678903",
+      "32019012",
+      "01329801",
+      "10456732"
+    ]
+
+spec :: Spec
+spec = do
+  describe "part 1" $ do
+    it "examples" $ do
+      part1 example `shouldBe` 36
+  describe "part 2" $ do
+    it "examples" $ do
+      part2 example `shouldBe` 81