Estimación Condicional con Redes Neuronales en R

# Red neuronal vs regresión lineal. ¿Cuál es el mejor estimador? ----------


# Paquetes ----------------------------------------------------------------

library("nnet")

# Regresión lineal --------------------------------------------------------


iteraciones <- 100
tamano_muestral <- 30
beta_0 <- 1
beta_1 <- -0.3


x <- seq(-3, 3, length.out = tamano_muestral)

genera_y <- function(x, beta_0, beta_1){
  beta_1*x + beta_0 + rnorm(length(x), 0, 0.5)
}

y <- genera_y(x, beta_0, beta_1)

modelo_lineal <- lm(y~x)

plot(x, y)
abline(beta_0, beta_1, col = 2, lwd = 2)
lines(x, modelo_lineal$fitted.values, col = 4, lwd = 2)


plot(x, modelo_lineal$fitted.values, type = "l")

for(i in seq_len(iteraciones)){
  y <- genera_y(x, beta_0, beta_1)
  
  modelo_lineal <- lm(y~x)
  
  lines(x, modelo_lineal$fitted.values)
  
}
abline(beta_0, beta_1, col = 2, lwd = 2)

# Red neuronal ------------------------------------------------------------

iteraciones <- 50
tamano_muestral <- 23

genera_y <- function(x, beta_0, beta_1){
  cos(x) + rnorm(length(x), 0, 0.5)
  # beta_1*x + beta_0 + rnorm(length(x), 0, 0.5)
}


X <- seq(0, 3*pi, length.out = tamano_muestral)
Y <- genera_y(X)

plot(Y~X)
lines(cos(X) ~ X, col = 2, lwd = 2)


red_neuronal <- nnet(X, Y, size = 8, linout = TRUE, trace = FALSE)

YY <- predict(red_neuronal)
lines(YY ~ X, col = 4, lwd = 2)


plot(Y~X, col = "white")

for(i in seq_len(iteraciones)){
  
  Y <- genera_y(X)
  red_neuronal <- nnet(X, Y, size = 8, linout = TRUE, trace = FALSE)
  YY <- predict(red_neuronal)
  lines(YY ~ X, col = 4)
  
}

lines(cos(X) ~ X, col = 2, lwd = 2)



# Tidy approach -----------------------------------------------------------


# Paquetes ----------------------------------------------------------------

library("dplyr")
library("magrittr")
library("ggplot2")
library("LaCroixColoR")

color_setup <- lacroix_palette("PassionFruit", n = 5, type = "discrete")[c(1, 4, 5)]

# Regresión lineal --------------------------------------------------------

iteraciones <- 100
tamano_muestral <- 30
beta_0 <- 1
beta_1 <- -0.3

x <- seq(-3, 3, length.out = tamano_muestral)

genera_y <- function(x, beta_0, beta_1){
  beta_1*x + beta_0 + rnorm(length(x), 0, 0.5)
}

nombre_iter <- paste("I", seq_len(iteraciones))

tibble(
  iter = rep(nombre_iter, each=tamano_muestral),
  datos_x = rep(x, iteraciones),
  datos_y = genera_y(datos_x, beta_0, beta_1)
) -> simulaciones

ggplot(simulaciones) +
  # geom_point(aes(x = datos_x, y = datos_y), colour = color_setup[3], size = 0.2) +
  geom_smooth(aes(x = datos_x, y = datos_y, group = iter), method = "lm", colour = color_setup[3], size = 0.2, se = FALSE) +
  geom_abline(intercept = beta_0, slope = beta_1, colour = color_setup[1], size = 1) +
  theme_minimal()


# Red neuronal ------------------------------------------------------------

iteraciones <- 50
tamano_muestral <- 23

X <- seq(0, 3*pi, length.out = tamano_muestral)

genera_y <- function(x, beta_0, beta_1){
  cos(x) + rnorm(length(x), 0, 0.5)
  # beta_1*x + beta_0 + rnorm(length(x), 0, 0.5)
}


nombre_iter <- paste("I", seq_len(iteraciones))

tibble(
  iter = rep(nombre_iter, each=tamano_muestral),
  datos_x = rep(X, iteraciones),
  datos_y = genera_y(datos_x, beta_0, beta_1)
) -> simulaciones

my_nnet <- function(form, data, weights) nnet(form, data = data, size = 8, linout = TRUE, trace = FALSE)

ggplot(simulaciones) +
  # geom_point(aes(x = datos_x, y = datos_y), colour = color_setup[3], size = 0.2) +
  geom_smooth(aes(x = datos_x, y = datos_y, group = iter), method = "my_nnet", colour = color_setup[3], size = 0.2, se = FALSE) +
  geom_line(aes(x = datos_x, y = cos(datos_x)), colour = color_setup[1], size = 1) +
  theme_minimal()```

Para los que no tienen claro que es una red neuronal. Aquí dejo un abrebocas de lo que trata.

La idea es sencilla, ya que se trata de imitar a las neuronas biológicas, conectadas entre sí y trabajando en conjunto, aprendiendo sobre el proceso. Dados unos parámetros hay una forma de combinarlos para predecir un cierto resultado. El problema estará en saber cómo combinarlos. Las redes neuronales son un modelo para encontrar esa combinación de parámetros y aplicarla al mismo tiempo. El objetivo es encontrar la combinación que mejor se ajusta entrenando a la red neuronal. Este entrenamiento, aprendizaje, es la parte crucial de la RNA, ya que nos marcará la precisión del algoritmo. Consiste en encontrar esa relación de pesos a través de un proceso iterativo en el que, secuencialmente, se va analizando cada uno de los patrones de entrada a la red, reajustando en cada iteración la relación de pesos. Es en este punto cuando se introducirá una función de error que irá midiendo el rendimiento de la red en un momento dado, donde el objetivo será, obviamente, minimizar dicha función de error. El algoritmo se detendrá cuando se alcance la cota de error establecida por el usuario (o en caso de ciclo corto, cuando el error no decrezca sensiblemente).

En la cuestión de la convergencia además de las gráficas y ejemplos que hemos hecho deben de existir algunas demostraciones, si alguien sabe de algún recurso o PDF donde ver estos teoremas y demostraciones se lo agradecería
😃

#Paquetes
library('nnet')

# Red neuronal
iteraciones <- 150
tamano_muestral <- 200

genera_y <- function(x){
  cos(x) + rnorm(length(x), 0, 0.5)
}
X <- seq(0, 3 * pi, length.out = tamano_muestral )
Y <- genera_y(X)

plot(Y  ~ X)
lines(cos(X) ~ X, col = 2, lwd = 2)

red_neuronal <- nnet(X, Y, size = 6, linout = TRUE, trace = FALSE)

YY <- predict(red_neuronal)

lines(YY ~ X, col = 4, lwd = 2)

plot(Y ~ X)

for (i in seq_len(iteraciones)){
  Y <- genera_y(X)
  red_neuronal <- nnet(X, Y, size = 6, linout = TRUE, trace = FALSE)
  YY <- predict(red_neuronal)
  lines(YY ~ X, col = 4, lwd = 2)
}

lines(cos(X) ~ X, col = 2, lwd = 2)

# Regresion lineal
iteraciones <- 500
tamano_muestral <- 200
beta_0 <- 1
beta_1 <- 2 

genera_y <- function(x, beta_0, beta_1){
  beta_1*x + beta_0 + rnorm(length(x), 0, 0.5)
}

X <- seq(0, 3 * pi, length.out = tamano_muestral )
Y <- genera_y(X, beta_0, beta_1)

regresion_lineal <- lm(Y ~ X)

plot(X ~ Y)


lines(X ~ regresion_lineal$fitted.values, col = 4, lwd = 2)
YY <- beta_1*X + beta_0
lines(X ~ YY, col = 2, lwd = 2)

plot(Y ~ X)

for (i in seq_len(iteraciones)){
  Y <- genera_y(X, beta_0, beta_1)
  regresion_lineal <- lm(Y ~ X)
  lines(regresion_lineal$fitted.values ~ X, col = 4, lwd = 2)
  
}
YY <- beta_1*X + beta_0
lines(YY ~ X, col = 2, lwd = 2)

Aplicación con la regresión lineal:

Presenta resultados aparentemente insesgados y a medida en que aumentamos el tamaño de muestra e iteraciones, parece que el modelo está dentro de los resultados posibles de la nube de datos.

Código

# Regresion lineal
iteraciones <- 500
tamano_muestral <- 200
beta_0 <- 1
beta_1 <- 2 

genera_y <- function(x, beta_0, beta_1){
  beta_1*x + beta_0 + rnorm(length(x), 0, 0.5)
}

X <- seq(0, 3 * pi, length.out = tamano_muestral )
Y <- genera_y(X, beta_0, beta_1)

regresion_lineal <- lm(Y ~ X)

plot(X ~ Y)


lines(X ~ regresion_lineal$fitted.values, col = 4, lwd = 2)
YY <- beta_1*X + beta_0
lines(X ~ YY, col = 2, lwd = 2)

plot(Y ~ X)

for (i in seq_len(iteraciones)){
  Y <- genera_y(X, beta_0, beta_1)
  regresion_lineal <- lm(Y ~ X)
  lines(regresion_lineal$fitted.values ~ X, col = 4, lwd = 2)
  
}
YY <- beta_1*X + beta_0
lines(YY ~ X, col = 2, lwd = 2) 

Gráficos

Yo hice así el de regresión lineal, no sé si está correcto

#Regresion lineal

genera_y <- function(x){
  cos(x) + rnorm(length(x), 0, 0.5)
}

X <- seq(0,3*pi, length.out = tamano_muestral)
Y <- genera_y(X)
plot(Y~X)
lines(cos(X)~X, col=2, lwd=2)

x_est <- cos(X) #Transformación
regr_cos <- lm(Y~x_est)
coeficientes <- regr_cos$coefficients
y_est <- coeficientes[1] + coeficientes[2]*cos(X)
lines(y_est~X)

plot(Y~X)

for(i in seq_len(iteraciones)){
  Y <- genera_y(X)
  x_est <- cos(X) #Transformación
  regr_cos <- lm(Y~x_est)
  coeficientes <- regr_cos$coefficients
  y_est <- coeficientes[1] + coeficientes[2]*cos(X)
  lines(y_est~X, col=4, lwd=2)
}
lines(cos(X)~X, col=2, lwd=2)

Dejo mi Notebook:
https://colab.research.google.com/drive/1KAeAnb171pHEKjxjEx1WDN4TRTkx0WYd?usp=sharing