Question

一个学生注意到，使用相同的数据和等效的方程，nls.lm始终给出不同的结果。

我能找到的最接近的问题的方程式中确实有一个错误，所以我将在下面的代码中显示这些方程式是等效的。（Q：[Differences in ^ and exp() notation in nls models][1]）

我们希望得到相同结果的两个方程是：

D0 * pars $ A * exp（-pars $ mu1 * tt）+ D0 * pars $ B * exp（-pars $ mu2 * tt）
D0 *（pars $ A * exp（-pars $ mu1 * tt）+ pars $ B * exp（-pars $ mu2 * tt））

我怀疑这可能是找到不同的局部最小值的结果，因此我对公式1和2（Fit1和Fit2）重复了10次优化。如果这只是局部最小值的差异，我会期望不一致的最佳参数。但是，当我运行下面的代码时，每次迭代都获得了两组相同的最佳参数。

这似乎是一个问题，因为方程的编写方式直接影响残差平方和的大小。有谁知道为什么使用nls.lm来优化这两个方程的结果始终不同？

library(reshape)
library(ggplot2)
library(minpack.lm)

mydata <- data.frame("Time.hrs" = c(0,4,8,12,24,48),
                        "values" = c(5.27, 4.60, 4.15, 3.85, 3.40, 3.15))

optimizer_function <- function(Fit_function) {
  # define inputs to nls.lm
  costFun <- function(pars, observed, tt, D0) observed - Fit_function(pars, tt, D0)
  pars0 <- list(A = 1, B = 0.1, mu1 = 0.1, mu2 = 0.1 )
  lb <- c(0.01, 0.00001, 0.01, 0.0001)
  ub <- c(3, 1, 1, 0.15)  
  #optimize
  nls <- nls.lm(par = pars0, lower = lb, upper = ub, fn=costFun,
                    D0 =  mydata$values[1], observed = mydata$values, tt = mydata$Time.hrs,
                 control = nls.lm.control(ftol = 1e-20, ptol = 1e-15))

  return(nls)}

Fit1 <- function(pars, tt, D0) D0 * pars$A * exp(-pars$mu1 * tt) + D0 * pars$B * exp(-pars$mu2 * tt)
Fit2 <- function(pars, tt, D0) D0 * (pars$A * exp(-pars$mu1 * tt) + pars$B * exp(-pars$mu2 * tt))
nls1 <- optimizer_function(Fit1)
nls2 <- optimizer_function(Fit2)

nls1
nls2


results1 <- NULL
results2 <- NULL

## Optimization
for (n in c(1:100)) {
  ## Solve
  nls1 <- optimizer_function(Fit1)
  nls2 <- optimizer_function(Fit2)
  results1 <- as.data.frame(rbind(results1, nls1$par))
  results2 <- as.data.frame(rbind(results2, nls2$par))
}
results1
results2

为了确保拟合方程实际上相等，我用每个方程（Fit1和Fit2）模拟了每组最佳参数。 debug_plot显示，针对任意一组最佳参数评估Fit1和Fit2可获得等效的结果。

resultslist <- list("ParamsfromFit1" = nls1$par, "ParamsfromFit2" = nls2$par)
fitslist <- list("Fit1" = Fit1, "Fit2" = Fit2)

simulation_function <- function(parameters, raw_data, this_fit) {
  t_data <- seq(from = 0, to = 50, by = 0.1)
  Dinitial <- raw_data$value[1]
  y_data <- as.numeric(this_fit(pars = parameters, tt = t_data, D0 = Dinitial))
  this_ydata <- cbind.data.frame(t_data, y_data)
  return(this_ydata)}

sim_long <- data.frame()
for (res in c(1:length(resultslist))) {
  this_parameters <- resultslist[res][[1]]
  for (fit in c(1:length(fitslist))) {
    this_fit <- fitslist[fit][[1]]
    this_data <- simulation_function(this_parameters, mydata, this_fit)
    sim_long <- rbind.data.frame(sim_long,
                                 cbind.data.frame(rep(names(resultslist)[res],nrow(this_data)),
                                                  rep(names(fitslist)[fit],nrow(this_data)),
                                                  this_data))
  }
}

names(sim_long) <- c("Parameters", "Fit", "t_data", "y_data")

debug_plot <- ggplot() +
  geom_line(data = sim_long, aes(x = t_data, y = y_data, color = Parameters, linetype = Fit)) + 
  facet_wrap(~Fit) +
  theme_bw() + #removes default gray plot background
  scale_x_continuous(expand = c(0,0)) + #removes default space between plot and axis
  scale_y_continuous(expand = c(0,0)) 

debug_plot

为什么nls.lm对于等效方程式给出的结果不一致？

0 个答案: