具有五个参数的非线性模型（w / nls R）

Question

这是我的第一个问题，如果我做错了任何事情，请告诉我。我们有一个包含两个变量的df，并希望将EPR（蛋的生产率）建模为温度的函数。

与nls页面相关的软件包：

install.packages("tidyverse")
install.packages("nls.multstart")
install.packages("nlstools")
library(tidyverse)
library(nls.multstart) 
library(nlstools)

来自较大df的相关变量：

temp=c(9.2,9.9,12.7,12.8,14.3,14.5,16.3,16.5,18,18,19.6,19.6,19.9,19.9,22,22.4,23.2,23.4,25.3,25.6,27,27.3,28.5,30.3,20.9)
EPR=c(1.5,0,0,0,1.27,0.56,3.08,0.575,2.7,3.09,2,6.3,2,3.76,3.7,1.65,7.1,18.9,7.07,3.77,13.79,0,0,0.47,0)
df<-data.frame(temp,EPR)

在这里，我用五个要估计的参数（k1，a，b，k2，c）编写公式，temp将是x值。到目前为止一切顺利。

formula<-function(k1,a,b,k2,c,temp) {
 modelEPR<-k1*1/(1+exp(-a*(temp-b)))-k2*exp(c*temp)
 return(modelEPR)
}

这就是我被困住的地方；我已经在使用相当狭窄的start_lower和upper，因为现在通过成功使用excel求解器知道参数了。通过这种方法获得的值将为我提供一个模型，尽管这是一个不准确的模型。是的，我在开始时给起点和终点的范围要大得多，但这并没有带来更好的结果。

fit <- nls_multstart(EPR ~ formula(k1,a,b,k2,c,temp),
                 data = df,
                 iter = 100,
                 start_lower = c(k1 = 14, a = 0.3, b = 20, k2 = 0.02, c = 0.15),
                 start_upper = c(k1 = 15, a = 0.5, b = 21, k2 = 0.08, c = 0.24),
                 supp_errors = 'Y',
                 na.action = na.omit)

fit

如前所述，我使用excel解算器成功制作了模型，并获得了参数估计值，然后尝试将其手动插入R中，从而获得了更好的模型。

model<-df %>%
 mutate(pred=(14.69/(1+exp(-0.41*(temp-20.52)))-0.05*exp(0.19 *temp))) %>% 
 ggplot()+
 xlab("Temperature (°C)")+
 ylab("EPR (Eggs per female per day")+
 geom_point(aes(temp,EPR))+
 geom_line(aes(temp,pred),col="red")

model

最终，我有两个问题；   a）我做错了什么？还是仅仅是数据很奇怪？似乎可以与excel更好地协作？   b）如何编写拟合和模型之间的桥梁？ fit将产生5个参数，但是如何将它们直接插入到模型函数中？我可以在这里以某种方式利用变异吗？

不胜感激！

Answer 1

A。起始值和拟合模型

要获取初始值：

1. 如果为k1 = 0，则可以按以下方式重新排列公式，然后将拟合线性模型的结果用作c的起始值。

   log(EPR) ~ log(k2) + c * temp
   

2. b是temp的移位，而a是缩放比例，因此选择b = mean(temp)和a = 1/sd(temp)

3. 我们可以使用algorithm = "plinear"来避免为线性参数（即k1和k2）指定起始值。使用plinear时，公式的右侧应为矩阵，使得k1乘以第一列，再加上k2乘以第二列，得出预测的EPR。

这给出了以下内容。请注意，k1输出中的k2和.lin1将由.lin2和nls表示。

fm1 <- lm(log(EPR) ~ temp, df, subset = EPR > 0)
st2 <- list(c = coef(fm1)[[2]], a = 1/sd(df$temp), b = mean(df$temp))
fo2 <- EPR ~ cbind(1/(1+exp(-a*(temp-b))), -exp(c*temp))
fm2 <- nls(fo2, df, start = st2, algorithm = "plinear", 
  control = list(maxiter = 200))
deviance(fm2) # residual sum of squares
## [1] 333.6

请注意，这表示比问题中所示的拟合值低（更好）的残差平方和：

sum((df$EPR - pred)^2) # residual sum of squares for fit shown in question
## [1] 339.7

未使用任何软件包。

我们可以绘制两个拟合，其中问题的拟合为蓝色，而此处的拟合为红色。从图中可以看出一个疑问，两个大EFR值是否离群，是否应该排除它们。

plot(EPR ~ temp, df)
lines(fitted(fm2) ~ temp, df, subset = order(temp), col = "red")
lines(pred ~ temp, df, subset = order(temp), col = "blue")

[截屏后继续]

B。给定参数的模型评估

对于用公式表示法表示的给定模型，我们可以使用nls2包在给定参数下对其进行评估。 nls2的参数与nls相似，但是如果起始值是一行数据帧且算法为"brute"，则它仅返回起始处求值的右侧值价值观。有关更多信息，请参见?nls。

library(nls2)

fo <- EPR ~ k1*1/(1+exp(-a*(temp-b)))-k2*exp(c*temp)
st <- list(k1 = 14.69, a = 0.41, b = 20.52, k2 = 0.05, c = 0.19)
fm <- nls2(fo, df, start = data.frame(st), algorithm = "brute")

deviance(fm)
## [1] 339.7

fitted(fm) # predictions at parameter values given in st

或就功能而言：

rhs <- function(a, b, c, k1, k2, temp) k1*1/(1+exp(-a*(temp-b)))-k2*exp(c*temp)
p <- do.call("rhs", c(st, list(temp = df$temp)))
all.equal(p, pred)
## [1] TRUE