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] MonkeyHoldsParsing 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 itemsPutting 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 logsThe 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 . testCode
You can get the code from my locally-hosted Git repo, or from Gitlab.
