This challenge is what we venezuelans describe as «concha de mango». It is deceptively simple at first, but you'll inevitable fall in the trap.

Not to worry. You can get out of big trouble, with a little Chinese magic.

## The Problem

There's a group of monkeys hoarding stuff. They take turns looking at their loot. And by that they mean doing math on your «worry value» for each item. Depending on said math's result, they toss items around. You're asked to keep track of the tossing.

The input looks like

Monkey 0:\n
Starting items: 79, 98\n
Operation: new = old * 19\n
Test: divisible by 23\n
If true: throw to monkey 2\n
If false: throw to monkey 3\n
\n
Monkey 1:\n
Starting items: 54, 65, 75, 74\n
Operation: new = old + 6\n
Test: divisible by 19\n
If true: throw to monkey 2\n
If false: throw to monkey 0\n

and corresponds to the simulation's initial state. That is, for each monkey you'll get:

• The initial list of items they hold and their «worry value».

• The operation to find the resulting «worry value».

• A test to figure out which monkey to throw the item after.

The problem's description has a thorough example of what's going on. From that we take that Monkeys take turns, starting with Monkey 0, so that each Monkey updates and acts over their respective stuff before the next Monkey. A «round» is completed after all Monkeys do their thing. We're asked to simulate a certain number of rounds and report on the number of inspections monkeys made.

## Main Program

The main program is pretty much the same as Day 1.

## Modeling the simulation

Judging by the sample input, it seemed all numbers were going to be positive. Also, it looked like the only operations would be adding, multiplying, and squaring, thus keeping them positive. The only «odd» operation was a «divide by 3» before performing the test: one can deduce it's an integer division from the example, and it would keep numbers positive anyway. These observations were confirmed by inspecting my particular input data.

I would need to quickly search and update each Monkey's state, so it made sense to use Data.IntMap as I did on Day 5.

import qualified Data.IntMap as DIM

I also had three different Int things to handle: the Monkey id's for the DIM.IntMap, the «worry level» for the items, and the number of inspections. The last one was going to be «hidden» in the state, but the first two were going to be in function signatures, and I wanted to avoid mixing them up. I did not go full newtype on them, but used simple type aliases

type MonkeyId = Int
type Worry    = Int

and started defining types to handle the structured values needed for the simulation.

A simple sum type is enough for modeling Operations,

data Op   = Add Worry | Mul Worry | Square
deriving (Show,Eq)

and since the operation is always going to be applied to a given «worry value», let's abstract their evaluation with a helper function.

eval :: Op -> Worry -> Worry
eval (Add dw) w0 = w0 + dw
eval (Mul tw) w0 = w0 * tw
eval Square   w0 = w0 * w0

As for the selector to determine which Monkey to throw an item to, it made sense to encode it as a labeled product type

data Next = Next { modulus :: Worry
, onTrue  :: MonkeyId
, onFalse :: MonkeyId
}
deriving (Show,Eq)

with a helper function that, given a Next and Worry level, produces the corresponding MonkeyId to throwTo

throwTo :: Next -> Worry -> MonkeyId
throwTo n w = if w `mod` modulus n == 0
then onTrue n
else onFalse n

I could finally model a Monkey using a labeled product type

data Monkey = Monkey { idx         :: MonkeyId
, items       :: [Worry]
, new         :: Op
, next        :: Next
, inspections :: Int
}
deriving Show

Notice the name idx so it doesn't clash with the standard id function, as well as the inspections counter, a plain Int.

All we need is a parser that loads all Monkeys into the proper DIM.IntMap and writing the actual simulation.

## Parsing the initial state

After realizing all numbers are going to be positive integers, I started by writing

parseInt :: Parser Int
parseInt = read <\$> many1 digit

To parse a list of «worry levels» items, such as

Starting items: 79, 98\n

per the example, we need to ignore leading white space, check the constant string up to and including the space after the colon, and then collect one or more numbers separated by comma and space, ending with a new line.

parseItems :: Parser [Worry]
parseItems = do spaces
string "Starting items: "
parseInt `sepBy1` (char ',' >> space) <* newline

Notice the use of Applicative's (<*) to combine two parsers into one, returning the result of the first parser.

Parsing the operation is a bit more interesting. Looking at the corresponding line from three examples

Operation: new = old * 19
Operation: new = old + 6
Operation: new = old * old

we notice there's a common prefix, ending at the space after the old. As discussed in Day 7, we must left-factor this common prefix into its own parser, in order for the whole parser to be deterministic. Therefore we write a parser that checks and ignores it

parsePrefix :: Parser ()
parsePrefix = spaces >> string "Operation: new = old " >> pure ()

and this let's us write the parser for the actual operation as

parseNew :: Parser Op
parseNew = parsePrefix >> (parseSum <|> parseMul)
where
parseSum  :: Parser Op
parseSum  =  Add <\$> (string "+ " >> parseInt)
parseMul  :: Parser Op
parseMul  = do string "* "
(string "old" >> pure Square) <|> (Mul <\$> parseInt)

For the constructors requiring a value (Add and Mul) we take advantage of parsers being Applicative to fmap the constructor over the result of the parseInt. There's another left-factoring to discriminate multiplication and squaring common prefix.

A similar technique is used to parse the test-selector. This is slightly more interesting, because it's provided in three lines such as

Test: divisible by 23
If true: throw to monkey 2
If false: throw to monkey 3

So it's a matter of having a parser for the Test:... line, a parser for the If.. line that capture the Bool and the Int, and then use Applicative composition.

parseNext :: Parser Next
parseNext = Next <\$> parseMod
<*> parseThrow "true"
<*> parseThrow "false"
where
parseMod :: Parser Worry
parseMod = do spaces
string "Test: divisible by "
parseInt <* newline
parseThrow   :: String -> Parser MonkeyId
parseThrow s = do spaces
string \$ "If " ++ s ++ ": throw to monkey "
parseInt <* newline

The local parseThrow is a nice example of a parameterized parser.

All these parsers can be combined to parse one Monkey. The MonkeyId will come from the input file, while the number of inspections will be initialized with zero.

parseMonkey :: Parser Monkey
parseMonkey = Monkey <\$> parseId
<*> parseItems
<*> parseNew
<*> parseNext
<*> pure 0
where
parseId :: Parser MonkeyId
parseId = do string "Monkey "
parseInt <* (char ':' >> newline)

The top-level Parser is suppose to return a DIM.IntMap Monkey. The input file separates every Monkey with a newline, so we can start with

ghci> :type parseMonkey `sepBy1` newline
parseMonkey `sepBy1` newline :: Parser [Monkey]

The IntMap API provides fromList, requiring a list of tuples (Int,a) where the first is the index corresponding to the item a to store on the map. In our case, for every Monkey m we'd need idx m, so

ghci> :type DIM.fromList . map (\m -> (idx m, m))
[Monkey] -> IntMap Monkey

and we are just an fmap away!

parseInput :: Parser (DIM.IntMap Monkey)
parseInput = DIM.fromList . map (\m -> (idx m, m)) <\$> parseMonkey `sepBy1` newline

As usual, I write a top-level function that runs the parser and returns the unadorned result.

loadMonkeys :: String -> DIM.IntMap Monkey
Right im -> im
Left  _e -> undefined

We are asked to simulate a number of rounds. Each round requires simulating the behavior of each Monkey. The state of our simulation is held entirely within the DIM.IntMap Monkey: the initial state is the one we receive as input, and every round computes a new state.

This suggests splitting the computation so that there's a function simulateRounds taking care of threading the state round-by-round, and a function monkeyAround that simulates a single round. I remembered the «divide by 3», to manage worry, thought of it as a simulation independent behavior, and decided to abstract it as an additional argument.

For the «outer loop» I wrote:

simulateRounds :: Int
-> (Worry -> Worry)
-> DIM.IntMap Monkey
-> DIM.IntMap Monkey
simulateRounds n mw s0 = foldl' step s0 [1..n]
where
step s _ = monkeyAround mw s

At every step we take the current state of the simulation and round number. There's no use for the round number, so I simply ignore it, and just simulate one round using current state s to produce the updated state. foldl' takes care of the «threading» -- no need for State Monad. Notice how the «manage worry» function (mw) is handed to monkeyAround.

The «inner loop» is precisely monkeyAround. It works on the current state to produce a new state. Therefore, it needs to receive the current DIM.IntMap Monkey to produce a new adjusted DIM.IntMap Monkey after the needed changes. Monkeys take turns in order, and the IntMap API provides DIM.keys that returns a list of all indexes in ascending order. This means we can start writing

monkeyAround :: (Worry -> Worry)
-> DIM.IntMap Monkey
-> DIM.IntMap Monkey
monkeyAround manage s = foldl' monkeyBusiness s \$ DIM.keys s
where

The first argument is the manage worry function we'll use later. The second argument s is the IntMap corresponding to the current state we need to modify. It's used to get the list of ordered Monkey indexes used foldl' over, as well as the initial accumulator. We now conduct monkeyBusiness over the current state for a particular MonkeyId using a local function

monkeyBusiness :: DIM.IntMap Monkey    -- current state
-> MonkeyId             -- acting monkey
-> DIM.IntMap Monkey
where
Just m = DIM.lookup k im
is     = items m
im'    = foldl' (throwItems m) im is
m'     = m { items = []
, inspections = inspections m + length is
}

We are sure the DIM.lookup will be successful -- we're using foldl' over the result of DIM.keys -- so we pattern-match the Maybe to get the Monkey m currently acting up. We get the list of items and use throwItems to process each one: those items are going to other monkeys on the current IntMap im, resulting in a new updated map im' except for the current Monkey m. A new Monkey m' is created using m as template but with an empty list of items (since they've been already thrown) and incrementing the number of inspections with precisely the number of items thrown (a warranted use of length!). Using DIM.adjust makes it easy to replace the Monkey at the current key k with the newly created m'.

As for the current Monkey being able to throwItems around, notice how the first argument will be fixed to the current Monkey thanks to currying. That makes the resulting function perfect for handling one item at a time using foldl', and changing the simulation state one destination at a time.

throwItems :: Monkey             -- Current Monkey
-> DIM.IntMap Monkey  -- Current State
-> Worry              -- Item's worry level
-> DIM.IntMap Monkey
throwItems mk cm it =
let w = manage \$ eval (new mk) it
in  DIM.adjust (\x -> x { items = items x ++ [ w ] })
(throwTo (next mk) w)
cm

We start by evaluating the current monkey's worry expression (new mk) over the item, and apply the manage worry function on the result, to get the updated worry w. The key for the Monkey to DIM.adjust can be computed passing the current monkey's destination rule (next mk) and the updated worry w, to throwTo. The destination monkey is adjusted by adding the updated worry w as the last element of its items.

## Solving Part A

We must simulate 20 rounds and «manage» our worry dividing by 3. After the simulation is complete, we need to find the two largest number of inspections and multiply them.

We compose all the aforementioned functions, take advantage of IntMap API, and the reverse order sorting trick from Day 1. As usual, we reason about our code in a sound way

loadMonkeys :: String -> DIM.IntMap Monkey
ghci> :type simulateRounds 20 (`div` 3) . loadMonkeys
simulateRounds 20 (`div` 3) . loadMonkeys :: String -> DIM.IntMap Monkey
ghci> :type DIM.elems . simulateRounds 20 (`div` 3) . loadMonkeys
DIM.elems . simulateRounds 20 (`div` 3) . loadMonkeys :: String -> [Monkey]
ghci> :type map inspections . DIM.elems . simulateRounds 20 (`div` 3) . loadMonkeys
map inspections . DIM.elems . simulateRounds 20 (`div` 3) . loadMonkeys :: String -> [Int]

to end up writing

partA :: String -> Int
partA input = i0 * i1
where
[i0,i1] = take 2
\$ sortBy (flip compare)
\$ map inspections
\$ DIM.elems
\$ simulateRounds 20 (`div` 3)

## Failing at Part B

Using partA on the input computed the correct result and uncovered Part B. The simulation must go over 10000 rounds now, that's fine. However, we're given the hint that «an item no longer causes your worry level to be divided by three», followed by the worrying «you'll need to find another way to keep your worry levels manageable».

After replacing

simulateRounds 20 (`div` 3)

with

simulateRounds 10000 id

I got a number that was fairly large, but wrong. The code works fine, as exhibited by Part A, so it must be a case of numeric overflow.

The result it's the product of the larger inspections. There are 8 monkeys throwing things around, there are roughly 30 items being shuffled around, so if every monkey would receive and throw all items, we'd be looking at every monkey having about

8 monkey * 30 inspections/monkey * 10000 rounds = 2400000

inspection, and 2400000 * 2400000 is still a reasonable Int. No overflow on the inspection count or its product.

Adjusting the worry level always start by increasing the value (addition, multiplication, and squaring). After taking out the division, it's reasonable to think these numbers could grow so big, that they wouldn't fit on an Int.

Being the lazy professional, I first tried changing

type Worry = Word64

to use unsigned 64-bit integers, because they are always positive and huge. It did not work, so I tried

type Worry = Integer

to no avail. Haskell's Integer has arbitrary precision at the expense of RAM, but the numbers grew so big that even with 32Gb of RAM the computation wasn't completing after minutes of chugging and near out-of-memory.

I was missing something, so I had to aim better.

## Old problems require old solutions

It was clear that worry levels were overflowing, so the test-selector was sending them the wrong way. This made the inspection counts wrong.

I looked at the sample input and noticed the divisibility tests were, respectively

23 19 13 17

Then I looked at my particular input for the same, finding

11 13 17 19 2 3 5 7

They're all prime numbers. And then it hit me: use The Chinese Remainder Theorem to simplify the numbers! I can use the CRT because:

1. Each monkey is computing a particular congruence equation: adding, multiplying (repeated addition), or squaring (repeated addition, again), over a modulus.

2. The divisors used for congruence (modulus) are prime numbers, therefore co-primes pairwise (as CRT requires).

Now, how to use it is probably not clear. Even if you carefully read the Wikipedia Article and any decent Discrete Math book. I knew about this trick because it was shown to me in class, so I'll share the same example:

Consider number 694223. It is fairly «large» compared to primes 2, 7, and 11. If we look at their congruences separately, we have

694223 mod  2 = 1
694223 mod  7 = 5
694223 mod 11 = 2

Now consider 2*7*11 = 154 and 694223 mod 154 = 145. Look at the congruences

145 mod  2 = 1
145 mod  7 = 5
145 mod 11 = 2

This is a consequence of CRT, and it's the way to «keep your worry levels manageable». When the numbers were reasonably small, dividing by 3 kept them at bay. For bigger numbers, we can compute the congruence over the product of the moduli, knowing that the individual congruences will produce the same result, regardless of which monkey handles the new reduced-size item.

The resulting code ended up being

partB :: String -> Int
partB input = i0 * i1
where
[i0,i1] = take 2
\$ sortBy (flip compare)
\$ map inspections
\$ DIM.elems
\$ simulateRounds 10000 control
\$ monkeys
chinese = product \$ map (modulus.next) \$ DIM.elems monkeys
control w = if w >= chinese then w `mod` chinese else w

After loading our input into monkeys we compute the product of all the modulus, and use it as module for numbers that grow bigger than it.

## Conclusion

This is the kind of problem that illustrates why reasoning at scale is an important skill when programming. The algorithm is deceptively simple to write and straightforward to verify. It fails when the data it works with grows. It's not easy to solve even with better data types, because growth is exponential and deviously hidden.

Looking at the huge integers reminded me of the code one needs to work with when implementing cryptographic algorithms. All moduli being primes brought me back to studying Rings during college Algebra courses, before the lighter Discrete Math courses came to replace them. I looked up CRT, and reading through the «Proof» section somehow triggered the memory of the trick.

I don't think I'd ever come up with that trick unless someone showed it to me. It's not something that comes out of pure experience -- you need the theory to be this clever. Period.

As Jack Burton would say, «If you have a problem like that again, just reach for the sky!»