commit e997a8d442a1800dcfee18262a0049e7878a7092 · drubery.com/aoc2025

+78 -2
src/Day10.hs
···

       1
       1
        
       module Day10 where

     

       2
       2
        
       

     

       3
       3
       +
       import Data.Ratio ((%), Ratio)

     

       4
       4
       +
       import Util (split)

     

       5
       5
       +
       import Data.Maybe (catMaybes)

     

       6
       6
       +
       import Data.Ord (comparing)

     

       7
       7
       +
       import Data.List (sortBy)

     

       8
       8
       +
       import qualified Data.Map as Map

     

       9
       9
       +
       import Data.Map (Map)

     

       10
       10
       +
       import Debug.Trace

     

       11
       11
       +
       

     

       12
       12
       +
       type Button = [Int]

     

       13
       13
       +
       type Display = [Int]

     

       14
       14
       +
       type Machine = (Button, [Button], [Int])

     

       15
       15
       +
       

     

       16
       16
       +
       parse :: String -> [Machine]

     

       17
       17
       +
       parse = map parseLine . lines

     

       18
       18
       +
         where parseDisplay :: String -> [Int]

     

       19
       19
       +
               parseDisplay s = [i | (i,c) <- zip [0..] (init (tail s)), c == '#']

     

       20
       20
       +
       

     

       21
       21
       +
               parseInts :: String -> [Int]

     

       22
       22
       +
               parseInts s = map read $ split ',' $ (init (tail s))

     

       23
       23
       +
               

     

       24
       24
       +
               parseLine line =

     

       25
       25
       +
                 let w = words line

     

       26
       26
       +
                     disp = head w

     

       27
       27
       +
                     jolt = last w

     

       28
       28
       +
                  in (parseDisplay disp, map parseInts (init (tail w)), parseInts jolt)

     

       29
       29
       +
       

     

       30
       30
       +
       xor :: [Int] -> [Int] -> [Int]

     

       31
       31
       +
       xor a [] = a

     

       32
       32
       +
       xor [] b = b

     

       33
       33
       +
       xor (a:as) (b:bs) | a < b  = (a : xor as (b:bs))

     

       34
       34
       +
       xor (a:as) (b:bs) | a == b = xor as bs

     

       35
       35
       +
       xor (a:as) (b:bs) | a > b  = (b : xor (a:as) bs)

     

       36
       36
       +
       

     

       37
       37
       +
       minimumMaybe :: [Maybe Int] -> Maybe Int

     

       38
       38
       +
       minimumMaybe ns =

     

       39
       39
       +
         case catMaybes ns of

     

       40
       40
       +
           [] -> Nothing

     

       41
       41
       +
           ns' -> Just $ minimum ns'

     

       42
       42
       +
       

     

       43
       43
       +
       solveMachine :: Machine -> Maybe Int

     

       44
       44
       +
       solveMachine ([],[],_) = Just 0

     

       45
       45
       +
       solveMachine (_,[],_) = Nothing

     

       46
       46
       +
       solveMachine (goal, (b:bs), jolt) =

     

       47
       47
       +
         minimumMaybe [solveMachine (goal, bs, jolt),

     

       48
       48
       +
                       (+ 1) <$> solveMachine (xor goal b, bs, jolt)]

     

       49
       49
       +
       

     

       3
       50
        
       part1 :: String -> String

     

       4
       4
       -
       part1 _ = "Day 10 part 1"

     

       51
       51
       +
       part1 input =

     

       52
       52
       +
         let machines = parse input

     

       53
       53
       +
             solutions = map solveMachine machines

     

       54
       54
       +
          in case sequence solutions of

     

       55
       55
       +
               Just ss -> show $ sum ss

     

       56
       56
       +
               Nothing -> "Failed"

     

       57
       57
       +
       

     

       58
       58
       +
       buttonToRepeat :: Int -> Button -> [Int]

     

       59
       59
       +
       buttonToRepeat i button = go 0 button

     

       60
       60
       +
        where go n [] = repeat 0

     

       61
       61
       +
              go n (b:bs) =

     

       62
       62
       +
                if n == b then

     

       63
       63
       +
                  (i : go (n+1) bs)

     

       64
       64
       +
                else

     

       65
       65
       +
                  (0 : go (n+1) (b:bs))

     

       66
       66
       +
       

     

       67
       67
       +
       gaussJordan :: Map (Int,Int) (Ratio Int) -> Map Int (Ratio Int) -> (Map (Int,Int) (Ratio Int), Map Int (Ratio Int), Int)

     

       68
       68
       +
       gaussJordan m g = error "GJ"

     

       69
       69
       +
       

     

       70
       70
       +
       solveMachine2 :: [Button] -> [Int] -> Maybe Int

     

       71
       71
       +
       solveMachine2 buttons goal =

     

       72
       72
       +
         let mat = Map.fromList [((i,j),1 % 1) | (i,b) <- zip [0..] buttons, j <- b]

     

       73
       73
       +
             g = Map.fromList $ zip [0..] (map (% 1) goal)

     

       74
       74
       +
             (mat', g', rank) = gaussJordan mat g

     

       75
       75
       +
          in Just 0

     

       5
       76
        
       

     

       6
       77
        
       part2 :: String -> String

     

       7
       7
       -
       part2 _ = "Day 10 part 2"

     

       78
       78
       +
       part2 input =

     

       79
       79
       +
         let machines = parse input

     

       80
       80
       +
             solutions = map (\(_,b,g) -> solveMachine2 b g) machines

     

       81
       81
       +
          in case sequence solutions of

     

       82
       82
       +
               Just ss -> show $ sum ss

     

       83
       83
       +
               Nothing -> "Failed"