day8 part one

aoc2024.cabal

@@ -34,6 +34,7 @@ library
       Day6
       Day6.Guard
       Day7
+      Day8
   other-modules:
       Paths_aoc2024
   autogen-modules:

input/day8.txt

@@ -0,0 +1,50 @@
+...............e...........j6.....................
+.....1...............................t.....i......
+.....4.......3..............x..tL......m..........
+.......L.....................Dxj..................
+4....X..................F.....................m...
+.............4.......x....F........k..............
+......3...................t..........i.........Z..
+....L..................y.....F..e.....Z...........
+X.............1........C..........i...D...........
+........4.....................D.....k.X...m.......
+...1...............D........e......6..............
+...3.Y...................................m8.......
+..OL.........................x....Z....g..........
+....3......5.........................6j...........
+...................J..5r.F..k...y.................
+.......................................Z..a.......
+...........................5........j.........a.u.
+...p..............Y....X..........................
+...O.........................kd...................
+........................t.................i.......
+..................J..............u...........z....
+.O.....9.............J..............p..u..........
+.....9............................................
+l...6.....1........e......I................a......
+...................................az.............
+........M.......J...................gI....z.......
+.......Y...l...........p......g....d.......W......
+........5l....9................d.....g............
+.A....9.l.Y............I..............B.......s...
+..................................K.....B.........
+....M.............7.......8..........h.....K......
+.......0f...oc..............G...d7.......z...s..yW
+...M........0...........Gf.....................T..
+................r......G..................w....h..
+...........cP................G.8.R..............T.
+.................A.............N............u..B..
+..H.c..b............................K...CB.....y..
+......c...bP...2............7..K..................
+......b.o....0.......P.............s........h.R...
+......2........f..S........8.....................R
+U....2..............p..............7..............
+.HE..b......A.............N..............w....C...
+................................N.............w...
+.........E...........M................W.......T...
+......E...rS2...........W....................N....
+.....SP..n.....r..0...............................
+.....H..............A............................w
+..........n..U....................s...............
+..n.So.....U................f.....................
+Ho................................................

src/Data/Matrix.hs

@@ -5,22 +5,23 @@ module Data.Matrix
   ( Matrix,
     Position,
     buildMatrix,
-    groupWith,
     lookupValue,
     lookup,
     lookupMultiple,
     filterWithKey,
     size,
     insert,
+    groupByWith,
+    filter,
+    isInBounds,
   )
 where
 
-import qualified Data.IntMap.Lazy as IntMap
 import Data.List (find)
 import Data.Map.Lazy (Map)
 import qualified Data.Map.Lazy as Map
 import Data.Maybe
-import Prelude hiding (lookup)
+import Prelude hiding (filter, lookup)
 
 newtype Matrix v = Matrix (Map (Int, Int) v)
 
@@ -42,9 +43,15 @@ buildMatrix xs = Matrix (go xs 0 Map.empty)
 size :: Matrix v -> Int
 size (Matrix hmap) = Map.size hmap
 
+isInBounds :: Position -> Matrix v -> Bool
+isInBounds pos (Matrix hmap) = Map.member pos hmap
+
 filterWithKey :: (Position -> v -> Bool) -> Matrix v -> Matrix v
 filterWithKey f (Matrix hmap) = Matrix (Map.filterWithKey f hmap)
 
+filter :: (v -> Bool) -> Matrix v -> Matrix v
+filter f (Matrix hmap) = Matrix (Map.filter f hmap)
+
 lookup :: Position -> Matrix v -> Maybe v
 lookup position (Matrix hmap) = Map.lookup position hmap
 
@@ -69,18 +76,18 @@ lookupValue v (Matrix hmap) =
    in fst <$> mEntry
 
 {--
-Given a matrix of elements and a function mapping a position into an aggregation of its values,
-group the elements by the aggregation result.
+Group elements given a function.
+The function receives an entry of the matrix and returns a pair of key -> value.
 The values are grouped in order.
 --}
-groupWith :: forall v. (Position -> Int) -> Matrix v -> [[v]]
-groupWith f (Matrix hmap) =
+groupByWith :: forall v a b. (Ord a) => ((Position, v) -> (a, b)) -> Matrix v -> Map a [b]
+groupByWith f (Matrix hmap) =
   let sortedEntries = Map.toAscList hmap
-      intMap = foldr (\(position, value) -> insertValue (f position) value) IntMap.empty sortedEntries
-   in IntMap.elems intMap
+   in foldr (insert' . f) Map.empty sortedEntries
   where
-    insertValue key value =
-      IntMap.alter
+    insert' :: (a, b) -> Map a [b] -> Map a [b]
+    insert' (key, value) =
+      Map.alter
         ( \case
             Nothing -> Just [value]
             Just xs -> Just (value : xs)

src/Day4.hs

@@ -1,17 +1,11 @@
 module Day4 (partOne, partTwo) where
 
 import Data.List (sort, transpose)
+import qualified Data.Map.Lazy as Map
 import qualified Data.Matrix as M
 
 partOne :: String -> Int
-partOne input =
-  let horizontalLines = lines input
-      verticalLines = transpose horizontalLines
-      matrix = M.buildMatrix horizontalLines
-      positiveDiagonals = M.groupWith (uncurry (+)) matrix
-      negativeDiagonals = M.groupWith (uncurry (-)) matrix
-      allLines = horizontalLines ++ verticalLines ++ positiveDiagonals ++ negativeDiagonals
-   in sum $ map countXMAS allLines
+partOne input = sum $ map countXMAS allLines
   where
     countXMAS :: String -> Int
     countXMAS ('X' : xs@('M' : 'A' : 'S' : _)) = 1 + countXMAS xs
@@ -19,6 +13,13 @@ partOne input =
     countXMAS (_ : xs) = countXMAS xs
     countXMAS [] = 0
 
+    horizontalLines = lines input
+    verticalLines = transpose horizontalLines
+    matrix = M.buildMatrix horizontalLines
+    positiveDiagonals = Map.elems $ M.groupByWith (\((row, col), value) -> (row + col, value)) matrix
+    negativeDiagonals = Map.elems $ M.groupByWith (\((row, col), value) -> (row - col, value)) matrix
+    allLines = horizontalLines ++ verticalLines ++ positiveDiagonals ++ negativeDiagonals
+
 partTwo :: String -> Int
 partTwo input = M.size (M.filterWithKey isXMAS matrix)
   where

src/Day8.hs

@@ -0,0 +1,34 @@
+module Day8 (partOne, partTwo) where
+
+import Data.List (nub, subsequences)
+import qualified Data.Map.Lazy as Map
+import Data.Matrix (Position)
+import qualified Data.Matrix as M
+import Data.Maybe (mapMaybe)
+
+type AntiNode = (Int, Int)
+
+partOne :: String -> Int
+partOne input = length $ filter (`M.isInBounds` matrix) $ nub $ concatMap (uncurry getAntiNodes) combinations
+  where
+    matrix = M.buildMatrix (lines input)
+    noDotsMatrix = M.filter (/= '.') matrix
+    pointGroups = Map.elems $ M.groupByWith (\(position, value) -> (value, position)) noDotsMatrix
+    combinations = concatMap pairs pointGroups
+
+partTwo :: String -> Int
+partTwo input = undefined
+
+pairs :: [a] -> [(a, a)]
+pairs xs = mapMaybe parse $ subsequences xs
+  where
+    parse :: [a] -> Maybe (a, a)
+    parse [x, y] = Just (x, y)
+    parse _ = Nothing
+
+getAntiNodes :: Position -> Position -> [AntiNode]
+getAntiNodes (xrow, xcol) (yrow, ycol) = case distance of
+  (0, 0) -> []
+  (drow, dcol) -> [(xrow + drow, xcol + dcol), (yrow - drow, ycol - dcol)]
+  where
+    distance = (xrow - yrow, xcol - ycol)