23 December 2020 ; tagged in: advent of code , haskell

Advent of Code 2020 day 14

Bit-twiddling, until it wasn't.

Advent of Code 2020 day 14

I thought day 14 would be a load of bit-twiddling. Part 1 was, but part 2 went in other directions so I moved a bit away from just bits and Int64 values.

Data and data structures

In a vast oversight of computer designers everywhere, 36-bit unsigned integers aren't a widely-used machine word. Luckily, the high 28 bits are never used, so I can get away with using Int64 (from Data.Int) for the machine's memory.

But I can't use Int64 for everything. The bit-twiddling functions in Data.Bits use Int values to address the locations within a word. And the masks are three-valued objects, so I created a new algebraic type to represent them.

Finally, I create a record for the Machine. Not that this contains the two mask types needed for both parts 1 and 2.

data MaskValue = Zero | One | Wild deriving (Show, Eq)
type MaskMap = M.Map Int MaskValue
data Instruction = Mask MaskMap | Assignment Int64 Int64
  deriving (Show, Eq)

type Memory = M.Map Int64 Int64
data Machine = Machine { mMemory :: Memory
                       , mMask :: MaskMap
                       , mMask0 :: Int64
                       , mMask1 :: Int64
                       } deriving (Show, Eq)

emtpyMachine = Machine M.empty M.empty (complement 0) 0

Parsing the input is a bit more complex than before, due to the need to create the Maps to hold the mask. I create them with the utility functions maskify and readMaskChar. The rest of the parser should be readable, but note the need to have brackets around the rules that read the text.

programP = (maskP <|> assignmentP) `sepBy` endOfLine

maskP = maskify <$> ("mask = " *> (many (digit <|> letter)))
assignmentP = Assignment <$> ("mem[" *> decimal) <* "] = " <*> decimal

maskify :: String -> Instruction
maskify chars = Mask (M.fromList locValues)
  where mValues = map readMaskChar chars
        locValues = zip [0..] $ reverse mValues

readMaskChar '0' = Zero
readMaskChar '1' = One
readMaskChar 'X' = Wild

Part 1

The overall processing of the program is straightforward: create an empty machine, apply the instructions one at a time to get to the final state. That's folding the instructions into the machine, with a function to apply a single instruction.

part1 program = sum $ M.elems $ mMemory finalMachine
  where finalMachine = executeInstructions1 program

executeInstructions1 instructions = 
  foldl' executeInstruction1 emtpyMachine instructions

executeInstruction1 :: Machine -> Instruction -> Machine
executeInstruction1 machine (Mask mask) = makeMask machine mask
executeInstruction1 machine (Assignment loc value) = 
  assignValue machine loc value

(I did think about using a State monad to hold the machine, but decided that the extra setup and teardown for it wasn't worth the benefit, given that the contents of the State would be almost immediately unpacked.)

Executing the instructions revolves around the masking operation. For bits, we have the identities

  • x OR 0 = x; x OR 1 = 1
  • x AND 0 = 0; x AND 1 = x

I can apply the 1s in the mask by having a 36-bit word that's all 0s except for the mask's 1s, and ORing it with the value.Similarly, I can apply the 0s in the mask by having a 36-bit word that's all 1s except for the mask's 0s, and ANDing it with the value. The gives the maskValue function:

maskValue machine value = 
  (value .|. (mMask1 machine)) .&. (mMask0 machine)

(where .|. and .&. are bitwise OR and AND respectively).

Given maskValue, writing assignValue is simple.

assignValue machine loc value = 
  machine {mMemory = M.insert loc value' mem}
  where value' = maskValue machine value
        mem = mMemory machine

All that's left is to create the two masks.

To create the mask of 1s, I start with a word of all zeros (zeroBits) and setBit where there's a One in the mask. I cover all the mask with a fold. Creating the mask of 0s is the same, but using complement zeroBits as there isn't a built-in oneBits.

maskOnes :: MaskMap -> Int64
maskOnes mask = foldl' setBit zeroBits ones
  where ones = M.keys $ M.filter (== One) mask

maskZeroes :: MaskMap -> Int64
maskZeroes mask = foldl' clearBit (complement zeroBits) zeroes
  where zeroes = M.keys $ M.filter (== Zero) mask

Part 2

Things got more complex here. The main task is to convert one address into a set of addresses, so the value can be applied to all addresses in that set.

First, a couple of functions to convert between MaskMaps and Int64s. Note that encodeMask will throw an error if it's asked to convert something containing a Wild value. In production code, I'd do something more robust than this.

encodeMask :: MaskMap -> Int64
encodeMask mask = M.foldrWithKey' setBitValue zeroBits mask
  where setBitValue _ Zero n = n
        setBitValue i One n = setBit n i

decodeMask :: Int64 -> MaskMap
decodeMask val = M.fromList [ (i, decodeBit $ testBit val i) 
                            | i <- [0..(finiteBitSize val)] 
  where decodeBit True = One
        decodeBit False = Zero

There are a bunch of different ways to convert a single item into a list of possibles. I thought about using a List monad to represent the non-deterministic nature of the address, but ended up doing the simpler equivalent of using list comprehensions.

Given a mask value and a list of masks, applyBit will create a new list of masks. If the bit is Zero, the masks stay the same. If the bit is One, it replaces the corresponding value in each of the masks. If the bit is Wild, it creates two new masks for each one present, for the two different bit values.

applyAddressMask :: MaskMap -> MaskMap -> [MaskMap]
applyAddressMask mask address = M.foldrWithKey' applyBit [address] mask

applyBit :: Int -> MaskValue -> [MaskMap] -> [MaskMap]
applyBit _ Zero ms = ms
applyBit k One  ms = [ M.insert k One m | m <- ms ]
applyBit k Wild ms = [ M.insert k b m | m <- ms, b <- [Zero, One] ]

With the ability to create lists of masks, the instruction execution is updating the memory in every location in that list.

executeInstruction2 :: Machine -> Instruction -> Machine
executeInstruction2 machine (Mask mask) = machine {mMask = mask}
executeInstruction2 machine (Assignment loc value) = machine {mMemory = mem'}
  where locs = map encodeMask $ applyAddressMask (mMask machine) $ decodeMask loc
        mem = mMemory machine
        mem' = foldl' (\m l -> M.insert l value m) mem locs


You can find the code here or on Gitlab.