eldridge.cam
Advent of Code solutions
solved by translating to haskell :) 2025 is done
+51
-34
2025/10/p2.hs
+51
-34
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
···
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
···
1
import Control.Monad (guard)
2
+
import Control.Monad.State
3
+
import Data.Bits
4
+
import Data.Bool
5
+
import Data.Function ((&))
6
+
import Data.List (find, foldl1, nub, sort, sortBy, sum)
7
+
import Data.Map (Map, insert)
8
+
import qualified Data.Map as Map
9
import Data.Ord (comparing)
10
+
import Text.Parsec (between, char, digit, many, many1, parse, sepBy1, sepEndBy, (<|>))
11
12
integer = read <$> many digit
13
···
18
joltage :: [Int] <- between (char '{') (char '}') $ integer `sepBy1` char ','
19
return $ (joltage, buttons)
20
21
+
targetState '.' = False
22
+
targetState '#' = True
23
24
+
buttonBits len button = foldl setBit 0 $ map (\n -> len - n - 1) button
25
26
+
decrAt 0 (m : ms) = m - 1 : ms
27
+
decrAt i (m : ms) = m : decrAt (i - 1) ms
28
29
+
applyButton target [] = target
30
+
applyButton target (i : rest) = applyButton (decrAt i target) rest
31
32
+
choose :: Int -> [a] -> [[a]]
33
+
choose 0 _ = [[]]
34
+
choose n [] = []
35
+
choose n (x : xs) = ((x :) <$> choose (n - 1) xs) ++ choose n xs
36
37
+
solveBits :: [[Int]] -> Int -> Int -> [[[Int]]]
38
+
solveBits buttons len target =
39
+
[option | n <- [0 .. length buttons], option <- choose n buttons, target == (foldl xor 0 $ fmap (buttonBits len) option)]
40
41
+
solve buttons joltage = evalState (solve_ joltage) Map.empty
42
where
43
+
solve_ :: [Int] -> State (Map [Int] Int) Int
44
+
solve_ joltage = do
45
+
cached <- gets (Map.lookup joltage)
46
+
case cached of
47
+
Nothing -> do
48
+
ans <- compute joltage
49
+
modify $ insert joltage ans
50
+
return ans
51
+
Just answer -> return answer
52
+
compute :: [Int] -> State (Map [Int] Int) Int
53
+
compute joltage =
54
+
if all (== 0) joltage
55
+
then return 0
56
+
else
57
+
joltage
58
+
& fmap (\n -> n `mod` 2)
59
+
& foldl (\joltage bit -> bit .|. joltage `shift` 1) 0
60
+
& solveBits buttons (length joltage)
61
+
& fmap (\sol -> (foldl applyButton joltage sol, length sol))
62
+
& filter (\(remaining, _) -> all (>= 0) remaining)
63
+
& mapM
64
+
( \(remaining, score) -> do
65
+
sub <- solve_ (fmap (`div` 2) remaining)
66
+
return $ sub * 2 + score
67
+
)
68
+
& fmap (foldl min 10000000)
69
70
+
answer input = sum $ fmap (\(j, b) -> solve b j) machines
71
where
72
Right machines = parse (machine `sepEndBy` char '\n') "" input
73
+
74
main = getContents >>= print . answer
+2
-5
2025/10/p2.tri
+2
-5
2025/10/p2.tri
···
42
func apply_button target [i, ..rest] = apply_button (decr_at i target) rest
43
44
func solve_bits buttons target =
45
-
it::range 1 (length buttons)
46
|> it::flat_map (fn n. it::choose n buttons)
47
-
|> it::filter ((==) target << reduce (^) << map (button_bits (length target)))
48
49
proc solver!(buttons) {
50
let cache = {||}
···
55
}
56
if all ((==) 0) joltage {
57
return 0
58
-
}
59
-
if all (fn n. n % 2 == 0) joltage {
60
-
return solve!(map (fn n. n // 2) joltage) * 2
61
}
62
let best = joltage
63
|> map (fn n. n % 2 == 1)
···
42
func apply_button target [i, ..rest] = apply_button (decr_at i target) rest
43
44
func solve_bits buttons target =
45
+
it::range 0 (length buttons)
46
|> it::flat_map (fn n. it::choose n buttons)
47
+
|> it::filter ((==) target << fold (^) (target ^ target) << map (button_bits (length target)))
48
49
proc solver!(buttons) {
50
let cache = {||}
···
55
}
56
if all ((==) 0) joltage {
57
return 0
58
}
59
let best = joltage
60
|> map (fn n. n % 2 == 1)