Advent of Code 2020 in Haskell - Day 22



Jump to:

D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13 | D14 | D15 | D16 | D17 | D18 | D19 | D20 | D21 | D22 | D23 | D24 | D25


Part 1

More simulate-the-game problems! Day 22 asks us to run through a simple card game so that we can determine the game state when a winner is decided.

I suspect this problem is meant to force the implementer to think about which data structure to use. It seems to be the case that many programming languages have the "most popular" data structure as one that only has cheap insertion/removal at one end (e.g., C++ std::vector, or Haskell's list). In this game, we need to be able to efficiently remove elements from one end and place them at the other. Haskell does have a data structure for that: Seq.

    
import D22input
-- p1 :: [Int]
-- p2 :: [Int]
import Data.Foldable (toList)
import qualified Data.List as List
import qualified Data.Maybe as Maybe
import Data.Sequence ((|>), ViewL((:<)), ViewR((:>)))
import qualified Data.Sequence as Seq

type GameState = (Seq.Seq Int, Seq.Seq Int)

playRound :: GameState -> GameState
playRound (d1, d2) =
    let h1 = Seq.viewl d1
        h2 = Seq.viewl d2
        in case (h1, h2) of
            (Seq.EmptyL, _) -> (d1, d2)
            (_, Seq.EmptyL) -> (d1, d2)
            (c1 :< c1s, c2 :< c2s) ->
                if c1 < c2
                then (c1s, c2s |> c2 |> c1)
                else (c1s |> c1 |> c2, c2s)

steadyState :: Eq a => (a -> a) -> a -> a
steadyState f x
    | f x == x = x
    | otherwise = steadyState f (f x)

winningScore :: Seq.Seq Int -> Int
winningScore s = let n = Seq.length s
                    in sum $ zipWith (*) [n,n-1..1] (toList s)

solve :: Int
solve = let initialState = (Seq.fromList p1, Seq.fromList p2)
            (end1, end2) = steadyState playRound initialState
            in max (winningScore end1) (winningScore end2)

main :: IO ()
main = print $ solve              
    

We represent the game state (the two decks, in order) as two sequences of integers. Extracting from the head and appending to the tail is slightly awkward (accomplished by viewl and the |> operator, respectively), but other than that, the playRound function, which advances the game by one round, is a straightforward transcription of the game rules.

One quirk is that, if the game is already over, we choose to return the state unchanged. This allows us to repurpose the steadyState function that we wrote in Day 11 to concisely obtain the end state of the game.

Computation of the final score is easily done with zipWith to perform the multiplication, and sum to obtain the final answer.

Part 2

Part 2 changes the rules of the game, and there are two main changes we need to implement. First, we need to handle the possibility of infinite cycles by remembering past game states and breaking out if it occurs. Second, we need to modify the playRound function so that we drop into a sub-game if the conditions call for it.

The rest of the problem is the same though, so here's where things change:

    
import Data.HashSet as Set

data Player = P1 | P2 deriving (Show, Eq)

type GameState = (Seq.Seq Int, Seq.Seq Int)
type Memo = Set.HashSet ([Int], [Int])

seen :: GameState -> Memo -> Bool
seen (d1, d2) memo = 
    Set.member (Data.Foldable.toList d1, Data.Foldable.toList d2) memo

memoize :: GameState -> Memo -> Memo
memoize (d1, d2) memo = 
    Set.insert (Data.Foldable.toList d1, Data.Foldable.toList d2) memo

playRound :: GameState -> GameState
playRound (d1, d2) =
    let h1 = Seq.viewl d1
        h2 = Seq.viewl d2
        in case (h1, h2) of
            (Seq.EmptyL, _) -> (d1, d2)
            (_, Seq.EmptyL) -> (d1, d2)
            (c1 :< c1s, c2 :< c2s) ->
                if (c1 <= Seq.length c1s) && (c2 <= Seq.length c2s)
                then if (winnerOf (Seq.take c1 c1s, Seq.take c2 c2s) Set.empty) == P2
                    then (c1s, c2s |> c2 |> c1)
                    else (c1s |> c1 |> c2, c2s)
                else if (c1 < c2)
                    then (c1s, c2s |> c2 |> c1)
                    else (c1s |> c1 |> c2, c2s)

winnerOf :: GameState -> Memo -> Player
winnerOf s@(d1, d2) memo
    | seen s memo = P1
    | Seq.length d1 == 0 = P2
    | Seq.length d2 == 0 = P1
    | otherwise = winnerOf (playRound s) (memoize s memo)  
    

We first introduce a new Memo data type, which is a set of game states (i.e., two lists of integers). Unfortunately, our GameState data type is not hashable by default, so we remember the list versions instead; but thankfully, ([Int],[Int]) is hashable by default, so we don't need to write our own hash function or anything like that. seen is a helper function that returns whether our game state has been seen before. memoize is another helper function that adds our game state to the set of seen states.

The winnerOf function takes a game state and returns only the winner, memoizing at each step and early returning P1 if we reach a state that has been seen before.

winnerOf is then used by the new playRound function, which is now easy to write again as a straightforward transcription of the rules outlined in the problem. Note that once we again we have recursion between two functions, where playRound calls winnerOf, and winnerOf calls playRound. In this case, we are convinced that the recursion will terminate because of the early termination. Each round changes the game state, and there are a finite (albeit large) number of possible game states. Therefore, we are guaranteed to either reach a state where one of the decks is empty, or to reach a state that we've seen before.


Jump to:

D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13 | D14 | D15 | D16 | D17 | D18 | D19 | D20 | D21 | D22 | D23 | D24 | D25