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

我正在尝试粘贴所有可能的字符，这些字符在一个N*N矩阵中以任何对角线排列

例如，考虑以下3×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])
}

#创建矩阵，转换为字符数据帧
矩阵对于矩阵，这可以通过对四个可能的旋转进行
diag
来实现。如果按如下（）设置旋转函数，则这将变得简单：

> 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"

哦，如果使用矩阵而不是数据，这很容易。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

如果您想让它向后，只需使用
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

rotate一种方法是在矩阵上使用
diag
，此处称为
mat
，以避免与函数名冲突，并反转的行和/或列顺序以获得每个对角线和方向

您可以使用一个辅助功能来实现反转系统化，这样您就可以使用
sapply
来循环

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"

revMat将
矩阵
转换为实际矩阵
m
（与数据帧相反）。那么四条对角线是：

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

m为了创建原始数据，只需执行
matrix可能不想将其称为
matrix
，因为这也是一个函数名。旋转可能成本高昂。你可以用两个诊断，然后反转它们的结果，比如“yef”==“fey”，y'know@Frank-公平。在我看来，仅仅调用四个旋转就可以最清楚地知道代码应该做什么，这通常比效率更重要。。。但对于非常大的矩阵，反转可以节省大量的时间。我会相应地更新。我认为反转矩阵和旋转矩阵一样昂贵：）@bartektartanus是的，尽管你的基准表明它取决于大小。如果你想测试速度，你可以省去粘贴部分：
bartvec我认为矩阵子集比向量子集稍微好一点，比如10-15%。任何结果都可以通过sapply（res，paste0，collapse=“”）
传递相关：结果表明，
diag
是我见过的最差的优化基函数。
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

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"

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