Day 4: Ceres Search

README.md

@@ -8,3 +8,4 @@ Development occurs in language-specific directories:
 |[Day1.hs](hs/src/Day1.hs)|[Day1.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day1.kt)|[day1.py](py/aoc2024/day1.py)|[day1.rs](rs/src/day1.rs)|
 |[Day2.hs](hs/src/Day2.hs)|[Day2.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day2.kt)|[day2.py](py/aoc2024/day2.py)|[day2.rs](rs/src/day2.rs)|
 |[Day3.hs](hs/src/Day3.hs)|[Day3.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day3.kt)|[day3.py](py/aoc2024/day3.py)|[day3.rs](rs/src/day3.rs)|
+|[Day4.hs](hs/src/Day4.hs)||||

hs/aoc2024.cabal

@@ -24,6 +24,7 @@ library
     Day1
     Day2
     Day3
+    Day4
 
   other-modules:
     Common
@@ -62,6 +63,7 @@ test-suite aoc2024-test
     Day1Spec
     Day2Spec
     Day3Spec
+    Day4Spec
 
   build-depends:
     aoc2024,

hs/app/Main.hs

@@ -10,6 +10,7 @@ import Data.Text.IO qualified as TIO (readFile)
 import Day1 qualified (part1, part2)
 import Day2 qualified (part1, part2)
 import Day3 qualified (part1, part2)
+import Day4 qualified (part1, part2)
 import System.Environment (getArgs, lookupEnv)
 import System.FilePath (combine)
 
@@ -35,3 +36,4 @@ main = do
   run 1 (either fail print) [Day1.part1, Day1.part2]
   run 2 (either fail print) [Day2.part1, Day2.part2]
   run 3 print [Day3.part1, Day3.part2]
+  run 4 print [Day4.part1, Day4.part2]

hs/bench/Main.hs

@@ -9,6 +9,7 @@ import Data.Text.IO qualified as TIO (readFile)
 import Day1 qualified (part1, part2)
 import Day2 qualified (part1, part2)
 import Day3 qualified (part1, part2)
+import Day4 qualified (part1, part2)
 import System.Environment.Blank (getEnv, setEnv, unsetEnv)
 import System.FilePath (combine)
 
@@ -43,5 +44,11 @@ main =
           "Day 3"
           [ bench "part 1" $ nf Day3.part1 input,
             bench "part 2" $ nf Day3.part2 input
+          ],
+      env (getDayInput 4) $ \input ->
+        bgroup
+          "Day 4"
+          [ bench "part 1" $ nf Day4.part1 input,
+            bench "part 2" $ nf Day4.part2 input
           ]
     ]

hs/src/Day4.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- Module:         Day4
+-- Description:    <https://adventofcode.com/2024/day/4 Day 4: Ceres Search>
+module Day4 (part1, part2) where
+
+import Control.Monad (guard)
+import Data.List (tails)
+import Data.Text (Text)
+import Data.Text qualified as T (drop, index, length, lines, reverse, splitOn, takeEnd, transpose, unpack)
+
+part1 :: Text -> Int
+part1 input = sum $ pred . length . T.splitOn "XMAS" <$> gs
+  where
+    g = T.lines input
+    d1 = T.transpose (zipWith T.drop [0 ..] g) ++ T.transpose (zipWith T.takeEnd [0 ..] $ T.reverse <$> g)
+    d2 = T.transpose (zipWith T.drop [0 ..] $ T.reverse <$> g) ++ T.transpose (zipWith T.takeEnd [0 ..] g)
+    gs = concat [g, T.reverse <$> g, T.transpose g, T.transpose $ reverse g, d1, T.reverse <$> d1, d2, T.reverse <$> d2]
+
+part2 :: Text -> Int
+part2 input = length $ do
+  prev : line : next : _ <- tails $ T.lines input
+  (i, 'A') <- zip [0 ..] $ T.unpack line
+  guard $ [prev !? pred i, prev !? succ i, next !? pred i, next !? succ i] `elem` ["MMSS", "MSMS", "SMSM", "SSMM"]
+  where
+    t !? i
+      | 0 <= i, i < T.length t = t `T.index` i
+      | otherwise = '\0'

hs/test/Day4Spec.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Day4Spec (spec) where
+
+import Data.Text (Text)
+import Data.Text qualified as T (unlines)
+import Day4 (part1, part2)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+example :: Text
+example =
+  T.unlines
+    [ "MMMSXXMASM",
+      "MSAMXMSMSA",
+      "AMXSXMAAMM",
+      "MSAMASMSMX",
+      "XMASAMXAMM",
+      "XXAMMXXAMA",
+      "SMSMSASXSS",
+      "SAXAMASAAA",
+      "MAMMMXMMMM",
+      "MXMXAXMASX"
+    ]
+
+spec :: Spec
+spec = do
+  describe "part 1" $ do
+    it "examples" $ do
+      part1 example `shouldBe` 18
+  describe "part 2" $ do
+    it "examples" $ do
+      part2 example `shouldBe` 9