day14.md

Day 14

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

I guess today is a "here's the algorithm, now implement it" puzzle, to contrast/take a break from yesterday's "here's the goal, figure out the algorithm" :)

First, let's start with an intermediate data type representing the actions possible on each line:

data Instr =
      Mask [Maybe Bool]
    | Write Int Int

The mask will be a list of Maybe Bool, where X is Nothing, 0 is Just False, and 1 is Just True. However, it's important to reverse the string when parsing it from the input, because we want index 0 to correspond to bit 0, index 1 to correspond to bit 1, etc., to make our lives easier.

That's because we can implement the application of a mask (for part 1) using ifoldl', a version of foldl' that gives you an item's index as you are folding it:

import           Data.Bits (clearBit, setBit)
import           Control.Lens.Indexed (ifoldl')

applyMask1 :: Int -> [Maybe Bool] -> Int
applyMask1 = ifoldl' $ \i x -> \case
    Nothing    -> x
    Just False -> clearBit x i
    Just True  -> setBit   x i

If the bit list contains a Nothing in a given index, leave the item unchanged. If it contains a Just False, clear that index's bit (set it to zero). If it contains a Just Nothing, set that index's bit (set it to one).

And that leaves part 1 as a foldl through all the instructions, keeping the current map and mask as state:

import           Data.IntMap (IntMap)
import qualified Data.IntMap as IM

part1 :: [Instr] -> (IntMap Int, [Maybe Bool])
part1 = foldl' go (IM.empty, [])
  where
    go :: (IntMap Int, [Maybe Bool]) -> Instr -> (IntMap Int, [Maybe Bool])
    go (!mp, !msk) = \case
      Mask  msk'   -> (mp, msk')
      Write addr n ->
        let mp' = IM.insert addr (applyMask1 n msk) mp
        in  (mp', msk)

Part 2's mask application is interesting, because it lives in "non-determinancy". Basically, each bit mask bit application could potentially yield multiple possibilities. We have to accumulate every nested possibility. This feature is given to us by list's Monad instance, so we can swap ifoldl' for ifoldM:

ifoldl' :: (Int -> b -> a ->   b) -> b -> [a] ->   b
ifoldlM :: (Int -> b -> a -> m b) -> b -> [a] -> m b

For ifoldlM, each result lives in monad m, so the semantics of "proceeding along the fold" are deferred to the Monad instance for m. If m is Maybe, it means that you only proceed if you get a Just, or else short-circuit with Nothing. If m is IO, it means that proceeding involves chaining the IO action's execution and binding the result to give it to the function's next iteration. If m is [] (list), it means that subsequent chaining will run the function on every possibility returned by the function's previous call, accumulating every possible way of choosing every possible choice. (I talked about this in more depth in one of my first ever Haskell blog posts).

import           Control.Lens.Indexed (ifoldlM)

applyMask2 :: Int -> [Maybe Bool] -> [Int]
applyMask2 = ifoldlM $ \i x -> \case
    Nothing    -> [clearBit x i, setBit x i]
    Just False -> [x]
    Just True  -> [setBit x i]

For these, we return a list of every possible change from a given bit mask bit. For the Nothing "floating" case, there are two possibilities; for the other two, there is only one. We trust list's Monad instance to properly thread over all possible results into a list of all possible changes that that Int could have been subjected to.

And so, part 2 looks a lot like part 1!

part2 :: [Instr] -> (IntMap Int, [Maybe Bool])
part2 = foldl' go (IM.empty, [])
  where
    go :: (IntMap Int, [Maybe Bool]) -> Instr -> (IntMap Int, [Maybe Bool])
    go (!mp, !msk) = \case
      Mask  msk'   -> (mp, msk')
      Write addr n ->
        let newMp = IM.fromList ((,n) <$> applyMask2 addr msk)
        in  (newMp <> mp, msk)

(<>) here is a left-biased merger, so it merges in all of the newly seen indices into the existing ones.

Back to all reflections for 2020

Day 14 Benchmarks

>> Day 14a
benchmarking...
time                 158.7 μs   (158.0 μs .. 159.4 μs)
                     0.999 R²   (0.997 R² .. 1.000 R²)
mean                 157.9 μs   (157.6 μs .. 158.6 μs)
std dev              1.293 μs   (845.8 ns .. 2.372 μs)

* parsing and formatting times excluded

>> Day 14b
benchmarking...
time                 25.76 ms   (24.66 ms .. 27.04 ms)
                     0.990 R²   (0.979 R² .. 0.998 R²)
mean                 25.49 ms   (25.02 ms .. 26.27 ms)
std dev              1.358 ms   (982.2 μs .. 1.914 ms)
variance introduced by outliers: 20% (moderately inflated)

* parsing and formatting times excluded