feat: day4 part one

aoc2024.cabal

@@ -28,6 +28,8 @@ library
       Day1
       Day2
       Day3
+      Day4
+      Day4.Matrix
       Day5
   other-modules:
       Paths_aoc2024
@@ -50,6 +52,7 @@ test-suite aoc2024-test
       Day1Spec
       Day2Spec
       Day3Spec
+      Day4Spec
       Day5Spec
       Paths_aoc2024
   autogen-modules:

src/Day4.hs

@@ -0,0 +1,23 @@
+module Day4 (partOne, partTwo) where
+
+import Data.List (transpose)
+import qualified Day4.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
+  where
+    countXMAS :: String -> Int
+    countXMAS ('X' : xs@('M' : 'A' : 'S' : _)) = 1 + countXMAS xs
+    countXMAS ('S' : xs@('A' : 'M' : 'X' : _)) = 1 + countXMAS xs
+    countXMAS (_ : xs) = countXMAS xs
+    countXMAS [] = 0
+
+partTwo :: String -> Int
+partTwo _input = 0

src/Day4/Matrix.hs

@@ -0,0 +1,42 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Day4.Matrix (Matrix, buildMatrix, groupWith) where
+
+import Data.IntMap.Lazy (IntMap)
+import qualified Data.IntMap.Lazy as IntMap
+
+type AssocList k v = [(k, v)]
+
+newtype Matrix v = Matrix (AssocList (Int, Int) v)
+
+buildMatrix :: [[a]] -> Matrix a
+buildMatrix xs = Matrix (go xs 0 [])
+  where
+    go [] _ acc = acc
+    go (x : xs') row acc =
+      let acc' = parseRow x (row, 0) acc
+       in go xs' (row + 1) acc'
+
+    parseRow [] _ acc = acc
+    parseRow (x : xs') (row, column) acc =
+      let acc' = ((row, column), x) : acc
+       in parseRow xs' (row, column + 1) acc'
+
+{--
+Given a matrix of elements and a function mapping a position into an aggregation of its values,
+group the elements by the aggregation result
+--}
+groupWith :: forall v. ((Int, Int) -> Int) -> Matrix v -> [[v]]
+groupWith f (Matrix matrix) =
+  let intMap :: IntMap [v]
+      intMap = foldr (\(position, value) -> insertValue (f position) value) IntMap.empty matrix
+   in IntMap.elems intMap
+  where
+    insertValue key value =
+      IntMap.alter
+        ( \case
+            Nothing -> Just [value]
+            Just xs -> Just (value : xs)
+        )
+        key

test/Day4Spec.hs

@@ -0,0 +1,26 @@
+module Day4Spec (spec) where
+
+import Day4 (partOne, partTwo)
+import Test.Hspec
+
+spec :: Spec
+spec = do
+  describe "PartOne" $ do
+    it "works" $ do
+      partOne input `shouldBe` 18
+
+  describe "PartTwo" $ do
+    it "works" $ do
+      partTwo input `shouldBe` 9
+  where
+    input =
+      "MMMSXXMASM\n\
+      \MSAMXMSMSA\n\
+      \AMXSXMAAMM\n\
+      \MSAMASMSMX\n\
+      \XMASAMXAMM\n\
+      \XXAMMXXAMA\n\
+      \SMSMSASXSS\n\
+      \SAXAMASAAA\n\
+      \MAMMMXMMMM\n\
+      \MXMXAXMASX"