Advent of Code 2022 day 11

Day 11 was probably the most complex challenge so far, and saw the return on the RWS (Reader-Writer-State) monad to keep track of all the monkeys.

Data representation

This needed quite a few data structures to keep track of all the different parts.

The first decision was to separate the data into parts that would fit the RWS approach. The description of the monkeys' decision-making parameters formed the Reader.  The log of how many items were processed was the Writer. The detail of which monkeys held which items was the State. The Reader part was mainly a Map from monkey ID to its parameters and the State was a Map from monkey ID to the items it held.

Within that, I expressed the "operation" as data, rather than a function that transformed the old worry level to the new one. Finally, the monkey description contained the function that was applied to the worry scores after each update, to keep the scores in a sensible range. For part 1, that limiting function was 'div' 3; for part 2 it was 'mod' k where k was the product of all the "divisible by" values.

data MonkeyCode = MonkeyCode
  { _operation :: Expression
  , _test :: Int
  , _trueTarget :: Int
  , _falseTarget :: Int
  }
  deriving (Show, Eq)

data Expression = Expression Operator Operand deriving (Show, Eq)
data Operator = Plus | Times deriving (Show, Eq)
data Operand = Literal Int | Old deriving (Show, Eq)

type MonkeyCodes = M.IntMap MonkeyCode
data MonkeyDescription = MonkeyDescription { _limit :: Int -> Int
                                           , _codes :: MonkeyCodes
                                           }

makeLenses ''MonkeyCode                                           

The State and Writer parts were simpler. The MonkeyLog held how many items were handled by each monkey in each step of the simulaton.

type MonkeyHolds = M.IntMap [Int]
data MonkeyLog = MonkeyLog Int Int -- monkey ID, number of items handled this round
  deriving (Show, Eq)

type MonkeyHandler = RWS MonkeyDescription [MonkeyLog] MonkeyHolds

Parsing the input took some space, as the data format was verbose.

monkeysP = makeMonkeyMaps <$> (monkeyP `sepBy` (endOfLine <* endOfLine))
  where makeMonkeyMaps monkeys = 
          ( M.fromList $ map fst monkeys
          , M.fromList $ map snd monkeys
          )

monkeyP = mkMonkeyPair <$> mIdP <*> startingP <*> operatorP 
                       <*> testP <*> trueTargetP <*> falseTargetP
  where mkMonkeyPair mId holding _operation _test _trueTarget _falseTarget = 
          ((mId, MonkeyCode{..}), (mId, holding))

mIdP = ("Monkey " *> decimal) <* ":" <* endOfLine
startingP = ("  Starting items: " *> (decimal `sepBy` ", ")) <* endOfLine
operatorP = ("  Operation: new = old " *> expressionP) <* endOfLine
testP = ("  Test: divisible by " *> decimal) <* endOfLine
trueTargetP = ("    If true: throw to monkey " *> decimal) <* endOfLine
falseTargetP = ("    If false: throw to monkey " *> decimal)

expressionP = Expression <$> (opP <* " ") <*> operandP
opP = (Plus <$ "+") <|> (Times <$ "*")
operandP = (Literal <$> decimal) <|> (Old <$ "old")

One monkey's decision

throwItem handles one monkey throwing one item. It updates the worry value, tests it against that monkey's criterion, determines which monkey should receive the item, and updates that monkey's list with the new item.

throwItem :: Int -> Int -> MonkeyHandler ()
throwItem mId currentWorry = 
  do  monkey <- asks ((! mId) . _codes)
      threshold <- asks _limit
      let newWorry = updateWorry currentWorry (monkey ^. operation) threshold
      let testResult = worryTest (monkey ^. test) newWorry
      let recipient = if testResult 
                      then (monkey ^. trueTarget)
                      else (monkey ^. falseTarget)
      modify (receivesItem recipient newWorry)

This all uses a bunch of helper functions. updateWorry calculates the new worry level, using the threshold function after the monkey's defined operation.

updateWorry :: Int -> Expression -> (Int -> Int) -> Int
updateWorry current (Expression operator operand) threshold
  | operator == Plus  = threshold (current + n) 
  | operator == Times = threshold (current * n) 
  where n = evalOperand operand
        evalOperand (Literal k) = k
        evalOperand Old = current

worryTest :: Int -> Int -> Bool
worryTest divisor worry = worry `mod` divisor == 0

receivesItem :: Int -> Int -> MonkeyHolds -> MonkeyHolds
receivesItem mId worry items = M.adjust (++ [worry]) mId items

Putting it together

Given one monkey throwing one item, having all monkeys throw all items to make a round is a couple of mapM calls.

throwRound :: MonkeyHandler ()
throwRound =
  do mIds <- gets M.keys
     mapM_ throwItems mIds

throwItems :: Int -> MonkeyHandler ()
throwItems mId = 
  do items <- gets (! mId)
     mapM_ (throwItem mId) items
     modify (M.insert mId [])
     tell [MonkeyLog mId (length items)]

throwItems also writes the log of how many items are thrown by this monkey this round.

There are a couple of functions to extract the desired value from the log.

sumLogs :: [MonkeyLog] -> M.IntMap Int
sumLogs logs = foldl' addCount M.empty logs
  where addCount m (MonkeyLog mId n) 
          | mId `M.member` m = M.adjust (+ n) mId m
          | otherwise = M.insert mId n m

monkeyBusinessLevel :: [MonkeyLog] -> Int
monkeyBusinessLevel logs = prolifics!!0 * prolifics!!1
  where prolifics = reverse $ sort $ M.elems $ sumLogs logs

The final part is to assemble the monkey description (together with the limiting function) and simulate the required number of rounds.

part1, part2 :: MonkeyCodes -> MonkeyHolds -> Int
part1 monkeyCode monkeyHold = monkeyBusinessLevel logs
  where monkeyDesc = MonkeyDescription { _limit = (`div` 3)
                                       , _codes = monkeyCode
                                       }
        (_, logs) =  execRWS (replicateM_ 20 throwRound) 
                             monkeyDesc monkeyHold

part2 monkeyCode monkeyHold = monkeyBusinessLevel logs
  where monkeyDesc = MonkeyDescription { _limit = (`mod` threshold)
                                       , _codes = monkeyCode
                                       }
        (_, logs) =  execRWS (replicateM_ 10000 throwRound) 
                             monkeyDesc monkeyHold
        threshold = product $ monkeyCode ^.. folded . test

Code

You can get the code from my locally-hosted Git repo, or from Gitlab.