Advent of Code 2021: Day 4


The Data


See the explanation for today’s challenge here. Most of the data we’ve dealt with so far has been 1 dimensional vectors, but for Day 4 we’re going to start working with 3-dimensional data. We’re playing BINGO!

The first line of data is a vector of numbers that are called out in the bingo game. We will extract these separately.

#Read first line of data that includes the announced numbers
number_calls_chr <- readLines("./data/Day4.txt", n = 1)

#Covert this to a vector of integers
number_calls_int <- as.integer(stringr::str_split(number_calls_chr, pattern = ",", simplify = TRUE))

number_calls_int
##   [1] 13 47 64 52 60 69 80 85 57  1  2  6 30 81 86 40 27 26 97 77 70 92 43 94  8
##  [26] 78  3 88 93 17 55 49 32 59 51 28 33 41 83 67 11 91 53 36 96  7 34 79 98 72
##  [51] 39 56 31 75 82 62 99 66 29 58  9 50 54 12 45 68  4 46 38 21 24 18 44 48 16
##  [76] 61 19  0 90 35 65 37 73 20 22 89 42 23 15 87 74 10 71 25 14 76 84  5 63 95

We then have a set of 100 bingo boards, each of which has 2 dimensions (5 rows and 5 columns). So how do we deal with this? One solution is to build a multi-dimensional array. A multi-dimensional array can be indexed just like a vector (1D) or matrix (2D), so we can easily work with and manipulate the data.

#Read in the bingo boards as integers
allboards <- as.integer(scan("./data/Day4.txt", what = "list", skip = 2))

#Convert into 3D matrix
board_array  <- array(allboards, dim = c(5, 5, length(allboards)/25))

#Index the 1st and 2nd boards
board_array[,,1:2]
## , , 1
## 
##      [,1] [,2] [,3] [,4] [,5]
## [1,]   88   22    7   12   97
## [2,]   67   76   42   68   45
## [3,]   20   86    6   92   13
## [4,]   19   44   69   21   52
## [5,]   15   73   25   75   70
## 
## , , 2
## 
##      [,1] [,2] [,3] [,4] [,5]
## [1,]   75   17   92   44   23
## [2,]   98   93   56    0    6
## [3,]   24   46   97   65   53
## [4,]   18   49   57   54   42
## [5,]   77   13   66   74   20

We can return a 3-dimensional position of a given number using which() and the argument arr.ind = TRUE. This will come in handy for our challenges!

#Find the location of the number 0 on the first two boards
#It is at position 2,4 on the 2nd board
which(board_array[,,1:2] == 0, arr.ind = TRUE)
##      dim1 dim2 dim3
## [1,]    2    4    2


The Challenges


Challenge 1


For the first challenge we need to determine which of our 100 boards will win first. To keep track of all the boards I’ll create a corresponding 3D array of logical information (TRUE/FALSE) that records whether a number on a board has been marked.

#Array of logical data for all boards
result_array <- array(rep(FALSE, n = length(allboards)), dim = c(5, 5, length(allboards)/25))

#Show array for the same 2 boards
result_array[,,1:2]
## , , 1
## 
##       [,1]  [,2]  [,3]  [,4]  [,5]
## [1,] FALSE FALSE FALSE FALSE FALSE
## [2,] FALSE FALSE FALSE FALSE FALSE
## [3,] FALSE FALSE FALSE FALSE FALSE
## [4,] FALSE FALSE FALSE FALSE FALSE
## [5,] FALSE FALSE FALSE FALSE FALSE
## 
## , , 2
## 
##       [,1]  [,2]  [,3]  [,4]  [,5]
## [1,] FALSE FALSE FALSE FALSE FALSE
## [2,] FALSE FALSE FALSE FALSE FALSE
## [3,] FALSE FALSE FALSE FALSE FALSE
## [4,] FALSE FALSE FALSE FALSE FALSE
## [5,] FALSE FALSE FALSE FALSE FALSE

Now we need to work through each of the called numbers and work out which board gets a full row or column first (we’re ignoring diagonals here). We’ll just use a for loop to run through all these numbers.

#Loop through all numbers called
result <- NULL
for (number in number_calls_int){

  #Use which to find all locations where this number occurs
  #Update results on the corresponding array of logicals.
  result_array[which(board_array == number, arr.ind = TRUE)] <- TRUE

  #Use apply to run through every board (the 3rd dimension, thus MARGIN = 3)
  #Check if any boards have full rows or columns
  board_status <- apply(result_array, MARGIN = 3, FUN = function(x){

    any(rowSums(x) == 5) | any(colSums(x) == 5)

  })

  has_winner <- any(board_status)

  #If there is a winner compute our answer
  if (has_winner) {

    winner <- board_array[,,board_status]
    unmarked <- winner[!result_array[,,board_status]]

    #Challenge asks for unmarked numbers * current number called
    result <- sum(unmarked) * number

    break()

  }

}

result
## [1] 49686

Challenge 2


For the second challenge, we need to find the board that will win last. This time around I’ll practice building a recursive function again.

#Reset our results array
result_array <- array(rep(FALSE, n = length(allboards)), dim = c(5, 5, length(allboards)/25))
#Create recursive function.
play_bingo <- function(bingo_boards, numbers, i, current_results){

  #Find current number being called
  number <- numbers[i]

  #Update results board with new number called.
  current_results[which(bingo_boards == number, arr.ind = TRUE)] <- TRUE

  #Check status of all boards
  board_status <- apply(current_results, MARGIN = 3, FUN = function(x){

    any(rowSums(x) == 5) | any(colSums(x) == 5)

  })

  #If there is only one board left and it is finished...
  if (length(board_status) == 1 & sum(board_status) == 1) {

    #Then return our answer
    last_winner <- bingo_boards[,,1]
    unmarked <- last_winner[!current_results[,,1]]

    return(sum(unmarked) * number)

  #Otherwise, remove all winning boards and call the function again...
  } else {

    #Filter only losing boards...
    losing_boards  <- bingo_boards[,,!board_status, drop = FALSE]
    losing_results <- current_results[,,!board_status, drop = FALSE]

    #Recall function with next number
    Recall(bingo_board = losing_boards, numbers = numbers, i = i + 1, current_results = losing_results)

  }

}
#Let's get our result!
play_bingo(bingo_boards = board_array, numbers = number_calls_int, i = 1, current_results = result_array)
## [1] 26878

By using a 3D array we were able to easily work with this data. And there’s no reason to stop at 3 dimensions, you can build larger multi-dimensional arrays that can be indexed and searched through in just the same way.

#Go crazy and build a 4D array with 2 sets of boards!
fourD_array <- array(c(allboards, allboards), dim = c(5, 5, length(allboards)/25, 2))

#Return 1st board being played in the 2nd game
fourD_array[,,1,2]
##      [,1] [,2] [,3] [,4] [,5]
## [1,]   88   22    7   12   97
## [2,]   67   76   42   68   45
## [3,]   20   86    6   92   13
## [4,]   19   44   69   21   52
## [5,]   15   73   25   75   70


See previous solutions here:

Post-doctoral researcher

Ecologist and data science, interested in using data science techniques for conservation outcomes.