Почему nls () выдаёт мне ошибку «матрица сингулярного градиента при начальных оценках параметров»?

У меня есть некоторые основные данные о сокращении выбросов и стоимости автомобиля:

q24 <- read.table(text = "reductions  cost.per.car
    50  45
    55  55
    60  62
    65  70
    70  80
    75  90
    80  100
    85  200
    90  375
    95  600
    ",header = TRUE, sep = "")

Я знаю, что это экспоненциальная функция, поэтому я ожидаю, что смогу найти модель, которая соответствует:

    model <- nls(cost.per.car ~ a * exp(b * reductions) + c, 
         data = q24, 
         start = list(a=1, b=1, c=0))

но я получаю ошибку:

Error in nlsModel(formula, mf, start, wts) : 
  singular gradient matrix at initial parameter estimates

Я прочитал тонну вопросов об ошибке, которую я вижу, и я понимаю, что проблема, вероятно, в том, что мне нужны лучшие / другие startзначения (они initial parameter estimatesимеют немного больше смысла), но я не уверен, учитывая Данные, которые у меня есть, как я бы пошел об оценке лучших параметров.

Автоматический поиск хороших начальных значений для нелинейной модели - это искусство. (Для одноразовых наборов данных сравнительно легко, когда вы можете просто нанести на график данные и сделать хорошие предположения визуально.) Один из подходов состоит в том, чтобы линеаризовать модель и использовать оценки наименьших квадратов.

В этом случае модель имеет вид

для неизвестных параметров . Наличие экспоненты побуждает нас использовать логарифмы - но добавление c затрудняет это. Заметьте, однако, что если является положительным , то с будет меньше наименьшего ожидаемого значения Y --и , следовательно , может быть немного меньше , чем наименьшее наблюдаемым значением Y . (Если a может быть отрицательным, вам также необходимо учитывать значение c , которое немного больше наибольшего наблюдаемого значения Y ).$a,b,c$$c$$a$$c$$Y$$Y$$a$$c$$Y$

Тогда давайте позаботимся о , используя в качестве начальной оценки c 0 что-то вроде половины минимума наблюдений y i . Теперь модель можно переписать без этого сложного аддитивного термина, как$c$$c_0$$y_i$

Что мы можем взять журнал:

Это линейное приближение к модели. Оба и b могут быть оценены по методу наименьших квадратов.$\log(a)$$b$

Вот пересмотренный код:

c.0 <- min(q24$cost.per.car) * 0.5
model.0 <- lm(log(cost.per.car - c.0) ~ reductions, data=q24)
start <- list(a=exp(coef(model.0)[1]), b=coef(model.0)[2], c=c.0)
model <- nls(cost.per.car ~ a * exp(b * reductions) + c, data = q24, start = start)

Его вывод (для данных примера)

Nonlinear regression model
  model: cost.per.car ~ a * exp(b * reductions) + c
   data: q24
        a         b         c 
 0.003289  0.126805 48.487386 
 residual sum-of-squares: 2243

Number of iterations to convergence: 38 
Achieved convergence tolerance: 1.374e-06

Конвергенция выглядит хорошо. Давайте построим это:

plot(q24)
p <- coef(model)
curve(p["a"] * exp(p["b"] * x) + p["c"], lwd=2, col="Red", add=TRUE)

Это сработало хорошо!

При автоматизации этого процесса вы можете выполнить быстрый анализ остатков, например сравнить их крайние значения с разбросом данных ( ). Вам также может понадобиться аналогичный код, чтобы справиться с возможностью a < 0 ; Я оставляю это как упражнение.$y$$a\lt 0$

Другой метод оценки начальных значений основан на понимании их значения, которое может быть основано на опыте, физической теории и т. Д. В моем ответе описан расширенный пример (умеренно сложного) нелинейного соответствия, начальные значения которого можно определить таким образом. на /stats//a/15769 .

Визуальный анализ диаграммы рассеяния (для определения начальных оценок параметров) описан и проиллюстрирован по адресу /stats//a/32832 .

В некоторых случаях создается последовательность нелинейных подгонок, в которой можно ожидать, что решения будут меняться медленно. В этом случае часто удобно (и быстро) использовать предыдущие решения в качестве начальных оценок для следующих . Я помню, как использовал эту технику (без комментариев) на /stats//a/63169 .

Эта библиотека смогла решить мою проблему с помощью nls singular gradient: http://www.r-bloggers.com/a-better-nls/ Пример:

library(minpack.lm)
nlsLM(function, start=list(variable=2,variable2=12))

Итак ... Я думаю, что я неправильно прочитал это как экспоненциальную функцию. Все, что мне было нужно, былоpoly()

model <- lm(cost.per.car ~ poly(reductions, 3), data=q24)
new.data <- data.frame(reductions = c(91,92,93,94))
predict(model, new.data)

plot(q24)
lines(q24$reductions, predict(model, list(reductions = q24$reductions)))

Или, используя lattice:

xyplot(cost.per.car ~ reductions, data = q24,
       panel = function(x, y) {
         panel.xyplot(x, y)
         panel.lines(x, predict(model,list(reductions = x) ))
       }, 
       xlab = "Reductions", 
       ylab = "Cost per car")