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

Code

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