Skip to content

Commit f845c9a

Browse files
committed
slight day 20 search optimization
1 parent 7bfa291 commit f845c9a

File tree

1 file changed

+21
-2
lines changed

1 file changed

+21
-2
lines changed

2024/AOC2024/Day20.hs

+21-2
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,6 @@ where
1414

1515
import AOC.Common (findKeyFor, floodFill)
1616
import AOC.Common.Point (Point, cardinalNeighbsSet, mannDist, mannNorm, parseAsciiMap)
17-
import AOC.Common.Search (bfs)
1817
import AOC.Solver (noFail, type (:~>) (..))
1918
import Data.Map (Map)
2019
import qualified Data.Map as M
@@ -24,6 +23,26 @@ import qualified Data.Set as S
2423
import Data.Traversable (mapAccumR)
2524
import Data.Tuple.Strict (T2 (..))
2625

26+
racePath ::
27+
-- | walls
28+
Set Point ->
29+
-- | start
30+
Point ->
31+
-- | end
32+
Point ->
33+
Maybe [Point]
34+
racePath walls start end = go Nothing start
35+
where
36+
go :: Maybe Point -> Point -> Maybe [Point]
37+
go prev here = do
38+
next <- S.lookupMin candidates
39+
(here :)
40+
<$> if next == end
41+
then pure [end]
42+
else go (Just here) next
43+
where
44+
candidates = maybe id S.delete prev $ cardinalNeighbsSet here `S.difference` walls
45+
2746
findCheats ::
2847
-- | walls
2948
Set Point ->
@@ -37,7 +56,7 @@ findCheats ::
3756
Int ->
3857
Maybe Int
3958
findCheats walls start end len thresh = do
40-
path <- (start :) <$> bfs ((`S.difference` walls) . cardinalNeighbsSet) start (== end)
59+
path <- racePath walls start end
4160
pure . sum . snd $ mapAccumR go (T2 0 M.empty) path
4261
where
4362
go :: T2 Int (Map Point Int) -> Point -> (T2 Int (Map Point Int), Int)

0 commit comments

Comments
 (0)