comparing 82723a0582cfd9aa4a9099bd4fefdab359a1d0e1 and main on drubery.com/aoc2025

-6

generate.py

···

       1
       1
       -
       # for i in range(1,25):

     

       2
       2
       -
       #    f = open(f"src/Day{i}.hs", "w")

     

       3
       3
       -
       #    f.write(f"module Day{i} where\n\npart1 :: String -> String\npart1 _ = \"Day {i} part 1\"\n\npart2 :: String -> String\npart2 _ = \"Day {i} part 2\"\n")

     

       4
       4
       -
       

     

       5
       5
       -
       for i in range(1,13):

     

       6
       6
       -
           print(f"\"{i}\" -> do\n          putStrLn $ \"Part 1: \" ++ Day{i}.part1 input\n          putStrLn $ \"Part 2: \" ++ Day{i}.part2 input\n    ",end='')

+119 -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
       +
       type Matrix = (Int, Int, Map (Int,Int) (Ratio Int))

     

       68
       68
       +
       

     

       69
       69
       +
       cols :: Matrix -> Int

     

       70
       70
       +
       cols (_, c, _) = c - 1

     

       71
       71
       +
       

     

       72
       72
       +
       rows :: Matrix -> Int

     

       73
       73
       +
       rows (r, _, _) = r

     

       74
       74
       +
       

     

       75
       75
       +
       mat :: Matrix -> Map (Int,Int) (Ratio Int)

     

       76
       76
       +
       mat (_, _, m) = m

     

       77
       77
       +
       

     

       78
       78
       +
       minimum' :: Ord a => [a] -> Maybe a

     

       79
       79
       +
       minimum' [] = Nothing

     

       80
       80
       +
       minimum' as = Just $ minimum as

     

       81
       81
       +
       

     

       82
       82
       +
       pivotCell :: Matrix -> Int -> Int -> Maybe (Int, Int)

     

       83
       83
       +
       pivotCell m minRow minCol =

     

       84
       84
       +
         minimum' [(i,j) | i <- [minCol..cols m - 1],

     

       85
       85
       +
                           j <- [minRow..rows m - 1],

     

       86
       86
       +
                           (mat m) Map.! (i,j) /= 0]

     

       87
       87
       +
       

     

       88
       88
       +
       eraseColumn :: Int -> Int -> Matrix -> Matrix

     

       89
       89
       +
       eraseColumn i j m = error "TODO"

     

       90
       90
       +
       

     

       91
       91
       +
       swapCols :: Int -> Int -> Matrix -> Matrix

     

       92
       92
       +
       swapCols i i' m = error "TODO"

     

       93
       93
       +
         -- let (r,c,d) = m

     

       94
       94
       +
         --     d' = Map.fromList

     

       95
       95
       +
         --            ([((i,j), d Map.! (i',j)) | j <- [0..rows - 1]] ++

     

       96
       96
       +
         --             [((i',j), d Map.! (i,j)) | j <- [0..rows - 1]])

     

       97
       97
       +
         --  in (r,c,Map.union d' d)

     

       98
       98
       +
       

     

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

     

       100
       100
       +
       gaussJordan mat = error "TODO" -- go mat 0 0

     

       101
       101
       +
        -- where go m minRow minCol =

     

       102
       102
       +
        --         case pivotCell m minRow minCol of

     

       103
       103
       +
        --           Nothing -> m

     

       104
       104
       +
        --           Just (i,j) ->

     

       105
       105
       +
        --             let m' = eraseColumn minCol minRow $

     

       106
       106
       +
        --                      normalizeRow minCol minRow $

     

       107
       107
       +
        --                      swapRows j minRow $

     

       108
       108
       +
        --                      swapCols i minCol m

     

       109
       109
       +
        --              in go m' (minRow + 1) (minCol + 1)

     

       110
       110
       +
       

     

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

     

       112
       112
       +
       solveMachine2 buttons goal = error "TODO"

     

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

     

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

     

       115
       115
       +
         --     (mat', g', rank) = gaussJordan mat g

     

       116
       116
       +
         --  in Just 0

     

       5
       117
        
       

     

       6
       118
        
       part2 :: String -> String

     

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

     

       119
       119
       +
       part2 input =

     

       120
       120
       +
         let machines = parse input

     

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

     

       122
       122
       +
          in case sequence solutions of

     

       123
       123
       +
               Just ss -> show $ sum ss

     

       124
       124
       +
               Nothing -> "Failed"

+78

src/Day10_part2.py

···

       1
       1
       +
       import sys

     

       2
       2
       +
       import itertools

     

       3
       3
       +
       

     

       4
       4
       +
       def parseIntList(s):

     

       5
       5
       +
           return list(map(int, s[1:-1].split(",")))

     

       6
       6
       +
       

     

       7
       7
       +
       def parseMachine(line):

     

       8
       8
       +
           words = line.split(" ")

     

       9
       9
       +
           buttons = list(map(parseIntList, words[1:-1]))

     

       10
       10
       +
           goal = parseIntList(words[-1])

     

       11
       11
       +
           return (buttons, goal)

     

       12
       12
       +
       

     

       13
       13
       +
       def solveMachine(machine):

     

       14
       14
       +
           (buttons, goal) = machine

     

       15
       15
       +
           rows = len(goal)

     

       16
       16
       +
           cols = len(buttons) + 1

     

       17
       17
       +
           matrix = [[0 for _ in range(rows)] for _ in range(cols)]

     

       18
       18
       +
           for i,button in enumerate(buttons):

     

       19
       19
       +
               for b in button:

     

       20
       20
       +
                   matrix[i][b] = 1

     

       21
       21
       +
           for i in range(rows):

     

       22
       22
       +
               matrix[cols-1][i] = -goal[i]

     

       23
       23
       +
           maxPresses = max(goal)

     

       24
       24
       +
           # Row reduce matrix

     

       25
       25
       +
           curRow,curCol = 0,0

     

       26
       26
       +
           freeVars = []

     

       27
       27
       +
           while curRow < rows and curCol < cols:

     

       28
       28
       +
               pivotRow = None

     

       29
       29
       +
               for i in range(curRow, rows):

     

       30
       30
       +
                   if matrix[curCol][i] != 0:

     

       31
       31
       +
                       pivotRow = i

     

       32
       32
       +
                       break

     

       33
       33
       +
               if pivotRow is None:

     

       34
       34
       +
                   freeVars.append(curCol)

     

       35
       35
       +
                   curCol += 1

     

       36
       36
       +
                   continue

     

       37
       37
       +
               for i in range(cols):

     

       38
       38
       +
                   matrix[i][curRow], matrix[i][pivotRow] = matrix[i][pivotRow], matrix[i][curRow]

     

       39
       39
       +
               for j in range(rows):

     

       40
       40
       +
                   if j == curRow:

     

       41
       41
       +
                       continue

     

       42
       42
       +
                   a,b = matrix[curCol][curRow],-matrix[curCol][j]

     

       43
       43
       +
                   for i in range(cols):

     

       44
       44
       +
                       matrix[i][j] = a*matrix[i][j] + b*matrix[i][curRow]

     

       45
       45
       +
               curRow += 1

     

       46
       46
       +
               curCol += 1

     

       47
       47
       +
           while curCol < cols:

     

       48
       48
       +
               freeVars.append(curCol)

     

       49
       49
       +
               curCol += 1

     

       50
       50
       +
           # The last col is going to be fixed at 1

     

       51
       51
       +
           freeVars.pop()

     

       52
       52
       +
           minMoves = maxPresses * len(buttons)

     

       53
       53
       +
           for freeAssignment in itertools.product(range(maxPresses+1), repeat=len(freeVars)):

     

       54
       54
       +
               varAssignment = [None for i in range(cols)]

     

       55
       55
       +
               varAssignment[-1] = 1

     

       56
       56
       +
               valid = True

     

       57
       57
       +
               for i,v in enumerate(freeVars):

     

       58
       58
       +
                   varAssignment[v] = freeAssignment[i]

     

       59
       59
       +
               for j in range(rows-1,-1,-1):

     

       60
       60
       +
                   nonZeroCols = [i for i in range(cols) if matrix[i][j] != 0]

     

       61
       61
       +
                   if len(nonZeroCols) == 0:

     

       62
       62
       +
                       continue

     

       63
       63
       +
                   rhs = -sum([varAssignment[c]*matrix[c][j] for c in nonZeroCols[1:]])

     

       64
       64
       +
                   lhs = matrix[nonZeroCols[0]][j]

     

       65
       65
       +
                   if rhs % lhs != 0:

     

       66
       66
       +
                       valid = False

     

       67
       67
       +
                       break

     

       68
       68
       +
                   if rhs // lhs < 0:

     

       69
       69
       +
                       valid = False

     

       70
       70
       +
                       break

     

       71
       71
       +
                   varAssignment[nonZeroCols[0]] = rhs // lhs

     

       72
       72
       +
               if not valid:

     

       73
       73
       +
                   continue

     

       74
       74
       +
               minMoves = min(minMoves, sum(varAssignment) - 1)

     

       75
       75
       +
           return minMoves

     

       76
       76
       +
       

     

       77
       77
       +
       machines = [parseMachine(line) for line in open(sys.argv[1]).read().strip().split("\n")]

     

       78
       78
       +
       print(sum(map(solveMachine, machines)))

+56 -2

src/Day11.hs

···

       1
       1
        
       module Day11 where

     

       2
       2
        
       

     

       3
       3
       +
       import Debug.Trace

     

       4
       4
       +
       import qualified Data.Map as Map

     

       5
       5
       +
       import Data.Map (Map)

     

       6
       6
       +
       

     

       7
       7
       +
       parse :: String -> Map String [String]

     

       8
       8
       +
       parse = Map.fromList . map parseLine . lines

     

       9
       9
       +
         where parseLine :: String -> (String, [String])

     

       10
       10
       +
               parseLine s =

     

       11
       11
       +
                 let w = words s

     

       12
       12
       +
                  in (init $ head w, tail w)

     

       13
       13
       +
       

     

       14
       14
       +
       pathCount :: Map String [String] -> String -> String -> Int

     

       15
       15
       +
       pathCount edges from to =

     

       16
       16
       +
         let m = Map.fromList [(v, ct v) | v <- Map.keys edges]

     

       17
       17
       +
             ct v = if v == to then 1 else sum $ map (m Map.!) (edges Map.! v)

     

       18
       18
       +
          in ct from

     

       19
       19
       +
       

     

       3
       20
        
       part1 :: String -> String

     

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

     

       21
       21
       +
       part1 input =

     

       22
       22
       +
         let edges = Map.insert "out" [] $ parse input

     

       23
       23
       +
          in show $ pathCount edges "you" "out"

     

       24
       24
       +
       

     

       25
       25
       +
       

     

       26
       26
       +
       pathCount2 :: Map String [String] -> String -> String -> Int

     

       27
       27
       +
       pathCount2 edges from to =

     

       28
       28
       +
         let neitherMemo = Map.fromList [(v, neither v) | v <- Map.keys edges]

     

       29
       29
       +
             neither v = if v == to then 1 else sum $ map (neitherMemo Map.!) (edges Map.! v)

     

       30
       30
       +
       

     

       31
       31
       +
             withDacMemo = Map.fromList [(v, withDac v) | v <- Map.keys edges]

     

       32
       32
       +
             withDac v = if v == to then

     

       33
       33
       +
                           0

     

       34
       34
       +
                         else if v == "dac" then

     

       35
       35
       +
                           sum $ map (neitherMemo Map.!) (edges Map.! v)

     

       36
       36
       +
                         else

     

       37
       37
       +
                           sum $ map (withDacMemo Map.!) (edges Map.! v)

     

       38
       38
       +
             

     

       39
       39
       +
             withFftMemo = Map.fromList [(v, withFft v) | v <- Map.keys edges]

     

       40
       40
       +
             withFft v = if v == to then

     

       41
       41
       +
                           0

     

       42
       42
       +
                         else if v == "fft" then

     

       43
       43
       +
                           sum $ map (neitherMemo Map.!) (edges Map.! v)

     

       44
       44
       +
                         else

     

       45
       45
       +
                           sum $ map (withFftMemo Map.!) (edges Map.! v)

     

       46
       46
       +
             

     

       47
       47
       +
             withBothMemo = Map.fromList [(v, withBoth v) | v <- Map.keys edges]

     

       48
       48
       +
             withBoth v = if v == to then

     

       49
       49
       +
                           0

     

       50
       50
       +
                          else if v == "dac" then

     

       51
       51
       +
                            sum $ map (withFftMemo Map.!) (edges Map.! v)

     

       52
       52
       +
                          else if v == "fft" then

     

       53
       53
       +
                            sum $ map (withDacMemo Map.!) (edges Map.! v)

     

       54
       54
       +
                          else

     

       55
       55
       +
                            sum $ map (withBothMemo Map.!) (edges Map.! v)

     

       56
       56
       +
          in withBoth from

     

       5
       57
        
       

     

       6
       58
        
       part2 :: String -> String

     

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

     

       59
       59
       +
       part2 input =

     

       60
       60
       +
         let edges = Map.insert "out" [] $ parse input

     

       61
       61
       +
          in show $ pathCount2 edges "svr" "out"

+14 -2

src/Day12.hs

···

       1
       1
        
       module Day12 where

     

       2
       2
        
       

     

       3
       3
       +
       parse :: String -> [(Int,Int,[Int])]

     

       4
       4
       +
       parse = map parseLine . drop 30 . lines

     

       5
       5
       +
         where parseLine line =

     

       6
       6
       +
                 let w = words line

     

       7
       7
       +
                     (size,counts) = (head w, map read $ tail w)

     

       8
       8
       +
                     cols = read $ take 2 size

     

       9
       9
       +
                     rows = read $ take 2 $ drop 3 size

     

       10
       10
       +
                  in (cols, rows, counts)

     

       11
       11
       +
       

     

       3
       12
        
       part1 :: String -> String

     

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

     

       13
       13
       +
       part1 input =

     

       14
       14
       +
         let regions = parse input

     

       15
       15
       +
             slack (cols, rows, counts) = cols * rows - 7 * (counts !! 0) - 7 * (counts !! 1) - 7 * (counts !! 2) - 5 * (counts !! 3) - 7 * (counts !! 4) - 6 * (counts !! 5)

     

       16
       16
       +
          in show $ length $ filter (> 0) $ map slack regions

     

       5
       17
        
       

     

       6
       18
        
       part2 :: String -> String

     

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

     

       19
       19
       +
       part2 _ = "You win!"

+37 -2

src/Day2.hs

···

       1
       1
        
       module Day2 where

     

       2
       2
        
       

     

       3
       3
       +
       import Debug.Trace

     

       4
       4
       +
       import Util

     

       5
       5
       +
       

     

       6
       6
       +
       isPartOneCandidate :: Int -> Bool

     

       7
       7
       +
       isPartOneCandidate n =

     

       8
       8
       +
         let s = show n

     

       9
       9
       +
             d = length s

     

       10
       10
       +
          in take (d `div` 2) s == drop (d `div` 2) s

     

       11
       11
       +
       

     

       12
       12
       +
       isPartTwoCandidate :: Int -> Bool

     

       13
       13
       +
       isPartTwoCandidate n =

     

       14
       14
       +
         let s = show n

     

       15
       15
       +
             d = length s

     

       16
       16
       +
             cands = [concat $ replicate k $ take (d `div` k) s | k <- [2..d]]

     

       17
       17
       +
          in any (== s) cands

     

       18
       18
       +
       

     

       19
       19
       +
       parseEntry :: [String] -> (Int, Int)

     

       20
       20
       +
       parseEntry (a : b : _) = (read a, read b)

     

       21
       21
       +
       parseEntry _ = error "Unreachable "

     

       22
       22
       +
       

     

       23
       23
       +
       parse :: String -> [(Int, Int)]

     

       24
       24
       +
       parse s = 

     

       25
       25
       +
           map (parseEntry . split '-') $

     

       26
       26
       +
           split ',' s

     

       27
       27
       +
       

     

       3
       28
        
       part1 :: String -> String

     

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

     

       29
       29
       +
       part1 input = show $

     

       30
       30
       +
           sum $

     

       31
       31
       +
           filter isPartOneCandidate $

     

       32
       32
       +
           concat $

     

       33
       33
       +
           map (\(a,b) -> [a..b]) $

     

       34
       34
       +
           parse input

     

       5
       35
        
       

     

       6
       36
        
       part2 :: String -> String

     

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

     

       37
       37
       +
       part2 input = show $

     

       38
       38
       +
           sum $

     

       39
       39
       +
           filter isPartTwoCandidate $

     

       40
       40
       +
           concat $

     

       41
       41
       +
           map (\(a,b) -> [a..b]) $

     

       42
       42
       +
           parse input

+20 -2

src/Day3.hs

···

       1
       1
        
       module Day3 where

     

       2
       2
        
       

     

       3
       3
       +
       import Data.Char

     

       4
       4
       +
       

     

       5
       5
       +
       parse :: String -> [[Int]]

     

       6
       6
       +
       parse input = map (map digitToInt) (lines input)

     

       7
       7
       +
       

     

       8
       8
       +
       maxJoltages :: [Int] -> [Int]

     

       9
       9
       +
       maxJoltages bank =

     

       10
       10
       +
         let update states k = zipWith max states (0 : [10*s + k | s <- states])

     

       11
       11
       +
          in foldl update (repeat 0) bank

     

       12
       12
       +
       

     

       3
       13
        
       part1 :: String -> String

     

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

     

       14
       14
       +
       part1 input =

     

       15
       15
       +
         show $

     

       16
       16
       +
         sum $

     

       17
       17
       +
         map (\bank -> (maxJoltages bank) !! 2) $

     

       18
       18
       +
         parse input

     

       5
       19
        
       

     

       6
       20
        
       part2 :: String -> String

     

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

     

       21
       21
       +
       part2 input =

     

       22
       22
       +
         show $

     

       23
       23
       +
         sum $

     

       24
       24
       +
         map (\bank -> (maxJoltages bank) !! 12) $

     

       25
       25
       +
         parse input

+38 -2

src/Day4.hs

···

       1
       1
        
       module Day4 where

     

       2
       2
        
       

     

       3
       3
       +
       import qualified Data.Map as Map

     

       4
       4
       +
       import Data.Map (Map)

     

       5
       5
       +
       import Util

     

       6
       6
       +
       

     

       7
       7
       +
       parse :: String -> Grid

     

       8
       8
       +
       parse = toGrid

     

       9
       9
       +
       

     

       10
       10
       +
       isOccupied :: Grid -> (Int,Int) -> Bool

     

       11
       11
       +
       isOccupied grid p = Map.lookup p grid == Just '@'

     

       12
       12
       +
       

     

       13
       13
       +
       isAccessible :: Grid -> (Int,Int) -> Char -> Bool

     

       14
       14
       +
       isAccessible grid p '@' =

     

       15
       15
       +
         length (filter (isOccupied grid) (neighbors8 p)) < 4

     

       16
       16
       +
       isAccessible _ _ _ = False

     

       17
       17
       +
       

     

       3
       18
        
       part1 :: String -> String

     

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

     

       19
       19
       +
       part1 input =

     

       20
       20
       +
         let grid = parse input

     

       21
       21
       +
          in show $

     

       22
       22
       +
             length $

     

       23
       23
       +
             Map.filterWithKey (isAccessible grid) grid

     

       24
       24
       +
       

     

       25
       25
       +
       removeAccessible :: Grid -> Grid

     

       26
       26
       +
       removeAccessible grid =

     

       27
       27
       +
         let accessible = Map.filterWithKey (isAccessible grid) grid

     

       28
       28
       +
          in Map.difference grid accessible

     

       29
       29
       +
       

     

       30
       30
       +
       removeAll :: Grid -> Grid

     

       31
       31
       +
       removeAll grid =

     

       32
       32
       +
         let grids = iterate removeAccessible grid

     

       33
       33
       +
             stabilized (x : y : gs) =

     

       34
       34
       +
               if Map.size x == Map.size y then

     

       35
       35
       +
                 x

     

       36
       36
       +
               else

     

       37
       37
       +
                 stabilized (y : gs)

     

       38
       38
       +
          in stabilized grids

     

       5
       39
        
       

     

       6
       40
        
       part2 :: String -> String

     

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

     

       41
       41
       +
       part2 input =

     

       42
       42
       +
         let grid = parse input

     

       43
       43
       +
          in show $ Map.size $ Map.difference grid (removeAll grid)

+43 -2

src/Day5.hs

···

       1
       1
        
       module Day5 where

     

       2
       2
        
       

     

       3
       3
       +
       import Debug.Trace

     

       4
       4
       +
       import Data.Char

     

       5
       5
       +
       import Data.List

     

       6
       6
       +
       import Util

     

       7
       7
       +
       

     

       8
       8
       +
       type Range = (Int,Int)

     

       9
       9
       +
       

     

       10
       10
       +
       parse :: String -> ([Range], [Int])

     

       11
       11
       +
       parse s = foldl addLine ([], []) $ map (map read) $ map (splitOn (not . isDigit)) $ lines s

     

       12
       12
       +
         where addLine (ranges, queries) [lhs, rhs] = ((lhs, rhs) : ranges, queries)

     

       13
       13
       +
               addLine (ranges, queries) [q] = (ranges, q : queries)

     

       14
       14
       +
               addLine (ranges, queries) [] = (ranges, queries)

     

       15
       15
       +
       

     

       16
       16
       +
       inRange :: Range -> Int -> Bool

     

       17
       17
       +
       inRange (lo,hi) q = lo <= q && q <= hi

     

       18
       18
       +
       

     

       19
       19
       +
       inRanges :: [Range] -> Int -> Bool

     

       20
       20
       +
       inRanges rs q = any (\r -> inRange r q) rs

     

       21
       21
       +
       

     

       3
       22
        
       part1 :: String -> String

     

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

     

       23
       23
       +
       part1 input =

     

       24
       24
       +
         let (rs,qs) = parse input

     

       25
       25
       +
          in show $

     

       26
       26
       +
             length $

     

       27
       27
       +
             filter (inRanges rs) qs

     

       28
       28
       +
       

     

       29
       29
       +
       rangeUnion :: [Range] -> [Range]

     

       30
       30
       +
       rangeUnion rs =

     

       31
       31
       +
         let mergeWith cur [] = [cur]

     

       32
       32
       +
             mergeWith (lo,hi) ((lo',hi') : rest) =

     

       33
       33
       +
               if lo' <= hi then

     

       34
       34
       +
                 mergeWith (lo, max hi hi') rest

     

       35
       35
       +
               else

     

       36
       36
       +
                 (lo, hi) : mergeWith (lo', hi') rest

     

       37
       37
       +
       

     

       38
       38
       +
             merge [] = []

     

       39
       39
       +
             merge (r : rest) = mergeWith r rest

     

       40
       40
       +
          in merge $ sort rs

     

       5
       41
        
       

     

       6
       42
        
       part2 :: String -> String

     

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

     

       43
       43
       +
       part2 input =

     

       44
       44
       +
         let (rs, _) = parse input

     

       45
       45
       +
          in show $

     

       46
       46
       +
             sum $

     

       47
       47
       +
             map (\(a,b) -> b-a+1) $

     

       48
       48
       +
             rangeUnion rs

+22 -3

src/Day6.hs

···

       1
       1
        
       module Day6 where

     

       2
       2
        
       

     

       3
       3
       +
       import Data.List

     

       4
       4
       +
       import Debug.Trace

     

       5
       5
       +
       import Util

     

       6
       6
       +
       

     

       7
       7
       +
       solveProblem :: ([Int], String) -> Int

     

       8
       8
       +
       solveProblem (terms, "+") = sum terms

     

       9
       9
       +
       solveProblem (terms, "*") = product terms

     

       10
       10
       +
       

     

       3
       11
        
       part1 :: String -> String

     

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

     

       5
       5
       -
       

     

       12
       12
       +
       part1 input =

     

       13
       13
       +
         let l = lines input

     

       14
       14
       +
             terms = map (map read) $ transpose $ map words $ init l

     

       15
       15
       +
             ops = words $ last l

     

       16
       16
       +
          in

     

       17
       17
       +
             show $

     

       18
       18
       +
             sum $

     

       19
       19
       +
             map solveProblem (zip terms ops)

     

       20
       20
       +
             

     

       6
       21
        
       part2 :: String -> String

     

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

     

       22
       22
       +
       part2 input =

     

       23
       23
       +
         let l = lines input

     

       24
       24
       +
             terms :: [[Int]] = map (map read) $ splitOn null $ map trim $ transpose $ init l

     

       25
       25
       +
             ops = words $ last l

     

       26
       26
       +
         in show $ sum $ map solveProblem (zip terms ops)

+52 -2

src/Day7.hs

···

       1
       1
        
       module Day7 where

     

       2
       2
        
       

     

       3
       3
       +
       import Util

     

       4
       4
       +
       import Data.Map (Map)

     

       5
       5
       +
       import qualified Data.Map as Map

     

       6
       6
       +
       import Data.Set (Set)

     

       7
       7
       +
       import qualified Data.Set as Set

     

       8
       8
       +
       import Debug.Trace

     

       9
       9
       +
       

     

       10
       10
       +
       -- New beam positions and number of splits

     

       11
       11
       +
       splitBeams :: Grid -> (Set Point2, Int) -> (Set Point2, Int)

     

       12
       12
       +
       splitBeams g (beams,splits) =

     

       13
       13
       +
         foldl (\(beams',splits') (x,y) ->

     

       14
       14
       +
                 if Map.lookup (x,y+1) g == Just '^' then

     

       15
       15
       +
                   (Set.insert (x-1,y+1) $ Set.insert (x+1,y+1) beams', splits' + 1)

     

       16
       16
       +
                 else

     

       17
       17
       +
                   (Set.insert (x,y+1) beams', splits'))

     

       18
       18
       +
               (Set.empty, splits)

     

       19
       19
       +
               beams

     

       20
       20
       +
       

     

       3
       21
        
       part1 :: String -> String

     

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

     

       22
       22
       +
       part1 input =

     

       23
       23
       +
         let grid = toGrid input

     

       24
       24
       +
             starts = map fst $ filter ((== 'S') . snd) (Map.toList grid)

     

       25
       25
       +
             rows = maximum $ map snd $ Map.keys grid

     

       26
       26
       +
             (_, splits) = foldl

     

       27
       27
       +
                                 (\(beams', splits') _ -> splitBeams grid (beams', splits'))

     

       28
       28
       +
                                 (Set.fromList starts, 0)

     

       29
       29
       +
                                 [0..rows]

     

       30
       30
       +
          in show splits

     

       5
       31
        
       

     

       32
       32
       +
       splitTime :: Grid -> Map Point2 Int -> Map Point2 Int

     

       33
       33
       +
       splitTime g beams =

     

       34
       34
       +
         Map.foldlWithKey (\beams' (x,y) times ->

     

       35
       35
       +
                          if Map.lookup (x,y+1) g == Just '^' then

     

       36
       36
       +
                            Map.insertWith (+) (x-1,y+1) times $

     

       37
       37
       +
       		     Map.insertWith (+) (x+1,y+1) times $

     

       38
       38
       +
       		     beams'

     

       39
       39
       +
                          else

     

       40
       40
       +
       		     Map.insertWith (+) (x,y+1) times beams')

     

       41
       41
       +
       	Map.empty

     

       42
       42
       +
       	beams

     

       43
       43
       +
       		  

     

       6
       44
        
       part2 :: String -> String

     

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

     

       45
       45
       +
       part2 input =

     

       46
       46
       +
         let grid = toGrid input

     

       47
       47
       +
             starts = map fst $ filter ((== 'S') . snd) (Map.toList grid)

     

       48
       48
       +
             rows = maximum $ map snd $ Map.keys grid

     

       49
       49
       +
             beams = foldl

     

       50
       50
       +
                        (\beams' _ -> splitTime grid beams')

     

       51
       51
       +
                        (Map.fromList [(s,1) | s <- starts])

     

       52
       52
       +
                        [0..rows]

     

       53
       53
       +
          in

     

       54
       54
       +
            show $

     

       55
       55
       +
            sum $

     

       56
       56
       +
            map snd $

     

       57
       57
       +
            Map.toList beams

+67 -2

src/Day8.hs

···

       1
       1
        
       module Day8 where

     

       2
       2
        
       

     

       3
       3
       +
       import Util

     

       4
       4
       +
       import Debug.Trace

     

       5
       5
       +
       import Data.Ord

     

       6
       6
       +
       import Data.Tuple (swap)

     

       7
       7
       +
       import Data.List (tails, sortBy, sort)

     

       8
       8
       +
       import Data.Map (Map)

     

       9
       9
       +
       import qualified Data.Map as Map

     

       10
       10
       +
       

     

       11
       11
       +
       parseLine :: [String] -> Point3

     

       12
       12
       +
       parseLine [a,b,c] = (read a, read b, read c)

     

       13
       13
       +
       

     

       14
       14
       +
       parse :: String -> [Point3]

     

       15
       15
       +
       parse s =

     

       16
       16
       +
         map (parseLine . split ',') $ lines s

     

       17
       17
       +
       

     

       18
       18
       +
       dist2 :: Point3 -> Point3 -> Int

     

       19
       19
       +
       dist2 (x,y,z) (x',y',z') = (x-x') ^ 2 + (y-y') ^ 2 + (z-z') ^ 2

     

       20
       20
       +
       

     

       21
       21
       +
       pairs :: [a] -> [(a,a)]

     

       22
       22
       +
       pairs xs = [(x, y) | (x:ys) <- tails xs, y <- ys]

     

       23
       23
       +
       

     

       24
       24
       +
       merge :: (Point3, Point3) -> Map Point3 Int -> Map Point3 Int

     

       25
       25
       +
       merge (p, q) m =

     

       26
       26
       +
         let pid = m Map.! p

     

       27
       27
       +
             qid = m Map.! q

     

       28
       28
       +
          in if pid == qid then

     

       29
       29
       +
               m

     

       30
       30
       +
             else

     

       31
       31
       +
               Map.map (\c -> if c == pid then qid else c) m

     

       32
       32
       +
       

     

       3
       33
        
       part1 :: String -> String

     

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

     

       34
       34
       +
       part1 input =

     

       35
       35
       +
         let boxes = parse input

     

       36
       36
       +
             connectionOrder =

     

       37
       37
       +
               dropWhile (\(p,q) -> p == q) $

     

       38
       38
       +
               sortBy (comparing (\(p,q) -> dist2 p q)) $

     

       39
       39
       +
               pairs boxes

     

       40
       40
       +
             circuits =

     

       41
       41
       +
               foldl (\ids' edge -> merge edge ids')

     

       42
       42
       +
                 (Map.fromList $ zip boxes [1..])

     

       43
       43
       +
                 (take 1000 connectionOrder)

     

       44
       44
       +
             sizes =

     

       45
       45
       +
               reverse $

     

       46
       46
       +
               sort $

     

       47
       47
       +
               map snd $

     

       48
       48
       +
               Map.toList $

     

       49
       49
       +
               Map.foldl (\sizes' c -> Map.insertWith (+) c 1 sizes')

     

       50
       50
       +
                 Map.empty

     

       51
       51
       +
                 circuits

     

       52
       52
       +
          in show $ product $ take 3 sizes

     

       5
       53
        
       

     

       6
       54
        
       part2 :: String -> String

     

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

     

       55
       55
       +
       part2 input =

     

       56
       56
       +
         let boxes = parse input

     

       57
       57
       +
             connectionOrder =

     

       58
       58
       +
               dropWhile (\(p,q) -> p == q) $

     

       59
       59
       +
               sortBy (comparing (\(p,q) -> dist2 p q)) $

     

       60
       60
       +
               pairs boxes

     

       61
       61
       +
             circuits =

     

       62
       62
       +
               scanl (\ids' edge -> merge edge ids')

     

       63
       63
       +
                 (Map.fromList $ zip boxes [1..])

     

       64
       64
       +
                 connectionOrder

     

       65
       65
       +
             merges =

     

       66
       66
       +
               filter (\((p,q),ids) -> ids Map.! p /= ids Map.! q)

     

       67
       67
       +
       	  $ zip connectionOrder circuits

     

       68
       68
       +
             ((p,q),_) = merges !! (length boxes - 2)

     

       69
       69
       +
             (x,_,_) = p

     

       70
       70
       +
             (x',_,_) = q

     

       71
       71
       +
          in show (x * x')

     

       72
       72
       +

+38 -2

src/Day9.hs

···

       1
       1
        
       module Day9 where

     

       2
       2
        
       

     

       3
       3
       +
       import Util

     

       4
       4
       +
       

     

       5
       5
       +
       parseLine :: [String] -> Point2

     

       6
       6
       +
       parseLine [x,y] = (read x, read y)

     

       7
       7
       +
       

     

       8
       8
       +
       parse :: String -> [Point2]

     

       9
       9
       +
       parse s = map (parseLine . split ',') $ lines s

     

       10
       10
       +
       

     

       11
       11
       +
       area :: Point2 -> Point2 -> Int

     

       12
       12
       +
       area (x,y) (z,w) = (abs (x - z) + 1) * (abs (y - w) + 1)

     

       13
       13
       +
       

     

       3
       14
        
       part1 :: String -> String

     

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

     

       15
       15
       +
       part1 input =

     

       16
       16
       +
         let pts = parse input

     

       17
       17
       +
          in show $

     

       18
       18
       +
             maximum $

     

       19
       19
       +
             [ area p q | p <- pts, q <- pts ]

     

       20
       20
       +
       

     

       21
       21
       +
       uniq :: Eq a => [a] -> [a]

     

       22
       22
       +
       uniq [] = []

     

       23
       23
       +
       uniq [a] = [a]

     

       24
       24
       +
       uniq (a:b:cs) = if a == b then uniq (b:cs) else a : (uniq (b:cs))

     

       25
       25
       +
       

     

       26
       26
       +
       edgeIntersect :: (Point2, Point2) -> (Point2, Point2) -> Bool

     

       27
       27
       +
       edgeIntersect (p,q) (r,s) =

     

       28
       28
       +
         max (fst r) (fst s) > min (fst p) (fst q) &&

     

       29
       29
       +
         min (fst r) (fst s) < max (fst p) (fst q) &&

     

       30
       30
       +
         max (snd r) (snd s) > min (snd p) (snd q) &&

     

       31
       31
       +
         min (snd r) (snd s) < max (snd p) (snd q)

     

       32
       32
       +
       

     

       33
       33
       +
       containsRect :: Point2 -> Point2 -> [(Point2,Point2)] -> Bool

     

       34
       34
       +
       containsRect p q edges =

     

       35
       35
       +
         not $ or [edgeIntersect (p,q) e | e <- edges]

     

       5
       36
        
       

     

       6
       37
        
       part2 :: String -> String

     

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

     

       38
       38
       +
       part2 input =

     

       39
       39
       +
         let pts = parse input

     

       40
       40
       +
             edges = zip pts ((tail pts) ++ [head pts])

     

       41
       41
       +
          in show $

     

       42
       42
       +
             maximum $

     

       43
       43
       +
             [area p q | p <- pts, q <- pts, containsRect p q edges]

+36

src/Util.hs

···

       1
       1
       +
       module Util where

     

       2
       2
       +
       

     

       3
       3
       +
       import Data.Char (isSpace)

     

       4
       4
       +
       import qualified Data.Map as Map

     

       5
       5
       +
       import Data.Map (Map)

     

       6
       6
       +
       

     

       7
       7
       +
       splitOn :: (a -> Bool) -> [a] -> [[a]]

     

       8
       8
       +
       splitOn p s = case dropWhile p s of

     

       9
       9
       +
                     [] -> []

     

       10
       10
       +
                     s' -> w : splitOn p s''

     

       11
       11
       +
                           where (w, s'') = break p s'

     

       12
       12
       +
       

     

       13
       13
       +
       split :: (Eq a) => a -> [a] -> [[a]]

     

       14
       14
       +
       split c = splitOn (== c)

     

       15
       15
       +
       

     

       16
       16
       +
       enumerate :: [a] -> [(Int,a)]

     

       17
       17
       +
       enumerate l = zip [0..] l

     

       18
       18
       +
       

     

       19
       19
       +
       type Point2 = (Int,Int)

     

       20
       20
       +
       type Point3 = (Int,Int,Int)

     

       21
       21
       +
       type Grid = Map Point2 Char

     

       22
       22
       +
       

     

       23
       23
       +
       toGrid :: String -> Grid

     

       24
       24
       +
       toGrid s = Map.fromList [((x,y),c) | (y,r) <- enumerate (lines s), (x,c) <- enumerate r]

     

       25
       25
       +
       

     

       26
       26
       +
       neighbors8 :: Point2 -> [Point2]

     

       27
       27
       +
       neighbors8 (x,y) =

     

       28
       28
       +
         [(x-1,y-1),(x,y-1),(x+1,y-1),(x-1,y),(x+1,y),(x-1,y+1),(x,y+1),(x+1,y+1)]

     

       29
       29
       +
       

     

       30
       30
       +
       neighbors4 :: Point2 -> [Point2]

     

       31
       31
       +
       neighbors4 (x,y) =

     

       32
       32
       +
         [(x-1,y), (x+1,y), (x,y-1), (x,y+1)]

     

       33
       33
       +
       

     

       34
       34
       +
       trim :: String -> String

     

       35
       35
       +
       trim = f . f

     

       36
       36
       +
         where f = reverse . dropWhile isSpace

Compare changes