Advent of Code 2025
drubery.com
1module Day10 where
2
3import Data.Ratio ((%), Ratio)
4import Util (split)
5import Data.Maybe (catMaybes)
6import Data.Ord (comparing)
7import Data.List (sortBy)
8import qualified Data.Map as Map
9import Data.Map (Map)
10import Debug.Trace
11
12type Button = [Int]
13type Display = [Int]
14type Machine = (Button, [Button], [Int])
15
16parse :: String -> [Machine]
17parse = map parseLine . lines
18 where parseDisplay :: String -> [Int]
19 parseDisplay s = [i | (i,c) <- zip [0..] (init (tail s)), c == '#']
20
21 parseInts :: String -> [Int]
22 parseInts s = map read $ split ',' $ (init (tail s))
23
24 parseLine line =
25 let w = words line
26 disp = head w
27 jolt = last w
28 in (parseDisplay disp, map parseInts (init (tail w)), parseInts jolt)
29
30xor :: [Int] -> [Int] -> [Int]
31xor a [] = a
32xor [] b = b
33xor (a:as) (b:bs) | a < b = (a : xor as (b:bs))
34xor (a:as) (b:bs) | a == b = xor as bs
35xor (a:as) (b:bs) | a > b = (b : xor (a:as) bs)
36
37minimumMaybe :: [Maybe Int] -> Maybe Int
38minimumMaybe ns =
39 case catMaybes ns of
40 [] -> Nothing
41 ns' -> Just $ minimum ns'
42
43solveMachine :: Machine -> Maybe Int
44solveMachine ([],[],_) = Just 0
45solveMachine (_,[],_) = Nothing
46solveMachine (goal, (b:bs), jolt) =
47 minimumMaybe [solveMachine (goal, bs, jolt),
48 (+ 1) <$> solveMachine (xor goal b, bs, jolt)]
49
50part1 :: String -> String
51part1 input =
52 let machines = parse input
53 solutions = map solveMachine machines
54 in case sequence solutions of
55 Just ss -> show $ sum ss
56 Nothing -> "Failed"
57
58buttonToRepeat :: Int -> Button -> [Int]
59buttonToRepeat i button = go 0 button
60 where go n [] = repeat 0
61 go n (b:bs) =
62 if n == b then
63 (i : go (n+1) bs)
64 else
65 (0 : go (n+1) (b:bs))
66
67type Matrix = (Int, Int, Map (Int,Int) (Ratio Int))
68
69cols :: Matrix -> Int
70cols (_, c, _) = c - 1
71
72rows :: Matrix -> Int
73rows (r, _, _) = r
74
75mat :: Matrix -> Map (Int,Int) (Ratio Int)
76mat (_, _, m) = m
77
78minimum' :: Ord a => [a] -> Maybe a
79minimum' [] = Nothing
80minimum' as = Just $ minimum as
81
82pivotCell :: Matrix -> Int -> Int -> Maybe (Int, Int)
83pivotCell m minRow minCol =
84 minimum' [(i,j) | i <- [minCol..cols m - 1],
85 j <- [minRow..rows m - 1],
86 (mat m) Map.! (i,j) /= 0]
87
88eraseColumn :: Int -> Int -> Matrix -> Matrix
89eraseColumn i j m = error "TODO"
90
91swapCols :: Int -> Int -> Matrix -> Matrix
92swapCols i i' m = error "TODO"
93 -- let (r,c,d) = m
94 -- d' = Map.fromList
95 -- ([((i,j), d Map.! (i',j)) | j <- [0..rows - 1]] ++
96 -- [((i',j), d Map.! (i,j)) | j <- [0..rows - 1]])
97 -- in (r,c,Map.union d' d)
98
99gaussJordan :: Map (Int,Int) (Ratio Int) -> Map (Int,Int) (Ratio Int)
100gaussJordan mat = error "TODO" -- go mat 0 0
101 -- where go m minRow minCol =
102 -- case pivotCell m minRow minCol of
103 -- Nothing -> m
104 -- Just (i,j) ->
105 -- let m' = eraseColumn minCol minRow $
106 -- normalizeRow minCol minRow $
107 -- swapRows j minRow $
108 -- swapCols i minCol m
109 -- in go m' (minRow + 1) (minCol + 1)
110
111solveMachine2 :: [Button] -> [Int] -> Maybe Int
112solveMachine2 buttons goal = error "TODO"
113 -- let mat = Map.fromList [((i,j),1 % 1) | (i,b) <- zip [0..] buttons, j <- b]
114 -- g = Map.fromList $ zip [0..] (map (% 1) goal)
115 -- (mat', g', rank) = gaussJordan mat g
116 -- in Just 0
117
118part2 :: String -> String
119part2 input =
120 let machines = parse input
121 solutions = map (\(_,b,g) -> solveMachine2 b g) machines
122 in case sequence solutions of
123 Just ss -> show $ sum ss
124 Nothing -> "Failed"