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 8

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

Nothing tooooo complicated about today's, I feel: it is another staple of AoC --- simulating a virtual machine! :) Only this time our program is separate from our memory, so we don't have any actual self-modifying code. However, my guard is up: this might turn into one of those soon in another day.

At least, there are some interesting things we can do to prepare for a potential switch to different requirements in a later day (with the Ixed) typeclass, and also a nice way to handle the perturbations in Part 2 using holesOf and lens traversal composition.

My main program was a sequence of Command:

data Instr = NOP | ACC | JMP

type Command = (Instr, Int)

But, what container should we use for these?

  1. [Command]: Nope, bad, literally no reason to ever use this except for O(1) push and pop. The main operation here is indexing, and it's O(i) on the index.
  2. Vector Command: Very fast indexing (O(1) on the index), but very bad for any sort of addition of new instructions in-flight if that comes up in the future. But good enough for now.
  3. Seq Command: Efficient indexing (O(1) on the index), and very good for adding new instructions to either end (or even in the middle) in-flight if it comes to that.
  4. IntMap Command: Efficient indexing (O(1) on the index), very good for adding new instructions to either end, and also good for a sparse program bank if it ever comes to that.

Luckily, we can get a common interface for all four of these options by using the Ixed typeclass from the lens library, which abstracts over different "indexable" things. You'd get a safe index with xs ^? ix i. So whenever possible, I've written all my code to work generally over all four of these in case I have to swap quickly in the future.

One theoretical nice container would actually be the PointedList data type (one implementation is in the pointedlist library). This is because all of our addressing is relative, so instead of storing a "current index", we could just always point towards the focus of the tape, and shift the tape left or right for JMP.

However, this is kind of difficult to adapt to work in a uniform interface to the other four, goodbye theoretical nicety, sacrificed in the name of adaptivity :'(

So for my solution I used Vector, which has just the API necessary without the extra flexibility that Seq and IntMap offer, since we don't need it! But, just know that things could be swapped at any time, thanks to the magic (or horror, depending on your point of view) of typeclasses.

On the other hand, if we separate out the index from a fixed container, it does make the state a lot simpler. It means that our state is really only the current pointer and the accumulator:

data CState = CS { csPtr :: !Int, csAcc :: !Int }

initialCS :: CState
initialCS = CS 0 0

runCommand :: Vector Command -> CState -> Maybe CState

So our actual program becomes a very tight CState -> Maybe CState loop -- very efficient because the state is only a tuple! That means that we can simply chain things using iterateMaybe go get a list of all successive states:

-- | A handy utility function I keep around
iterateMaybe :: (a -> Maybe a) -> a -> [a]
iterateMaybe f = go
    go x = x : case f x of
      Nothing -> []
      Just y  -> go y

allStates :: Vector Command -> [CState]
allStates cmd = iterateMaybe (runCommand cmd) initialCS

So now we have a generator of all the states a given program bank will ever output. For part 1, we just need to find a loop. Luckily I have another handy utility function that scans a list and reports the first time a projection function's result is repeated

-- | Lazily find the first repeated projection.
firstRepeatedBy :: Ord a => (b -> a) -> [b] -> Maybe b
firstRepeatedBy f = go S.empty
    go seen (x:xs)
      | f x `S.member` seen = Just x
      | otherwise           = go (f x `S.insert` seen) xs
    go _ []     = Nothing

part1 :: Vector Command -> Maybe CState
part1 cmd = firstRepititionBy csPtr states
    states = iterateMaybe (runCommand cmd) inititialCS

Now all that's left is to actually implement runCommand!

    :: Vector Command
    -> CState
    -> Maybe CState
runCommand cmds cs = (cmds ^? ix (csPtr cs)) <&> \case
    (NOP, _) -> cs { csPtr = csPtr cs + 1 }
    (ACC, i) -> cs { csPtr = csPtr cs + 1, csAcc = csAcc cs + i }
    (JMP, i) -> cs { csPtr = csPtr cs + i }

-- note: <&> is flip fmap

And the nice thing about it is that if we leave off the type annotation of runCommand, we actually get a really nice polymorphic type if we ask GHC what it expects:

    :: (Ixed t, Index t ~ Int, IxValue t ~ (Instr, Int))
    => t
    -> CState
    -> Maybe CState

This is the fully polymorphic signature that you get just from using cmds ^? ix (csPtr cs). It says that you can use this on any program bank t that's an instance of Ixed, as long as its index type is Int and the value at that index is a (Instr, Int). Nothing about the typeclasses here is inherently lensy, it's just a typeclass (like any other) to abstract over common interfaces that many types might have. In this fully polymorphic signature, we can use this on Vector Command, [Command], Seq Command, and IntMap Command, as we wish to in the future if the need comes up.

For part 2 we can take advantage of some actual lens/optics magic, by using holesOf:

    :: Traversal' s a
    -> s
    -> [Pretext (->) a a s]

The type is definitely scary, but holesOf is saying:

  1. Give me a specification of which holes you want to poke (Traversal' s a, a value s with holes a)
  2. ... and an item you want to poke the holes in (s)
  3. ... and I'll return to you a list of continuations (Pretext (->) a a (t a)), each one allowing you to edit a different hole in s.

Pretext is a bit of a complicated type, but the main interface you would use it with is:

peeks :: (a -> a) -> Pretext (->) a a s -> s

peeks as for a function you would want to run on a hole (the a -> a), the continuation you got from holesOf, and then returns the "modified" s, modified according to that transformation you ran on that hole.

(thanks to mniip on freenode IRC for pointing out how these two work together to me!)

Every item in the list returned by holesOf corresponds to a different hole, so for example:

ghci> map (peeks negate) (holesOf traverse [1,2,3])
  [ [-1, 2, 3]
  , [ 1,-2, 3]
  , [ 1, 2,-3]

The traverse :: Traversal' [a] a is a Traversal that specifies the "holes" of a list [a] to be each item a in that list. And so holesOf traverse [1,2,3] will return three Pretexts: one corresponding to modifying each item in the list individually.

peeks negate on each of the three items returned by holesOf traverse [1,2,3] will return the modified list, each with a single hole edited by negate.

In our case, instead of negate, we can use a flipInstr that flips NOP to JMP and JMP to NOP:

flipInstr :: Command -> Command
flipInstr = \case
    NOP -> JMP
    ACC -> ACC
    JMP -> NOP

And now peeks flipInstr will do the right thing:

ghci> map (peeks flipInstr) (holesOf traverse [NOP,ACC,JMP,JMP])

An extra coolio thing is that traversals compose with ., so we can actually use a traversal _1 (here, Traversal' (a,b) a, which says the single "hole" in an (a,b) is the first item in the tuple) to be more nuanced with our hole selection:

ghci> map (peeks flipInstr)
        (holesOf (traverse . _1) [(NOP,1),(ACC,2),(JMP,3),(JMP,4)])
  [ [(JMP,1),(ACC,2),(JMP,3),(JMP,4)]
  , [(NOP,1),(ACC,2),(JMP,3),(JMP,4)]
  , [(NOP,1),(ACC,2),(NOP,3),(JMP,4)]
  , [(NOP,1),(ACC,2),(JMP,3),(NOP,4)]


With that we can fully write part2: for each perturbation, check if there is a loop. If there is a loop, this ain't it. If there isn't a loop, then we hit the jackpot: return the last item in our list of seen states, as that's the last state before termination.

part2 :: Vector Command -> Maybe CState
part2 cmds0 = listToMaybe
    [ res
    | cmds <- peeks flipInstr <$> holesOf (traverse . _1) cmds0
    , let states = iterateMaybe (runCommand cmds) initialCS
    , res  <- case firstRepeatedBy csPtr stats of
        Nothing -> [last states]    -- loop found
        Just _  -> []               -- no loop found

In my actual code, I actually use the experiment function instead of peeks -- it's like a "peeksM", in a way:

peeks      :: (a ->   a) -> Pretext (->) a a s ->   a
experiment :: (a -> f a) -> Pretext (->) a a s -> f a

So instead of giving it a Instr -> Instr, you could give it an Instr -> Maybe Instr, and "cancel out" any branches that don't need to be addressed:

experiment :: (a -> Maybe a) -> Pretext (->) a a s -> Maybe a   -- in our case

flipInstrs :: Command -> Maybe Command
flipInstrs = \case
    NOP -> Just JMP
    ACC -> Nothing  -- for ACC indices, don't do anything
    JMP -> Just JMP
ghci> map (experiment flipInstrs)
        (holesOf (traverse . _1) [(NOP,1),(ACC,2),(JMP,3),(JMP,4)])
[ Just [(JMP,1),(ACC,2),(JMP,3),(JMP,4)]
, Nothing
, Just [(NOP,1),(ACC,2),(NOP,3),(JMP,4)]
, Just [(NOP,1),(ACC,2),(JMP,3),(NOP,4)]
part2 :: Vector Command -> Maybe CState
part2 cmds0 = listToMaybe
    [ res
    | Just cmds <- experiment flipInstr <$> holesOf (traverse . _1) cmds0
    , let states = iterateMaybe (runCommand cmds) initialCS
    , res  <- case firstRepeatedBy csPtr stats of
        Nothing -> [last states]    -- loop found
        Just _  -> []               -- no loop found

Not a super huge improvement, but maybe more theoretically nice because we can skip over the possible trials where we are permuting an ACC. By my reckoning, 52% of my input file instructions were ACC instructions, so this small thing actually shaves off a decent amount of time.

Back to all reflections for 2020

Day 8 Benchmarks

>> Day 08a
time                 6.243 μs   (6.182 μs .. 6.346 μs)
                     0.998 R²   (0.996 R² .. 1.000 R²)
mean                 6.210 μs   (6.180 μs .. 6.325 μs)
std dev              192.8 ns   (60.82 ns .. 390.0 ns)
variance introduced by outliers: 38% (moderately inflated)

* parsing and formatting times excluded

>> Day 08b
time                 2.473 ms   (2.298 ms .. 2.654 ms)
                     0.967 R²   (0.953 R² .. 0.984 R²)
mean                 2.485 ms   (2.401 ms .. 2.589 ms)
std dev              298.9 μs   (248.6 μs .. 339.1 μs)
variance introduced by outliers: 74% (severely inflated)

* parsing and formatting times excluded