Unter den Transponierten von quadratischen Blöcken in einer rechteckigen Matrix r

Question

glaubte, ich habe zwei quadratische Matrizen (eigentlich viel mehr), die miteinander verbunden sind:

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 die Transponieren jede (3x3) Matrix nehmen möchten und halten sie geklebten nebeneinander, so ist das Ergebnis:

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 

ich will nicht dies manuell tun, weil es viele Matrices cbound zusammen, nicht nur 2.

würde ich eine Lösung wie das vermeidet Klo ping oder apply (was nur ein Wrapper für eine Schleife ist). Ich brauche die effiziente Lösung, weil das Zehntausende Male laufen muss.

Answer 1

Eine Möglichkeit ist, Matrix Indizierung

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

---

Dies nimmt die transponierte Matrix zu verwenden und rearanges die Spalten in die gewünschte Reihenfolge.

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 

Also wollen wir die 1., 3. und 5. Spalten und 2, 4 und 6. Spalten zusammen. Eine Möglichkeit ist es, diese mit

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

Als Alternative zu Index, Sie

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

---

Versuchen Sie, auf einer neuen 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

Dies könnte es tun:

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 

war neugierig und die beiden Ansätze zeitlich. Der matrix Ansatz von user20650 verwendet wird, ist viel schneller als die lapply Ansatz, den ich verwendet:

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