Paste all possible diagonals of an n*n matrix or dataframe

Question

I'm trying to paste all possible characters that are arranged in any diagonal within an N * N matrix.

For example, consider the following 3 X 3 matrix:

#Create matrix, convert to character dataframe
matrix <- matrix(data=c('s','t','y','a','e','l','f','n','e'),nrow=3,ncol=3)
matrix <- as.data.frame(matrix)
for(i in 1:length(colnames(matrix))){
  matrix[,i] <- as.character(matrix[,i])
}

In the matrix above I need to paste the diagonals: "see","fey", "ees", and "yef". I can find these in the dataframe with the following code:

diag <- paste(matrix[1,1],matrix[2,2],matrix[3,3],sep='')
diag1 <- paste(matrix[1,3],matrix[2,2],matrix[3,1],sep='')
diag2 <- paste(matrix[3,1],matrix[2,2],matrix[1,3],sep='')
diag3 <- paste(matrix[3,3],matrix[2,2],matrix[1,1],sep='')

The problem is that I want to automate this so that it will work on any N x N matrix. (I'm writing a function to find the diagonals in any N X N matrix). Is there an efficient way to do this?

In order to create your original data just do `matrix <- data.frame(matrix(c('s','t','y','a','e','l','f','n','e'), ncol = 3), stringsAsFactors = FALSE)` — David Arenburg, May 04 '15 at 14:13
Probably don't want to call it `matrix`, since that's also a function name. — Frank, May 04 '15 at 14:48

score 10 · Accepted Answer · edited May 04 '15 at 15:42

Oh, that's easy if you use matrix instead of data.frame :) We can choose matrix elements just like we can take vector elements:

matrix[1:3] # First three elements == first column

n <- ncol(matrix)
(1:n-1)*n+1:n
## [1] 1 5 9
(1:n-1)*n+n:1
## [1] 3 5 7

So now we can use this:

matrix[(1:n-1)*n+1:n]
[1] "s" "e" "e"
paste0(matrix[(1:n-1)*n+1:n],collapse="")
[1] "see"

And if you want it backwards, just reverse the vector of indexes using rev function:

paste0(matrix[rev((1:n-1)*n+1:n)],collapse="")
[1] "ees"

Some benchmarks:

rotate <- function(x) t(apply(x, 2, rev))
revMat <- function(mat, dir=0){
    x <- if(bitwAnd(dir,1)) rev(seq(nrow(mat))) else seq(nrow(mat))
    y <- if(bitwAnd(dir,2)) rev(seq(ncol(mat))) else seq(nrow(mat))
    mat[x,y]
}

bartek <- function(matrix){
    n <- ncol(matrix)
    c(paste0(matrix[(1:n-1)*n+1:n],collapse=""), paste0(matrix[rev((1:n-1)*n+1:n)],collapse=""),
      paste0(matrix[(1:n-1)*n+n:1],collapse=""), paste0(matrix[rev((1:n-1)*n+n:1)],collapse=""))
}

Joe <- function(matrix){
    diag0 <- diag(matrix)
    diag1 <- diag(rotate(matrix))
    diag2 <- rev(diag0)
    diag3 <- rev(diag1)
    c(paste(diag0, collapse = ""),paste(diag1, collapse = ""),
      paste(diag2, collapse = ""),paste(diag3, collapse = ""))
}

James <- function(mat){
    sapply(0:3,function(x) paste(diag(revMat(mat,x)),collapse=""))
}

matrix <- matrix(c('s','t','y','a','e','l','f','n','e'), ncol = 3)

microbenchmark(bartek(matrix), Joe(matrix), James(matrix))
Unit: microseconds
           expr     min       lq      mean   median      uq     max neval
 bartek(matrix)  50.273  55.2595  60.78952  59.4390  62.438 134.880   100
    Joe(matrix) 167.431 176.6170 188.46908 182.8260 192.646 337.717   100
  James(matrix) 321.313 334.3350 346.15230 339.7235 348.565 447.115   100


matrix <- matrix(1:10000, ncol=100)
microbenchmark(bartek(matrix), Joe(matrix), James(matrix))
Unit: microseconds
           expr      min       lq      mean   median        uq      max neval
 bartek(matrix)  314.385  326.752  336.1194  331.936  337.9805  423.323   100
    Joe(matrix) 2168.141 2221.477 2460.1002 2257.439 2298.4400 8856.482   100
  James(matrix) 1200.572 1250.354 1407.5943 1276.307 1323.8845 7419.931   100

If you want to test speed, you could leave off the paste part: `bartvec <- function(m){n <- ncol(m); list(m[(1:n-1)*n+1:n],m[rev((1:n-1)*n+1:n)],m[(1:n-1)*n+n:1],m[rev((1:n-1)*n+n:1)])}; bartvec2 <- function(m){n <- ncol(m);v1 <- m[(1:n-1)*n+1:n]; v2 <-m[rev((1:n-1)*n+1:n)]; list(v1,rev(v1),v2,rev(v2))}; bartmat <- function(m){n <- ncol(m);ix <- 1:n;v1 <- m[cbind(ix,ix)];v2 <- m[cbind(ix,rev(ix))];list(v1,rev(v1),v2,rev(v2))}; microbenchmark(bartvec(mat),bartvec2(mat),bartmat(mat))` where `nc <- 1e4; mat <- matrix(sample(letters,nc^2,replace=TRUE), ncol = nc)` — Frank, May 04 '15 at 16:28
I see matrix subsetting being a little better than vector subsetting there, like 10-15%. Any result could be passed through `sapply(res,paste0,collapse="")` — Frank, May 04 '15 at 16:29
Related: http://stackoverflow.com/questions/20489636/the-diag-function-in-r turns out `diag` is the worst-optimized base function I've ever seen. — Frank, May 04 '15 at 16:40

score 3 · Answer 2 · edited May 23 '17 at 11:33

For a matrix, this can be accomplished by taking the diag of the four possible rotations. If you set up a rotate function as follows (credit), this becomes straightforward:

> rotate <- function(x) t(apply(x, 2, rev))
> diag0 <- paste(diag(matrix), collapse = "")
> diag1 <- paste(diag(rotate(matrix)), collapse = "")
> diag2 <- paste(diag(rotate(rotate(matrix))), collapse = "")
> diag3 <- paste(diag(rotate(rotate(rotate(matrix)))), collapse = "")
> diag0
[1] "see"
> diag1
[1] "yef"
> diag2
[1] "ees"
> diag3
[1] "fey"

As pointed out by Frank in comments, this could become slow for sufficiently large matrices (on my machine, rotate starts to take longer than about a second for matrices larger than 1000 X 1000). You can save some time by using rev prior to pasting, eg:

> diag0 <- diag(matrix)
> diag1 <- diag(rotate(matrix))
> diag2 <- rev(diag0)
> diag3 <- rev(diag1)
> paste(diag2, collapse = "")
[1] "ees"
> paste(diag3, collapse = "")
[1] "fey"

Rotating could be costly. You could do it with two diags and then reverse their results, like "yef" == "fey", y'know — Frank, May 04 '15 at 14:47
@Frank- fair. To my mind, just calling the four rotations makes it most clear what the code is supposed to do, which is usually more important than efficiency... but for very large matrices reversal could save significant amounts of time. I'll update accordingly. — Joe, May 04 '15 at 14:53

James · Answer 3 · 2015-05-04T15:37:00.217

3

One way is to use diag on the matrix, called mat here to avoid clashing with the function name, and reversing the row and/or column orders for to get each diagonal and direction.

You can do it with a supplementary function to make the reversals systematic so you can use sapply to loop.

revMat <- function(mat, dir=0)
{
    x <- if(bitwAnd(dir,1)) rev(seq(nrow(mat))) else seq(nrow(mat))
    y <- if(bitwAnd(dir,2)) rev(seq(ncol(mat))) else seq(nrow(mat))
    mat[x,y]
}

sapply(0:3,function(x) paste(diag(revMat(mat,x)),collapse=""))
[1] "see" "yef" "fey" "ees"

edited May 04 '15 at 15:37

answered May 04 '15 at 14:49

James

65,548
14
155
193

2

I think that reversing matrix is as costly as rotating :) – bartektartanus May 04 '15 at 15:23
@bartektartanus Yes, although it seems your benchmark suggests that it is size dependent. – James May 04 '15 at 15:36

G. Grothendieck · Answer 4 · 2015-05-04T15:37:34.773

3

Convert matrix to an actual matrix m (as opposed to a data frame). Then the four diagonals are:

m <- as.matrix(matrix)
ix <- ncol(m):1

paste(diag(m), collapse = "")
paste(diag(m[ix,]), collapse = "")
paste(diag(m[,ix]), collapse = "")
paste(diag(m[ix, ix]), collapse = "")

edited May 04 '15 at 15:37

answered May 04 '15 at 15:31

G. Grothendieck

254,981
17
203
341

Paste all possible diagonals of an n*n matrix or dataframe

4 Answers4

Linked