Done day 20 part 2

diff --git a/advent20/Main.hs b/advent20/Main.hs
index 93f5dc8b1ecd77b3d6dc848d1d09fd13a1e093c0..91f94a66cff1a5d28bdf3b5fd069424bce269b6a 100644 (file)
--- a/advent20/Main.hs
+++ b/advent20/Main.hs
@@ -27,15 +27,17 @@ main =
   do  dataFileName <- getDataFileName
       text <- readFile dataFileName
       let track = mkTrack text
-      print track
+      -- 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 $ fmap (\h -> (h, pathCostWithCheat 2 track costsFromStart costsFromGoal h)) $ M.keys costsFromStart
+      -- print $ allCheatedCosts 2 track costsFromStart costsFromGoal
+      -- print $ findSavings 2 track costsFromStart costsFromGoal
+      -- print $ findSavings 20 track costsFromStart costsFromGoal
       print $ part1 track costsFromStart costsFromGoal
+      print $ part2 track costsFromStart costsFromGoal
       -- let allTrails = allRoutesFrom maze
       -- -- print allTrails
       -- print $ part1 allTrails
@@ -44,16 +46,21 @@ main =
 -- part1, part2 :: [Agendum] -> Int
 -- part1 trails = cost $ head trails
 
-findSavings track costsFromStart costsFromGoal = fmap (\g -> (length g, head g)) $ group $ sort savings
+findSavings cheatLen track costsFromStart costsFromGoal = fmap (\g -> (length g, head g)) $ group $ sort savings
   where fullCost = costsFromStart M.! track.goal
-        cheatCosts = allCheatedCosts track costsFromStart costsFromGoal
+        cheatCosts = allCheatedCosts cheatLen 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
+        cheatCosts = allCheatedCosts 2 track costsFromStart costsFromGoal
+        savings = filter (>= 100) $ fmap (\c -> fullCost - c) cheatCosts
+part2 track costsFromStart costsFromGoal = length savings       
+  where fullCost = costsFromStart M.! track.goal
+        cheatCosts = allCheatedCosts 20 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
@@ -70,10 +77,10 @@ showTrackWithCheat track here = unlines $ fmap showRow [0..rMax]
         cMax = maximum $ fmap (\(V2 _ c) -> c) $ S.toList $ walls track
         showRow r = [ showCell (V2 r c) | c <- [0..cMax] ]
         showCell pos
-          | pos == here = '@'
+          | pos == here = '□'
           | pos == start track = 'S'
           | pos == goal track = 'E'
-          | pos `S.member` walls track = 'â\98\90'
+          | pos `S.member` walls track = 'â\96 '
           | otherwise = '.'
 
 costsFrom :: Track -> TrackCost -> TrackCost -> TrackCost
@@ -93,16 +100,25 @@ neighbours track here =
             here ^+^ V2 1 0, here ^+^ V2 (-1) 0 ]
 
 
-allCheatedCosts track costsFromStart costsFromGoal = 
-  catMaybes [ pathCostWithCheat track costsFromStart costsFromGoal h 
-            | h <- S.toList track.walls 
+allCheatedCosts cheatLen track costsFromStart costsFromGoal = 
+  concat [ pathCostWithCheat cheatLen track costsFromStart costsFromGoal h 
+            | h <- M.keys costsFromStart 
             ]
 
-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
+pathCostWithCheat :: Int -> Track -> TrackCost -> TrackCost -> Position -> [Int]
+pathCostWithCheat cheatLen track costsFromStart costsFromGoal here =
+  fmap (+ costsFromStart M.! here) continueCosts 
   where
-    nbrs = neighbours track here
-    costsToStart = catMaybes $ fmap (`M.lookup` costsFromStart) nbrs
-    costsToGoal  = catMaybes $ fmap (`M.lookup` costsFromGoal)  nbrs
+    nbrs =  [ here ^+^ (V2 dr dc) 
+            | dr <- [-cheatLen .. cheatLen]
+            , dc <- [-cheatLen .. cheatLen]
+            , abs dr + abs dc <= cheatLen
+            ]
+    continueCosts = catMaybes $ fmap contCost nbrs
+    contCost :: Position -> Maybe Int
+    contCost nbr = do gc <- M.lookup nbr costsFromGoal
+                      let sc = l2Dist nbr here
+                      return $ gc + sc
+
+l2Dist :: Position -> Position -> Int
+l2Dist (V2 r1 c1) (V2 r2 c2) = abs (r1 - r2) + abs (c1 - c2)

diff --git a/adventofcode24.cabal b/adventofcode24.cabal
index 5e148df7694cd6c5d7ea74b25d1b43f7b6674937..32d048036217e6f9c66d78b23d9f5753ae99e914 100644 (file)
--- a/adventofcode24.cabal
+++ b/adventofcode24.cabal
@@ -198,4 +198,4 @@ executable advent19a
 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
+  build-depends: containers, linear