Perché nls () mi dà errori di "matrice gradiente singolare alle stime iniziali dei parametri"?

Ho alcuni dati di base sulla riduzione delle emissioni e sul costo per auto:

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

So che questa è una funzione esponenziale, quindi mi aspetto di riuscire a trovare un modello adatto a:

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

ma sto ricevendo un errore:

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

Ho letto un sacco di domande sull'errore che sto vedendo e sto raccogliendo che il problema è probabilmente che ho bisogno di startvalori migliori / diversi (il che initial parameter estimatesha un po 'più senso) ma non sono sicuro, dato il dati che ho, come farei per stimare parametri migliori.

Trovare automaticamente buoni valori iniziali per un modello non lineare è un'arte. (È relativamente facile per i set di dati una tantum quando è possibile tracciare semplicemente i dati e fare alcune ipotesi visivamente.) Un approccio è quello di linearizzare il modello e utilizzare le stime dei minimi quadrati.

In questo caso, il modello ha la forma

per parametri sconosciuti . La presenza dell'esponenziale ci incoraggia a usare i logaritmi - ma l'aggiunta di c rende difficile farlo. Si noti, tuttavia, che se un è positivo allora c sarà inferiore al minimo valore atteso di Y --e quindi potrebbe essere un po 'inferiore al minimo osservata valore di Y . (Se a potrebbe essere negativo, dovrai anche considerare un valore di c che è un po 'più grande del più grande valore osservato di Y. )$a,b,c$$c$$a$$c$$Y$$Y$$a$$c$$Y$

Prendiamoci quindi cura di usando come stima iniziale c 0 qualcosa come metà del minimo delle osservazioni y i . Il modello può ora essere riscritto senza quel termine additivo spinoso come$c$$c_0$$y_i$

Che possiamo prendere il registro di:

$\log(a)$$b$

Ecco il codice rivisto:

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)

Il suo output (per i dati di esempio) è

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

La convergenza sembra buona. Tracciamolo:

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

Ha funzionato bene!

$y$$a\lt 0$

Un altro metodo per stimare i valori iniziali si basa sulla comprensione del loro significato, che può essere basato sull'esperienza, sulla teoria fisica, ecc. Un esempio esteso di adattamento non lineare (moderatamente difficile) i cui valori iniziali possono essere determinati in questo modo è descritto nella mia risposta all'indirizzo /stats//a/15769 .

L'analisi visiva di un diagramma a dispersione (per determinare le stime dei parametri iniziali) è descritta e illustrata su /stats//a/32832 .

In alcune circostanze, viene eseguita una sequenza di accoppiamenti non lineari in cui è possibile aspettarsi che le soluzioni cambino lentamente. In tal caso è spesso conveniente (e veloce) utilizzare le soluzioni precedenti come stime iniziali per quelle successive . Ricordo di aver usato questa tecnica (senza commento) su /stats//a/63169 .

Questa libreria è stata in grado di risolvere il mio problema con nls singular gradient: http://www.r-bloggers.com/a-better-nls/ Un esempio:

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

Quindi ... penso di aver letto male questa come una funzione esponenziale. Tutto ciò di cui avevo bisogno erapoly()

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

Oppure, usando 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")