arrayにapply()すること

• 昨日の記事で、まず、アレイの形が変わらないような関数をapply()を使って実行したときの、アレイの形の変化を抑える話をするために、アレイの転置について書いた
• 今日は、それを応用して、arrayにapply()をかけて、アレイの形そのままに出す方法
• これによって、行列にapply()をかけて、同じサイズの行列が返ってくるときの、転置問題も解消する （予定）

# A アレイ
# apply()の次元指定
# fは関数
# '...'はfが取る、A以外の引数
my.apply.fix.dim <- function(A,k,f, ...){
# array Aの各軸の長さ
	as <- dim(A)
# array A の次元
	d <- length(as)
# 処理をする軸と固定する軸とをno.k,kとで表す
	no.k <- (1:d)[-k]
# apply()処理する
	post.apply <- apply(A,k,f,...)
# これが、できた情報の並べ方指定のための順列ベクトル
	tmp <-c(no.k,k)
# apply()の出力は、処理軸ごとに出して、固定軸ごとに積み重ねるので
# その順序でアレイにし
# そのうえで、アレイの転置をする
	my.t.array(array(post.apply,as[tmp]),order(tmp))
}
# 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)
my.apply.fix.dim(A,c(1),cumsum)
my.apply.fix.dim(A,c(2),cumsum)

as <- c(2,3,4)
A <- array(1:prod(as),as)
my.apply.fix.dim(A,c(1,2),cumsum)
my.apply.fix.dim(A,c(1,3),cumsum)
my.apply.fix.dim(A,c(2,3),cumsum)

• 使ってみる
• 行列

as <- c(2,3)
A <- array(1:prod(as),as)
A
apply(A,1,cumsum)
apply(A,2,cumsum)
my.apply.fix.dim(A,c(1),cumsum)
my.apply.fix.dim(A,c(2),cumsum)
my.apply.fix.dim(A,c(1),function(x,a){cumsum(x)+a},10)

> A
     [,1] [,2] [,3]
[1,]    1    3    5
[2,]    2    4    6
> apply(A,1,cumsum)
     [,1] [,2]
[1,]    1    2
[2,]    4    6
[3,]    9   12
> apply(A,2,cumsum)
     [,1] [,2] [,3]
[1,]    1    3    5
[2,]    3    7   11
> my.apply.fix.dim(A,c(1),cumsum)
     [,1] [,2] [,3]
[1,]    1    4    9
[2,]    2    6   12
> my.apply.fix.dim(A,c(2),cumsum)
     [,1] [,2] [,3]
[1,]    1    3    5
[2,]    3    7   11
> my.apply.fix.dim(A,c(1),function(x,a){cumsum(x)+a},10)
     [,1] [,2] [,3]
[1,]   11   14   19
[2,]   12   16   22

• ３次元

as <- c(2,3,4)
A <- array(1:prod(as),as)
A
my.apply.fix.dim(A,c(1),cumsum)
my.apply.fix.dim(A,c(1,2),cumsum)
my.apply.fix.dim(A,c(1,3),cumsum)
my.apply.fix.dim(A,c(2,3),cumsum)

> 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.apply.fix.dim(A,c(1),cumsum)
, , 1

     [,1] [,2] [,3]
[1,]    1    4    9
[2,]    2    6   12

, , 2

     [,1] [,2] [,3]
[1,]   16   25   36
[2,]   20   30   42

, , 3

     [,1] [,2] [,3]
[1,]   49   64   81
[2,]   56   72   90

, , 4

     [,1] [,2] [,3]
[1,]  100  121  144
[2,]  110  132  156

> my.apply.fix.dim(A,c(1,2),cumsum)
, , 1

     [,1] [,2] [,3]
[1,]    1    3    5
[2,]    2    4    6

, , 2

     [,1] [,2] [,3]
[1,]    8   12   16
[2,]   10   14   18

, , 3

     [,1] [,2] [,3]
[1,]   21   27   33
[2,]   24   30   36

, , 4

     [,1] [,2] [,3]
[1,]   40   48   56
[2,]   44   52   60

> my.apply.fix.dim(A,c(1,3),cumsum)
, , 1

     [,1] [,2] [,3]
[1,]    1    4    9
[2,]    2    6   12

, , 2

     [,1] [,2] [,3]
[1,]    7   16   27
[2,]    8   18   30

, , 3

     [,1] [,2] [,3]
[1,]   13   28   45
[2,]   14   30   48

, , 4

     [,1] [,2] [,3]
[1,]   19   40   63
[2,]   20   42   66

> my.apply.fix.dim(A,c(2,3),cumsum)
, , 1

     [,1] [,2] [,3]
[1,]    1    3    5
[2,]    3    7   11

, , 2

     [,1] [,2] [,3]
[1,]    7    9   11
[2,]   15   19   23

, , 3

     [,1] [,2] [,3]
[1,]   13   15   17
[2,]   27   31   35

, , 4

     [,1] [,2] [,3]
[1,]   19   21   23
[2,]   39   43   47