Done day 20 part 1

diff --git a/advent20/Main.hs b/advent20/Main.hs
new file mode 100644 (file)
index 0000000..93f5dc8
--- /dev/null
+++ b/advent20/Main.hs
@@ -0,0 +1,108 @@
+-- Writeup at https://work.njae.me.uk/2024/12/16/advent-of-code-2024-day-16/
+
+import AoC
+
+-- import Data.Char
+import Linear (V2(..), (^+^), perp)
+import qualified Data.Set as S
+import qualified Data.Map.Strict as M
+import Data.Maybe
+import Data.List
+
+type Position = V2 Int -- r, c
+
+type Walls = S.Set Position
+
+data Track = Track
+  { walls :: Walls
+  , start :: Position
+  , goal :: Position
+  } deriving (Eq, Ord, Show)
+
+type TrackCost = M.Map Position Int
+
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- readFile dataFileName
+      let track = mkTrack text
+      print track
+      let costsFromStart = costsFrom track (M.singleton track.start 0) (M.singleton track.start 0)
+      let costsFromGoal = costsFrom track (M.singleton track.goal 0) (M.singleton track.goal 0)
+      -- print costsFromStart
+      -- print costsFromGoal
+      -- print $ fmap (\h -> (h, pathCostWithCheat track costsFromStart costsFromGoal h)) $ S.toList track.walls
+      -- print $ allCheatedCosts track costsFromStart costsFromGoal
+      print $ findSavings track costsFromStart costsFromGoal
+      print $ part1 track costsFromStart costsFromGoal
+      -- let allTrails = allRoutesFrom maze
+      -- -- print allTrails
+      -- print $ part1 allTrails
+      -- print $ part2 allTrails
+
+-- part1, part2 :: [Agendum] -> Int
+-- part1 trails = cost $ head trails
+
+findSavings track costsFromStart costsFromGoal = fmap (\g -> (length g, head g)) $ group $ sort savings
+  where fullCost = costsFromStart M.! track.goal
+        cheatCosts = allCheatedCosts track costsFromStart costsFromGoal
+        savings = filter (> 0) $ fmap (\c -> fullCost - c) cheatCosts
+
+part1 track costsFromStart costsFromGoal = length savings
+  where fullCost = costsFromStart M.! track.goal
+        cheatCosts = allCheatedCosts track costsFromStart costsFromGoal
+        savings = filter (>= 100) $ fmap (\c -> fullCost - c) cheatCosts
+
+mkTrack :: String -> Track
+mkTrack text = Track { walls = walls, start = start, goal = goal }
+  where rows = lines text
+        rMax = length rows - 1
+        cMax = (length $ head rows) - 1
+        walls = S.fromList [ V2 r c | r <- [0..rMax], c <- [0..cMax], rows !! r !! c == '#' ]
+        start = head [ V2 r c | r <- [0..rMax], c <- [0..cMax], rows !! r !! c == 'S' ]
+        goal = head [ V2 r c | r <- [0..rMax], c <- [0..cMax], rows !! r !! c == 'E' ]
+
+
+showTrackWithCheat :: Track -> Position -> String
+showTrackWithCheat track here = unlines $ fmap showRow [0..rMax]
+  where rMax = maximum $ fmap (\(V2 r _) -> r) $ S.toList $ walls track
+        cMax = maximum $ fmap (\(V2 _ c) -> c) $ S.toList $ walls track
+        showRow r = [ showCell (V2 r c) | c <- [0..cMax] ]
+        showCell pos
+          | pos == here = '@'
+          | pos == start track = 'S'
+          | pos == goal track = 'E'
+          | pos `S.member` walls track = '☐'
+          | otherwise = '.'
+
+costsFrom :: Track -> TrackCost -> TrackCost -> TrackCost
+costsFrom track costs boundary
+  | M.null boundary = costs
+  | otherwise = costsFrom track costs' boundary''
+  where boundary' = M.foldlWithKey addBoundary M.empty boundary
+        addBoundary acc here cost = 
+          M.union acc $ M.fromList $ zip (neighbours track here) (repeat (cost + 1))
+        boundary'' = boundary' `M.difference` costs
+        costs' = costs `M.union` boundary'
+
+neighbours :: Track -> Position -> [Position]
+neighbours track here = 
+  filter (`S.notMember` track.walls) 
+          [ here ^+^ V2 0 1, here ^+^ V2 0 (-1), 
+            here ^+^ V2 1 0, here ^+^ V2 (-1) 0 ]
+
+
+allCheatedCosts track costsFromStart costsFromGoal = 
+  catMaybes [ pathCostWithCheat track costsFromStart costsFromGoal h 
+            | h <- S.toList track.walls 
+            ]
+
+pathCostWithCheat :: Track -> TrackCost -> TrackCost -> Position -> Maybe Int
+pathCostWithCheat track costsFromStart costsFromGoal here 
+  | (not $ null costsToStart) && (not $ null costsToGoal) = Just $ minimum costsToStart + minimum costsToGoal + 2
+  | otherwise = Nothing
+  where
+    nbrs = neighbours track here
+    costsToStart = catMaybes $ fmap (`M.lookup` costsFromStart) nbrs
+    costsToGoal  = catMaybes $ fmap (`M.lookup` costsFromGoal)  nbrs

diff --git a/adventofcode24.cabal b/adventofcode24.cabal
index fd60adf7a34396f493e09e516e94c1ba795cf458..5e148df7694cd6c5d7ea74b25d1b43f7b6674937 100644 (file)
--- a/adventofcode24.cabal
+++ b/adventofcode24.cabal
@@ -193,4 +193,9 @@ executable advent19p
 executable advent19a
   import: warnings, common-extensions, build-directives, common-modules
   main-is: advent19/MainA.hs 
-  build-depends: attoparsec, text
\ No newline at end of file
+  build-depends: attoparsec, text
+
+executable advent20
+  import: warnings, common-extensions, build-directives, common-modules
+  main-is: advent20/Main.hs
+  build-depends: containers, linear
\ No newline at end of file