Question

这是我第一次尝试进行模型优化。我使用DeSolve模拟模型并尝试使用耦合到R中的optim-function的目标函数进行优化。我通常使用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))
  })
}

这里是优化函数 - 我每次优化迭代模拟三次。请注意，我只优化了所有参数的子集，一个特定参数（Tlog）针对三种模拟中的每一种都以目标为导向进行了更改：

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

如您所见，目标函数由每次迭代的三次模拟中的每一次的结果组成。我实现了一个if语句，暗示如果满足某个条件就应该返回NA。显然这不起作用。算法只是取消了。我可以说它应该返回一个不合需要的数值作为客观值，但这可能会导致函数相信它在连续发生时连续发生收敛。

您是否知道如果条件满足，如何强制algorihm忽略当前参数集并转而跳转到另一个条件？

我希望这是有道理的 - 祝福并多多谢！

R：根据if语句

0 个答案: