[R-br] Adicionar restrições a parâmetros em regressão não linear no R

[Delcio Rudinei Bortolanza]

Vejam o seguinte script:


rm(list=ls(all=TRUE))

library(minpack.lm)

dados<-read.table(header = TRUE, dec=",",text=
"psi theta
0,01 0,5
0,5 0,48
1 0,42
3 0,4
10 0,39
30 0,35
100 0,3
300 0,28
1000 0,27
")
dados

theta=dados$theta
psi=dados$psi

durner<-as.formula(theta~0.6*(thetar+((thetas-thetar)/(1+(alpha0*psi)^n0)^(1-1/n0)))+
                         0.4*(thetar+((thetas-thetar)/(1+(alpha1*psi)^n1)^(1-1/n1))))

dur<-nlsLM(durner,
          start=list(thetas=0.5,thetar=0.25,alpha0=0.1,n0=2,alpha1=0.1,n1=1),data = dados,
          algorithm = "LM",
          trace = "F",
          control = list(maxiter = 500))
summary(dur)

rsquared<-1-(sum(residuals(dur)^2)/sum((theta - mean(theta))^2))
rsquared

thetas=coef(dur)[1]
thetar=coef(dur)[2]
alpha0=coef(dur)[3]
n0=coef(dur)[4]
alpha1=coef(dur)[5]
n1=coef(dur)[6]

par(mar=c(4,4,1,1))
par(mfrow = c(1, 1))
plot(psi,theta,xlim = c(min(psi),max(psi)),log = "x",las=1,xaxt="n",ylab=expression(theta~(m^{3}~m^{-3})),xlab=expression(abs(psi)~(kPa)),mgp=c(2.5, 1, 0))
labels <- 10^(-3:3)
axis(1, at=labels, labels=labels,lwd.ticks = 2) #,tck=-0.05
axis(1, at=sort(sapply(1:9, function(x) x*10^(-3:3))), label=NA, lwd=0.5)

curve(0.6*(thetar+((thetas-thetar)/(1+(alpha0*psi)^n0)^(1-1/n0)))+
      0.4*(thetar+((thetas-thetar)/(1+(alpha1*psi)^n1)^(1-1/n1))),add = T,xname = "psi")



Gostaria de, ao invés de dar valores (0.6 e 0.4):

durner<-as.formula(theta~0.6*(thetar+((thetas-thetar)/(1+(alpha0*psi)^n0)^(1-1/n0)))+
                         0.4*(thetar+((thetas-thetar)/(1+(alpha1*psi)^n1)^(1-1/n1))))


adicionar dois parâmetros (w0 e w1):

durner<-as.formula(theta~w0*(thetar+((thetas-thetar)/(1+(alpha0*psi)^n0)^(1-1/n0)))+
                         w1*(thetar+((thetas-thetar)/(1+(alpha1*psi)^n1)^(1-1/n1))))

mas de tal forma que: w0+w1==1.

Alguém tem sabe como poderia fazer isso?


Att., Delcio Bortolanza

Doutorando em Agronomia-UPF
-------------- Próxima Parte ----------
Um anexo em HTML foi limpo...
URL: <http://listas.inf.ufpr.br/pipermail/r-br/attachments/20170808/631e1522/attachment.html>