R:跳过optim中依赖于if语句的迭代

R:跳过optim中依赖于if语句的迭代,r,optimization,R,Optimization,这是我第一次尝试执行模型优化。 我使用DeSolve模拟模型,并尝试使用与R中的optim函数耦合的目标函数进行优化。我通常使用Nelder Mead或L-BFGS-B 以下是模型函数: library(deSolve) model <- function(t, y, parms) { with(as.list(c(y, parms)), { y1=400*sin((2*pi)/(10^Tlog)*t)+600 dY2 = ((kA1*(Atot-y2)*y1^nA)/

这是我第一次尝试执行模型优化。 我使用DeSolve模拟模型,并尝试使用与R中的optim函数耦合的目标函数进行优化。我通常使用Nelder Mead或L-BFGS-B

以下是模型函数:

library(deSolve)
model <- function(t, y, parms) {
  with(as.list(c(y, parms)), {
    y1=400*sin((2*pi)/(10^Tlog)*t)+600
    dY2 = ((kA1*(Atot-y2)*y1^nA)/(KmA^nA+y1^nA)-kA2*y2)
    dY3 = ((kD1*(Dtot-y3)*y1^nD)/(KmD^nD+y1^nD)-kD2*y3)
    dY4 = ((kP1*(Ptot-y4)*y2^nP1)/(KmP1^nP1+y2^nP1)-(kP2*(y4)*y3^nP2)/(KmP2^nP2+y3^nP2))
    dY5 = y2
    dY6 = y3
    dY7 = y4
    list(c(dY2, dY3, dY4, dY5, dY6, dY7))
  })
}
正如您所见,目标函数由每次迭代的三个模拟中的每个模拟的结果组成。我实现了一个if语句,这意味着如果满足某个条件,它应该返回NA。显然,这是行不通的。算法只是取消。我可以说,它应该返回一个不希望作为目标值的数值,但这可能会导致函数认为它在一行中出现得太频繁时会收敛

如果满足某个条件,你知道如何强制算法取消当前参数集,并跳到另一个参数集吗


我希望这是有道理的——祝你好运,谢谢你

我还没有试过,但是也许设置为
Inf
而不是
NA
应该可以解决这个问题?嘿-谢谢你的回复。我试过了。不幸的是,它与使用“NA”时具有相同的效果。以下错误消息在满足if条件后立即取消算法:“optim中的错误(par=c(kA1=P_init[1,1],KmA=P_init[2,1],kA2=P_init[3,:无法在初始参数下计算函数”也许问题是这样的?试着一步一步地减少优化问题,扔掉不影响优化的部分,最终你会设法缩小优化范围。
ls <- function(par,extra) {
  if(min(par)<0.01 || max(par) >10000) {
    return(NA)
  }
  with(as.list(c(par, extra)), {
    #1
    parms <- c(vol=vol, kA1=kA1, nA=nA, KmA=KmA, Atot=Atot, kA2=kA2,
               kD1=kD1, nD=nD, KmD=KmD, Dtot=Dtot, kD2=kD2, 
               kP1=kP1, nP1=nP1, KmP1=KmP1,Ptot=Ptot,kP2=kP2,nP2=nP2,KmP2=KmP2,
               Tlog=-1)
    yini <- c(y2 = 0, y3 = 0, y4 = 0, y5 = 0, y6 = 0, y7 = 0)
    times <- seq(from = 0, to = 100, by = 0.01)
    out <- as.data.frame(ode (times = times, y = yini, func = model, parms = parms, ynames = FALSE))
    out[,5:7]=out[,5:7]/out[,1]
    colnames(out)=c("t[s]","A[nM]","D[nM]","P[nM]","A_act[nM]","D_act[nM]","P_act[nM]")
    O_1=(out$`P_act[nM]`[nrow(out)-1])
    #2
    parms <- c(vol=vol, kA1=kA1, nA=nA, KmA=KmA, Atot=Atot, kA2=kA2,
               kD1=kD1, nD=nD, KmD=KmD, Dtot=Dtot, kD2=kD2, 
               kP1=kP1, nP1=nP1, KmP1=KmP1,Ptot=Ptot,kP2=kP2,nP2=nP2,KmP2=KmP2,
               Tlog=1)
    # y2 = A; y3 = D; y4 = P; y5 = A_Act; y6 = D_Act; y7 = P_Act
    yini <- c(y2 = 0, y3 = 0, y4 = 0, y5 = 0, y6 = 0, y7 = 0)
    times <- seq(from = 0, to = 1000, by = 0.01)
    out <- as.data.frame(ode (times = times, y = yini, func = model, parms = parms, ynames = FALSE))
    out[,5:7]=out[,5:7]/out[,1]
    colnames(out)=c("t[s]","A[nM]","D[nM]","P[nM]","A_act[nM]","D_act[nM]","P_act[nM]")
    O_2=(out$`P_act[nM]`[nrow(out)-1])
    #3
    parms <- c(vol=vol, kA1=kA1, nA=nA, KmA=KmA, Atot=Atot, kA2=kA2,
               kD1=kD1, nD=nD, KmD=KmD, Dtot=Dtot, kD2=kD2, 
               kP1=kP1, nP1=nP1, KmP1=KmP1,Ptot=Ptot,kP2=kP2,nP2=nP2,KmP2=KmP2,
               Tlog=3)

    # y2 = A; y3 = D; y4 = P; y5 = A_Act; y6 = D_Act; y7 = P_Act
    yini <- c(y2 = 0, y3 = 0, y4 = 0, y5 = 0, y6 = 0, y7 = 0)
    times <- seq(from = 0, to = 10000, by = 0.01)
    out <- as.data.frame(ode (times = times, y = yini, func = model, parms = parms, ynames = FALSE))
    out[,5:7]=out[,5:7]/out[,1]
    colnames(out)=c("t[s]","A[nM]","D[nM]","P[nM]","A_act[nM]","D_act[nM]","P_act[nM]")
    O_3=(out$`P_act[nM]`[nrow(out)-1])

    if(O_2<(max(c(O_1,O_3)))) {
      return(NA)
    }

    Objective=1/(abs(O_2-O_1))+1/(abs(O_2-O_3))
    print(c(O_1,O_2,O_3))
    print(Objective)
    print("####")
    return(Objective)
  })
}
P_init=matrix(ncol=1,nrow=10)
for(i in 1:length(P_init)) {
  P_init[i,1]=runif(1,0.001,10000)
}

Res=optim(par=c(kA1=P_init[1,1], KmA=P_init[2,1], kA2=P_init[3,1],
                kD1=P_init[4,1], KmD=P_init[5,1],kD2=P_init[6,1], 
                kP1=P_init[7,1], KmP1=P_init[8,1],kP2=P_init[9,1],KmP2=P_init[10,1]),
          extra=c(vol=1,nA=4,nD=4,nP1=4,nP2=4,Atot=5000,Dtot=5000,Ptot=5000),
          fn=ls,control=list(trace=TRUE))