Rコードの最適化例：行が同じ数かどうかの判定
をテンプレートにして作成
[
トップ
] [
新規
|
一覧
|
検索
|
最終更新
|
ヘルプ
]
開始行:
SIZE(20){COLOR(magenta){Rコードの最適化例：行の要素が全部...
r-help 記事より:
(数値)データフレーム x の各行が同じ数からなるかどうかを計...
## テストデータ作成(正解は 12)
set.seed(3141592)
x <- as.data.frame(matrix(sample(0:2, 1000, repl=T, prob...
## 速度検査コード(100回の平均値)
## 念の為に、最初にガベージコレクションをしておく
gc()
mean(sapply(1:100, function(i) system.time(test1(x))[1])...
## x を数値行列に変換し、行毎にユニークな要素数を求め、...
nuniq <- function(x) length(unique(x)) # 補助関数
test1 <- function(x) as.numeric(apply(as.matrix(x), 1, n...
[1] 0.0266
[1] 12
# 内側の apply で x[i,j]==x[i,1] なら x[i,j] を TRUE、さ...
# x[i,1] は必ず TRUE になることを注意
# 外側の apply で 各列が同じ要素からなれば TRUE、さもな...
test2 <- function (x) apply(apply(x, 2, "==", x[,1]), 1,...
[1] 0.011
[1] 12
# 内側の apply で x[i,j]==x[i,1] なら x[i,j] を TRUE、さ...
# 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* は不要なのではない...
-もとのリクエストは「結果を 0,1 で返すこと」となっていた...
-0/1で返すならそうですね。~
gc() をしても，なおかつ 100 回くらいの system.time ではば...
-列数が決まっているなら，以下のように展開するのが一番早い...
今使えるコンピュータは遅いので，test4 との速度比で表して...
> test4 <- function (x) rowSums(x==x[,1])==ncol(x) + 0
> a <- gc()
> mean(sapply(1:10000, function(i) system.time(test4(x))...
[1] 0.00719
[1] 12
> test8 <- function(x) x[,1] == x[,2] & x[,1] == x[,3] &...
> a <- gc()
> mean(sapply(1:10000, function(i) system.time(test8(x))...
[1] 0.004146
[1] 12
> 0.00719/0.004146
[1] 1.734202
少しだけ速い(^_^) -- [[青木繁伸]] &new{2004-07-21 (水) 00...
-うむ、これは反則。しかし、具体的なケースでは「それだけに...
-やっぱり反則ですか。それなら，関数を作る関数も書いたら反...
> 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, pr...
> makefunction(ncol(x))
> test.x
function(x) x[,1] == x[,2] & x[,1] == x[,3] & x[,1] == x...
> a <- gc()
> mean(sapply(1:100, function(i) system.time(test.x(x))[...
[1] 0.004
[1] 12
関数を作る関数については，どこかで質問がありましたが，こ...
-拍手。青木さんのアイデアを借用し次のコードを思いつきまし...
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(tes...
[1] 0.002047
> gc(); mean(sapply(1:10000, function(i) system.time(tes...
[1] 0.003264
> 0.003264/0.002047
[1] 1.594529
#comment
終了行:
SIZE(20){COLOR(magenta){Rコードの最適化例：行の要素が全部...
r-help 記事より:
(数値)データフレーム x の各行が同じ数からなるかどうかを計...
## テストデータ作成(正解は 12)
set.seed(3141592)
x <- as.data.frame(matrix(sample(0:2, 1000, repl=T, prob...
## 速度検査コード(100回の平均値)
## 念の為に、最初にガベージコレクションをしておく
gc()
mean(sapply(1:100, function(i) system.time(test1(x))[1])...
## x を数値行列に変換し、行毎にユニークな要素数を求め、...
nuniq <- function(x) length(unique(x)) # 補助関数
test1 <- function(x) as.numeric(apply(as.matrix(x), 1, n...
[1] 0.0266
[1] 12
# 内側の apply で x[i,j]==x[i,1] なら x[i,j] を TRUE、さ...
# x[i,1] は必ず TRUE になることを注意
# 外側の apply で 各列が同じ要素からなれば TRUE、さもな...
test2 <- function (x) apply(apply(x, 2, "==", x[,1]), 1,...
[1] 0.011
[1] 12
# 内側の apply で x[i,j]==x[i,1] なら x[i,j] を TRUE、さ...
# 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* は不要なのではない...
-もとのリクエストは「結果を 0,1 で返すこと」となっていた...
-0/1で返すならそうですね。~
gc() をしても，なおかつ 100 回くらいの system.time ではば...
-列数が決まっているなら，以下のように展開するのが一番早い...
今使えるコンピュータは遅いので，test4 との速度比で表して...
> test4 <- function (x) rowSums(x==x[,1])==ncol(x) + 0
> a <- gc()
> mean(sapply(1:10000, function(i) system.time(test4(x))...
[1] 0.00719
[1] 12
> test8 <- function(x) x[,1] == x[,2] & x[,1] == x[,3] &...
> a <- gc()
> mean(sapply(1:10000, function(i) system.time(test8(x))...
[1] 0.004146
[1] 12
> 0.00719/0.004146
[1] 1.734202
少しだけ速い(^_^) -- [[青木繁伸]] &new{2004-07-21 (水) 00...
-うむ、これは反則。しかし、具体的なケースでは「それだけに...
-やっぱり反則ですか。それなら，関数を作る関数も書いたら反...
> 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, pr...
> makefunction(ncol(x))
> test.x
function(x) x[,1] == x[,2] & x[,1] == x[,3] & x[,1] == x...
> a <- gc()
> mean(sapply(1:100, function(i) system.time(test.x(x))[...
[1] 0.004
[1] 12
関数を作る関数については，どこかで質問がありましたが，こ...
-拍手。青木さんのアイデアを借用し次のコードを思いつきまし...
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(tes...
[1] 0.002047
> gc(); mean(sapply(1:10000, function(i) system.time(tes...
[1] 0.003264
> 0.003264/0.002047
[1] 1.594529
#comment
ページ名:
![[RjpWiki]](image/../Rlogo.png "[RjpWiki]")
