Project Euler - Problem 11: Largest product in a grid

In the 20×20 grid below, four numbers along a diagonal line have been marked in red.

08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08 49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00 81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65 52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91 22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80 24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50 32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70 67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21 24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72 21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95 78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92 16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57 86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58 19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40 04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66 88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69 04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36 20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16 20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54 01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48

The product of these numbers is 26 × 63 × 78 × 14 = 1788696.

What is the greatest product of four adjacent numbers in the same direction (up, down, left, right, or diagonally) in the 20×20 grid?

To simplify the problem, the general strategy is to break it down into smaller, manageable parts. In this particular case, let consider a grid as a matrix in R, so the problem now can be translated into two steps:

find all possible vectors of four adjacent numbers in the same direction from the matrix, and
find the greatest product of these vectors.

I start on the simplest data structure an atomic vector of integers, for example, given a vector v <- c(1, 2, 3, 4, 5, 6), find out all vectors of length k can be made from v.

adj_vect <- function(v, k) {
  stopifnot(k <= length(v))
  v <- as.integer(v)
  first <- 1
  last <- length(v) - k + 1
  lapply(first:last, function(x) v[x:(x + k - 1)])
}
adj_vect(v = 1:6, k = 3)

## [[1]]
## [1] 1 2 3
## 
## [[2]]
## [1] 2 3 4
## 
## [[3]]
## [1] 3 4 5
## 
## [[4]]
## [1] 4 5 6

For matrix, it is quite easy to get row-wise and column-wise vectors by employ function apply().

(m <- matrix(1:16, nrow = 4, byrow = T))

##      [,1] [,2] [,3] [,4]
## [1,]    1    2    3    4
## [2,]    5    6    7    8
## [3,]    9   10   11   12
## [4,]   13   14   15   16

apply(m, 1, adj_vect, k = 3) # by row

## [[1]]
## [[1]][[1]]
## [1] 1 2 3
## 
## [[1]][[2]]
## [1] 2 3 4
## 
## 
## [[2]]
## [[2]][[1]]
## [1] 5 6 7
## 
## [[2]][[2]]
## [1] 6 7 8
## 
## 
## [[3]]
## [[3]][[1]]
## [1]  9 10 11
## 
## [[3]][[2]]
## [1] 10 11 12
## 
## 
## [[4]]
## [[4]][[1]]
## [1] 13 14 15
## 
## [[4]][[2]]
## [1] 14 15 16

To extract diagonal vectors, the tricky part is to find their indexes in the matrix.

idx_matx <- outer(1:nrow(m), 1:ncol(m), "+")
idx_vect <- as.vector(idx_matx)
idx_vect <- lapply(unique(idx_vect), function(x) which(idx_vect == x))
lapply(1:length(idx_vect), function(x) as.vector(m)[idx_vect[[x]]])

## [[1]]
## [1] 1
## 
## [[2]]
## [1] 5 2
## 
## [[3]]
## [1] 9 6 3
## 
## [[4]]
## [1] 13 10  7  4
## 
## [[5]]
## [1] 14 11  8
## 
## [[6]]
## [1] 15 12
## 
## [[7]]
## [1] 16

Putting it all together, I have make_adj_vect() which returns all vectors of length k derived from k adjacent elements in a matrix.

make_adj_vect <- function(m, k) {
  ## by row and column
  horiz_vec <- apply(m, 1, adj_vect, k = k)
  vert_vec <- apply(m, 2, adj_vect, k = k)
  
  ## by diagonal
  idx_matx <- outer(1:nrow(m), 1:ncol(m), "+")
  idx_vect <- as.vector(idx_matx)
  idx_vect <- lapply(unique(idx_vect), function(x) which(idx_vect == x))
  
  diag1_vec <- lapply(1:length(idx_vect), function(x) as.vector(m)[idx_vect[[x]]])
  diag1_vec <- Filter(function(x) length(x) >= k, diag1_vec)
  diag1_vec <- lapply(diag1_vec, adj_vect, k = k)

  diag2_vect <- lapply(1:length(idx_vect), function(x) as.vector(m[, ncol(m):1])[idx_vect[[x]]])
  diag2_vect <- Filter(function(x) length(x) >= k, diag2_vect)
  diag2_vect <- lapply(diag2_vect, adj_vect, k = k)
  c(horiz_vec, vert_vec, diag1_vec, diag2_vect)
}

maxt <- read.table("~/grid.txt", header = F)
maxt <- as.matrix(maxt)
colnames(maxt) <- NULL

prod_vect <- make_adj_vect(maxt, k = 4)
prod <- lapply(prod_vect, function(x) vapply(x, prod, numeric(1)))
Reduce(max, prod)
## 70600674

Project Euler - Problem 11: Largest product in a grid

2017/04/29