2024-20 part 2 in haskell

This commit is contained in:
Julien Dessaux 2025-06-16 00:17:43 +02:00
parent cfde33a57b
commit 45cb3b76ba
Signed by: adyxax
GPG key ID: F92E51B86E07177E
2 changed files with 96 additions and 8 deletions

View file

@ -49,15 +49,17 @@ type Visited = M.Map Coord Int
type Cost = Int
compute :: Input -> Int -> Int
compute input minGains = trace (show findAllShortcutCosts) $ length $ filter (>= minGains) findAllShortcutCosts
compute input minGain = findAllShortcut
where
findAllShortcutCosts :: [Int]
findAllShortcutCosts = M.foldrWithKey findShortcutCostsFrom [] costs
findShortcutCostsFrom :: Coord -> Int -> [Int] -> [Int]
findShortcutCostsFrom (x, y) c acc = acc ++ catMaybes [ if and [input V.! y V.! (x+1) == Wall, M.member (x+2, y) costs] then Just (costs M.! (x+2, y) - c - 2) else Nothing
, if and [input V.! y V.! (x-1) == Wall, M.member (x-2, y) costs] then Just (costs M.! (x-2, y) - c - 2) else Nothing
, if and [input V.! (y+1) V.! x == Wall, M.member (x, y+2) costs] then Just (costs M.! (x, y+2) - c - 2) else Nothing
, if and [input V.! (y-1) V.! x == Wall, M.member (x, y-2) costs] then Just (costs M.! (x, y-2) - c - 2) else Nothing]
findAllShortcut :: Int
findAllShortcut = M.foldrWithKey findShortcutFrom 0 costs
findShortcutFrom :: Coord -> Int -> Int -> Int
findShortcutFrom (x, y) c acc = M.foldrWithKey validShortcut acc candidates
where
candidates = M.filterWithKey (\(x', y') _ -> (abs $ x - x') + (abs $ y - y') <= 2) costs
validShortcut :: Coord -> Int -> Int -> Int
validShortcut (x', y') c' acc' = let gain = c' - c - (abs $ x - x') - (abs $ y - y')
in if gain >= minGain then acc' + 1 else acc'
(costs, len) = walk M.empty 0 (sx, sy)
where
walk :: Visited -> Int -> Coord -> (Visited, Int)