Done day 4

diff --git a/advent04/Main.hs b/advent04/Main.hs
new file mode 100644 (file)
index 0000000..fc8b0b7
--- /dev/null
+++ b/advent04/Main.hs
@@ -0,0 +1,83 @@
+-- Writeup at https://work.njae.me.uk/2024/12/04/advent-of-code-2024-day-4/
+
+import AoC
+import Linear
+import Data.Array.IArray
+
+type Position = V2 Int -- r, c
+type Grid = Array Position Char
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- readFile dataFileName
+      let grid = mkGrid text
+      -- print grid
+      -- putStrLn $ showGrid grid
+      print $ part1 grid
+      print $ part2 grid
+
+part1, part2 :: Grid -> Int
+part1 grid = length $ filter (== targetWord) 
+                    $ foundWords grid 
+                    $ validWords grid 
+                    $ potentialWords grid
+
+part2 grid = length $ filter isXmas 
+                    $ foundWords grid 
+                    $ validWords grid 
+                    $ potentialXs grid
+
+targetWord :: String
+targetWord = "XMAS"
+
+targetLength :: Int
+targetLength = length targetWord
+
+extensions :: Int -> [[Position]]
+extensions n = fmap go directions
+  where 
+    go d = take n $ iterate (^+^ d) (V2 0 0)
+    directions =  [ V2 dr dc
+                  | dr <- [-1, 0, 1] 
+                  , dc <- [-1, 0, 1]
+                  , dr /= 0 || dc /= 0
+                  ]
+
+xExtension :: [Position]
+xExtension = [V2 0 0, V2 -1 -1, V2 1 -1, V2 -1 1, V2 1 1]
+
+potentialWords, potentialXs :: Grid -> [[Position]]
+potentialWords grid = concatMap go $ indices grid
+  where go pos = fmap (^+^ pos) <$> extensions targetLength
+
+potentialXs grid = go <$> indices grid
+  where go pos = fmap (^+^ pos) xExtension
+
+validWords :: Grid -> [[Position]] -> [[Position]]
+validWords grid = filter allInBounds
+  where allInBounds = all (inRange (bounds grid))
+
+foundWords :: Grid -> [[Position]] -> [String]
+foundWords grid = fmap (fmap (grid !))
+
+isXmas :: String -> Bool
+isXmas "AMMSS" = True
+isXmas "ASMSM" = True
+isXmas "AMSMS" = True
+isXmas "ASSMM" = True
+isXmas _ = False
+
+mkGrid :: String -> Grid
+mkGrid text = listArray ((V2 0 0), (V2 r c)) $ concat rows
+  where rows = lines text
+        r = length rows - 1
+        c = (length $ head rows) - 1
+
+showGrid :: Grid -> String
+showGrid grid = unlines rows
+  where (_, V2 rMax cMax) = bounds grid
+        rows = [showRow r | r <- [0..rMax]]
+        showRow r = [showElem r c | c <- [0..cMax]]
+        showElem r c = grid ! (V2 r c)
+

diff --git a/adventofcode24.cabal b/adventofcode24.cabal
index ecb556c8f8a67350fa257ce1c7e1e47b8a303d37..29d55f2c40c67fe7e28614bd897b87dd8e0a3852 100644 (file)
--- a/adventofcode24.cabal
+++ b/adventofcode24.cabal
@@ -85,3 +85,8 @@ executable advent03
   import: warnings, common-extensions, build-directives, common-modules
   main-is: advent03/Main.hs  
   build-depends: attoparsec, text
+
+executable advent04
+  import: warnings, common-extensions, build-directives, common-modules
+  main-is: advent04/Main.hs  
+  build-depends: array, linear