提高模拟性能 - 解析花费了太多时间

时间:2014-07-03 22:03:15

标签: r performance parsing profiling

我正在使用不同的概率分布和不同的参数进行一些模拟。示例:distribiution - normal,参数mean和sd。均值是固定的(例如0)并且sd从例如1变为5.我写了一些函数来处理这个,简单的版本会给你的想法如下:

test <- function(x, fixed, value, changed, seq){
    expr <- eval(parse(text=stri_flatten(c(fixed,"=",value))))
    for(i in seq_along(seq)){
        expr2 <- eval(parse(text=stri_flatten(c(changed,"=",seq[i]))))
        y <- dnorm(x, expr, expr2)
        sqrt(y*y + y*y)
    }
}

在我的函数解析中占用了一半的模拟时间(25秒内为13秒)。我需要改进这个,任何想法如何?您可以运行Rprof函数并检查结果:

{Rprof();test(-10:10,"mean",0,"sd",seq(1,5,length.out = 1001));Rprof(NULL);}
summaryRprof()

我模拟的Rprof结果(仅部分)

summaryRprof()
$by.self
                       self.time self.pct total.time total.pct
"parse"                    13.48    53.71      15.42     61.43
"ifelse"                    2.26     9.00      23.64     94.18
"structure"                 1.56     6.22       2.66     10.60
".External"                 0.80     3.19      17.90     71.31
"$<-"                       0.54     2.15       0.54      2.15
"options"                   0.52     2.07       0.54      2.15
"makeRestartList"           0.50     1.99       1.98      7.89
"c"                         0.46     1.83       0.46      1.83
"match"                     0.40     1.59       0.40      1.59
"doWithOneRestart"          0.38     1.51       1.60      6.37
"eval"                      0.32     1.27      15.84     63.11
"stopifnot"                 0.26     1.04       0.34      1.35
".Call"                     0.26     1.04       0.28      1.12
"phirsch"                   0.24     0.96      24.46     97.45
"t"                         0.24     0.96       0.26      1.04
"any"                       0.24     0.96       0.24      0.96
"pbeta"                     0.22     0.88      22.00     87.65
"list"                      0.20     0.80       0.20      0.80
"%in%"                      0.16     0.64       0.38      1.51
"^"                         0.14     0.56       0.14      0.56
"floor"                     0.14     0.56       0.14      0.56

加快这一点的一个想法是使用内部解析功能:

text <- "a <- 5"
internalParse <- function(x) .Internal(parse(stdin(), NULL, x, NULL, NULL, "unknown"))
microbenchmark(parse(text=text), internalParse(text))
## Unit: microseconds
##                 expr     min       lq  median       uq       max neval
##   parse(text = text) 146.388 196.4995 254.677 333.5975 11487.912   100
##  internalParse(text)  75.639  96.5910 115.239 135.3885  5031.508   100

1 个答案:

答案 0 :(得分:2)

怎么样

test2 <- function(x, fixed, value, changed, seqvec){
    argList0 <- setNames(list(value),fixed)
    for(i in seq_along(seqvec)){
        argList <- c(list(x),argList0,setNames(list(seqvec[i]),changed))
        y <- do.call(dnorm,argList)
        sqrt(y*y + y*y)
    }
}

(调用数字向量seq可能是一个坏主意:它大部分时间都可以工作,但是当它失败时会以非常混乱的方式失​​败!)

基准:

microbenchmark(test(-10:10,"mean",0,"sd",seq(1,5,length.out = 1001)),test2(-10:10,"mean",0,"sd",seq(1,5,length.out = 1001)),times = 10)
Unit: milliseconds
       expr       min        lq    median        uq       max neval
  test(...) 638.06613 643.23257 663.01249 682.08094 740.33703    10
 test2(...)  21.71302  22.07522  23.23993  28.96877  30.46197    10

我认为

outer(-10:10,1:5,dnorm,mean=0)

应该更多更快,但它并不完全清楚你实际上想要做什么。