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
loadMonkeys input = case parse parseInput "loadMonkeys" input of
Right im -> im
Left _e -> undefined
Monkey business
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
monkeyBusiness im k = DIM.adjust (const m') k im'
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
ghci> :type loadMonkeys
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)
$ loadMonkeys input
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:
Each monkey is computing a particular congruence equation: adding, multiplying (repeated addition), or squaring (repeated addition, again), over a modulus.
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
monkeys = loadMonkeys input
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!»