Question

是否有一种有效的方法可以从顶部或底部开始每行将矩阵移动一列？

例如，请考虑以下矩阵：

     [,1] [,2] [,3] [,4] [,5]
[1,]    1    4    7   10   13
[2,]    2    5    8   11   14
[3,]    3    6    9   12   15

如果从下往上移动，它应该如下所示：

     [,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,]   NA   NA    1    4    7   10   13
[2,]   NA    2    5    8   11   14   NA
[3,]    3    6    9   12   15   NA   NA

如果从上到下移动，它应该如下所示：

     [,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,]    1    4    7   10   13   NA   NA
[2,]   NA    2    5    8   11   14   NA
[3,]   NA   NA    3    6    9   12   15

以下是我用for循环的方法，但我想知道是否有更简单的方法：

oldNumCols <- ncol(matrix.data)
newNumCols <- sum(dim(matrix.data))-1
shiftedData <- matrix(NA, nrow = nrow(matrix.data), ncol = newNumCols)
for(i in 1:nrow(matrix.data))
{
  #posToReplace <- newNumCols - oldNumCols + 1:oldNumCols - i + 1 # shifting from the bottom up
  posToReplace <- 1:oldNumCols + i - 1 # shifting from the top down
  shiftedData[i,] <- replace(shiftedData[i,], posToReplace, matrix.data[i,])
}

Answer 1

您可以尝试一些花哨的矩阵索引来放置值。例如，这是一个可以提供帮助的功能

rowslide <- function(x, bottomup=FALSE) {
    m <- matrix(NA, nrow=nrow(x), ncol=ncol(x)+nrow(x)-1)
    a <- -1
    b <- nrow(x)
    if(bottomup) {
        a <- 1
        b <- -1
    }
    idx<-cbind(
        rep(1:nrow(x), each=ncol(x)),
        a*rep(1:nrow(x), each=ncol(x))+1:ncol(x)+b
    )
    m[idx]<-t(x)
    m
}

我们用

测试它

x<-matrix(1:15, nrow=3)

rowslide(x)
#      [,1] [,2] [,3] [,4] [,5] [,6] [,7]
# [1,]    1    4    7   10   13   NA   NA
# [2,]   NA    2    5    8   11   14   NA
# [3,]   NA   NA    3    6    9   12   15

rowslide(x, TRUE)
#      [,1] [,2] [,3] [,4] [,5] [,6] [,7]
# [1,]   NA   NA    1    4    7   10   13
# [2,]   NA    2    5    8   11   14   NA
# [3,]    3    6    9   12   15   NA   NA

Answer 2

我走了另一条路：

turn_out <- function(mat) {
  indx <- sweep(col(mat),1,1:nrow(mat)-1,"+")
  out <- matrix(NA, nrow(mat), ncol(mat)+nrow(mat)-1)
  for(i in 1:nrow(mat)) out[i,indx[i,]] <- mat[i,]
  out
}

<强>测试

matrix.data <- matrix(1:15, 3)
turn_out(matrix.data)
     [,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,]    1    4    7   10   13   NA   NA
[2,]   NA    2    5    8   11   14   NA
[3,]   NA   NA    3    6    9   12   15

Answer 3

这里有两种可能性，包括速度测试。第一个使用来自＆＃34; binhf＆＃34; -library的＆＃34; shift＆＃34; -function：

library(binhf)

M <- matrix(1:12,3,4)

system.time(
  for ( t in 1:100000 )
  {
    n <- nrow(M)
    m <- ncol(M)

    A <- cbind(M,matrix(NA,n,n-1))

    for (i in 1:n) { A[i,] <- shift(A[i,],i-1) }
  }
)

它更短，但更慢：

       User      System verstrichen 
       9.64        0.00        9.73 
> A
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1    4    7   10   NA   NA
[2,]   NA    2    5    8   11   NA
[3,]   NA   NA    3    6    9   12

＆＃34;基础R＆＃34; -solution：

M <- matrix(1:12,3,4)

system.time(
  for ( t in 1:100000 )
  {
    n <- nrow(M)
    m <- ncol(M)

    k <- (0:(n-1))*(m+n)+1
    i <- outer(k,1:m,"+")-1

    a <- rep(NA,n*(m+n-1))
    a[i] <- M

    A <- matrix(a,n,m+n-1,byrow=TRUE)
  }
)

它更长，但更快：

       User      System verstrichen 
       4.09        0.00        4.18 
> A
     [,1] [,2] [,3] [,4] [,5] [,6]
[1,]    1    4    7   10   NA   NA
[2,]   NA    2    5    8   11   NA
[3,]   NA   NA    3    6    9   12

这是我用于测试的矩阵：

> M
     [,1] [,2] [,3] [,4]
[1,]    1    4    7   10
[2,]    2    5    8   11
[3,]    3    6    9   12

我使用15×20矩阵重复测试。＆＃34; shift＆＃34; -solution的结果：

   User      System verstrichen 
  64.18        0.01       64.66

＆＃34;基础R＆＃34; -solution再次更快：

   User      System verstrichen 
  10.89        0.00       10.99

代码的速度是问题的表述介于两者之间：

   User      System verstrichen 
  29.44        0.02       29.63

这里是＆＃34; rowslide＆＃34; -solution的结果：

   User      System verstrichen 
  14.38        0.00       14.48

最后＆＃34; turn_out＆＃34; -solution：

   User      System verstrichen 
  18.95        0.00       19.03

创建每行移动一列的矩阵

3 个答案: