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
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
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
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
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