day 8

aoc2024.cabal

@@ -25,6 +25,7 @@ source-repository head
 
 library
   exposed-modules:
+      Data.List.Extra
       Data.Matrix
       Day1
       Day2
@@ -62,6 +63,7 @@ test-suite aoc2024-test
       Day5Spec
       Day6Spec
       Day7Spec
+      Day8Spec
       Paths_aoc2024
   autogen-modules:
       Paths_aoc2024

src/Data/List/Extra.hs

@@ -0,0 +1,14 @@
+module Data.List.Extra (combinations, pairs) where
+
+import Data.List (subsequences)
+import Data.Maybe (mapMaybe)
+
+combinations :: Int -> [a] -> [[a]]
+combinations k xs = filter ((== k) . length) $ subsequences xs
+
+pairs :: [a] -> [(a, a)]
+pairs xs = mapMaybe parse $ combinations 2 xs
+  where
+    parse :: [a] -> Maybe (a, a)
+    parse [x, y] = Just (x, y)
+    parse _ = Nothing

src/Day8.hs

@@ -1,34 +1,51 @@
 module Day8 (partOne, partTwo) where
 
-import Data.List (nub, subsequences)
+import Data.List (nub)
+import Data.List.Extra (pairs)
 import qualified Data.Map.Lazy as Map
-import Data.Matrix (Position)
+import Data.Matrix (Matrix, Position)
 import qualified Data.Matrix as M
-import Data.Maybe (mapMaybe)
 
-type AntiNode = (Int, Int)
+type Node = (Int, Int)
 
 partOne :: String -> Int
-partOne input = length $ filter (`M.isInBounds` matrix) $ nub $ concatMap (uncurry getAntiNodes) combinations
+partOne input = length $ filter (`M.isInBounds` grid) $ nub antiNodes
   where
-    matrix = M.buildMatrix (lines input)
-    noDotsMatrix = M.filter (/= '.') matrix
-    pointGroups = Map.elems $ M.groupByWith (\(position, value) -> (value, position)) noDotsMatrix
-    combinations = concatMap pairs pointGroups
+    grid = M.buildMatrix (lines input)
+    antiNodes = concatMap (uncurry getAntiNodes) $ nodePairs grid
+
+    getAntiNodes x y = case distance x y of
+      (0, 0) -> []
+      d -> [add x d, substract y d]
 
 partTwo :: String -> Int
-partTwo input = undefined
-
-pairs :: [a] -> [(a, a)]
-pairs xs = mapMaybe parse $ subsequences xs
+partTwo input = length antiNodes
   where
-    parse :: [a] -> Maybe (a, a)
-    parse [x, y] = Just (x, y)
-    parse _ = Nothing
+    matrix = M.buildMatrix (lines input)
+    combinations = nodePairs matrix
+    antiNodes = nub $ concatMap (uncurry getAntiNodes) combinations
 
-getAntiNodes :: Position -> Position -> [AntiNode]
-getAntiNodes (xrow, xcol) (yrow, ycol) = case distance of
+    getAntiNodes x y = case distance x y of
       (0, 0) -> []
-  (drow, dcol) -> [(xrow + drow, xcol + dcol), (yrow - drow, ycol - dcol)]
-  where
-    distance = (xrow - yrow, xcol - ycol)
+      d -> computePointsAtDistance x d add ++ computePointsAtDistance y d substract
+
+    computePointsAtDistance point dist f =
+      let point' = f point dist
+       in if M.isInBounds point matrix
+            then point : computePointsAtDistance point' dist f
+            else []
+
+nodePairs :: Matrix Char -> [(Node, Node)]
+nodePairs matrix =
+  let noDotsMatrix = M.filter (/= '.') matrix
+      pointGroups = Map.elems $ M.groupByWith (\(position, value) -> (value, position)) noDotsMatrix
+   in concatMap pairs pointGroups
+
+substract :: Position -> (Int, Int) -> (Int, Int)
+substract (x, y) (dx, dy) = (x - dx, y - dy)
+
+add :: Position -> (Int, Int) -> (Int, Int)
+add (x, y) (dx, dy) = (x + dx, y + dy)
+
+distance :: Position -> Position -> (Int, Int)
+distance (xrow, xcol) (yrow, ycol) = (xrow - yrow, xcol - ycol)

test/Day8Spec.hs

@@ -0,0 +1,27 @@
+module Day8Spec (spec) where
+
+import Day8 (partOne, partTwo)
+import Test.Hspec
+
+spec :: Spec
+spec = do
+  describe "PartOne" $ do
+    it "works" $ do
+      partOne input `shouldBe` 14
+  describe "PartTwo" $ do
+    it "works" $ do
+      partTwo input `shouldBe` 34
+  where
+    input =
+      "............\n\
+      \........0...\n\
+      \.....0......\n\
+      \.......0....\n\
+      \....0.......\n\
+      \......A.....\n\
+      \............\n\
+      \............\n\
+      \........A...\n\
+      \.........A..\n\
+      \............\n\
+      \............"