Day 8: Resonant Collinearity

README.md

@@ -12,3 +12,4 @@ Development occurs in language-specific directories:
 |[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)|[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)||||

hs/aoc2024.cabal

@@ -28,6 +28,7 @@ library
     Day5
     Day6
     Day7
+    Day8
 
   other-modules:
     Common
@@ -73,6 +74,7 @@ test-suite aoc2024-test
     Day5Spec
     Day6Spec
     Day7Spec
+    Day8Spec
 
   build-depends:
     aoc2024,

hs/app/Main.hs

@@ -14,6 +14,7 @@ import Day4 qualified (part1, part2)
 import Day5 qualified (part1, part2)
 import Day6 qualified (part1, part2)
 import Day7 qualified (part1, part2)
+import Day8 qualified (part1, part2)
 import System.Environment (getArgs, lookupEnv)
 import System.FilePath (combine)
 import Text.Megaparsec (errorBundlePretty)
@@ -44,3 +45,4 @@ main = do
   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]
+  run 8 print [Day8.part1, Day8.part2]

hs/bench/Main.hs

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

hs/src/Day8.hs

@@ -0,0 +1,38 @@
+-- |
+-- Module:         Day8
+-- Description:    <https://adventofcode.com/2024/day/8 Day 8: Resonant Collinearity>
+module Day8 (part1, part2) where
+
+import Control.Monad (guard)
+import Data.Containers.ListUtils (nubOrd)
+import Data.Ix (Ix (inRange))
+import Data.Map qualified as Map (elems, fromListWith)
+import Data.Set qualified as Set (singleton, toList)
+import Data.Text (Text)
+import Data.Text qualified as T (length, lines, unpack)
+
+solve :: ((Int, Int) -> (Int, Int) -> [(Int, Int)]) -> Text -> Int
+solve extend input =
+  length . nubOrd $ do
+    values <- Set.toList <$> Map.elems points
+    p0 <- values
+    p1 <- values
+    guard $ p0 /= p1
+    takeWhile (inRange ((0, 0), (height - 1, width - 1))) $ extend p0 p1
+  where
+    input' = T.lines input
+    height = length input'
+    width = maximum $ T.length <$> input'
+    points =
+      Map.fromListWith (<>) $
+        [ (c, Set.singleton (y, x))
+        | (y, line) <- zip [0 ..] $ T.lines input,
+          (x, c) <- zip [0 ..] $ T.unpack line,
+          c /= '.'
+        ]
+
+part1 :: Text -> Int
+part1 = solve $ \(y0, x0) (y1, x1) -> [(2 * y1 - y0, 2 * x1 - x0)]
+
+part2 :: Text -> Int
+part2 = solve $ \(y0, x0) (y1, x1) -> zip [y1, 2 * y1 - y0 ..] [x1, 2 * x1 - x0 ..]

hs/test/Day8Spec.hs

@@ -0,0 +1,34 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Day8Spec (spec) where
+
+import Data.Text (Text)
+import Data.Text qualified as T (unlines)
+import Day8 (part1, part2)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+example :: Text
+example =
+  T.unlines
+    [ "............",
+      "........0...",
+      ".....0......",
+      ".......0....",
+      "....0.......",
+      "......A.....",
+      "............",
+      "............",
+      "........A...",
+      ".........A..",
+      "............",
+      "............"
+    ]
+
+spec :: Spec
+spec = do
+  describe "part 1" $ do
+    it "examples" $ do
+      part1 example `shouldBe` 14
+  describe "part 2" $ do
+    it "examples" $ do
+      part2 example `shouldBe` 34