Принимая транспонирование квадратных блоков в виде прямоугольной матрицы Г

Question

Пусть у меня есть две квадратные матрицы (на самом деле гораздо больше), которые связаны друг с другом:

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 

Я хочу взять транспонирование каждой матрицы (3х3) и держать их клееного бок о бок, так что результат:

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 

Я не хочу, чтобы сделать это вручную, потому что это МНОГО матрицы cbound вместе, а не только 2.

Я хотел бы решение, которое позволяет избежать уборная ping или apply (это всего лишь оболочка для цикла). Мне нужно эффективное решение, потому что это нужно будет запускать десятки тысяч раз.

Answer 1

Один из способов заключается в использовании матричный Индексация

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

---

Это происходит транспонированная матрица и rearanges столбцы желаемый порядок.

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 

Итак, мы хотим, чтобы 1, 3 и 5 столбцы и 2, 4 и 6 столбцы вместе. Одним из способов является индексом этих с

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

В качестве альтернативы можно использовать

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

---

Попробуйте на новую матрицу

(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

Это может сделать это:

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 

Было любопытно и засек два подхода. matrix подход, используемый user20650 гораздо быстрее, чем lapply подход я использовал:

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