# /wakamoleguy

## Advent of Code 2022 - Day 11: Monkey in the Middle

With this Day 11: Monkey in the Middle challenge, I had hoped to use something clever to keep track of the throws. Perhaps the Writer monad could be tacked on to my simulation to sum the throws as we went? But alas, I wasn't able to get that working, since each monkey needs their own throw counter.

In the end, the code is pretty straight forward. We define a data type for our monkeys. We need indexed access to them, so we store them in an Array. Since we're appending a lot of items to the end of lists, I used Data.Sequence instead of a plain list.

Parsing this input seemed like a waste of time, so you'll see the hard-coded list of monkeys in the code below.

### Wait But Part 2?

The key insight in Part 2 is to use modular arithmetic to keep the numbers small. Each of the inspect operations checks whether a result is divisible by a small prime number, and addition and squaring preserve that test when taken modulo that same number.

Since all of our test functions use different numbers, we take the least common multiple as our worst case. This is somewhere around 10 million (or 223 million if you want the example to work!)

### Full Code

module AOC2022.Day11 (spec) where

import Data.Array
( Array,
accum,
elems,
indices,
listArray,
(!),
(//),
)
import Data.Foldable (toList)
import Data.List (foldl', sortOn)
import Data.Ord (Down (Down))
import Data.Sequence (Seq, empty, fromList, length, (|>))
import Test.Hspec (describe, hspec, it, shouldBe)
import Prelude hiding (length)

spec :: IO ()
spec = hspec $do describe "Day 11"$ do
describe "Part 1" $do it "runs on custom input"$ do
part1 exampleMonkeys shouldBe 10605
part1 myMonkeys shouldBe 0 -- redacted
describe "Part 2" $do it "runs on custom input"$ do
part2 exampleMonkeys shouldBe 2713310158
part2 myMonkeys shouldBe 0 -- redacted

data Monkey = Monkey
{ items :: Seq Int,
operation :: Int -> Int,
test :: Int -> Int,
throwCount :: Int
}

exampleMonkeys :: Array Int Monkey
exampleMonkeys =
listArray
(0, 3)
[ Monkey (fromList [79, 98]) (* 19) (\x -> if x mod 23 == 0 then 2 else 3) 0,
Monkey (fromList [54, 65, 75, 74]) (+ 6) (\x -> if x mod 19 == 0 then 2 else 0) 0,
Monkey (fromList [79, 60, 97]) (\x -> x * x) (\x -> if x mod 13 == 0 then 1 else 3) 0,
Monkey (fromList [74]) (+ 3) (\x -> if x mod 17 == 0 then 0 else 1) 0
]

maxmod :: Int
maxmod = 2 * 3 * 5 * 7 * 11 * 13 * 17 * 19 * 23

myMonkeys :: Array Int Monkey
myMonkeys =
listArray
(0, 7)
[ Monkey (fromList [63, 84, 80, 83, 84, 53, 88, 72]) (* 11) (\x -> if x mod 13 == 0 then 4 else 7) 0,
Monkey (fromList [67, 56, 92, 88, 84]) (+ 4) (\x -> if x mod 11 == 0 then 5 else 3) 0,
Monkey (fromList [52]) (\x -> x * x) (\x -> if even x then 3 else 1) 0,
Monkey (fromList [59, 53, 60, 92, 69, 72]) (+ 2) (\x -> if x mod 5 == 0 then 5 else 6) 0,
Monkey (fromList [61, 52, 55, 61]) (+ 3) (\x -> if x mod 7 == 0 then 7 else 2) 0,
Monkey (fromList [79, 53]) (+ 1) (\x -> if x mod 3 == 0 then 0 else 6) 0,
Monkey (fromList [59, 86, 67, 95, 92, 77, 91]) (+ 5) (\x -> if x mod 19 == 0 then 4 else 0) 0,
Monkey (fromList [58, 83, 89]) (* 19) (\x -> if x mod 17 == 0 then 2 else 1) 0
]

catchItem :: Monkey -> Int -> Monkey
catchItem monkey item = monkey {items = items monkey |> item}

step :: (Int -> Int) -> Array Int Monkey -> Int -> Array Int Monkey
step worryReducer monkeys i = monkeys'
where
m = monkeys ! i
itemThrows = (\item -> (test m item, item)) . worryReducer . operation m <$> items m m' = m {items = empty, throwCount = throwCount m + length itemThrows} monkeys' = accum catchItem monkeys (toList itemThrows) // [(i, m')] oneRound :: (Int -> Int) -> Array Int Monkey -> Array Int Monkey oneRound worryReducer monkeys = foldl' (step worryReducer) monkeys$ indices monkeys

monkeyBusiness :: Array Int Monkey -> Int
monkeyBusiness = product . take 2 . sortOn Down . elems . fmap throwCount

part1 :: Array Int Monkey -> Int
part1 monkeys = monkeyBusiness $foldl' (const . oneRound (div 3)) monkeys [1 .. 20] part2 :: Array Int Monkey -> Int part2 monkeys = monkeyBusiness$ foldl' (const . oneRound (mod maxmod)) monkeys [1 .. 10000]

### Advent of Code 2022 Series

This post is part of a series describing my Haskell solutions to Advent of Code 2022.

Next: Day 12: Hill Climbing Algorithm Previous: Day 10: Cathode-Ray Tube

Cheers!