Simulación Spline

Introducción

La simulación spline es una técnica no paramétrica utilizada para representar curvas en modelos no lineales, para estudiar el comportamiento de datos. En el siguiente caso se busca calibrar la función del modelo teniendo en cuenta el número de nodos, para ello se dispone de una base de datos definida como datos que cuenta con 200 filas y 2 columnas, también llamadas variables (x, y). En la variable x se determina por números aleatorios uniformes entre 0 y 8 ubicados de forma ascendente, por otro lado la variable y está definida una función f no lineal y un error determinado por números aleatorios uniformes.

Para trabajar con los datos se emplean las librerías tidyverse y spline.

library(tidyverse)

## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.4.0     ✔ purrr   1.0.1
## ✔ tibble  3.1.8     ✔ dplyr   1.1.0
## ✔ tidyr   1.3.0     ✔ stringr 1.5.0
## ✔ readr   2.1.4     ✔ forcats 1.0.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()

library(splines)

n <- 200
f <- function(x) 2 + 1.5*sin(x) + 0.07*x^2

x <- sort(runif(n, 0, 8))
error <- rnorm(n)
y <- f(x) + error
datos <- tibble(x = x, y = y)

La librería tidyverse es una colección de paquetes diseñados para la ciencia de datos, incluye paquetes populares como ggplot2 para visualización, dplyr para manipulación de datos, tidyr para limpieza de datos, entre otros. Por otra parte, la librería spline proporciona funciones para la creación y manipulación de splines.

Regresión Spline

Teniendo en cuenta los datos definidos en la primera sección, se declara dentro de la variable nod el número de nodos que se estudiaran para la determinar la flexibilidad por medio de la técnica de regresión spline. Posteriormente dentro de la variable nodos en primer lugar, se genera una secuencia de números entre 0 y 8 con una longitud de nod + 2, en este caso nod = 9 por lo que se obtienen 11 dígitos. En segundo lugar, se sustrae el primer y último elemento de la variable nodos ya que este método es débil en los extremos.

nod <- 9
nodos <- seq(0,8, length.out = nod+2)
nodos <- nodos[-c(1, length(nodos))]

Se define la intersección de cada nodo en la variable rspline, luego usando la función predict dentro de la variable rspred se infieren los datos obtenidos en la variable rspline

rspline <- lm(formula = y~bs(x,
                             knots = nodos,
                             degree = 3)) 

rspred <- predict(object = rspline)

Por medio de la función mutate de la librería dplyer se inserta una columna en la base de datos, antes definida en la variable datos, que contiene información sobre la predicciones realizadas en la variable rspred.

datos <- datos %>% mutate(y_pred = rspred)

Se emplea la técnica validación cruzada para evaluar el rendimiento del modelo y estimar cómo se desempeñará el modelo en datos nuevos y no vistos, por ello en la variable pg se definen los límites para la toma de datos y en la variable datos_s se cargan los cambios a la base de datos.

pg <- floor(n/5):floor(4*n/5)
datos_s <- datos[pg,]

A continuación, se presentan gráficos creados con la función ggplot para la regresión spline.

Gráficos

Se presentarán 4 gráficos que muestran el comportamiento del método simulación spline alterando el número de nodos, definido en la variable nod anteriormente. Se estudiará su comportamiento con 9, 11, 17 y 33 nodos, para evidenciar como influye en la flexibilidad del modelo. Cabe resaltar que este número de nodos fue a criterio del investigador.

Regresión Spline 9 nodos

datos <- tibble(x = x, y = y)

nod <- 9
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)
datos <- datos %>% mutate(y_pred = rspred)
pg <- floor(n/5):floor(4*n/5)
datos_s <- datos[pg,]

plot_1 <- ggplot(datos, aes(x = x, y = y)) + geom_point()
plot_1_2 <- plot_1 + geom_point(data = datos_s, mapping = aes(x = x, y = y),
                              colour = "blue")
plot1_3 <- plot_1_2 + geom_line(mapping = aes(x = x, y = y_pred), data = datos, colour = "green", linewidth = 1.25)
plot1_3 + geom_line(mapping = aes(x = x, y = y_pred), data = datos_s, colour = "red", linewidth = 1.5) + labs(title = "Cubic Spline", subtitle = "9 nodos")

Regresión Spline 11 nodos

datos1 <- tibble(x = x, y = y)

nod1 <- 11
nodos1 <- seq(0,8, length.out = nod1+2)
nodos1 <- nodos1[-c(1, length(nodos1))]


rspline1 <- lm(formula = y~bs(x,
                             knots = nodos1,
                             degree = 3)) 

rspred1 <- predict(object = rspline1)
datos1 <- datos1 %>% mutate(y_pred1 = rspred1)
pg <- floor(n/5):floor(4*n/5)
datos1_s <- datos1[pg,]

plot_2 <- ggplot(datos1, aes(x = x, y = y)) + geom_point()
plot_2_2 <- plot_2 + geom_point(data = datos1_s, mapping = aes(x = x, y = y),
                                colour = "blue")
plot2_3 <- plot_2_2 + geom_line(mapping = aes(x = x, y = y_pred1), data = datos1, colour = "green", linewidth = 1.25)
plot2_3 + geom_line(mapping = aes(x = x, y = y_pred1), data = datos1_s, colour = "red", linewidth = 1.5) + labs(title = "Cubic Spline", subtitle = "11 nodos")

Regresión Spline 17 nodos

datos2 <- tibble(x = x, y = y)

nod2 <- 17
nodos2 <- seq(0,8, length.out = nod2+2)
nodos2 <- nodos2[-c(1, length(nodos2))]


rspline2 <- lm(formula = y~bs(x,
                              knots = nodos2,
                              degree = 3)) 

rspred2 <- predict(object = rspline2)
datos2 <- datos2 %>% mutate(y_pred2 = rspred2)
pg <- floor(n/5):floor(4*n/5)
datos2_s <- datos2[pg,]

plot_3 <- ggplot(datos2, aes(x = x, y = y)) + geom_point()

plot_3_2 <- plot_3 + geom_point(data = datos2_s, mapping = aes(x = x, y = y),
                                colour = "blue")
plot3_3 <- plot_3_2 + geom_line(mapping = aes(x = x, y = y_pred2), data = datos2, colour = "green", linewidth = 1.25)
plot3_3 + geom_line(mapping = aes(x = x, y = y_pred2), data = datos2_s, colour = "red", linewidth = 1.5) + labs(title = "Cubic Spline", subtitle = "17 nodos")

Regresión Spline 33 nodos

datos3 <- tibble(x = x, y = y)

nod3 <- 33
nodos3 <- seq(0,8, length.out = nod3+2)
nodos3 <- nodos3[-c(1, length(nodos3))]


rspline3 <- lm(formula = y~bs(x,
                              knots = nodos3,
                              degree = 3)) 

rspred3 <- predict(object = rspline3)
datos3 <- datos3 %>% mutate(y_pred3 = rspred3)
pg <- floor(n/5):floor(4*n/5)
datos3_s <- datos3[pg,]

plot_4 <- ggplot(datos3, aes(x = x, y = y)) + geom_point()
plot_4_2 <- plot_4 + geom_point(data = datos3_s, mapping = aes(x = x, y = y),
                                colour = "blue")
plot4_3 <- plot_4_2 + geom_line(mapping = aes(x = x, y = y_pred3), data = datos3, colour = "green", linewidth = 1.5)
plot4_3 + geom_line(mapping = aes(x = x, y = y_pred3), data = datos3_s, colour = "red", linewidth = 1.5) + labs(title = "Cubic Spline", subtitle = "33 nodos")

Conclusión

De los graficos generados, se evidencia que a mayor número de nodos existe más flexibilidad en el modelo, por lo que aumenta la varianza y disminuye el sesgo. El gráfico que más se ajusta a los datos es el que presenta menor número de nodos. cabe resaltar que los modelos ajustan muy bien los datos de entrenamiento con los de prueba.