我正在尝试使用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阶的主要未成年人不是肯定的