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

【问题标题】：Paste all possible diagonals of an n*n matrix or dataframe粘贴 n*n 矩阵或数据框的所有可能对角线
【发布时间】：2015-05-04 14:11:06
【问题描述】：

我正在尝试粘贴所有可能的字符，这些字符排列在 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 矩阵上工作。（我正在编写一个函数来查找任何 N X N 矩阵中的对角线）。有没有有效的方法来做到这一点？

【问题讨论】：

为了创建您的原始数据，只需执行matrix <- data.frame(matrix(c('s','t','y','a','e','l','f','n','e'), ncol = 3), stringsAsFactors = FALSE)
可能不想叫它matrix，因为那也是一个函数名。

标签： r dataframe

【解决方案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

【讨论】：

如果你想测试速度，你可以省略粘贴部分：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)
我看到矩阵子集比那里的向量子集好一点，比如 10-15%。任何结果都可以通过sapply(res,paste0,collapse="")
相关：stackoverflow.com/questions/20489636/the-diag-function-in-r 原来 diag 是我见过的优化最差的基本函数。

【解决方案2】：

对于矩阵，这可以通过取四个可能的旋转中的diag 来完成。如果您按如下方式设置旋转功能 (credit)，这将变得很简单：

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

正如 Frank 在 cmets 中指出的那样，对于足够大的矩阵，这可能会变得很慢（在我的机器上，rotate 对于大于 1000 X 1000 的矩阵开始需要超过大约一秒的时间）。您可以在粘贴之前使用rev 节省一些时间，例如：

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

【讨论】：

轮换可能代价高昂。你可以用两个诊断然后反转它们的结果，比如“yef”==“fey”，你知道
@Frank-fair。在我看来，仅调用四个旋转就可以最清楚地说明代码应该做什么，这通常比效率更重要……但是对于非常大的矩阵，反转可以节省大量时间。我会相应地更新。

【解决方案3】：

一种方法是在矩阵上使用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"

【讨论】：

我认为反转矩阵和旋转一样昂贵:)
@bartektartanus 是的，尽管您的基准似乎表明它取决于大小。

【解决方案4】：

将matrix 转换为实际矩阵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 = "")

【讨论】：