ノート/ノート
訪問者数 2183 最終更新 2014-07-22 (火) 14:16:24
参考になるサイト
参考 > R コード最適化のコツと実例集--RipWikiから ポイントはなるべくベクトル一体のまま計算すること。 本当に効いてます。
自分で直面した例 > 画像のX-Yを半分の解像度に落とすために、4ピクセルずつ足して一ピクセルとするプログラムの例
ステップバイステップに動くかどうか確認しながら試したので、一々変数に代入しているが、不要 u <- array(c(1:64), c(8,8)) ## Narabekae l <- length(u[1,]) v1 <- array(u, c(l*2,l/2)) v2 <- array(c(v1[1:l,],v1[(l+1):(2*l),]), c(l,l)) v3 <- t(v2) v4 <- array(v3, c(l*2,l/2)) v5 <- array(c(v4[1:l,],v4[(l+1):(l*2),]), c(l,l)) v6 <- t(v5) ## Bunkatsu m <- l/2 v71 <- v6[1:m,1:m] v72 <- v6[1:m,(m+1):l] v73 <- v6[(m+1):l,1:m] v74 <- v6[(m+1):l,(m+1):l] v7 <- v71+v72+v73+v74
実行すると
u <- array(c(1:64), c(8,8)) サンプルデータを作る [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [1,] 1 9 17 25 33 41 49 57 [2,] 2 10 18 26 34 42 50 58 [3,] 3 11 19 27 35 43 51 59 [4,] 4 12 20 28 36 44 52 60 [5,] 5 13 21 29 37 45 53 61 [6,] 6 14 22 30 38 46 54 62 [7,] 7 15 23 31 39 47 55 63 [8,] 8 16 24 32 40 48 56 64 l <- length(u[1,]) lは8になる v1 <- array(u, c(l*2,l/2)) これで縦長4×16の配列に作り直す [,1] [,2] [,3] [,4] [1,] 1 17 33 49 [2,] 2 18 34 50 [3,] 3 19 35 51 [4,] 4 20 36 52 [5,] 5 21 37 53 [6,] 6 22 38 54 [7,] 7 23 39 55 [8,] 8 24 40 56 [9,] 9 25 41 57 [10,] 10 26 42 58 [11,] 11 27 43 59 [12,] 12 28 44 60 [13,] 13 29 45 61 [14,] 14 30 46 62 [15,] 15 31 47 63 [16,] 16 32 48 64 v2 <- array(c(v1[1:l,],v1[(l+1):(2*l),]), c(l,l)) v1の上8行(v1[1:l])と下8行(v1[(l+1;(2*l),])を別々にして横に並べたものを作る。大きさ16x16の配列に並べなおす [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [1,] 1 17 33 49 9 25 41 57 [2,] 2 18 34 50 10 26 42 58 [3,] 3 19 35 51 11 27 43 59 [4,] 4 20 36 52 12 28 44 60 [5,] 5 21 37 53 13 29 45 61 [6,] 6 22 38 54 14 30 46 62 [7,] 7 23 39 55 15 31 47 63 [8,] 8 24 40 56 16 32 48 64 v3 <- t(v2) 今度はこれを転置(行と列とを入換え)して、同じロジック(半分ずつにして並べ替え)をする [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [1,] 1 2 3 4 5 6 7 8 [2,] 17 18 19 20 21 22 23 24 [3,] 33 34 35 36 37 38 39 40 [4,] 49 50 51 52 53 54 55 56 [5,] 9 10 11 12 13 14 15 16 [6,] 25 26 27 28 29 30 31 32 [7,] 41 42 43 44 45 46 47 48 [8,] 57 58 59 60 61 62 63 64 v4 <- array(v3, c(l*2,l/2)) (上と同じロジック)v3を縦長に作り直す [,1] [,2] [,3] [,4] [1,] 1 3 5 7 [2,] 17 19 21 23 [3,] 33 35 37 39 [4,] 49 51 53 55 [5,] 9 11 13 15 [6,] 25 27 29 31 [7,] 41 43 45 47 [8,] 57 59 61 63 [9,] 2 4 6 8 [10,] 18 20 22 24 [11,] 34 36 38 40 [12,] 50 52 54 56 [13,] 10 12 14 16 [14,] 26 28 30 32 [15,] 42 44 46 48 [16,] 58 60 62 64 v5 <- array(c(v4[1:l,],v4[(l+1):(l*2),]), c(l,l)) それを上半分と下半分にして横に並べる [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [1,] 1 3 5 7 2 4 6 8 [2,] 17 19 21 23 18 20 22 24 [3,] 33 35 37 39 34 36 38 40 [4,] 49 51 53 55 50 52 54 56 [5,] 9 11 13 15 10 12 14 16 [6,] 25 27 29 31 26 28 30 32 [7,] 41 43 45 47 42 44 46 48 [8,] 57 59 61 63 58 60 62 64 v6 <- t(v5) 転置を元へ戻す [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [1,] 1 17 33 49 9 25 41 57 [2,] 3 19 35 51 11 27 43 59 [3,] 5 21 37 53 13 29 45 61 [4,] 7 23 39 55 15 31 47 63 [5,] 2 18 34 50 10 26 42 58 [6,] 4 20 36 52 12 28 44 60 [7,] 6 22 38 54 14 30 46 62 [8,] 8 24 40 56 16 32 48 64 ここまでで、4×4の行列=1つ1つは元の行列の要素1個おきに取ったもの=が4つ集まったものになった。たとえば [,1] [,2] [,3] [,4] [1,] 1 17 33 49 [2,] 3 19 35 51 [3,] 5 21 37 53 [4,] 7 23 39 55 次に、上のような4×4の行列を切り出す。 ## Bunkatsu m <- l/2 v71 <- v6[1:m,1:m] v72 <- v6[1:m,(m+1):l] v73 <- v6[(m+1):l,1:m] v74 <- v6[(m+1):l,(m+1):l] だから、v71は [,1] [,2] [,3] [,4] [1,] 1 17 33 49 [2,] 3 19 35 51 [3,] 5 21 37 53 [4,] 7 23 39 55 で、v72は [,1] [,2] [,3] [,4] [1,] 9 25 41 57 [2,] 11 27 43 59 [3,] 13 29 45 61 [4,] 15 31 47 63 最後に、本当にやりたかったこと、つまり元の行列の(1,1)と(1,2)と(2,1)と(2,2)を合算すること、を計算する。 そのためには、v71, v72, v73, v74それぞれの第(1,1)要素を足せばよい。それを、v71〜74の8×8要素のすべてについてそれぞれ足す。 v7 <- v71+v72+v73+v74 これで出来上がり [,1] [,2] [,3] [,4] [1,] 22 86 150 214 [2,] 30 94 158 222 [3,] 38 102 166 230 [4,] 46 110 174 238