何时使用eval(parse())合适?

何时使用eval(parse())合适?,r,parsing,eval,R,Parsing,Eval,我知道eval(parse())的速度很慢,并且经常导致调试问题。但是,在某些情况下使用eval(parse())是合适的,甚至是必要的吗 下面有一个例子,我使用了eval(parse())。我正在尝试解决一个ODE系统,其中模型定义是从用户输入设置的,并粘贴在一个函数中,如diffeqns所示。参数从优化步骤获得,该步骤涉及求解ODE。因此,eval(parse())将被多次计算。在这种情况下,如何避免eval(parse()) library(deSolve) diffeqns <-

我知道
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)
库(deSolve)

Diffiqns对于使用
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,")")

tmp\u test\u params我做了一个小实验,测试用
substitute
替换
parse
可以获得多少收益。在我的(慢速)计算机上使用以下代码获得的结果是:

> system.time(test1())
   user  system elapsed 
 275.38    0.11  314.78 
> system.time(test2())
   user  system elapsed 
 181.96    0.09  205.27 
我不确定这是否是速度上的显著提升。或者我没有正确使用
替换

下面的代码改编自@hadley

库(deSolve)

你能在公式界面中指定它们而不是字符串吗?@Thomas,我不确定我是否理解你的建议。对于简单的情况,我可以编写类似于
y~y_0*exp(-k(t))
的代码。但是我不能把程序遇到的所有情况都写下来。或者我可以写
y~fo(P)
。但是
fo()
再次包含
eval(parse())
construction.@Carl Witthoft--所以帮助中心FTW:“为链接提供上下文。我们鼓励链接到外部资源,但请在链接周围添加上下文,以便您的其他用户了解它是什么以及为什么存在。始终引用重要链接中最相关的部分,以防目标站点无法访问或永久脱机。“使用
substitute()
而不是
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)

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())