Prendendo la trasposta di blocchi quadrati rettangolare matrice r

Question

Supponiamo di avere due matrici quadrate (in realtà molti altri) che sono legati insieme:

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 

voglio prendere la trasposta di ciascuna matrice (3x3) e tenerli incollati lato all'altro, il risultato è quindi:

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 

non voglio farlo manualmente perché è matrici MOLTI cbound insieme, non solo 2.

desidero una soluzione che evita gabinetto ping o apply (che è solo un wrapper per un loop). Ho bisogno della soluzione efficiente perché questo dovrà funzionare decine di migliaia di volte.

Answer 1

Un modo è quello di utilizzare matrice indicizzazione

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

---

Questo prende la matrice trasposta e rearanges le colonne l'ordine desiderato

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 

Quindi vogliamo le colonne 1a, 3a e 5a e 2, 4 e 6a colonne insieme. Un modo è quello di indicizzare questi con

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

In alternativa, è possibile utilizzare

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

---

provare su una nuova matrice

(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

Questo potrebbe farlo:

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 

era curioso e corredati i due approcci. L'approccio matrix utilizzato da user20650 è molto più veloce rispetto all'approccio lapply ho usato:

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