Day 21 wasn't too bad in theory, but a couple of annoying bugs made it took longer than it should. I thought I'd talk about both the solution and a quick look at debugging Haskell.
Part 1
The first question for me was how to represent a game state and a game as a whole. I considered using a State monad, but the part 1 puzzle was very similar to day 14 and day 17, in that an iterate over a step-update function would be enough to produce the answer. That suggested that a direct representation of the game would be enough for the moment. (I use a custom Show instance for compactness).
data Player = Player1 | Player2 deriving (Eq, Ord, Show)
data PlayerState = PlayerState
{ position :: Int
, score :: Int
} deriving (Eq, Ord, Show)
data Game = Game
{ players :: M.Map Player PlayerState
, current :: Player
, rolls :: Int
} deriving (Eq, Ord)
instance Show Game where
show game = "{" ++ (showPlayer Player1) ++ (showActive) ++ (showPlayer Player2) ++ "}"
where showPlayer p = (show $ position $ (players game) ! p) ++ "," ++ (show $ score $ (players game) ! p)
showActive = if (current game) == Player1 then "<" else ">"
I guessed that part 2 of the problem would change the dice generation function, so I made the dice stream an input into the game simulation. That changed the iteration function from iterate to scanl'.
part1 game = scoreGame finalGame
where finalGame = head $ dropWhile (not . finished 1000) $ scanl' gameStep game detDice
detDice = map (\n -> sum ([d `mod1` 100 | d <- [n..(n+2)]]::[Int])) [1, 4..]
I also created a couple of utility functions. mod1 is like mod, but keeps a number in the range [1, n] rather than [0, n-1].
finished :: Int -> Game -> Bool
finished threshold game = any (>= threshold) $ map score $ M.elems (players game)
scoreGame :: Game -> Int
scoreGame game = (rolls game) * losingScore
where losingScore = minimum $ map score $ M.elems (players game)
nextPlayer :: Player -> Player
nextPlayer Player1 = Player2
nextPlayer Player2 = Player1
mod1 :: Int -> Int -> Int
mod1 a b = ((a - 1) `mod` b) + 1
The gameStep function directly implements the rules of the game, as specified.
gameStep :: Game -> Int -> Game
gameStep game theseRolls = game'
where activePlayer = (players game) ! (current game)
pos = position activePlayer
sc = score activePlayer
pos' = (pos + theseRolls) `mod1` 10
sc' = sc + pos'
activePlayer' = PlayerState {position = pos', score = sc'}
current' = nextPlayer (current game)
players' = M.insert (current game) activePlayer' (players game)
game' = Game { players = players'
, current = current'
, rolls = rolls game + 3
}
Part 2
For part 2, I had to count all the possible histories that led to every finishing move. I decided to do that by maintaining a multiset of games, where each element of the multiset counted the number of histories that led to it. For example, this generates the set of dice rolls.
type Games = MS.MultiSet Game
type Dice = MS.MultiSet Int
type Winners = MS.MultiSet Player
diracDice :: Dice
diracDice = MS.fromList [a + b + c | a <- [1..3], b <- [1..3], c <- [1..3]]
Imperatively, the simulation algorithm is:
For each ongoing game:
For each dice roll:
Update this game with this dice roll
Record the number of histories as (number of games) × (number of dice rolls)
In a more functional style, both these loops are folds: combining a collection of items (each game, each dice roll) into a single value (the new multiset of histories). nonDetGameStep and nonDetGameStep1 represent the two loops above, while nonDetGameStep2 does the update within the inner loop. The new set of histories being built up is held in an accumulator, called acc. nonDetGameSimulation stops simulating when there are no longer any possible games, and also handles extracting the counts of winners.
nonDetGameSimulation :: Int -> Games -> Dice -> Winners -> Winners
nonDetGameSimulation winThreshold games0 dice winners0
| MS.null games0 = winners0
| otherwise = nonDetGameSimulation winThreshold games dice winners
where games' = nonDetGameStep games0 dice
(winGames, games) = MS.partition (finished winThreshold) games'
p1Wins = MS.size $ MS.filter (\g -> current g == Player2) winGames
p2Wins = MS.size $ MS.filter (\g -> current g == Player1) winGames
winners = MS.insertMany Player2 p2Wins $ MS.insertMany Player1 p1Wins winners0
nonDetGameStep :: Games -> Dice -> Games
nonDetGameStep games dice = MS.foldOccur (nonDetGameStep1 dice) MS.empty games
nonDetGameStep1 :: Dice -> Game -> MS.Occur -> Games -> Games
nonDetGameStep1 dice game gnum acc = MS.foldOccur (nonDetGameStep2 game gnum) acc dice
nonDetGameStep2 :: Game -> MS.Occur -> Int -> MS.Occur -> Games -> Games
nonDetGameStep2 game gnum roll dnum acc = MS.insertMany game' (gnum * dnum) acc
where game' = gameStep game roll
This was the correct approach, but a couple of typos meant it didn't work at first, giving much lower values than in the problem description.
Debugging
A problem with debugging Haskell is getting access to all the current values in a running program. The usual imperative approach, of littering code with print statements, doesn't work when code is outside the IO monad.
The Debug.Trace.trace function provides much the same effect, and that was all I needed for this problem.
The first problem was threading the accumulator through the folds. My original version of nonDetGameStep1 read as:
nonDetGameStep1 dice game gnum acc = MS.foldOccur (nonDetGameStep2 game gnum) MS.empty dice
which meant that nonDetGameStep2 only ran once for each call of nonDetGameSimulation. That was because Haskell was bright enough to realise that only the last-visited member of games would contribute to the new history, as the accumulator was reset to MS.empty each previous step.
With that solved, I got a much better answer bit it was still too small. A comparison with another solution on the solutions megathread revealed that my code wasn't including the last generation of game histories. That was caused by a typo in nonDetGameSimulation:
nonDetGameSimulation :: Int -> Games -> Dice -> Winners -> Winners
nonDetGameSimulation winThreshold games0 dice winners0
| MS.null games = winners0 -- <<<< Typo here
| otherwise = nonDetGameSimulation winThreshold games dice winners
where games' = nonDetGameStep games0 dice
(winGames, games) = MS.partition (finished winThreshold) games'
p1Wins = MS.size $ MS.filter (\g -> current g == Player2) winGames
p2Wins = MS.size $ MS.filter (\g -> current g == Player1) winGames
winners = MS.insertMany Player2 p2Wins $ MS.insertMany Player1 p1Wins winners0
The typo terminated the simulation when the next generation had no more games.
Fixing both of those gave the correct solution!
Code
You can get the code from my locally-hosed Git repo, or from Gitlab.