Introducción

En este proyecto implementamos una red neuronal simple para resolver el problema XOR. Utilizaremos diferentes filas de datos como ejemplo y mostraremos el proceso de entrenamiento automatizado.

Datos del Problema

Primero definimos los datos del problema XOR:

# Definir datos XOR
X <- matrix(c(0,0, 0,1, 1,0, 1,1), ncol = 2, byrow = TRUE)
Y <- matrix(c(0, 1, 1, 0), ncol = 1)

# Crear tabla de verdad
x1 <- c(0, 0, 1, 1)
x2 <- c(0, 1, 0, 1)
y <- c(0, 1, 1, 0)
tabla_xor <- data.frame(x1, x2, y)

kable(tabla_xor, caption = "Tabla de Verdad XOR")
Tabla de Verdad XOR
x1 x2 y
0 0 0
0 1 1
1 0 1
1 1 0

Arquitectura de la Red Neuronal

# Crear diagrama de red neuronal con ggplot2
nodos <- data.frame(
  nombre = c("X₁", "X₂", "h₁", "h₂", "O₁", "b₁", "b₂"),
  x = c(1, 1, 3, 3, 5, 2, 4),
  y = c(3, 1, 3.5, 1.5, 2.5, 4.5, 4.5),
  tipo = c("Entrada", "Entrada", "Oculta", "Oculta", "Salida", "Sesgo", "Sesgo")
)

conexiones <- data.frame(
  from_x = c(1, 1, 1, 1, 3, 3, 2, 2, 4),
  from_y = c(3, 3, 1, 1, 3.5, 1.5, 4.5, 4.5, 4.5),
  to_x = c(3, 3, 3, 3, 5, 5, 3, 3, 5),
  to_y = c(3.5, 1.5, 3.5, 1.5, 2.5, 2.5, 3.5, 1.5, 2.5),
  peso = c("w₁=0.2", "w₂=0.6", "w₃=-0.5", "w₄=0.4", "w₅=0.3", "w₆=0.7", 
           "b₁=0.1", "b₂=-0.1", "b₃=0.2")
)

ggplot() +
  geom_segment(data = conexiones, 
               aes(x = from_x, y = from_y, xend = to_x, yend = to_y),
               arrow = arrow(length = unit(0.3, "cm"), type = "closed"),
               color = "darkblue", size = 1.2, alpha = 0.7) +
  
  geom_text(data = conexiones,
            aes(x = (from_x + to_x) / 2, y = (from_y + to_y) / 2 + 0.2, 
                label = peso),
            size = 3, fontface = "bold", color = "red") +
  
  geom_point(data = nodos, 
             aes(x = x, y = y, color = tipo, shape = tipo), 
             size = 12) +
  
  geom_text(data = nodos, 
            aes(x = x, y = y, label = nombre), 
            color = "white", fontface = "bold", size = 4) +
  
  scale_color_manual(values = c("Entrada" = "steelblue", 
                                "Oculta" = "forestgreen", 
                                "Salida" = "orange", 
                                "Sesgo" = "gray50")) +
  scale_shape_manual(values = c("Entrada" = 16, 
                                "Oculta" = 16, 
                                "Salida" = 16, 
                                "Sesgo" = 15)) +
  
  labs(title = "Arquitectura de la Red Neuronal XOR",
       subtitle = "Entrada → Capa Oculta → Salida") +
  
  theme_void() +
  theme(plot.title = element_text(hjust = 0.5, size = 16, face = "bold"),
        plot.subtitle = element_text(hjust = 0.5, size = 12),
        legend.position = "bottom",
        legend.title = element_blank()) +
  
  coord_fixed(ratio = 1) +
  xlim(0, 6) + ylim(0, 5)
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

Configuración de la Red

# Función sigmoide
sigmoide <- function(x) {
  1 / (1 + exp(-x))
}

# Derivada de sigmoide
derivada_sigmoide <- function(x) {
  s <- sigmoide(x)
  s * (1 - s)
}

print("Funciones de activación configuradas correctamente")
## [1] "Funciones de activación configuradas correctamente"

Entrenamiento Automatizado

# Función para entrenar la red neuronal
entrenar_red <- function(entrada_fila, num_epocas = 5, tasa = 0.3, mostrar_detalle = FALSE) {
  
  # Reiniciar pesos a valores iniciales
  W_oculta <- matrix(c(0.2, -0.5, 0.6, 0.4), nrow = 2, byrow = TRUE)
  W_salida <- matrix(c(0.3, 0.7), nrow = 1)
  b_oculta <- c(0.1, -0.1)
  b_salida <- 0.2
  
  # Seleccionar entrada y objetivo
  entrada <- matrix(X[entrada_fila, ], ncol = 1)
  objetivo <- matrix(Y[entrada_fila, ], ncol = 1)
  
  if (mostrar_detalle) {
    cat("Entrenando con entrada:", X[entrada_fila, ], "-> Objetivo:", Y[entrada_fila, ], "\n")
  }
  
  resultados <- list()
  
  for (epoca in 1:num_epocas) {
    # Forward propagation
    z_oculta <- W_oculta %*% entrada + b_oculta
    a_oculta <- sigmoide(z_oculta)
    
    z_salida <- W_salida %*% a_oculta + b_salida
    a_salida <- sigmoide(z_salida)
    
    # Calcular error
    error <- 0.5 * (objetivo - a_salida)^2
    
    # Backpropagation
    delta_salida <- (objetivo - a_salida) * derivada_sigmoide(z_salida)
    dW_salida <- delta_salida %*% t(a_oculta)
    db_salida <- delta_salida
    
    delta_oculta <- (t(W_salida) %*% delta_salida) * derivada_sigmoide(z_oculta)
    dW_oculta <- delta_oculta %*% t(entrada)
    db_oculta <- delta_oculta
    
    # Actualizar pesos
    W_oculta <- W_oculta + tasa * dW_oculta
    W_salida <- W_salida + tasa * dW_salida
    b_oculta <- b_oculta + tasa * as.vector(db_oculta)
    b_salida <- b_salida + tasa * as.vector(db_salida)
    
    # Guardar resultados
    resultados[[epoca]] <- c(
      Epoca = epoca,
      W1 = W_oculta[1,1], W2 = W_oculta[1,2],
      W3 = W_oculta[2,1], W4 = W_oculta[2,2],
      W5 = W_salida[1,1], W6 = W_salida[1,2],
      Salida = as.numeric(a_salida),
      Error = as.numeric(error)
    )
  }
  
  return(do.call(rbind, resultados))
}

# PARÁMETROS CONFIGURABLES - CAMBIA ESTOS VALORES
EPOCAS <- 8  # Cambia este número según necesites
FILA_DATOS <- 3  # Qué fila usar (1, 2, 3, o 4)
TASA_APRENDIZAJE <- 0.3

# Entrenar la red
tabla_final <- entrenar_red(FILA_DATOS, EPOCAS, TASA_APRENDIZAJE, mostrar_detalle = TRUE)
## Entrenando con entrada: 1 0 -> Objetivo: 1

Comparación con Diferentes Épocas

# Función para comparar diferentes números de épocas
comparar_epocas <- function(epocas_lista = c(5, 10, 20)) {
  comparacion <- list()
  
  for (i in seq_along(epocas_lista)) {
    num_ep <- epocas_lista[i]
    resultado <- entrenar_red(FILA_DATOS, num_ep, TASA_APRENDIZAJE)
    
    # Tomar solo la última época
    ultima_fila <- resultado[nrow(resultado), ]
    comparacion[[i]] <- c(
      Epocas = num_ep,
      Salida_Final = ultima_fila["Salida"],
      Error_Final = ultima_fila["Error"]
    )
  }
  
  return(do.call(rbind, comparacion))
}

# Comparar con diferentes números de épocas
tabla_comparacion <- comparar_epocas(c(3, 5, 10, 15))
colnames(tabla_comparacion) <- c("Épocas", "Salida Final", "Error Final")

kable(tabla_comparacion, 
      digits = 6,
      caption = "Comparación de resultados según número de épocas") %>%
  kable_styling(bootstrap_options = c("striped", "hover"),
                full_width = FALSE) %>%
  row_spec(0, bold = TRUE, background = "#e74c3c", color = "white")
Comparación de resultados según número de épocas
Épocas Salida Final Error Final
3 0.706241 0.043147
5 0.719442 0.039356
10 0.747522 0.031873
15 0.770058 0.026437

Resultados

# Crear tabla de resultados
colnames(tabla_final) <- c("Época", "w₁", "w₂", "w₃", "w₄", "w₅", "w₆", "Salida", "Error")

kable(tabla_final, 
      digits = 4,
      caption = "Evolución del entrenamiento") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE) %>%
  row_spec(0, bold = TRUE, background = "#3498db", color = "white") %>%
  column_spec(1, bold = TRUE, background = "#ecf0f1")
Evolución del entrenamiento
Época w₁ w₂ w₃ w₄ w₅ w₆ Salida Error
1 0.2014 -0.5 0.6032 0.4 0.3113 0.7123 0.6917 0.0475
2 0.2029 -0.5 0.6064 0.4 0.3222 0.7241 0.6991 0.0453
3 0.2043 -0.5 0.6095 0.4 0.3328 0.7356 0.7062 0.0431
4 0.2058 -0.5 0.6125 0.4 0.3429 0.7466 0.7130 0.0412
5 0.2072 -0.5 0.6155 0.4 0.3527 0.7573 0.7194 0.0394
6 0.2086 -0.5 0.6184 0.4 0.3622 0.7676 0.7256 0.0377
7 0.2100 -0.5 0.6212 0.4 0.3714 0.7776 0.7315 0.0361
8 0.2114 -0.5 0.6240 0.4 0.3802 0.7873 0.7371 0.0346