R solution to max product in matrix for four adjacent numbers (Euler 11)

Question

Background

This is solution to Problem 11 on Project Euler that is concerned with finding largest product of four adjacent numbers in the provided grid.

Other than solving the problem I was also interested in creating a search function that would have a more generic character and could search across any number of adjacent numbers.

Provided Grid

Read as 11grid.txt in the provided code.

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

Solution

Notes

The solution:

1. Gets addresses of all cells in the matrix
2. From each address creates a list of neighbours in each direction (North, South, ...)
3. Product is calculated on each of the sets
4. Max product is returned

Code

# Notes -------------------------------------------------------------------

# Problem 11

# Data --------------------------------------------------------------------

# Read provided matrix
M <-
    matrix(
        data = scan("./problems/11/11grid.txt"),
        nrow = 20,
        ncol = 20
    )

# Support -----------------------------------------------------------------

# Pad matrix for the desired number of neighbhours
pad_matrix <- function(M, n = 4) {
    # Create a list of NAs to pad
    l <- lapply(X = 1:n, function(x) {
        NA
    })
    # Pad columns
    lc <- l
    lc[[1]] <- M
    Mcols <- do.call(what = cbind, args = lc)
    Mcols <- do.call(what = cbind, args = {
        # Pad other side
        lc[[1]] <- Mcols
        rev(lc)
    })
    # Pad rows
    lr <- l
    lr[[1]] <- Mcols
    Mcols_rows <- do.call(what = rbind, args = lr)
    Mcols_rows <- do.call(what = rbind, args = {
        # Pad other side
        lr[[1]] <- Mcols
        rev(lr)
    })
    Mcols_rows
}


# Search ------------------------------------------------------------------

search_product <- function(M = M, n = 4) {
    addresses <- expand.grid(x = sequence(nrow(M)),
                             y = sequence(ncol(M)))
    n_search <- n - 1

    # Create padded matrx
    M_pad <- pad_matrix(M = M, n = n)


    neighbhours_res <- apply(
        X = addresses,
        MARGIN = 1,
        FUN = function(M_addr) {
            tryCatch(
                expr = list(
                    North = M_pad[M_addr["x"]:(M_addr["x"] - n_search), M_addr["y"]],
                    North_East = c(M_pad[M_addr["x"], M_addr["y"]], sapply(
                        X = 1:n_search,
                        FUN = function(i) {
                            M_pad[M_addr["x"] - i,
                                  M_addr["y"] + i]
                        }
                    )),
                    East = M_pad[M_addr["x"], M_addr["y"]:(M_addr["y"] + n_search)],
                    South_East = c(M_pad[M_addr["x"], M_addr["y"]], sapply(
                        X = 1:n_search,
                        FUN = function(i) {
                            M_pad[M_addr["x"] + i,
                                  M_addr["y"] + i]
                        }
                    )),
                    South = M_pad[M_addr["x"]:(M_addr["x"] + n_search), M_addr["y"]],
                    South_West = c(M_pad[M_addr["x"], M_addr["y"]], sapply(
                        X = 1:n_search,
                        FUN = function(i) {
                            M_pad[M_addr["x"] + i,
                                  M_addr["y"] - i]
                        }
                    )),
                    West = M_pad[M_addr["x"], M_addr["y"]:(M_addr["y"] - n_search)],
                    North_West = c(M_pad[M_addr["x"], M_addr["y"]], sapply(
                        X = 1:n_search,
                        FUN = function(i) {
                            M_pad[M_addr["x"] - i,
                                  M_addr["y"] - i]
                        }
                    ))
                ),
                error = function(e) {
                    NA
                }
            )
        }
    )
    products <-
        rapply(object = neighbhours_res,
               f = prod,
               classes = "numeric")
    # Keep max only
    max(products, na.rm = TRUE)
}
res <- search_product(M = M, n = 4)
res

Answer 1

When working with matrices in R, you can often do an operation with a single command if you are clever about how that is structured. Take padding a matrix with npad missing values as an example. Your current code does this by first padding the columns and then padding the rows. However, you could define a correct-sized matrix with all missing values to start, and then store the original matrix at the correct location within the new matrix:

pad_matrix2 <- function(M, npad) {
  padded <- matrix(NA, nrow(M)+2*npad, ncol(M)+2*npad)
  padded[seq(npad+1, nrow(M)+npad),seq(npad+1, ncol(M)+npad)] <- M
  padded
}

This is much more compact code and will also be more efficient.

In terms of the search_product function, you have a lot of repeated code that does the same thing for a particular direction. You could avoid that by looping through a set of directions that you want to search:

search_product2 <- function(M, n=4) {
  npad <- n-1
  M_pad <- pad_matrix2(M, npad)
  directions <- rbind(c(1, 0), c(0, 1), c(1, 1), c(1, -1))
  all.pos <- expand.grid(r=seq(npad+1, nrow(M)+npad),
                         c=seq(npad+1, ncol(M)+npad))
  max(apply(directions, 1, function(direction) {
    max(Reduce("*", lapply(seq(0, n-1), function(dist) {
      M_pad[cbind(all.pos$r+dist*direction[1],
                  all.pos$c+dist*direction[2])]
    })), na.rm=TRUE)
  }))
}
search_product2(M, 4) == search_product(M, 4)
# [1] TRUE