eldridge.cam
Advent of Code solutions
translate to haskell but no dice
+57
2025/10/p2.hs
+57
2025/10/p2.hs
···
1
+
import Debug.Trace
2
+
import Text.Parsec
3
+
import Data.List (sortBy, sort, foldl1, find, nub, sum)
4
+
import Control.Monad (guard)
5
+
import Data.Ord (comparing)
6
+
7
+
integer = read <$> many digit
8
+
9
+
machine = do
10
+
_ :: [Char] <- between (char '[') (char ']') $ many1 (char '.' <|> char '#')
11
+
char ' '
12
+
buttons :: [[Int]] <- (between (char '(') (char ')') $ integer `sepBy1` char ',') `sepEndBy` char ' '
13
+
joltage :: [Int] <- between (char '{') (char '}') $ integer `sepBy1` char ','
14
+
return $ (joltage, buttons)
15
+
16
+
limitWithin target button = foldl1 min $ fmap (target !!) button
17
+
18
+
subAt 0 n (m:ms) = m - n:ms
19
+
subAt i n (m:ms) = m:subAt (i - 1) n ms
20
+
21
+
applyButton _ [] target = target
22
+
applyButton n (i:rest) target = applyButton n rest $ subAt i n $ target
23
+
24
+
covers target coverage =
25
+
all (\ i -> target !! i == 0 || i `elem` coverage) [0..length target - 1]
26
+
27
+
solvable _ _ [] = False
28
+
solvable remaining target allButtons@(button:buttons) =
29
+
if remaining < foldl1 max target || not (covers target $ nub $ concat allButtons)
30
+
then False
31
+
else
32
+
let limit = min remaining $ limitWithin target button in any pressAndSolve [limit, limit-1..0]
33
+
where
34
+
pressAndSolve times =
35
+
let newTarget = applyButton times button target in
36
+
if all ((==) 0) newTarget
37
+
then True
38
+
else solvable (remaining - times) newTarget (prioritize newTarget buttons)
39
+
40
+
rangeSize target buttons button =
41
+
let
42
+
others = nub $ concat $ filter ((/=) button) buttons
43
+
upper = limitWithin target button
44
+
in if covers target others then 1 else upper
45
+
46
+
prioritize target buttons =
47
+
sortBy (comparing $ rangeSize target buttons) buttons
48
+
49
+
solve (target, buttons) = ans
50
+
where
51
+
solveIn i = solvable (traceShowId i) target $ prioritize target buttons
52
+
Just ans = find solveIn [foldl1 max target..]
53
+
54
+
answer input = sum $ (traceShowId . solve . traceShowId) <$> machines
55
+
where
56
+
Right machines = parse (machine `sepEndBy` char '\n') "" input
57
+
main = getContents >>= print . answer