Taking the transpose of square blocks in a rectangular matrix r

Question

Suppose I have two square matrices (actually many others) that are related to each other:

mat = matrix(1:18,nrow=3,ncol=6) mat [,1] [,2] [,3] [,4] [,5] [,6] [1,] 1 4 7 10 13 16 [2,] 2 5 8 11 14 17 [3,] 3 6 9 12 15 18 

I want to take the transpose of each matrix (3x3) and stick them next to each other, so the result:

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

I do not want to do this manually, because these are MANY matrices fastened together, not just 2.

I need a solution that avoids looping or application (which is just a wrapper for the loop). I need an effective solution because it will need to be run tens of thousands of times.

Answer 1

One way is to use matrix indexing

 matrix(t(m), nrow=nrow(m))[, c(matrix(1:ncol(m), nrow(m), byrow=T)) ] 

---

This takes the transposed matrix and moves the columns in the desired order.

 m <- matrix(1:18,nrow=3,ncol=6) matrix(t(m), nrow=nrow(m)) # [,1] [,2] [,3] [,4] [,5] [,6] # [1,] 1 10 2 11 3 12 # [2,] 4 13 5 14 6 15 # [3,] 7 16 8 17 9 18 

So, we need the 1st, 3rd and 5th columns and the 2nd, 4th and 6th columns. One way is to index them using

 c(matrix(1:ncol(m), nrow(m), byrow=T)) #[1] 1 3 5 2 4 6 

Alternatively you can use

 idx <- rep(1:ncol(m), each=nrow(m), length=ncol(m)) ; do.call(cbind, split.data.frame(t(m), idx)) 

---

Try a new matrix

 (m <- matrix(1:50, nrow=5)) # [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] # [1,] 1 6 11 16 21 26 31 36 41 46 # [2,] 2 7 12 17 22 27 32 37 42 47 # [3,] 3 8 13 18 23 28 33 38 43 48 # [4,] 4 9 14 19 24 29 34 39 44 49 # [5,] 5 10 15 20 25 30 35 40 45 50 matrix(t(m), nrow=nrow(m))[, c(matrix(1:ncol(m), nrow(m), byrow=T)) ] # [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] # [1,] 1 2 3 4 5 26 27 28 29 30 # [2,] 6 7 8 9 10 31 32 33 34 35 # [3,] 11 12 13 14 15 36 37 38 39 40 # [4,] 16 17 18 19 20 41 42 43 44 45 # [5,] 21 22 23 24 25 46 47 48 49 50 

Answer 2

This can do it:

 mat = matrix(1:18,nrow=3,ncol=6) mat output <- lapply(seq(3, ncol(mat), 3), function(i) { t(mat[, c((i - 2):i)]) } ) output do.call(cbind, output) # [,1] [,2] [,3] [,4] [,5] [,6] #[1,] 1 2 3 10 11 12 #[2,] 4 5 6 13 14 15 #[3,] 7 8 9 16 17 18 

It was curious and timed to two approaches. The matrix approach used by user lapply much faster than my lapply approach:

 library(microbenchmark) mat = matrix(1:1600, nrow=4, byrow = FALSE) lapply.function <- function(x) { step1 <- lapply(seq(nrow(mat), ncol(mat), nrow(mat)), function(i) { t(mat[, c((i - (nrow(mat) - 1) ):i)]) } ) l.output <- do.call(cbind, step1) return(l.output) } lapply.output <- lapply.function(mat) matrix.function <- function(x) { m.output <- matrix(t(mat), nrow=nrow(mat))[, c(matrix(1:ncol(mat), nrow(mat), byrow=TRUE)) ] } matrix.output <- matrix.function(mat) identical(lapply.function(mat), matrix.function(mat)) microbenchmark(lapply.function(mat), matrix.function(mat), times = 1000) #Unit: microseconds # expr min lq mean median uq max neval # lapply.function(mat) 735.602 776.652 824.44917 791.443 809.856 2260.834 1000 # matrix.function(mat) 32.298 35.619 37.75495 36.826 37.732 78.481 1000