Before Advent of Code kicked off this year, I asked my coworker about his previous experiences doing it since I had never done it before. He said that he usually dropped out at around day 6 or 7. I didn't understand why at the time, but now I totally get it. It is really hard to keep up with the increasingly difficult problems while juggling work, family, church, and other activities. At long last, here is my solution to day number 4!

Part 1

The problem statement involves playing bingo with several boards simultaneously and determining which board wins first. The given input looks like this:

7,4,9,5,11,17,23,2,0,14,21,24,10,16,13,6,15,25,12,22,18,20,8,19,3,26,1

22 13 17 11  0
 8  2 23  4 24
21  9 14 16  7
 6 10  3 18  5
 1 12 20 15 19

 3 15  0  2 22
 9 18 13 17  5
19  8  7 25 23
20 11 10 24  4
14 21 16 12  6

14 21 17 24  4
10 16 15  9 19
18  8 23 26 20
22 11 13  6  5
 2  0 12  3  7

We first need to get the list of numbers that are called from the first row and then store all the bingo boards in some sort of data structure. We'll store each board as a nested list of integers, so a type alias will help with future type annotations. We also need to be able to split strings by a delimiter, so here is a recursive helper function to do that.

type Board = [[Int]]

split :: Char -> String -> [String]
split d s = case break (==d) s of
  (ls, "") -> [ls]
  (ls, x:rs) -> ls : split d rs

The break function just splits a list into two parts where the condition of (==d) is true. Then we return back a list of individual items separated by the delimiter. With this function, we can get the list of numbers from the first line of the input.

numbers :: [Int]
numbers = map read $ split ',' $ head input

Getting the boards is a bit trickier. We have to get lines of data in groups of five and add them to a list of boards. Assuming that there is a blank line after every bingo board, we can accumulate a current board until we reach a blank line and then push it onto the list of boards. We use the split function again to get the numbers, but we also filter out any blanks from leading spaces in front of single digit numbers.

acc :: (Board, [Board]) -> String -> (Board, [Board])
acc (current, boards) line
  | length numbers < 5 = ([], boards ++ [current])
  | otherwise          = (current ++ [numbers], boards)
  where numbers = map read $ filter (/="") $ split ' ' line :: [Int]

boards :: [Board]
boards = snd $ foldl acc ([], []) (drop 2 input)

In order to calculate the final score, we need to filter out all the called numbers from winning board and take the sum of the remaining numbers multiplied by the last called number.

score :: [Int] -> Board -> Int
score called board = last called * foldl (\sum row ->
  sum + foldl (\rowSum square ->
    if square `elem` called then rowSum else rowSum + square) 0 row) 0 board

Now we can finally move on to solving the problem. We need to solve each bingo board, which involves marking off all called numbers and checking if any row or column is completely marked off. We can check to see if a line is fully called using the following function.

fullLine :: [Int] -> [Int] -> Bool
fullLine numbers = foldl (\full square -> square `elem` numbers && full) True

Now we just call that function for every row and column for each board. But how to be parse over the columns? We can transform the columns into rows so that we can simply iterate over each column as we do with the rows. I used a rotate function instead of a transposing function because I thought the question also included diagonals. Getting the diagonal of a transposed square matrix returns the same diagonal from the original matrix, but by rotating the matrix, we can use the same code to get the opposite diagonal from the rotated matrix.

rotate :: [[a]] -> [[a]]
rotate [] = []
rotate ([]:_) = []
rotate m = map last m : rotate (map init m)

And finally, we can solve the problem! Instead of marking each called number off on each board as the numbers were called, I decided to reevaluate each board with the full list of called numbers. This was mostly out of caution because I didn't know if the second part would require calculating the score based on numbers that were called instead of the remaining numbers or something else involving the numbers that were called.

part1 :: Int -> [Board] -> Int
part1 n boards
  | not (null winners) = score called (head winners)
  | otherwise          = part1 (n + 1) boards
  where
    called = take n numbers
    winners = filter (\board ->
      foldl (\any row -> any || fullLine called row) False board
      || foldl (\any row -> any || fullLine called row) False (rotate board)) boards

We just filter the list of boards until we get one that wins and then calculate the final score. Here is the equivalent in JavaScript, which has pretty much the exact same approach.

const numbers = input[0].split(",").map((s) => parseInt(s));

const [, boards] = input.slice(2).reduce(
  ([current, boards], line) => {
    const numbers = line
      .split(" ")
      .filter((s) => s !== "")
      .map((s) => parseInt(s));
    return numbers.length < 5
      ? [[], [...boards, current]]
      : [[...current, numbers], boards];
  },
  [[], []]
);

const rotate = (board) =>
  board.reduce(
    (acc, row) =>
      row.map((_, i) => (acc[i] || []).concat([...row].reverse()[i])),
    []
  );

const fullLine = (numbers, line) =>
  line.reduce((full, square) => numbers.includes(square) && full, true);

const score = (called, board) =>
  called.slice(-1) *
  board.reduce(
    (sum, row) =>
      sum +
      row.reduce(
        (rowSum, square) =>
          called.includes(square) ? rowSum : rowSum + square,
        0
      ),
    0
  );

const part1 = (n, boards) => {
  const called = numbers.slice(0, n);
  const winner = boards.findIndex((board) => {
    return (
      board.reduce((any, row) => any || fullLine(called, row), false) ||
      rotate(board).reduce((any, row) => any || fullLine(called, row), false)
    );
  });
  if (winner >= 0) {
    return score(called.slice(0, n), boards[winner]);
  }
  return part1(n + 1, boards);
};

Part 2

Fortunately, the only difference between part 1 and part 2 for this problem is that instead of finding the first bingo board that wins, we need to find the last one. We can tweak the recursive function to look for losing boards instead of winning boards. When there are no more losing boards, we can take a step back and look at the previous losing boards. We calculate the score based on the next called number and then pass it back up the call chain. There is probably a much better way to do this, but it didn't require too many changes to the solution to part 1.

part2 :: Int -> [Board] -> Int
part2 n boards
  | null losers = -1
  | otherwise   =
    let lastCall = part2 (n + 1) boards
    in if lastCall == -1 then score (take (n + 1) numbers) (last losers) else lastCall
  where
    called = take n numbers
    losers = filter (\board -> not $
      foldl (\any row -> any || fullLine called row) False board
      || foldl (\any row -> any || fullLine called row) False (rotate board)) boards

The same thing can be accomplished in JavaScript.

const part2 = (n, boards) => {
  const called = numbers.slice(0, n);
  const losers = boards.filter((board) => {
    return !(
      board.reduce((any, row) => any || fullLine(called, row), false) ||
      rotate(board).reduce((any, row) => any || fullLine(called, row), false)
    );
  });
  if (losers.length === 0) return -1;
  const lastCall = part2(n + 1, losers);
  if (lastCall === -1) {
    return score(numbers.slice(0, n + 1), losers[0]);
  }
  return lastCall;
};

Sadly, this will be my last Advent of Code solution blog post for this year, but I'll be writing one more post about lessons learned from this short adventure. Thanks for reading!