Question

我知道eval(parse())很慢并且经常会导致调试问题。但是，是否适合使用eval(parse())？

是合适的甚至是必要的

我在下面有一个示例，我使用eval(parse())。我正在尝试解决一个ODE系统，其中模型定义是根据用户输入设置的，并粘贴在一个函数中，如diffeqns所示。参数从最小化步骤获得，该步骤涉及求解ODE。因此，eval(parse())将被多次评估。在这种情况下，如何避免eval(parse())？

library(deSolve)

diffeqns <- structure(c("d_ParentW = - k_ParentW_to_sink * ParentW - k_ParentW_to_ParentS * ParentW - k_ParentW_to_MetW * ParentW + k_ParentS_to_ParentW * ParentS", 
                        "d_ParentS = - k_ParentS_to_sink * ParentS + k_ParentW_to_ParentS * ParentW - k_ParentS_to_ParentW * ParentS - k_ParentS_to_MetS * ParentS", 
                        "d_MetW = - k_MetW_to_sink * MetW + k_ParentW_to_MetW * ParentW - k_MetW_to_MetS * MetW + k_MetS_to_MetW * MetS", 
                        "d_MetS = - k_MetS_to_sink * MetS + k_ParentS_to_MetS * ParentS + k_MetW_to_MetS * MetW - k_MetS_to_MetW * MetS"
                        ), .Names = c("ParentW", "ParentS", "MetW", "MetS"))
mod_vars <- c("ParentW", "ParentS", "MetW", "MetS")
odeini <- structure(c(103.5304, 0, 0, 0), .Names = c("ParentW", "ParentS", 
                                                     "MetW", "MetS"))
odeparms <- structure(c(0.0075920556751397, 109.831812097509, 0.00547432996880228, 
                        0.067528800735385, 0.40912980024133, 0.512110576238725, 93.2375019578296, 
                        1.48218125815231e-06, 312.228302990933, 255.11871122468), .Names = c("k_ParentW_to_sink", 
                                                                                             "k_ParentS_to_sink", "k_MetW_to_sink", "k_MetS_to_sink", "k_ParentW_to_ParentS", 
                                                                                             "k_ParentW_to_MetW", "k_ParentS_to_ParentW", "k_ParentS_to_MetS", 
                                                                                             "k_MetW_to_MetS", "k_MetS_to_MetW"))

## experimenting Scripts for cleaner coding!
DefDiff <- function(time, state, parms,mod_vars,diffeqns) {
  ## an updated version of mkindiff
  ## @example DefDiff(t,state,parms, mod_vars, diffeqns=mkinmodini$diffs)

  diffs <- vector()
  for (box in mod_vars)
  {
    diffname <- paste("d", box, sep="_")
    diffs[diffname] <- with(as.list(c(time,state, parms)),
                            eval(parse(text=diffeqns[[box]])))
  }
  ##https://stat.ethz.ch/pipermail/r-sig-dynamic-models/2010q2/000031.html
  #bady <- (!is.finite(diffs))|(diffs<=0)
  #diffs[bady] <- 0 
  return(list(c(diffs)))
}
diff1 <-function(time, state, parms){
  DefDiff(time, state, parms,mod_vars=mod_vars,diffeqns=diffeqns)
  }
outtimes <- seq(0,100,1)
out <- ode(
  y = odeini,
  times = outtimes,
  func = diff1,
  parms = odeparms)
matplot(out)

更新：

我试着考虑如何使用substitue代替parse，但我担心我需要重写我已编写的大量代码才能使其真正起作用。
以下是link，我认为eval(parse())很难避免。

Answer 1

我做了一个小实验来测试用parse替换substitute可以获得多少收益。在我的（慢）计算机上使用以下代码获得的结果是：

> system.time(test1())
   user  system elapsed 
 275.38    0.11  314.78 
> system.time(test2())
   user  system elapsed 
 181.96    0.09  205.27

我不确定这是否会显着提高速度。或者我没有正确使用substitute。

以下代码改编自@ hadley的another answer。

library(deSolve)

diffeqns <- structure(c("d_ParentW = - k_ParentW_to_sink * ParentW - k_ParentW_to_ParentS * ParentW - k_ParentW_to_MetW * ParentW + k_ParentS_to_ParentW * ParentS", 
                        "d_ParentS = - k_ParentS_to_sink * ParentS + k_ParentW_to_ParentS * ParentW - k_ParentS_to_ParentW * ParentS - k_ParentS_to_MetS * ParentS", 
                        "d_MetW = - k_MetW_to_sink * MetW + k_ParentW_to_MetW * ParentW - k_MetW_to_MetS * MetW + k_MetS_to_MetW * MetS", 
                        "d_MetS = - k_MetS_to_sink * MetS + k_ParentS_to_MetS * ParentS + k_MetW_to_MetS * MetW - k_MetS_to_MetW * MetS"
                        ), .Names = c("ParentW", "ParentS", "MetW", "MetS"))
mod_vars <- c("ParentW", "ParentS", "MetW", "MetS")
odeini <- structure(c(103.5304, 0, 0, 0), .Names = c("ParentW", "ParentS", 
                                                     "MetW", "MetS"))
odeparms <- structure(c(0.0075920556751397, 109.831812097509, 0.00547432996880228, 
                        0.067528800735385, 0.40912980024133, 0.512110576238725, 93.2375019578296, 
                        1.48218125815231e-06, 312.228302990933, 255.11871122468), .Names = c("k_ParentW_to_sink", 
                                                                                             "k_ParentS_to_sink", "k_MetW_to_sink", "k_MetS_to_sink", "k_ParentW_to_ParentS", 
                                                                                             "k_ParentW_to_MetW", "k_ParentS_to_ParentW", "k_ParentS_to_MetS", 
                                                                                             "k_MetW_to_MetS", "k_MetS_to_MetW"))

## experimenting Scripts for cleaner coding!
DefDiff <- function(time, state, parms,mod_vars,diffeqns) {
  ## an updated version of mkindiff
  ## @example DefDiff(t,state,parms, mod_vars, diffeqns=mkinmodini$diffs)

  diffs <- vector()
  for (box in mod_vars)
  {
    diffname <- paste("d", box, sep="_")
    diffs[diffname] <- with(as.list(c(time,state, parms)),
                            eval(parse(text=diffeqns[[box]])))
  }
  ##https://stat.ethz.ch/pipermail/r-sig-dynamic-models/2010q2/000031.html
  #bady <- (!is.finite(diffs))|(diffs<=0)
  #diffs[bady] <- 0 
  return(list(c(diffs)))
}
diff1 <-function(time, state, parms){
  DefDiff(time, state, parms,mod_vars=mod_vars,diffeqns=diffeqns)
  }
outtimes <- seq(0,100,1)

diffsub <- function(time,state,parms){
  diffs <- vector()
  diffexps <- Defdiff2(odeparms=parms,odeini=state,time=time)
  for (box in mod_vars)
  {
    diffname <- paste("d", box, sep="_")
    diffs[diffname] <-eval(diffexps[[box]])
  }
  return(list(c(diffs)))
}

## some functions to work out the expressions:
add_expr_1 <- function(x, y) {
  substitute(x + y, list(x = x, y = y))
}
add_expr <- function(x) Reduce(add_expr_1, x)
substitute_q <- function(x, env) {
    call <- substitute(substitute(y, env), list(y = x))
    eval(call)
}
neg_exp <- function(exp){
  ## example: neg_exp(neg_exp(1))
  substitute(-1*x,list(x=exp))
}
one_parent <- function(type,par,ini,t=0){
  if(type=="SFO"){
    rhs <- substitute(-k*M,list(k=par,M=ini))
  }else if(type=="DFOP"){
      rhs <- substitute(-(k1*g*exp(-k1*t)+k2*(1-g)*exp(-k2*t))/(g*exp(-k1*t)+(1-g)*exp(-k2*t))*M,list(k1=par[1],k2=par[2],g=par[3],M=ini,t=t))
  }else if(type=="FOMC"){
    rhs <- substitute(-alpha/beta*M/(t/beta+1),list(alpha=par[1],beta=par[2],M=ini,t=t))
  }else if(type=="HS"){
    rhs <- substitute(ifelse(t<=tb, -k1*M,-k2*M),list(k1=par[1],k2=par[2],tb=par[3],M=ini,t=t))
  }else{
    rhs <- NULL
  }
  rhs
}

Defdiff2 <- function(odeparms,odeini,time){
diffexps <- list()
diffexps[["ParentW"]] <- add_expr(list(
  one_parent("SFO",par=odeparms["k_ParentW_to_sink"],ini=odeini[["ParentW"]]),
  one_parent("SFO",par=odeparms["k_ParentW_to_MetW"],ini=odeini[["ParentW"]]),
  one_parent("SFO",par=odeparms["k_ParentW_to_ParentS"],ini=odeini[["ParentW"]]),
  neg_exp(one_parent("SFO",par=odeparms["k_ParentS_to_ParentW"],ini=odeini[["ParentS"]]))
  ))
diffexps[["ParentS"]] <- add_expr(list(
  one_parent("SFO",par=odeparms["k_ParentS_to_sink"],ini=odeini[["ParentS"]]),
  one_parent("SFO",par=odeparms["k_ParentS_to_MetS"],ini=odeini[["ParentS"]]),
  one_parent("SFO",par=odeparms["k_ParentS_to_ParentW"],ini=odeini[["ParentS"]]),
  neg_exp(one_parent("SFO",par=odeparms["k_ParentW_to_ParentS"],ini=odeini[["ParentW"]]))
  ))
diffexps[["MetW"]] <- add_expr(list(
  one_parent("SFO",par=odeparms["k_MetW_to_sink"],ini=odeini[["MetW"]]),
  one_parent("SFO",par=odeparms["k_MetW_to_MetS"],ini=odeini[["MetW"]]),
  neg_exp(one_parent("SFO",par=odeparms["k_ParentW_to_MetW"],ini=odeini[["ParentW"]])),
  neg_exp(one_parent("SFO",par=odeparms["k_MetS_to_MetW"],ini=odeini[["MetS"]]))
  ))
diffexps[["MetS"]] <- add_expr(list(
  one_parent("SFO",par=odeparms["k_MetS_to_sink"],ini=odeini[["MetS"]]),
  neg_exp(one_parent("SFO",par=odeparms["k_MetW_to_MetS"],ini=odeini[["MetW"]])),
  one_parent("SFO",par=odeparms["k_MetS_to_MetW"],ini=odeini[["MetS"]]),
  neg_exp(one_parent("SFO",par=odeparms["k_ParentS_to_MetS"],ini=odeini[["ParentS"]]))
  ))
return(diffexps)
}
test1 <- function(){
  for(i in 1:1000){
    out <- ode(
      y = odeini,
      times = outtimes,
      func = diff1,
      parms = odeparms)
    }
  }
test2 <- function(){
  for(i in 1:1000){
    out <- ode(
      y = odeini,
      times = outtimes,
      func = diffsub,
      parms = odeparms)
    }
  }
system.time(test1())
system.time(test2())

Answer 2

我使用optim函数对优化过程存在同样的问题。

据我了解，该函数的fn参数需要包含一个带有参数优化的向量：

c( par[1], par[2], par[3]) # if there only 3

因此，当多个参数被更改时，我创建下一个代码来获取此向量，仅指定参数的数量num_param

tmp_test_params <- NULL

for (i in 1:num_param) tmp_test_params[[i]]  <- paste ("par[",i,"]", sep = "")

tmp_texto <- paste ("",tmp_test_params, collapse = ",")
texto_param  <- paste0 ("c(",tmp_texto,")")

而不是在eval (parse (text=texto_param))

中使用fn

在这种情况下，我没有找到另一种方式。希望有人可以帮助我回答你的问题。

何时适合使用eval（parse（））？

2 个答案: