Advent of Code 2021 day 4

    The first step in this problem was just getting the data from input into a usable form. Attoparsec was up to the job, but there were a couple of things I had to be careful with. A row in a bingo square has to contain at least one number (hence sepBy1 in rowP) and numbers may have leading spaces, as well as being separated by spaces (hence the paddedDecimal parser). Sections in the input a separated by at least one blank line.

    bingoP = (,) <$> (calledP <* blankLines) <*> squaresP
    calledP = decimal `sepBy` ","
    squaresP = squareP `sepBy` blankLines
    squareP = rowP `sepBy` endOfLine
    rowP = paddedDecimal `sepBy1` " "
    -- paddedDecimal :: Parser Text Int
    paddedDecimal = (many " ") *> decimal
    blankLines = many1 endOfLine

    Design choices

    After that, I had a decision to make: how to represent a partially-completed bingo square?

    One approach was to have the square as list of lists of numbers, and delete numbers as they were called. That would leave a completed square as being one with an empty row or column.

    I decided not to go for that route for two reasons. One was following the domain. Called numbers aren't deleted, they're marked. Therefore, my representation should be able to represent called and uncalled numbers. The other reason was some caution about what would come with Part 2: would I have to process the called numbers?

    I defined the type BingoNum as being a combination of a number and its called state. A BingoSquare is a list of lists of BingoNums. A BingoState is a state in a game: the number just called and the squares that exist when that number is marked.

    data BingoNum = BingoNum Int Bool
      deriving (Eq, Show)
    type BingoSquare = [[BingoNum]]
    data BingoState = BingoState Int [BingoSquare]
      deriving (Eq, Show)

    Given those choices, I wrote a few simple functions to create, modify, and read these structures. Notably, the call function takes a called number and a BingoNum and sets the BingoNum as called if it matches the called number.  That makes the definition of callSquare much simpler. forceCall sets a number as called regardless.

    mkBingoNum :: Int -> BingoNum
    mkBingoNum n = BingoNum n False
    forceCall :: BingoNum -> BingoNum
    forceCall (BingoNum n _) = BingoNum n True
    call :: Int -> BingoNum -> BingoNum
    call num (BingoNum target called) 
      | num == target = BingoNum target True
      | otherwise = BingoNum target called
    isCalled :: BingoNum -> Bool
    isCalled (BingoNum _ c) = c
    value :: BingoNum -> Int
    value (BingoNum n _) = n
    mkSquare :: Square -> BingoSquare
    mkSquare = map (map mkBingoNum)
    callSquare :: Int -> BingoSquare -> BingoSquare
    callSquare n = map (map (call n))
    completed :: BingoSquare -> Bool
    completed sq = (any completedRow sq) || (any completedRow $ transpose sq)
    completedRow :: [BingoNum] -> Bool
    completedRow = all isCalled

    Playing Bingo

    As this puzzle is all about updating state, my first thought was to use a state monad to keep things neat. But after a bit of thought, I realised that the history of the game could be generated by a scanl across the numbers called. The list of called numbers (and the initial squares) would eventually fold into the final state. Using scanl rather than foldl would allow me to see the intermediate steps in the game, and pick the step that first produced a completed square.

    The wrinkle is that, if we think about bingo as a state-transition system, the states are the collections of called and uncalled numbers, and the transitions are the numbers called. To solve the problem, I need to keep together the state and the number that led to the transition into this state. As the first transition as no number called, I had to fill the slot with a dummy value.

    This is a time where laziness helps. I can use scanl' to lazily generate all the bingo cards, use dropWhile to eliminate the states without a completed card, then just pick out the first remaining state. The rest of the states aren't generated, as they're not needed.

    That's all done in part1, with a few other functions to support the processing.

    part1 :: [Int] -> [BingoSquare] -> Int
    part1 callNums squares = finalCalled * winningSum
      where allSteps = scanl' bingoStep (BingoState 0 squares) callNums
            BingoState finalCalled finalSquares = head $ dropWhile (not . hasCompletedSquare) allSteps
            winningSquare = head $ filter completed finalSquares
            winningSum = unmarkedSum winningSquare
    bingoStep :: BingoState -> Int -> BingoState
    bingoStep (BingoState _ squares) caller = BingoState caller squares'
      where squares' = map (callSquare caller) squares
    hasCompletedSquare :: BingoState -> Bool
    hasCompletedSquare (BingoState _n squares) = any completed squares
    unmarkedSum :: BingoSquare -> Int
    unmarkedSum bingoSquare = 
      sum [value bn | r <- bingoSquare, bn <- r, (not $ isCalled bn)]

    Part 2 is mostly the same, but I use a pruningBingoStep. Before calling a new number, I remove all squares that are completed, and modify the detection of the final state to skip states with more than one incomplete square.

    part2 :: [Int] -> [BingoSquare] -> Int
    part2 callNums squares = finalCalled * winningSum
      where allSteps = scanl' pruningBingoStep (BingoState 0 squares) callNums
            BingoState finalCalled finalSquares = 
              head $ dropWhile (not . hasCompletedSquare) 
                   $ dropWhile manyRemainingSquares allSteps
            winningSquare = head finalSquares
            winningSum = unmarkedSum winningSquare
    pruningBingoStep :: BingoState -> Int -> BingoState
    pruningBingoStep (BingoState _ squares) caller = BingoState caller squares''
      where squares' = filter (not . completed) squares
            squares'' = map (callSquare caller) squares'
    manyRemainingSquares :: BingoState -> Bool
    manyRemainingSquares (BingoState _ squares) = (length squares) > 1


    You can get the code from my locally-hosed Git repo, or from Gitlab.

    Neil Smith

    Read more posts by this author.