Se denomina Regression Spline cuando se dividen los datos en intervalos, fijando puntos de corte (nodos o knots) y en cada uno de esos intervalos se ajustan polinomios de orden d, incluyendo restricciones de forma que las derivadas sean continuas hasta el orden d-1.
Con un número de 200 datos, una función determinada f(x), con x números aleatorios entre 0 y 8 con distribución normal, y igual a la función más el error.
n<- 200
f<-function(x)2+1.5*sin(x)+0.07*x^2
x<-sort(runif(200,0,8))
error<-rnorm(n)
y<-f(x)+error
datos<-tibble(x=x,y=y)
En el siguiente trabajo se realiza el ajuste de un modelo de regresión mediante Regression Splines, teniendo en cuenta que el grado del polinomio, y en especial, el número de nodos, son los que determinan la flexibilidad del modelo. Para el ejercicio se emplea la función bs() del paquete splines seleccionado polinomio de grado 3, también conocido como splines cúbicos y nodos equiespaciados.
Se busca calibrar la cantidad de knots o nodos que mejor ajuste el modelo.
nod<-2
nodos<-seq(0,8,length.out=nod+2)
nodos<-nodos[-c(1,length(nodos))]
rspline<-lm(formula=y~bs(x,
knots=nodos,
degree=3))
rspred<-predict(object=rspline)
## # A tibble: 200 × 3
## x y predict
## <dbl> <dbl> <dbl>
## 1 0.00850 2.75 1.16
## 2 0.0808 2.20 1.43
## 3 0.101 0.267 1.50
## 4 0.111 0.665 1.54
## 5 0.147 0.363 1.66
## 6 0.165 1.35 1.72
## 7 0.300 2.86 2.14
## 8 0.363 3.42 2.31
## 9 0.374 2.45 2.34
## 10 0.517 4.38 2.69
## # ℹ 190 more rows
Los puntos de inflexión de la curva muestran dónde se encuentran los nodos. De acuerdo con el gráfico, se observan dos nodos.
datos_1 <- tibble(x=x,y=y)
nod_1 <- 5
nodos_1 <- seq(0,8,length.out=nod_1+2)
nodos_1 <- nodos_1[-c(1,length(nodos_1))]
rspline_1 <- lm(formula=y~bs(x,
knots=nodos_1,
degree=3))
rspred_1 <- predict(object=rspline_1)
## # A tibble: 200 × 3
## x y predict_1
## <dbl> <dbl> <dbl>
## 1 0.00850 2.75 1.26
## 2 0.0808 2.20 1.54
## 3 0.101 0.267 1.61
## 4 0.111 0.665 1.64
## 5 0.147 0.363 1.77
## 6 0.165 1.35 1.83
## 7 0.300 2.86 2.22
## 8 0.363 3.42 2.38
## 9 0.374 2.45 2.40
## 10 0.517 4.38 2.70
## # ℹ 190 more rows
De igual manera, del gráfico anterior se observan en total 5 nodos.
datos_2 <- tibble(x=x,y=y)
nod_2 <- 10
nodos_2 <- seq(0,8,length.out=nod_2+2)
nodos_2 <- nodos_2[-c(1,length(nodos_2))]
rspline_2 <- lm(formula=y~bs(x,
knots=nodos_2,
degree=3))
rspred_2 <- predict(object=rspline_2)
## # A tibble: 200 × 3
## x y predict_2
## <dbl> <dbl> <dbl>
## 1 0.00850 2.75 1.15
## 2 0.0808 2.20 1.47
## 3 0.101 0.267 1.56
## 4 0.111 0.665 1.60
## 5 0.147 0.363 1.75
## 6 0.165 1.35 1.82
## 7 0.300 2.86 2.29
## 8 0.363 3.42 2.48
## 9 0.374 2.45 2.51
## 10 0.517 4.38 2.84
## # ℹ 190 more rows
datos_3 <- tibble(x=x,y=y)
nod_3 <- 15
nodos_3 <- seq(0,8,length.out=nod_3+2)
nodos_3 <- nodos_3[-c(1,length(nodos_3))]
rspline_3 <- lm(formula=y~bs(x,
knots=nodos_3,
degree=3))
rspred_3 <- predict(object=rspline_3)
## # A tibble: 200 × 3
## x y predict_3
## <dbl> <dbl> <dbl>
## 1 0.00850 2.75 1.85
## 2 0.0808 2.20 1.48
## 3 0.101 0.267 1.44
## 4 0.111 0.665 1.43
## 5 0.147 0.363 1.43
## 6 0.165 1.35 1.45
## 7 0.300 2.86 1.97
## 8 0.363 3.42 2.34
## 9 0.374 2.45 2.40
## 10 0.517 4.38 3.11
## # ℹ 190 more rows
Mediante observación, se determina que la cantidad de nodos para el mejor ajute del modelo, son 10 nodos, puesto que con 2 y 5 nodos son poco flexibles, mientras que con 15 nodos presenta mucha variabilidad.
[Referencias: Casal, R., Bouzas, J. & Oviedo, M. (2021). Aprendizaje Estadístico. Obtenido de: https://rubenfcasal.github.io/aprendizaje_estadistico]