After the brain-burner of day 21, day 22 came as some blessed relief. It was similar to day 6, in that solving the problem was simple enough, but getting it to run in less than many hours was the part that took the effort.
Direct solutions
Part 1 was almost trivial: just translating the calculation into Haskell
part1 :: [Int] -> Int
part1 codes = sum $ fmap (followingSecret 2000) codes
nextSecret, step1, step2, step3, prune :: Int -> Int
nextSecret = step3 . step2 . step1
step1 n = prune $ (n * 64) `mix` n
step2 n = prune $ (n `div` 32) `mix` n
step3 n = prune $ (n * 2048) `mix` n
prune n = n `mod` 16777216
mix :: Int -> Int -> Int
mix s n = s `xor` n
followingSecret :: Int -> Int -> Int
followingSecret n s = (!! n) $ iterate nextSecret sThe direct solution to part 2 was also simple. I found the sale prices of each seller, all the possible "windows" I could instruct my buyer to find, then found the price of each window on each set of prices.
The core was converting the set of prices into a set of windows. Conveniently, the divvy function from Data.List.Split did most of it. I found the windows and, in pricesAndWindows, paired each one with the sale price at that position.
salePrices :: Int -> [Int]
salePrices s = take 2001 $ fmap (`mod` 10) $ iterate nextSecret s
priceChanges :: [Int] -> [Int]
priceChanges ps = zipWith (-) (tail ps) ps
windows :: [Int] -> [[Int]]
windows = divvy 4 1
pricesAndWindows :: [Int] -> [(Int, [Int])]
pricesAndWindows ps = zip (drop 4 ps) $ windows cs
where cs = priceChanges psFinding all possible windows was done the obvious way.
possibleWindows :: [[Int]]
possibleWindows = [ [a, b, c, d]
| a <- [-9..9]
, b <- [-9..9]
, c <- [-9..9]
, d <- [-9..9]
]Putting it all together:
part2 codes = maximum $ fmap valueOfWindow allWindows
where allPrices = fmap salePrices codes
allWindows = possibleWindows
valueOfWindow w = sum $ fmap (valueGivenWindow w) allPrices
valueGivenWindow :: [Int] -> [Int] -> Int
valueGivenWindow window ps
| null foundPrices = 0
| otherwise = fst $ head foundPrices
where vCs = pricesAndWindows ps
foundPrices = dropWhile (\(p, w) -> w /= window) vCs This solution is present as MainBruteForce.hs. It gives the correct answer for the test data, but takes a minute and a half to do it. It took ten hours to generate the answer for the full dataset. (but it got the right answer!) Even pruning the number of possible windows would only about half the time. A different approach was needed.
Optimising
The above approach tries every window on every position of each seller's price list. A better approach is to limit myself to only considering the windows that exist in those price lists.
For each seller, I create a Map going from windows to prices. I walk along the prices, building up the Map as I go. Then I merge all those maps, and find the highest total available price.
As a further optimisation, I "hash" the window to an integer value, by treating the window values as digits of a "balanced base-20 number" [^1] . That gives the type of the Prices map as
[^1] I originally used a base 10 encoding, but that led to hash collisions.
type Prices = M.IntMap Int
windows :: [Int] -> [Int]
windows = fmap encode . divvy 4 1
encode :: [Int] -> Int
encode xs = foldl' (\a n -> a * 20 + n) 0 xsThe price of a particular window (for a particular seller) is the first price found. I find them all with a fold over the list of windows, using flip const to keep the first price found.
windowsAndPrices :: [Int] -> Prices
windowsAndPrices ps = foldl' (\m (w, p) -> M.insertWith (flip const) w p m) M.empty wPs
where cs = priceChanges ps
wPs = zip (windows cs) (drop 4 ps)Once I have the prices for each seller's windows, I merge them and find the highest value.
part2 codes = maximum $ M.elems mergedPriceValues
where allPrices = fmap salePrices codes
allPriceValues = fmap windowsAndPrices allPrices
mergedPriceValues = M.unionsWith (+) allPriceValuesCode
You can get the code from my locally-hosted Git repo, or from Codeberg.
