参数拟合nls.lm和ode,""错误chol.default(object $ hessian)

时间:2018-02-13 10:35:49

标签: r ode

我正在尝试使用deSolve包中的ode函数和minpack.lm中的nls.lm函数在一组ODE模型中拟合一组参数。

我拟合的数据在此文件中:S1LDPE https://github.com/nhazimah/Work-Package-1.git

我创建了一个函数(S1newmodel),列出了6组输出(3个不同系统中C1和C2的浓度导数:sys1,sys2,sys3):

S1newmodel<- function(t,c,parms){

with(as.list(c(c, parms)),{
  #c is concentration on plastic
  #r is derivatives of the concentration on plastic

  #Description of parameters
  #k1: Fast step forward rate constant (k1-Cw->C1)
  #k2: Fast step reverse rate constant (k2-C1->Cw)
  #k3: Slow step rate constant
  #f1: fraction of plastic (P1/PT) in outer compartment (rapid process)

  #List of parameters set by each set-up (constant)
  tp=0.3178/70   #total plastic concentration in system (kg/L)         
  m=0.0053773     #total micelle concentration in system (kg/L)
  #Kow: Kow of chemical                                      

  #Calculation of Km from Kow
  Km=10^(0.76*log10(Kow)+0.88)


  #Calculation of Cw from mass balance
  Cw1=(cinit["C11"]*tp-tp*(f1*c["C11"]+(1-f1)*c["C21"]))/(Km*m+1)
  Cw2=(cinit["C12"]*tp-tp*(f1*c["C12"]+(1-f1)*c["C22"]))/(Km*m+1)
  Cw3=(cinit["C13"]*tp-tp*(f1*c["C13"]+(1-f1)*c["C23"]))/(Km*m+1)

  #Calculation of k2 from K(polymer)
  #k2=k1/(K*f1*tp)

  #derivatives dc/dt are computed below
  r=rep(0,length(c))
  r[1]=(k1/(f1*tp))*Cw1-(k2+k3)*c["C11"]+k3*c["C21"]        #dC1/dt (in ug/kg of component 1)
  r[2]=k3*c["C11"]-k3*c["C21"]                                  #dC2/dt (in ug/kg of component 2)
  r[3]=(k1/(f1*tp))*Cw2-(k2+k3)*c["C12"]+k3*c["C22"]        #dC1/dt (in ug/kg of component 1)
  r[4]=k3*c["C12"]-k3*c["C22"]                                  #dC2/dt (in ug/kg of component 2)
  r[5]=(k1/(f1*tp))*Cw3-(k2+k3)*c["C13"]+k3*c["C23"]        #dC1/dt (in ug/kg of component 1)
  r[6]=k3*c["C13"]-k3*c["C23"]                                  #dC2/dt (in ug/kg of component 2)

  #k1 from steady state solution
  Kp=k1/(k2*f1*tp)

  #Kow and Kp relationship
  Kp=10^(a*(log10(Kow))+b)


  return(list(r))})

}

接下来,我创建了一个函数ssq,它产生预测和实际数据之间残差的输出,然后将其传递给nls.lm函数以估计最佳参数。但是,与之前现有的nls.lm示例不同,我正在运行一个&#39; for&#39;循环函数读取不同的参数集,产生5组输出&#34; out&#34;。

ssq=function(parms){

    for(i in 1:5){



  #time points for which conc is reported
  #include points where data is available  
  t=c(seq(0,672,0.5),S1LDPE$time[S1LDPE$system=="PCB18sys1"])                           
  t=sort(unique(t))

  #parameters from the parameter estimation routine

  a=parms[1]
  b=parms[2]
  k1=parms[i+2]
  k2=parms[i+7]
  k3=parms[i+12]
  f1=parms[i+17]
  Kow=Kow[i]

  cinit=c(C11=unname(parms[i+22]),C21=unname(parms[i+22]),
          C12=unname(parms[i+27]),C22=unname(parms[i+27]),
          C13=unname(parms[i+32]),C23=unname(parms[i+32]))


  #solve OD for a given set of parameters
  out[[i]]=ode(y=cinit,times=t,func=S1newmodel,parms=list(a=a,b=b,k1=k1,k2=k2,k3=k3,f1=f1,Kow=Kow))

  #Calculate Ctot dataframes (contain sys1, sys2, sys3) for each PCB
  Ctot1[[i]]=(out[[i]][,2]*parms[[i+17]])+(out[[i]][,3]*(1-parms[[i+17]]))
  Ctot2[[i]]=(out[[i]][,4]*parms[[i+17]])+(out[[i]][,5]*(1-parms[[i+17]]))
  Ctot3[[i]]=(out[[i]][,6]*parms[[i+17]])+(out[[i]][,7]*(1-parms[[i+17]]))
  Ctot[[i]]=cbind(Ctot1[[i]],Ctot2[[i]],Ctot3[[i]])

  }

  pred<-do.call(cbind,Ctot)
  preddf<-data.frame(pred)

  #Give names to dataframe with PCB#sys# format
  colnames(preddf)[1:3]=sprintf("PCB18sys%d",1:3)
  colnames(preddf)[4:6]=sprintf("PCB31sys%d",1:3)
  colnames(preddf)[7:9]=sprintf("PCB28sys%d",1:3)
  colnames(preddf)[10:12]=sprintf("PCB52sys%d",1:3)
  colnames(preddf)[13:15]=sprintf("PCB66sys%d",1:3)

  time=out[[1]][,1]
  preddf<-cbind(time,preddf)

  #filter data that contains time points where data is available
  preddf=preddf[preddf$time %in% S1LDPE$time[S1LDPE$system=="PCB18sys1"],] 

    #Evaluate predicted vs experimental residual
  preddf=melt(preddf,id.var="time",variable.name="system",value.name="conc")
  ssqres=preddf$conc-S1LDPE$conc      

  return(ssqres)
}

以下是我猜测为初始估计的参数和边界条件(注意:Kow不是参数。它是每组的固定常数):

#parameter fitting using levenberg marquart algorithm
#initial guess for parameters
k1<-c(10,10,10,15,20)
k2<-c(0.2,0.1,0.2,0.3,0.3)
k3<-c(0.001,0.001,0.001,0.001,0.001)
f1<-c(0.2,0.2,0.2,0.2,0.2)
Cp1<-c(500,800,700,1000,1100)
Cp2<-c(600,800,700,1000,1000)
Cp3<-c(600,800,700,1000,1000)


parms  <- c(a=2,b=-1.5,k1=k1[1:5],k2=k2[1:5],k3=k3[1:5],f1=f1[1:5],Cp1=Cp1[1:5],Cp2=Cp2[1:5],Cp3=Cp3[1:5])

#Fixed values
Kow<-c(10^5.24,10^5.67,10^5.67,10^5.84,10^6.2)

#Frames for outputs
out<-c()
Ctot1<-c()
Ctot2<-c()
Ctot3<-c()
Ctot<-c()

#Lower and upper bounds
lower=as.vector(matrix(0,1,37))
lower[[2]]=-Inf

upper=as.vector(matrix(Inf,1,37))
upper[18:22]=1

最后,我将上述函数与nls.lm

相匹配
#fitting
fitval=nls.lm(par=parms,fn=ssq,lower=lower,upper=upper)

模型似乎在运行但是在i = 2时停止并在检查摘要时生成此消息:

chol.default(object $ hessian)出错:   1阶的主要未成年人不是肯定的

0 个答案:

没有答案