Regresión por polinomios locales.

En el paquete KernSmooth existen variedad de funciones para estimar modelos de regresión no paramétricos utilizando polinomios locales, así que me parece interesante exponer el uso de la función locpoly usando como ejemplo un ejercicio propuesto en una clase de modelización no paramétrica. El ejercicio fue tomado de los apuntes de la clase Modelos No Paramétricos del Máster en Estadística e Investigación Operativa impartido en la Universidad Politécnica de Cataluña.

Las instrucciones del ejercicio son las siguientes:
Haz la regresión de lgSpeed frente a Yr usando locpoly. Utiliza distintos valores de los parámetros bandwith, degree (grado del polinomio local ajustado) y drv (derivada estimada).

¿En qué años se produjo un aumento más rápido en la velocidad de los aviones fabricados? (Si no lo ves claro, prueba con bandwith = 7, degree = 1, drv = 1, o con bandwith = 10, degree = 2, drv = 1).

Para contestar la pregunta planteada se tiene que calcular la primera derivada de los polinomios locales y dibujarla para ver el comportamiento de las curvas y así determinar los periodos de mayor crecimiento.

La solución en R es:

# install.packages(c('KernSmooth', 'sm'))
library(KernSmooth)
library(sm)

Para obtener la despción de los datos sólo hace falta hacer lo siguiente:

provide.data(aircraft)

## Data file being loaded

head(aircraft)  # asi lucen los datos

##   Yr Period Power Span Length Weight Speed Range
## 1 14      1  82.0 12.8   7.60   1070   105   400
## 2 14      1  82.0 11.0   9.00    830   145   402
## 3 14      1 223.6 17.9  10.35   2200   135   500
## 4 15      1 164.0 14.5   9.80   1946   138   500
## 5 15      1 119.0 12.9   7.90   1190   140   400
## 6 15      1  74.5  7.5   6.30    653   177   350

Un poco de estimación….

lgSpeed <- log(Speed)
fit1 <- locpoly(Yr, lgSpeed, degree = 1, bandwidth = 7, drv = 1)
fit2 <- locpoly(Yr, lgSpeed, degree = 2, bandwidth = 10, drv = 1)

Graficando

plot(fit1, col=3, lwd=2, 
     type="l",  bty="l",
     main="Derivadas de orden 1 \n de los polinomios locales estimados",

     font.main=1, las=1,
     xlab="Year", xaxs="i",
     ylab="Derivadas de los polinomios locales estimados")

lines(fit2, col=6, lwd=2)

legend("topright", c("grado=1, bandwidth=7", "grado=2, bandwidth=10"),
       col=c(3,6), lty=1, fill= c(3,6), border= c(3,6),
       bty="n", cex=.9)

text(30, 0.023, "Periodo de mayor \n crecimiento en la \n velocidad de \n los aviones", cex=.95)

El primer polinomio sitúa el máximo nivel en incremento de velocidad de los aviones en el año 1934 mientras que el segundo polinomio lo sitúa en el año 1933, véase Figura. En términos de la variable Period esto corresponde al período 1.

1900 + floor(fit1$x[which.max(fit1$y)])  # año de mayor crecimiento según el primer polinomio

## [1] 1934

1900 + floor(fit2$x[which.max(fit2$y)])  # año de mayor crecimiento según el segundo polinomio

## [1] 1933