- 転置する
- アレイの各軸の要素数を使った「任意digit進法」みたいなもの
my.t.array <- function(A,v){
A.v <- c(A)
p <- list()
as <- dim(A)
for(i in 1:length(as)){
p[[i]] <- 1:as[i]
}
ad <- as.matrix(expand.grid(p))
as.2 <- as[v]
val2 <- apply(v <- (t(ad[,v])-1) * c(1,cumprod(as.2)[-length(as.2)]),2,sum)+1
array(A.v[order(val2)],as.2)
}
as <- c(2,3)
A <- array(1:prod(as),as)
v23 <- c(1,2)
v32 <- c(2,1)
A
my.t.array(A,v23)
my.t.array(A,v32)
> A
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6
> my.t.array(A,v23)
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6
> my.t.array(A,v32)
[,1] [,2]
[1,] 1 2
[2,] 3 4
[3,] 5 6
as <- c(2,3,4)
A <- array(1:prod(as),as)
v234 <- c(1,2,3)
v243 <- c(1,3,2)
v324 <- c(2,1,3)
v342 <- c(2,3,1)
v423 <- c(3,1,2)
v432 <- c(3,2,1)
A
my.t.array(A,v234)
my.t.array(A,v243)
my.t.array(A,v324)
my.t.array(A,v342)
my.t.array(A,v423)
my.t.array(A,v432)
> A
, , 1
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6
, , 2
[,1] [,2] [,3]
[1,] 7 9 11
[2,] 8 10 12
, , 3
[,1] [,2] [,3]
[1,] 13 15 17
[2,] 14 16 18
, , 4
[,1] [,2] [,3]
[1,] 19 21 23
[2,] 20 22 24
> my.t.array(A,v234)
, , 1
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6
, , 2
[,1] [,2] [,3]
[1,] 7 9 11
[2,] 8 10 12
, , 3
[,1] [,2] [,3]
[1,] 13 15 17
[2,] 14 16 18
, , 4
[,1] [,2] [,3]
[1,] 19 21 23
[2,] 20 22 24
> my.t.array(A,v243)
, , 1
[,1] [,2] [,3] [,4]
[1,] 1 7 13 19
[2,] 2 8 14 20
, , 2
[,1] [,2] [,3] [,4]
[1,] 3 9 15 21
[2,] 4 10 16 22
, , 3
[,1] [,2] [,3] [,4]
[1,] 5 11 17 23
[2,] 6 12 18 24
> my.t.array(A,v324)
, , 1
[,1] [,2]
[1,] 1 2
[2,] 3 4
[3,] 5 6
, , 2
[,1] [,2]
[1,] 7 8
[2,] 9 10
[3,] 11 12
, , 3
[,1] [,2]
[1,] 13 14
[2,] 15 16
[3,] 17 18
, , 4
[,1] [,2]
[1,] 19 20
[2,] 21 22
[3,] 23 24
> my.t.array(A,v342)
, , 1
[,1] [,2] [,3] [,4]
[1,] 1 7 13 19
[2,] 3 9 15 21
[3,] 5 11 17 23
, , 2
[,1] [,2] [,3] [,4]
[1,] 2 8 14 20
[2,] 4 10 16 22
[3,] 6 12 18 24
> my.t.array(A,v423)
, , 1
[,1] [,2]
[1,] 1 2
[2,] 7 8
[3,] 13 14
[4,] 19 20
, , 2
[,1] [,2]
[1,] 3 4
[2,] 9 10
[3,] 15 16
[4,] 21 22
, , 3
[,1] [,2]
[1,] 5 6
[2,] 11 12
[3,] 17 18
[4,] 23 24
> my.t.array(A,v432)
, , 1
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 7 9 11
[3,] 13 15 17
[4,] 19 21 23
, , 2
[,1] [,2] [,3]
[1,] 2 4 6
[2,] 8 10 12
[3,] 14 16 18
[4,] 20 22 24
as <- c(2,3,4,3)
A <- array(1:prod(as),as)
v2433 <- c(1,3,2,4)
v2433.2 <- c(1,3,4,2)
A
my.t.array(A,v2433)
my.t.array(A,v2433.2)
> A
, , 1, 1
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6
, , 2, 1
[,1] [,2] [,3]
[1,] 7 9 11
[2,] 8 10 12
, , 3, 1
[,1] [,2] [,3]
[1,] 13 15 17
[2,] 14 16 18
, , 4, 1
[,1] [,2] [,3]
[1,] 19 21 23
[2,] 20 22 24
, , 1, 2
[,1] [,2] [,3]
[1,] 25 27 29
[2,] 26 28 30
, , 2, 2
[,1] [,2] [,3]
[1,] 31 33 35
[2,] 32 34 36
, , 3, 2
[,1] [,2] [,3]
[1,] 37 39 41
[2,] 38 40 42
, , 4, 2
[,1] [,2] [,3]
[1,] 43 45 47
[2,] 44 46 48
, , 1, 3
[,1] [,2] [,3]
[1,] 49 51 53
[2,] 50 52 54
, , 2, 3
[,1] [,2] [,3]
[1,] 55 57 59
[2,] 56 58 60
, , 3, 3
[,1] [,2] [,3]
[1,] 61 63 65
[2,] 62 64 66
, , 4, 3
[,1] [,2] [,3]
[1,] 67 69 71
[2,] 68 70 72
> my.t.array(A,v2433)
, , 1, 1
[,1] [,2] [,3] [,4]
[1,] 1 7 13 19
[2,] 2 8 14 20
, , 2, 1
[,1] [,2] [,3] [,4]
[1,] 3 9 15 21
[2,] 4 10 16 22
, , 3, 1
[,1] [,2] [,3] [,4]
[1,] 5 11 17 23
[2,] 6 12 18 24
, , 1, 2
[,1] [,2] [,3] [,4]
[1,] 25 31 37 43
[2,] 26 32 38 44
, , 2, 2
[,1] [,2] [,3] [,4]
[1,] 27 33 39 45
[2,] 28 34 40 46
, , 3, 2
[,1] [,2] [,3] [,4]
[1,] 29 35 41 47
[2,] 30 36 42 48
, , 1, 3
[,1] [,2] [,3] [,4]
[1,] 49 55 61 67
[2,] 50 56 62 68
, , 2, 3
[,1] [,2] [,3] [,4]
[1,] 51 57 63 69
[2,] 52 58 64 70
, , 3, 3
[,1] [,2] [,3] [,4]
[1,] 53 59 65 71
[2,] 54 60 66 72
> my.t.array(A,v2433.2)
, , 1, 1
[,1] [,2] [,3] [,4]
[1,] 1 7 13 19
[2,] 2 8 14 20
, , 2, 1
[,1] [,2] [,3] [,4]
[1,] 25 31 37 43
[2,] 26 32 38 44
, , 3, 1
[,1] [,2] [,3] [,4]
[1,] 49 55 61 67
[2,] 50 56 62 68
, , 1, 2
[,1] [,2] [,3] [,4]
[1,] 3 9 15 21
[2,] 4 10 16 22
, , 2, 2
[,1] [,2] [,3] [,4]
[1,] 27 33 39 45
[2,] 28 34 40 46
, , 3, 2
[,1] [,2] [,3] [,4]
[1,] 51 57 63 69
[2,] 52 58 64 70
, , 1, 3
[,1] [,2] [,3] [,4]
[1,] 5 11 17 23
[2,] 6 12 18 24
, , 2, 3
[,1] [,2] [,3] [,4]
[1,] 29 35 41 47
[2,] 30 36 42 48
, , 3, 3
[,1] [,2] [,3] [,4]
[1,] 53 59 65 71
[2,] 54 60 66 72
- 実は、apply()を使って、ある一つの次元 k だけを除いて、次元指定をし、それに恒等関数を適用させることは、c(k,1,2,...,k-1,k+1,...)への「アレイ転置」と同じ
as <- c(2,3,4)
A <- array(1:prod(as),as)
ds <- 1:length(as)
k <- 2
apply(A,ds[-k],function(x){x})
my.t.array(A,c(k,ds[-k]))