r-statistics-fanの日記

統計好きの現場の臨床医の覚書のようなもの

算数問題その3

リスペクトしているサイトの一つ裏 RjpWikiで、コードの

改良がなされていた。

 

なんと、 gtools の permutations() で爆速のコードを実現している。

 

permutations()でも、問題に特化して探索範囲を狭くすれば

実行時間の桁が変わることが分かった。

勉強になった。というより、とてもワクワクした。

裏 RjpWikiに取り上げられて本当に光栄です。

しかしここで終わってはいけないと思い、先輩方に

少しでも近づくため、自分でもあがいてみる。

unique()を使うことによって更に短くなった。

一応brunner.munzel.test、median.test、wilcox.testいずれも

有意に実行時間が短縮した。

だけど、こんなのは小手先の改良。桁が変わるわけがない。

劇的な改良につながるのはやはり良いアルゴリズムなのだと

実感する。

はてなの仕様で二重括弧が勝手に脚注に変わるようだ

#無駄な30分がかかってしまった。blogは難しい。

   f3 = function() {library(gtools)
x = permutations(10, 4) apply(x, 1, function(y) { if (all(y != 6) && abs(y[1] - y[2]) == 6) { z1 = abs(diff(y)) z2 = abs(diff(z1)) z3 = abs(diff(z2)) if (length(table(c(y, z1, z2, z3))) == 10) { # print(c(y, z1, z2, z3)) return } } }) invisible() } f4 = function() { library(gtools) x = permutations(10, 4) apply(x, 1, function(y) { if ( (y[1] - 6) * (y[2] - 6) * (y[3] - 6) * (y[4] - 6) ) { if ( (y[1] - y[2])^2 == 36) { z1 = abs(diff(y)) z2 = abs(diff(z1)) z3 = abs(diff(z2)) if (length(unique(c(y, z1, z2, z3))) == 10) { # print(c(y, z1, z2, z3)) return } } } }) invisible() } niter <- 100 ft <- matrix(0, niter, ncol = 2) for (i in 1:niter) { ft[i, 1] <- system.time(f3())[3] } for (i in 1:niter) { ft[i, 2] <- system.time(f4())[3] } mean(ft[, 1])
## [1] 0.1131
mean(ft[, 2])
## [1] 0.0639

####比較####
library(lawstat) brunner.munzel.test(ft[, 1], ft[, 2]) median.test <- function(x, y) { med <- median(c(x, y)) mat <- matrix(c(length(x[x >= med]), length(x[x < med]), length(y[y >= med]), length(y[y < med])), nrow = 2, ncol = 2) return(fisher.test(mat)$p.value) # return(chisq.test(mat)$p.value) } median.test(ft[, 1], ft[, 2]) wilcox.test(ft[, 1], ft[, 2])