Skip to content
Switch branches/tags

Name already in use

A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
Go to file
Cannot retrieve contributors at this time

Day 15

all / 1 / 2 / 3 / 4 / 5 / 6 / 7 / 8 / 9 / 10 / 11 / 12 / 13 / 14 / 15 / 16 / 17 / 18 / 19 / 20 / 21 / 22 / 23 / 24 / 25

Available as an RSS Feed

Prompt / Code / Rendered

So it is yet another "here's the algorithm, implement it" days again! Only the challenge this time should probably implement it to be really fast!

I don't think there is too much wiggle room in how to implement things here; my original solution basically kept an IntMap to the last seen time of any value, and just repeatedly looked things up and modified the (current time, last said) tuple.

My original solution took around 70 seconds to run, and that was what I used to submit things originally. But let's see if we can get it down to something a little less...perceptible :) This reflection can be a deep dive into writing tight, performant Haskell.

The data type we'll be using is an unboxed mutable array. There's a trick we can use because we have a map from integers to values, we can just use the integer keys as the index to an array. This is usually a bad idea but for the fact that the keys we'll be using are bounded within a decently small range (we won't ever say a number that is greater than 30 million), so we can definitely accumulate 30 million-item array into memory without any major problems. We'll also store our last-said times as Int32 to be a little bit more efficient since we're trying to eek out every last bit of perf.

So overall we still keep some state: the current time and the last said item. Since those are just integers, we can keep that as pure in memory using StateT running over ST s (the mutable state monad, where our mutable vectors will live).

import           Control.Monad.ST
import           Control.Monad.State
import           GHC.Int (Int32)
import qualified Data.Vector.Unboxed.Mutable as MV

data LoopState = LS
    { lsLastSaid :: !Int
    , lsCurrTime :: !Int32

    :: MV.MVector s Int32                   -- ^ the mutable vector of last-seen times
    -> StateT (T2 Int32 Int) (ST s) ()      -- ^ an 'ST s' action with some pure (T2 Int32 Int) state
sayNext v = do
    L s i <- get                        -- get the current pure state
    lst <- v x                  -- our last said is x, so look up the last time we saw it
    MV.write v x i                      -- update the last-time-seen
    let j | lst == 0  = 0               -- we haven't seen it
          | otherwise = i - lst         -- we have seen it
    put (LS (fromIntegral j) (i + 1))   -- update last seen and current time
{-# INLINE sayNext #-}

We will want to INLINE this so that it gets inlined directly into our main loop code.

Oh, let's also write a function to initialize our sequence with starting inputs:

    :: MV.MVector s Int32                   -- ^ the mutable vector of last-seen times
    -> Int                                  -- ^ a number to "say"
    -> StateT (T2 Int32 Int) (ST s) ()      -- ^ an 'ST s' action with some pure (T2 Int32 Int) state
saySomething v y = do
    LS x i <- get
    MV.unsafeWrite v x i          -- write the last seen number with the right time
    put (LS y (i + 1))            -- queue up the write of the number to say
{-# INLINE saySomething #-}

And now we're good to go to put it all together! We can use whileM_ from Control.Monad.Loops to emulate a while loop, where our condition is whenever lsCurrTime reaches the maximum value.

-- | Returns 'True' until we need to stop
stopCond :: Int32 -> StateT (T2 Int32 Int) m Bool
stopCond n = gets $ \(LS _ i) -> i < n
{-# INLINE stopCond #-}
-- gets f = f <$> get, it maps a function on top of a get

looper :: Int -> [Int] -> Int
looper n xs = runST $ flip evalStateT (LS 0 0) $ do
    v <- MV.replicate n 0       -- initialize our vector with zeros
    traverse_ (saySomething v) xs
    whileM_ (stopCond n) (sayNext v)
    gets lsLastSaid

On my machine (with some minor optimizations, like using unsafeRead/unsafeWrite), this runs in 230ms for part 2...a much more reasonable improvement over my original 70 seconds! :)

part1 :: [Int] -> Int
part1 = looper 2020

part2 :: [Int] -> Int
part2 = looper 30000000

Back to all reflections for 2020

Day 15 Benchmarks

>> Day 15a
time                 2.523 μs   (2.390 μs .. 2.614 μs)
                     0.986 R²   (0.986 R² .. 0.989 R²)
mean                 2.320 μs   (2.266 μs .. 2.409 μs)
std dev              203.6 ns   (138.6 ns .. 256.9 ns)
variance introduced by outliers: 85% (severely inflated)

* parsing and formatting times excluded

>> Day 15b
time                 291.7 ms   (281.8 ms .. 304.4 ms)
                     0.999 R²   (0.999 R² .. 1.000 R²)
mean                 302.0 ms   (296.4 ms .. 312.7 ms)
std dev              9.904 ms   (3.637 ms .. 13.04 ms)
variance introduced by outliers: 16% (moderately inflated)

* parsing and formatting times excluded