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

时间:2015-05-04 14:11:06

标签: r dataframe

我正在尝试粘贴在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矩阵中的对角线)。有没有一种有效的方法呢?

4 个答案:

答案 0 :(得分:10)

哦,如果你使用矩阵代替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

答案 1 :(得分:3)

对于矩阵,可以通过采用四个可能的旋转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"

正如弗兰克在评论中指出的那样,对于足够大的矩阵来说,这可能会变得很慢(在我的机器上,对于大于1000 X 1000的矩阵,rotate开始花费的时间超过一秒钟)。在粘贴之前使用rev可以节省一些时间,例如:

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

答案 2 :(得分:3)

一种方法是在矩阵上使用diag,此处称为mat,以避免与函数名称发生冲突,并反转行和/或列顺序以获取每个对角线和方向。< / p>

您可以使用补充功能将反转系统化,以便您可以使用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"

答案 3 :(得分:3)

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