Skip to content

Reflections 2025

github-actions[bot] edited this page Dec 4, 2025 · 9 revisions

2016 / 2018 / 2019 / 2020 / 2021 / 2022 / 2023 / 2024 / 2025

Table of Contents

Day 1

Top / Prompt / Code / Standalone

Another tradition of advent of code day 1 --- everything is just a scan!

Once we parse the input into a list of integers:

parseInp :: String -> [Int]
parseInp = read . map rephrase . lines
  where
    rephrase 'R' = ' '
    rephrase 'L' = '-'
    rephrase d = d

Then we can do the cumulative sum and count the zero's. It actually becomes even easier if we restrict ourselves to the integers modulo 100 using the finite-typelits library and Finite n, using modulo :: Integer -> Finite n to cast:

part1 :: [Finite 100] -> Int
part1 = length . filter (== 0) . scanl' (+) 50

Part 2 you can probably do using more modulo and division tricks but the simplest way is probably just to explode all of the ranges and do the same counts. We use mapAccumL to map a stateful function, where the state is our current position and our output is the list of all the traveled numbers:

part2 :: [Int] -> Int
part2 = length . filter (== 0) . concat . snd . mapAccumL go 50
  where
    go curr bump
      | bump > 0 = (curr + bump, [curr + 1 .. curr + bump])
      | otherwise = (curr + bump, [curr + bump .. curr - 1])

Because of lazy lists, this is constant space! :)

Day 1 Benchmarks

>> Day 01a
benchmarking...
time                 167.3 μs   (167.1 μs .. 167.8 μs)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 168.4 μs   (167.9 μs .. 169.1 μs)
std dev              1.947 μs   (1.349 μs .. 2.629 μs)

* parsing and formatting times excluded

>> Day 01b
benchmarking...
time                 229.4 μs   (228.9 μs .. 230.0 μs)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 229.2 μs   (229.0 μs .. 229.7 μs)
std dev              1.075 μs   (790.8 ns .. 1.538 μs)

* parsing and formatting times excluded

Day 2

Top / Prompt / Code / Standalone

You can do this nicely using the IntSet type in the containers library, with IS.fromRange :: (Int, Int) -> IntSet. Then you can just turn the ranges IntSets and intersect them with the IntSet of all invalid IDs.

-- | repDigits 3 567 = 567567567
repDigits :: Int -> Int -> Int
repDigits n = read . concat . replicate n . show

-- | All duplicated IDs up to 1e11
rep2 :: IntSet
rep2 = IS.fromAscList . takeWhile (< 1e11) . map (repDigits 2) $ [1 ..]

part1 :: [(Int, Int)] -> Int
part1 = IS.foldl' (+) 0 . foldMap (IS.intersection rep2 . IS.fromRange)

And you can union together rep2, rep3, etc. too:

repN :: IntSet
repN = flip foldMap [2..11] \n ->
  IS.fromAscList . takeWhile (< 1e11) . map (repDigits n) $ [1 ..]

part2 :: [(Int, Int)] -> Int
part2 = IS.foldl' (+) 0 . foldMap (IS.intersection repN . IS.fromRange)

Day 2 Benchmarks

>> Day 02a
benchmarking...
time                 242.9 μs   (240.6 μs .. 246.8 μs)
                     0.999 R²   (0.998 R² .. 1.000 R²)
mean                 244.3 μs   (243.3 μs .. 245.7 μs)
std dev              4.414 μs   (2.645 μs .. 6.995 μs)
variance introduced by outliers: 11% (moderately inflated)

* parsing and formatting times excluded

>> Day 02b
benchmarking...
time                 264.2 μs   (257.1 μs .. 272.4 μs)
                     0.994 R²   (0.988 R² .. 1.000 R²)
mean                 258.2 μs   (256.5 μs .. 263.7 μs)
std dev              10.60 μs   (4.192 μs .. 19.23 μs)
variance introduced by outliers: 38% (moderately inflated)

* parsing and formatting times excluded

Day 3

Top / Prompt / Code / Standalone

My strategy was a depth first search, basically look for 999999999999, then 999999999998, then 999999997, etc. but immediately backtrack if any of the steps are impossible.

So, this means keeping track of a state of "what's left", and then branching out at different digit picks -- perfect for StateT List!

nextDigit :: StateT [Int] [] Int
nextDigit = do
  n <- lift [9,8,7,6,5,4,3,2,1]
  modifyM \xs ->
    [ xs'
    | x : xs' <- tails xs
    , x == n
    ]
  pure n

We pick a digit non-deterministically, and then we non-deterministically chop down our "what's left" list until we reach that digit. So nextDigit for 87681 would descend to result, state pairs of (8, [7,6,8,1]), (8, [1]), (7, [6,8,1]), (6, [8,1]), and (1, []). Those are our new candidates and the associated state after picking them. The trick is that we list them in the order that they are most likely to yield the biggest total number.

Once we do that, we just need to replicateM 12 to do it 12 (or 2) times:

search :: Int -> StateT [Int] [] String
search n = map intToDigit <$> replicateM n nextDigit

This will perform nextDigit n times, each time chomping down more of the string. The ones that yield no possible continuations will be pruned -- basically any time the "what's left" state gets empty, nextDigit will fail for the rest of that branch.

solve :: Int -> [String] -> Int
solve n = sum . map (read . head . evalState (search n) . map digitToInt)

part1 = solve 2
part2 = solve 12

Day 3 Benchmarks

>> Day 03a
benchmarking...
time                 286.6 μs   (285.6 μs .. 288.0 μs)
                     0.998 R²   (0.995 R² .. 1.000 R²)
mean                 296.5 μs   (290.5 μs .. 309.3 μs)
std dev              28.79 μs   (18.25 μs .. 45.33 μs)
variance introduced by outliers: 78% (severely inflated)

* parsing and formatting times excluded

>> Day 03b
benchmarking...
time                 4.350 ms   (4.332 ms .. 4.383 ms)
                     1.000 R²   (0.999 R² .. 1.000 R²)
mean                 4.344 ms   (4.330 ms .. 4.357 ms)
std dev              44.51 μs   (33.76 μs .. 58.07 μs)

* parsing and formatting times excluded

Day 4

Top / Prompt / Code / Standalone

For these I have a handy utility function to parse an ascii map into a set of points:

data V2 a = V2 a a

parseAsciiSet :: (Char -> Bool) -> String -> Set (V2 Int)

and also a handy function that gets all eight neighbors of a point:

fullNeighbsSet :: V2 Int -> Set (V2 Int)

They're actually fun to implement, exercise left to reader :)

Anyway once you have those, you can write a function of all reachable rolls:

reachable :: Set (V2 Int) -> Set (V2 Int)
reachable pts = flip S.filter pts \pt ->
  S.size (fullNeighbsSet pt `S.intersection` pts) < 4

And so we have:

part1 :: Set (V2 Int) -> Int
part1 = S.size . reachable

part2 :: Set (V2 Int) -> Int
part2 = S.size . fold . takeWhile (not . S.null) . unfoldr (Just . go)
  where
    go pts = (removed, pts `S.difference` removed)
      where
        removed = reachable pts

Day 4 Benchmarks

>> Day 04a
benchmarking...
time                 28.92 ms   (28.76 ms .. 29.04 ms)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 28.96 ms   (28.84 ms .. 29.15 ms)
std dev              317.2 μs   (170.3 μs .. 444.5 μs)

* parsing and formatting times excluded

>> Day 04b
benchmarking...
time                 725.9 ms   (713.9 ms .. 731.3 ms)
                     1.000 R²   (1.000 R² .. 1.000 R²)
mean                 727.0 ms   (725.3 ms .. 728.3 ms)
std dev              1.889 ms   (1.298 ms .. 2.189 ms)
variance introduced by outliers: 19% (moderately inflated)

* parsing and formatting times excluded

Clone this wiki locally