¿Cómo minimizar la suma residual de cuadrados de un ajuste exponencial?


14

Tengo los siguientes datos y me gustaría ajustarle un modelo de crecimiento exponencial negativo:

Days <- c( 1,5,12,16,22,27,36,43)
Emissions <- c( 936.76, 1458.68, 1787.23, 1840.04, 1928.97, 1963.63, 1965.37, 1985.71)
plot(Days, Emissions)
fit <- nls(Emissions ~ a* (1-exp(-b*Days)), start = list(a = 2000, b = 0.55))
curve((y = 1882 * (1 - exp(-0.5108*x))), from = 0, to =45, add = T, col = "green", lwd = 4)

El código funciona y se traza una línea de ajuste. Sin embargo, el ajuste no es visualmente ideal, y la suma residual de cuadrados parece ser bastante grande (147073).

¿Cómo podemos mejorar nuestro ajuste? ¿Los datos permiten un mejor ajuste?

No pudimos encontrar una solución a este desafío en la red. Cualquier ayuda directa o enlace a otros sitios web / publicaciones es muy apreciada.


1
En este caso, si considera un modelo de regresión , donde ϵ iN ( 0 , σ ) , obtendrá estimadores similares. Al trazar las regiones de confianza, se puede observar cómo están contenidos estos valores en las regiones de confinancia. No puede esperar un ajuste perfecto a menos que interpole los puntos o use un modelo no lineal más flexible. Emissionsi=f(Daysi,a,b)+ϵiϵiN(0,σ)

Cambié el título porque "modelo exponencial negativo" significa algo diferente de lo descrito en la pregunta.
whuber

Gracias por aclarar la pregunta (@whuber) y gracias por su respuesta (@Procrastinator). ¿Cómo puedo calcular y trazar las regiones de confianza? Y, ¿cuál sería un modelo no lineal más flexible?
Strohmi

44
Necesitas un parámetro adicional. Mira lo que pasa con fit <- nls(Emissions ~ a* (1- u*exp(-b*Days)), start = list(a = 2000, b = 0.1, u=.5)); beta <- coefficients(fit); curve((y = beta["a"] * (1 - beta["u"] * exp(-beta["b"]*x))), add = T).
whuber

1
@whuber: ¿tal vez deberías publicar eso como respuesta?
jbowman

Respuestas:


16

Una ley exponencial (negativa) toma la forma . Sin embargo, cuando permite cambios de unidades en los valores x e y , digamos y = α y + β y x = γ x + δ , entonces la ley se expresará comoy=exp(x)xyy=αy+βX=γX+δ

αy+β=y=exp(x)=exp(γxδ),

que algebraicamente es equivalente a

y=1αexp(γxδ)β=a(1uexp(bx))

utilizando tres parámetros , u = 1 / ( β exp ( δ ) ) , y b = γ . Podemos reconocer a como un parámetro de escala para y , b como un parámetro de escala para x , y u como derivado de un parámetro de ubicación para x .a=β/αu=1/(βexp(δ))b=γaybxux

Como regla general, estos parámetros se pueden identificar de un vistazo desde la gráfica :

  • El parámetro es el valor de la asíntota horizontal, un poco menos de 2000 .a2000

  • El parámetro es la cantidad relativa que la curva sube desde el origen hasta su asíntota horizontal. Aquí, el aumento, por lo tanto, es un poco menor que 2000 - 937 ; relativamente, eso es aproximadamente 0,55 de la asíntota.u20009370.55

  • Debido a que , cuando x es igual a tres veces el valor de 1 / b, la curva debería haber aumentado a aproximadamente 1 - 0.05 o 95 % de su total. El 95 % del aumento de 937 a casi 2000 nos sitúa alrededor de 1950 ; El escaneo a través de la trama indica que esto tomó de 20 a 25 días. La llamada de Hagámosle 24 por simplicidad, de donde b 3 / 24exp(3)0.05x1/b10.0595%95%93720001950202524 . (Este 95 %b3/24=0.12595% método del para observar una escala exponencial es estándar en algunos campos que utilizan mucho las parcelas exponenciales).

Veamos cómo se ve esto:

plot(Days, Emissions)
curve((y = 2000 * (1 - 0.56 * exp(-0.125*x))), add = T)

Eyeball fit

¡No está mal para empezar! (Incluso a pesar de escribir 0.56en lugar de 0.55, lo cual fue una aproximación cruda de todos modos). Podemos pulirlo con nls:

fit <- nls(Emissions ~ a * (1- u * exp(-b*Days)), start=list(a=2000, b=1/8, u=0.55))
beta <- coefficients(fit)
plot(Days, Emissions)
curve((y = beta["a"] * (1 - beta["u"] * exp(-beta["b"]*x))), add = T, col="Green", lwd=2)

NLS fit

La salida de nlscontiene información extensa sobre la incertidumbre de los parámetros. Por ejemplo , un simple summaryproporciona errores estándar de estimaciones:

> summary(fit)

Parameters:
   Estimate Std. Error t value Pr(>|t|)    
a 1.969e+03  1.317e+01  149.51 2.54e-10 ***
b 1.603e-01  1.022e-02   15.69 1.91e-05 ***
u 6.091e-01  1.613e-02   37.75 2.46e-07 ***

Podemos leer y trabajar con toda la matriz de covarianza de las estimaciones, que es útil para estimar intervalos de confianza simultáneos (al menos para grandes conjuntos de datos):

> vcov(fit)
             a             b             u
a 173.38613624 -8.720531e-02 -2.602935e-02
b  -0.08720531  1.044004e-04  9.442374e-05
u  -0.02602935  9.442374e-05  2.603217e-04

nls admite gráficos de perfil para los parámetros, brindando información más detallada sobre su incertidumbre:

> plot(profile(fit))

a :

Profile plot

219451995


Ah, casi se me olvida: res <- residuals(fit); res %*% resnos dice que introduciendo el tercer parámetrotu reduce la suma de cuadrados a 2724 (comparado con 147073como se indica en la pregunta).
whuber

Todo bien y buen whuber. Pero tal vez el OP tenía alguna razón para elegir el modelo exponencial (o tal vez es solo porque es bien conocido). Creo que primero deben observarse los residuos para el modelo exponencial. Grafíquelos contra posibles covariables para ver si hay estructura allí y no solo ruido aleatorio grande. Antes de saltar a modelos más sofisticados, intente ver si un modelo más elegante podría ayudar.
Michael R. Chernick

3
¿Por qué no miras la trama original, Michael? Esto hará que sea obvio por qué se necesita al menos un parámetro adicional. Tenga en cuenta, también, que en un comentario a la pregunta que hizo el OP, "¿cuál sería un modelo no lineal más flexible?" Una implicación del análisis inicial ofrecido en esta respuesta es que debe considerarse fuera de lo común para ajustar un exponencial con menos de tres parámetros: debe haber alguna restricción inherente que funcione en tales casos (como una unidad de medida intrínsecamente determinada o una ubicación intrínseca paraX)
whuber

2
¡No estaba criticando tu respuesta! No vi ninguna parcela residual. Todo lo que sugería es que las gráficas de residuos frente a covariables potenciales deberían ser el primer paso para encontrar un mejor modelo. Si pensara que tengo una respuesta que presentar allí, habría dado una respuesta en lugar de plantear mi punto como una constante. Pensé que habías dado una gran respuesta y yo estuve entre los que te dieron un +1.
Michael R. Chernick
Al usar nuestro sitio, usted reconoce que ha leído y comprende nuestra Política de Cookies y Política de Privacidad.
Licensed under cc by-sa 3.0 with attribution required.