遺伝学・遺伝統計学関連の姉妹ブログ『ryamadaの遺伝学・遺伝統計学メモ』
京都大学大学院医学研究科ゲノム医学センター統計遺伝学分野のWiki
講義・スライド
医学生物学と数学とプログラミングの三重学習を狙う学習ツール
駆け足で読む○○シリーズ
ぱらぱらめくるシリーズ
カシオの計算機
オンライン整数列大辞典

アレイの転置

R array 転置
  • 転置する
    • アレイの各軸の要素数を使った「任意digit進法」みたいなもの
# Aはアレイ
# vは、アレイの軸の順番の変更を指示する順列ベクトル
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]
# 新しいアレイでは、アレイAのベクトルA.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]))