Done day 10

diff --git a/advent10/Main.hs b/advent10/Main.hs
new file mode 100644 (file)
index 0000000..a209163
--- /dev/null
+++ b/advent10/Main.hs
@@ -0,0 +1,112 @@
+-- Writeup at https://work.njae.me.uk/2024/12/10/advent-of-code-2024-day-10/
+
+import AoC
+
+import Data.Char
+import Control.Monad.Reader
+import Linear (V2(..), (^+^)) -- , (^-^), (^*), _x, _y)
+import Data.Array.IArray
+import Data.List
+
+type Position = V2 Int -- r, c
+
+type Trail = [Position]
+
+type Grid = Array Position Int
+
+data TMap = TMap
+  { grid :: Grid
+  , starts :: [Position]
+  , goals :: [Position]
+  } deriving (Show)
+
+type TMapContext = Reader TMap
+
+data Agendum = 
+    Agendum { current :: Position
+            , trail :: Trail
+            } deriving (Show, Eq)
+
+type Agenda = [Agendum]
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- readFile dataFileName
+      let tmap = mkMap text
+      -- print tmap
+      let trailheads = tmap.starts
+      let allTrails = fmap (allRoutesFrom tmap) trailheads
+      print $ part1 allTrails
+      print $ part2 allTrails
+
+allRoutesFrom :: TMap -> Position -> [Agendum]
+allRoutesFrom tmap s = runReader (searchMap s) tmap
+
+part1, part2 :: [[Agendum]] -> Int
+part1 trails = sum $ fmap length $ fmap dedupe trails
+    where dedupe solns = nub $ fmap current solns
+
+part2 trails = sum $ fmap length trails
+
+mkMap :: String -> TMap
+mkMap text = TMap { .. }
+  where rows = lines text
+        r = length rows - 1
+        c = (length $ head rows) - 1
+        grid = listArray ((V2 0 0), (V2 r c)) $ map readElem $ concat rows
+        readElem x = if isDigit x then digitToInt x else -1
+        starts = [ V2 ra ca | ra <- [0..r], ca <- [0..c], rows !! ra !! ca == '0' ]
+        goals = [ V2 ra ca | ra <- [0..r], ca <- [0..c], rows !! ra !! ca == '9' ]
+
+searchMap :: Position -> TMapContext [Agendum]
+searchMap startPos = 
+  do agenda <- initAgenda startPos
+     bfs agenda []
+
+initAgenda :: Position -> TMapContext Agenda
+initAgenda pos = 
+    do let agendum = Agendum { current = pos, trail = [] }
+       return [agendum]
+
+bfs ::  Agenda -> [Agendum] -> TMapContext [Agendum]
+bfs [] founds = return founds
+bfs (currentAgendum : restAgenda) founds = 
+  do  let reached = currentAgendum.current
+      nexts <- candidates currentAgendum 
+      let newAgenda = restAgenda ++ nexts
+      reachedGoal <- isGoal reached
+      if reachedGoal
+      then bfs restAgenda (currentAgendum : founds)
+      else bfs newAgenda founds
+
+candidates :: Agendum -> TMapContext [Agendum]
+candidates agendum = 
+  do  let here = agendum.current
+      let previous = agendum.trail
+      succs <- successors here
+      mapM (makeAgendum previous) succs 
+
+makeAgendum :: Trail -> Position -> TMapContext Agendum
+makeAgendum previous here = 
+    do let newTrail = (here : previous)
+       return Agendum { current = here
+                      , trail = newTrail
+                      }
+
+successors :: Position -> TMapContext [Position]
+successors here = 
+  do  g <- asks grid
+      let height = (g ! here) + 1
+      let moves = [ here ^+^ delta
+                  | delta <- [ V2 (-1) 0, V2 1 0, V2 0 (-1), V2 0 1 ]
+                  ]
+      let boundMoves = filter (inRange (bounds g)) moves
+      let validMoves = filter (\m -> g ! m == height) boundMoves
+      return validMoves
+
+isGoal :: Position -> TMapContext Bool
+isGoal here = 
+  do gs <- asks goals
+     return $ here `elem` gs
+

diff --git a/adventofcode24.cabal b/adventofcode24.cabal
index accdec7f9dd21043f98c2da766bd77529cd61179..a188378d7fb6f4d232aa6bad691d7d06577c5edc 100644 (file)
--- a/adventofcode24.cabal
+++ b/adventofcode24.cabal
@@ -123,4 +123,9 @@ executable advent09
   import: warnings, common-extensions, build-directives, common-modules
   main-is: advent09/Main.hs  
   build-depends: containers
+
+executable advent10
+  import: common-extensions, build-directives
+  main-is: advent10/Main.hs
+  build-depends: linear, array, mtl
   
\ No newline at end of file