2014-10-31 19 views
3

对于这个数据集:

dat = structure(list(x = c(5L, 5L, 5L, 5L, 10L, 10L, 10L, 10L, 15L, 
15L, 15L, 15L, 17L, 17L, 17L, 17L, 20L, 20L, 20L, 20L, 20L, 20L, 
20L, 20L, 22L, 22L, 22L, 22L, 24L, 24L, 24L, 24L, 25L, 25L, 25L, 
25L, 27L, 27L, 27L, 27L, 30L, 30L, 30L, 30L, 35L, 35L, 35L, 35L), 
y = c(2.2, 2.2, 1.95, 1.9, 4.1, 3.95, 3.75, 3.4, 5.15, 4.6, 
4.75, 5.15, 3.7, 4.1, 3.9, 3.5, 7, 6.7, 6.7, 6.95, 4.95, 6, 6.45, 
6.4, 7, 4.45, 6.15, 6.4, 7, 6.6, 6.7, 7, 4.5, 4.7, 5.75, 4.35, 
5.4, 5.15, 5.7, 5.7, 0, 0, 0.5, 0, 0, 0, 0, 0)), .Names = c("x", "y"), 
row.names = c(6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 
15L, 16L, 17L, 34L, 35L, 36L, 37L, 18L, 19L, 20L, 21L, 38L, 39L, 
40L, 41L, 42L, 43L, 44L, 45L, 46L, 47L, 48L, 49L, 22L, 23L, 24L, 
25L, 50L, 51L, 52L, 53L, 26L, 27L, 28L, 29L, 30L, 31L, 32L, 33L), 
class = "data.frame") 

其中 “x” 是温度和 “y” 是一个生物过程NLS - 会聚误差

我想要的响应变量适合这种功能

beta.reg<-function(x, Yopt,Tmin,Topt,Tmax, b1) { 
Yopt*((x-Tmin)/(Topt-Tmin))^(b1*(Topt-Tmin)/(Tmax-Topt))*((Tmax-x)/(Tmax-Topt))^b1 
} 

mod <- nls(y ~ beta.reg(x, Yopt,Tmin,Topt,Tmax, b1), data=dat, 
     start=c(Yopt=6, Tmin=0.1, Topt=24, Tmax=30, b1=1), 
     control=nls.control(maxiter=800)) 

不过,我在此消息的错误:

Error en numericDeriv(form[[3L]], names(ind), env) : Missing value or an infinity produced when evaluating the model

我试过同样的功能与其他类似的数据集,并正确地配合......

rnorm<-(10) 
y <- c(20,60,70,49,10) 
rnorm<-(10) 
y <- c(20,60,70,49,10) 
dat<-data.frame(x = rep(c(15,20,25,30,35), times=5), 
       rep = as.factor(rep(1:5, each=5)), 
       y = c(y+rnorm(5), y+rnorm(5),y+rnorm(5),y+rnorm(5),y+rnorm(5))) 

有人能帮助我吗?

会议信息:

R version 3.1.1 (2014-07-10) 
Platform: x86_64-pc-linux-gnu (64-bit) 

attached base packages: 
[1] stats  graphics grDevices utils  datasets methods base  

other attached packages: 
[1] nlme_3.1-118  latticeExtra_0.6-26 RColorBrewer_1.0-5 lattice_0.20-29  

loaded via a namespace (and not attached): 
[1] grid_3.1.1 tools_3.1.1 
+0

这是在R吗?如果是这样,那么你应该添加[tag:R]标签。 – 2014-11-01 00:35:29

回答

4

这里有这么多的问题,我怀疑它能够充分地在SO后覆盖,但这应该让你开始。

首先,它看起来像你想Tmax < max(dat$x),例如,< 35.这会导致一个问题,因为那么Tmax - x < 0x一些值,当你试着去养一个负数的功率(在公式的第二项),你会得到NA的。这是错误信息的原因。

其次,非线性模型的收敛依赖于模型公式,也是数据,从而使过程与一组数据的收敛而不是另一个是完全不相关的事实。

第三,非线性建模平方残差之和最小化迭代作为参数的函数。如果RSS表面有本地最小值,并且您的start接近1,则算法会找到它。但只有全球最低是真正的解决方案。你的问题有很多很多局部最小值。

四,nls(...)默认使用高斯牛顿方法。高斯牛顿以移位参数(参数被添加到预测变量或从预测变量中减去而出名)是不稳定的,因此在你的情况下为TminTmax。幸运的是,minpak.lm包实现了Levenberg Marquardt方法,该方法在这些条件下更加稳定。该包中的nlsLM(...)函数使用与nls(...)相同的调用顺序,并返回nls类型的对象,因此该类对象的所有方法也可以正常工作。使用它。

第五,在非线性回归一个基本的假设(事实上所有最小二乘回归)是残差是正态分布的。所以你必须使用Q-Q图验证任何解决方案。

第六,你的模型有一个反常的特征。当Tmin -> -Inf模型中的第一项接近1。事实证明,这会产生比任何其他小于min(dat$x)的值更低的RSS,因此算法都倾向于将Tmin驱动为较大的负值。你可以很容易地看到如下:

library(minpack.lm) 
mod <- nlsLM(y ~ beta.reg(x, Yopt,Tmin,Topt,Tmax, b1), data=dat, 
      start=c(Yopt=6,Tmin=0,Topt=24,Tmax=50, b1=1), 
      control=nls.lm.control(maxiter=1024,maxfev=1024)) 
coef(summary(mod)) 
#   Estimate Std. Error  t value  Pr(>|t|) 
# Yopt 6.347019 0.2919686 21.73870235 8.055342e-25 
# Tmin -155.530098 2204.0011003 -0.07056716 9.440694e-01 
# Topt 21.157545 0.6702713 31.56564484 2.240134e-31 
# Tmax 35.000000 11.4838614 3.04775537 3.933164e-03 
# b1  3.321326 9.1844548 0.36162468 7.194035e-01 
sum(residuals(mod)^2) 
# [1] 50.24696 

par(mfrow=c(1,2)) 
plot(y~x,dat) 
with(as.list(coef(mod)),curve(beta.reg(x, Yopt,Tmin,Topt,Tmax, b1),add=TRUE)) 
qqnorm(residuals(mod)) 

这看起来像一个相当不错的配合但它不是:在QQ图表明残差不正常的远程。 Tminb1的估计值很差,而Tmin的值在物理上没有意义,这是数据问题,而不是合适的。

第七,事实证明,上面的适合实际上是一个本地最低。我们可以通过在Tmin,Tmaxb1(省略YoptTopt以节省时间,并且因为这些参数很好地估计而不考虑起点)来进行网格搜索来看到这一点。

init <- c(Yopt=6, Topt=24) 
grid <- expand.grid(Tmin= seq(0,4,len=100), 
        Tmax= seq(35,100,len=10), 
        b1 = seq(1,10,len=10)) 
mod.lst <- apply(grid,1,function(gr){ 
    nlsLM(y ~ beta.reg(x, Yopt,Tmin,Topt,Tmax, b1), data=dat, 
     start=c(init,gr),control=nls.control(maxiter=800)) }) 
rss <- sapply(mod.lst,function(m)sum(residuals(m)^2)) 
mod <- mod.lst[[which.min(rss)]] # fit with lowest RSS 
coef(summary(mod)) 
#  Estimate Std. Error  t value  Pr(>|t|) 
# Yopt 6.389238 0.2534551 25.208557840 2.177168e-27 
# Topt 22.636505 0.5605621 40.381798589 7.918438e-36 
# Tmin 35.000002 104.6221159 0.334537316 7.396005e-01 
# Tmax 36.234602 133.4987344 0.271422809 7.873647e-01 
# b1 -41.512912 7552.0298633 -0.005496921 9.956395e-01 
sum(residuals(mod)^2) 
# [1] 34.24019 

plot(y~x,dat) 
with(as.list(coef(mod)),curve(beta.reg(x, Yopt,Tmin,Topt,Tmax, b1),add=TRUE)) 
qqnorm(residuals(mod)) 

数学上,这是一个明显优于契合:RSS较低,残差更接近正态分布。同样,参数估计不准确且物理意义不大的事实是数据(也可能是模型公式)的问题,而不是拟合过程。

以上所有情况都表明您的模型存在问题。在数学上,它的一个问题是该函数在(Tmin,Tmax)之外的x未定义。由于数据输出为x=35,所以拟合算法决不会产生Tmax < 35(如果它收敛)。处理这个问题的方法会稍微改变你的模型函数,在该范围之外将其剪切为0。 (我不知道这是否合法,基于你的问题的物理性质,尽管...)。

beta.reg<-function(x, Yopt,Tmin,Topt,Tmax, b1) { 
    ifelse(x>Tmax,0, 
    ifelse(x<Tmin,0, 
     Yopt*((x-Tmin)/(Topt-Tmin))^(b1*(Topt-Tmin)/(Tmax-Topt))*((Tmax-x)/(Tmax-Topt))^b1 
)) 
} 

运行上述具有这种功能的产率的代码:

coef(summary(mod)) 
#   Estimate Std. Error  t value  Pr(>|t|) 
# Yopt 6.1470413 0.21976766 27.970636 3.202940e-29 
# Tmin -52.8172658 184.16899439 -0.286787 7.756528e-01 
# Topt 23.0777898 0.63750721 36.200045 7.638121e-34 
# Tmax 30.0039413 0.02529877 1185.984187 1.038918e-98 
# b1  0.5966129 0.32439982 1.839128 7.280793e-02 

sum(residuals(mod)^2) 
# [1] 28.10144 

par(mfrow=c(1,2)) 
plot(y~x,dat) 
with(as.list(coef(mod)),curve(beta.reg(x, Yopt,Tmin,Topt,Tmax, b1),add=TRUE)) 
qqnorm(residuals(mod)) 
qqline(residuals(mod)) 

事实上网格搜索产率完全相同的结果独立起点。请注意,RSS低于早期模型的任何结果,并且b1估计得更好(并且非常有效,与使用较早模型函数的估计不同)。残差仍然不正常,但在这种情况下,我想检查数据中的异常值。

+0

很棒@jlhoward!我也认为数据集有许多问题,但它是生物学......我会考虑你的答复的每一点:第一 - 显然,如果我测试温度> 30°C将有大约0的反应。我想过排除35°C点,具有'Tmax Juanchi 2014-11-03 18:57:56

+0

您的上一个模型似乎具有最好的生物学意义,而不考虑'Tmin'。我认为,用这个模型和数据集来估计'Tmin'是很困难的。你认为用x的一个子集 Juanchi 2014-11-03 19:08:32

+0

在我这样做之前,我会看看'x〜17'的数据。这些重复有些奇怪:很难解释为什么你的回答与'x〜10'相同,再加上这些点解释了残差中大多数正常偏差。你可以考虑排除这些重复和重新安装。 – jlhoward 2014-11-03 19:41:28

1

向@jlhoward的另一个可能的解决方案添加...

我发现这个nls2包:

library("nls2") 

从原始数据集Exludying x~17,35

newdat <- subset(dat, x!=17 & x!=35) 

应用功能,以减少数据集:

beta.reg<-with(newdat, 
      y ~ Yopt*((x-Tmin)/(Topt-Tmin))^(b1*(Topt-Tmin)/(Tmax-Topt))*((Tmax-x)/Tmax-Topt))^b1 
      ) 

创建一套首发:

st1 <- expand.grid(Yopt = seq(4, 8, len = 4), 
        Tmin = seq(0, 4, len = 4), 
        Topt = seq(15, 25, len = 4), 
        Tmax= seq(28, 38, len = 4), 
        b1 = seq(0, 4, len = 4)) 

拟合模型:

mod <- nls2(beta.reg, start = st1, algorithm = "brute-force") 

提取系数:

round(coef(summary(mod)),3) 

#  Estimate Std. Error t value Pr(>|t|) 
# Yopt 6.667  0.394 16.925 0.000 
# Tmin 0.000  12.023 0.000 1.000 
# Topt 21.667  0.746 29.032 0.000 
# Tmax 31.333  1.924 16.289 0.000 
# b1  1.333  1.010 1.320 0.197 

诊断:

sum(residuals(mod)^2) 

# [1] 50.18246 

最后,调整后的功能和QQ正常的情节:

par(mfrow=c(1,2)) 
with(newdat,plot(y~x,xlim=c(0,35))) 
points(fitted(mod)~I(newdat$x), pch=19) 
with(as.list(coef(mod)), 
curve(
    Yopt*((x-Tmin)/(Topt-Tmin))^(b1*(Topt-Tmin)/(Tmax-Topt))*((Tmax-x)/(Tmax-Topt))^b1, 
    add=TRUE, col="red")) 

qqnorm(residuals(mod)) 
qqline(residuals(mod)) 

+0

对于记录,'nls2(...)'(正如您使用的那样)不会最小化RSS,它将在每个4^5 = 1024个网格点计算RSS并报告具有最低RSS的点。这就是为什么你得到'Tmin = 0'; 'Tmin'值越低,RSS值越低,但这是网格中最低的值。 – jlhoward 2014-11-04 16:30:45

+0

这是真的。通过这种方式,我试图将“Tmin”的估计限制在某种生物学意义上,牺牲了RSS。这是否与您上一个型号的限制相同? 'beta.reg <-function(x,Yopt,Tmin,Topt,Tmax,b1)ifelse(x> Tmax,0, ifelse(x Juanchi 2014-11-04 17:28:20

+0

不。上面的模型仅限制函数在'x'超出'(Tmin,Tmax)'范围时返回0。它根本不会限制'Tmin'或'Tmax'。你所做的是给定所选参数空间,找到最小RSS(或多或少,这是一个非常粗糙的网格)。这在RSS意义上是“最合适的”,但是当你这样做时,你应该知道fit的统计数据(参数的se值等)是完全没有意义的。 – jlhoward 2014-11-04 20:44:57