何时使用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())