/wakamoleguy

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