Geek Answers Handbook

Creating a matrix shifted by one column of each row

Is there an effective way to shift the matrix by one column of each row, starting from the top or bottom?

For example, consider the following matrix:

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

If the shift is from bottom to top, it should look like this:

  [,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

If the shift is from top to bottom, it should look like this:

  [,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

Here's how I can do this with a for loop, but I wonder if there is an easier way:

 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,]) }
+4
source share
3 answers

You can try indexing fantasy matrices to put values. For example, here is a feature that may help

 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 }

And we test it with

 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
+3
source

I went the other way:

 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 }

Test

 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
+1
source

Here are two options, including speed checking. The first uses the "shift" function from the "binhf" library:

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

It is shorter but slower:

  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

"basic R" 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) } )

It is longer but faster:

  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

This is the matrix used for the test:

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

I repeated the test using a 15 by 20 matrix. The result for the “shift” solution:

  User System verstrichen 64.18 0.01 64.66

Again, the "basic R" resolution is faster:

  User System verstrichen 10.89 0.00 10.99

Code speed is a question somewhere in the middle:

  User System verstrichen 29.44 0.02 29.63

And here is the result for the "rowlide" solution:

  User System verstrichen 14.38 0.00 14.48

Finally, the "turn_out" solution:

  User System verstrichen 18.95 0.00 19.03
+1
source

More articles:


All Articles