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,test6 で +0 とか,test5 で 1* は不要なのではないでしょうか(不要だとすれば計算時間の無駄)。 -- 青木繁伸 2004-07-20 (火) 18:51:37
  • もとのリクエストは「結果を 0,1 で返すこと」となっていたのでこうなります。論理値では気持ちが悪い人が多いのでしょう。なお変換に要する追加時間はほとんど無視可能です。かえてみたら何と 0.0301 になってしまいました (^^; -- 2004-07-20 (火) 19:19:17
  • 0/1で返すならそうですね。
    gc() をしても,なおかつ 100 回くらいの system.time ではばらつきが多いですね。1000回にしてもなおばらつきます。計算時間測定のための何かいい方法はないでしょうかね。 -- 青木繁伸 2004-07-20 (火) 19:27:41
  • 列数が決まっているなら,以下のように展開するのが一番早い。反則気味ですが。
    今使えるコンピュータは遅いので,test4 との速度比で表しておきます。実行も1万回にして測定しました。
    > 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
  • うむ、これは反則。しかし、具体的なケースでは「それだけに通用するうまいやりかたがある」という教訓ですね。 -- 2004-07-21 (水) 01:01: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
  • 拍手。青木さんのアイデアを借用し次のコードを思いつきました。 -- 2004-07-21 (水) 03:48:52
    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


トップ   編集 凍結 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   ヘルプ   最終更新のRSS
Google
WWW を検索 OKADAJP.ORG を検索
Last-modified: 2015-03-01 (日) 01:15:59 (1718d)