Чому 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 a c Y Y a c $a,b,c$$c$$a$$c$$Y$$Y$$a$$c$$Y$

Тоді давайте подбаємо про , використовуючи в якості початкової оцінки щось на зразок половини мінімуму спостережень . Модель тепер може бути переписана без тернистого додаткового терміна якc 0 y $c$$c_0$$y_i$

Що ми можемо взяти журнал:

Це лінійне наближення до моделі. І і можна оцінити з найменшими квадратами.$\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)

Це спрацювало добре!

$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")