粘贴n*n矩阵或数据帧的所有可能对角线

Question

我正在尝试粘贴在N*N矩阵内以任何对角线排列的所有可能的字符.

例如,考虑以下3 X 3矩阵:

#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])
}

在上面的矩阵中,我需要粘贴对角线:"see","fey","ees"和"yef".我可以使用以下代码在数据框中找到它们:

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='')

问题是我想自动化它,以便它可以在任何N x N矩阵上工作.(我正在编写一个函数来查找任何NXN矩阵中的对角线).有没有一种有效的方法来做到这一点？

Answer 1

哦,如果你使用矩阵而不是data.frame :)这很容易我们可以选择矩阵元素,就像我们可以采用向量元素一样:

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

所以现在我们可以使用这个:

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

如果你想要它倒退,只需使用rev函数反转索引向量:

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

一些基准:

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