Part 1 of today’s Advent of Code problem, “Monkey Market”, was a simple implementation task. Part 2 showed promise, but apart from the convoluted statement hurdle, it turned out to be simple implementation as well. At least there’s no 2D grid involved. This is still literate Haskell, so let’s have a few imports to get started.

import Control.Arrow ((&&&))
import Data.Bits (xor)
import Data.List (tails)
import qualified Data.Map.Strict as Map

So each buyer shifts from a secret to the next using a simple formula. Let’s write a function for it.

nextSecret :: Int -> Int
nextSecret =
  prune . (mix <*> (2048 *)) .
  prune . (mix <*> (`div` 32)) .
  prune . (mix <*> (64 *))

Yes, there’s a bit of abuse of the (->) reader monad instance in there. Got to keep it interesting for me as well.

Anyway, the function uses two more bits of support code.

mix :: Int -> Int -> Int
mix = xor

prune :: Int -> Int
prune = (`mod` 16777216)

And that’s more or less all we need to wrap up part 1.

part1 :: [Int] -> Int
part1 = sum . map ((!! 2000) . iterate nextSecret)

Part 2 seemed a lot more interesting at first. Because I had noticed neither the 2000 limit for price change observation nor the 4 limit for the window length.

So let’s compute, for a starting secret, the full list of involved change window and associated price.

prefixPrices :: Int -> [([Int],Int)]
prefixPrices secret =
  let prices = (`mod` 10) <$> iterate nextSecret secret
      changes = take 2000 $ zipWith (-) (tail prices) prices
      prefixes = filter ((== 4) . length) $ take 4 <$> tails changes
  in zip prefixes (drop 4 prices)

Let’s gather all of those into a map. The seller will trigger for the first time it observes the change sequence, so we want left bias here.

ppMap :: Int -> Map.Map [Int] Int
ppMap = Map.fromListWith (flip const) . prefixPrices

We can now sum those results across all buyers and keep the largest.

part2 :: [Int] -> Int
part2 = maximum . Map.unionsWith (+) . map ppMap

A bit of wrapping…

parse :: String -> [Int]
parse = map read . lines

main :: IO ()
main = interact $ show . (part1 &&& part2) . parse

…and we’re done.

This concludes today’s problem, a rather boring one if you ask me. See you tomorrow!