Rコードの最適化例:行の要素が全部同じ数かどうかの判定 (Rコード最適化のコツと実例集 に戻る)
r-help 記事より:
(数値)データフレーム x の各行が同じ数からなるかどうかを計算する様々な方法(すべて投稿記事からの引用です、皆さん楽しんでいらっしゃる)
## テストデータ作成(正解は 12) set.seed(3141592) x <- as.data.frame(matrix(sample(0:2, 1000, repl=T, prob =c(5,3,1)), nr=200))
## 速度検査コード(100回の平均値) ## 念の為に、最初にガベージコレクションをしておく gc() mean(sapply(1:100, function(i) system.time(test1(x))[1])); sum(test1(x))
## x を数値行列に変換し、行毎にユニークな要素数を求め、それが 1 かどうか判定 nuniq <- function(x) length(unique(x)) # 補助関数 test1 <- function(x) as.numeric(apply(as.matrix(x), 1, nuniq) == 1) [1] 0.0266 [1] 12
# 内側の apply で x[i,j]==x[i,1] なら x[i,j] を TRUE、さもなければ FALSE とする # x[i,1] は必ず TRUE になることを注意 # 外側の apply で 各列が同じ要素からなれば TRUE、さもなければ FALSE を返す test2 <- function (x) apply(apply(x, 2, "==", x[,1]), 1, all) [1] 0.011 [1] 12
# 内側の apply で x[i,j]==x[i,1] なら x[i,j] を TRUE、さもなければ FALSE とする # x[i,1] は必ず TRUE になることを注意 # %*%rep(1,ncol(X)) で行毎の総和を計算し、それが ncol(x) に等しいかどうか検査 # 行毎の操作を省略 test3 <- function (x) { X <- as.matrix(x) apply(X,2, '==',X[,1])%*%rep(1,ncol(X)) == ncol(x) } [1] 0.0037 [1] 12
# 行 i 毎に x[i,j]==x[i,1] である j の総和が ncol(x) に等しいかどうか検査 # 最後の + 0 は論理値を数値に変えるトリック test4 <- function (x) rowSums(x==x[,1])==ncol(x) + 0 [1] 0.0035 [1] 12
# 行毎の標準偏差を計算し 0 かどうか検査 # 最後の + 0 は論理値を数値に変えるトリック # 数値誤差が入る可能性? test5 <- function (x) (sd(t(x))==0)+0 [1] 0.0298 [1] 12
# 各行の最大値と最小値が一致すればすべて同じになる minmax <- function(x) max(x)==min(x) test6 <- function(x) apply(x,1,minmax) [1] 0.0117 [1] 12 ## 次のようにインライン展開すると少し早くなるらしい test6 <- function(x) apply(x,1,function(x) min(x)==max(x))
x が数値と文字列双方を含む可能性のある場合に拡張してみよ。
> test4 <- function (x) rowSums(x==x[,1])==ncol(x) + 0 > a <- gc() > mean(sapply(1:10000, function(i) system.time(test4(x))[1])); sum(test4(x)) [1] 0.00719 [1] 12 > test8 <- function(x) x[,1] == x[,2] & x[,1] == x[,3] & x[,1] == x[,4] & x[,1] == x[,5] > a <- gc() > mean(sapply(1:10000, function(i) system.time(test8(x))[1])); sum(test8(x)) [1] 0.004146 [1] 12 > 0.00719/0.004146 [1] 1.734202少しだけ速い(^_^) -- 青木繁伸 2004-07-21 (水) 00:39:04
> makefunction <- function(n) + { + a <- "test.x <- function(x) " + for (i in 2:(n-1)) { + a <- paste(a, "x[,1] == x[,", i, "] & ", sep="") + } + a <- paste(a, "x[,1] == x[,", n, "]", sep="") + sink("test.x") + cat(a) + sink() + source("test.x") + } > set.seed(3141592) > x <- as.data.frame(matrix(sample(0:2, 1000, repl=T, prob =c(5,3,1)), nr=200)) > makefunction(ncol(x)) > test.x function(x) x[,1] == x[,2] & x[,1] == x[,3] & x[,1] == x[,4] & x[,1] == x[,5] > a <- gc() > mean(sapply(1:100, function(i) system.time(test.x(x))[1])); sum(test.x(x)) [1] 0.004 [1] 12関数を作る関数については,どこかで質問がありましたが,こんな風に作るのも一法でしょうか。 -- 青木繁伸 2004-07-21 (水) 01:18:21
test <- function(x) { e <- x[,1]==x[,2] + 0 if ( (n <- dim(x)[2]) > 2) for (i in 2:(n-1)) e <- e*(x[,i]==x[,i+1]) return(e) } > gc(); mean(sapply(1:10000, function(i) system.time(test(x))[1])) [1] 0.002047 > gc(); mean(sapply(1:10000, function(i) system.time(test4(x))[1])) [1] 0.003264 > 0.003264/0.002047 [1] 1.594529