En este trabajo se implementa y analiza una red neuronal de tipo feed-forward con arquitectura 2–2–1 (dos neuronas de entrada, dos ocultas y una de salida), entrenada mediante retropropagación del error y utilizando la función de activación logística. El entrenamiento se realiza en modo batch, es decir, presentando simultáneamente los cuatro patrones de XOR en cada época y calculando los gradientes promedio para la actualización de los pesos.

# Tabla de la función XOR
xor_df <- data.frame(
  x1 = c(0,0,1,1),
  x2 = c(0,1,0,1),
  y  = c(0,1,1,0)
)
xor_df
##   x1 x2 y
## 1  0  0 0
## 2  0  1 1
## 3  1  0 1
## 4  1  1 0
# ========== XOR 2-2-1 ENTRENAMIENTO (BATCH) ==========

# Datos (matriz completa)
X <- as.matrix(xor_df[, c("x1","x2")])  # N x 2
y <- xor_df$y                            # N
N <- nrow(X)

# Hiperparámetros
n_epocas   <- 10
tasa_apren <- 0.25

# Pesos iniciales 
init_params <- list(
  w1=0.1, w2=0.5, w3=-0.7, w4=0.3, w5=0.2, w6=0.4,
  b1=0,   b2=0,   b3=0
)

# Librerías
suppressPackageStartupMessages({
  library(ggplot2)
  library(grid)
  library(reticulate)
})

# Paquetes de Python
if (!py_module_available("matplotlib")) py_install("matplotlib", pip=TRUE)
if (!py_module_available("networkx"))  py_install("networkx",  pip=TRUE)

# Utilidades
sigmoid <- function(z) 1/(1+exp(-z))
make_params <- function(w1,w2,w3,w4,w5,w6,b1,b2,b3) list(w1=w1,w2=w2,w3=w3,w4=w4,w5=w5,w6=w6,b1=b1,b2=b2,b3=b3)
round_df <- function(df, digits=6){ num <- sapply(df, is.numeric); df[num] <- lapply(df[num], round, digits); df }

# ---- FORWARD (batch) ----
forward_batch <- function(X, y, p){
  x1 <- X[,1]; x2 <- X[,2]
  z1 <- p$w1*x1 + p$w3*x2 + p$b1        # N
  z2 <- p$w2*x1 + p$w4*x2 + p$b2        # N
  h1 <- sigmoid(z1)                     # N
  h2 <- sigmoid(z2)                     # N
  z3 <- p$w5*h1 + p$w6*h2 + p$b3        # N
  o1 <- sigmoid(z3)                     # N
  loss <- mean(0.5*(y - o1)^2)          # MSE con factor 1/2
  list(cache=list(x1=x1,x2=x2,z1=z1,h1=h1,z2=z2,h2=h2,z3=z3,o1=o1,y=y), loss=as.numeric(loss))
}

# ---- BACKWARD (batch): gradiente promedio en N ----
# (CORREGIDO: ahora incluye gradientes de b1, b2, b3)
backward_batch <- function(cache, p){
  with(cache, {
    # salida
    dE_dz3 <- (o1 - y) * (o1*(1 - o1))     # N
    g_w5 <- mean(dE_dz3 * h1)
    g_w6 <- mean(dE_dz3 * h2)
    g_b3 <- mean(dE_dz3)

    # ocultas
    dE_dz1 <- (dE_dz3 * p$w5) * (h1*(1 - h1))   # N
    dE_dz2 <- (dE_dz3 * p$w6) * (h2*(1 - h2))   # N

    list(
      w1 = mean(dE_dz1 * x1),
      w3 = mean(dE_dz1 * x2),
      w2 = mean(dE_dz2 * x1),
      w4 = mean(dE_dz2 * x2),
      w5 = g_w5,
      w6 = g_w6,
      b1 = mean(dE_dz1),
      b2 = mean(dE_dz2),
      b3 = g_b3
    )
  })
}

# ---- Paso de actualización ----
# (CORREGIDO: ahora actualiza b1, b2, b3)
step_update <- function(p, g, tasa_apren){
  p$w1 <- p$w1 - tasa_apren*g$w1; p$w2 <- p$w2 - tasa_apren*g$w2
  p$w3 <- p$w3 - tasa_apren*g$w3; p$w4 <- p$w4 - tasa_apren*g$w4
  p$w5 <- p$w5 - tasa_apren*g$w5; p$w6 <- p$w6 - tasa_apren*g$w6
  p$b1 <- p$b1 - tasa_apren*g$b1; p$b2 <- p$b2 - tasa_apren*g$b2; p$b3 <- p$b3 - tasa_apren*g$b3
  p
}

# ---- Bucle de entrenamiento (batch) ----
train_epocas_batch <- function(X, y, p, tasa_apren, n_epocas){
  history <- data.frame()
  for (e in seq_len(n_epocas)){
    fwd <- forward_batch(X, y, p)
    grads <- backward_batch(fwd$cache, p)
    p <- step_update(p, grads, tasa_apren)

    # guardamos salida promedio de la época para la tabla
    O1_mean <- mean(fwd$cache$o1)

    history <- rbind(history, data.frame(
      epoch=e, O1=as.numeric(O1_mean),
      w1=p$w1,w2=p$w2,w3=p$w3,w4=p$w4,w5=p$w5,w6=p$w6,
      b1=p$b1,b2=p$b2,b3=p$b3,
      error=as.numeric(fwd$loss)
    ))
  }
  list(params=p, history=history)
}

# Ejecutar entrenamiento (batch)
params0 <- do.call(make_params, init_params)
train <- train_epocas_batch(X, y, params0, tasa_apren=tasa_apren, n_epocas=n_epocas)
paramsF <- train$params

# ---- Preparar objetos para graficar en Python ----
build_graph_dict <- function(p, title_suffix){
  list(
    X1=0L, X2=1L, O1_target=1L,
    weights=list(w1=p$w1, w2=p$w2, w3=p$w3, w4=p$w4, w5=p$w5, w6=p$w6),
    biases =list(b1=p$b1, b2=p$b2, b3=p$b3),
    title_suffix=title_suffix
  )
}

main <- reticulate::import_main()
main$NN_INIT   <- build_graph_dict(params0, " (inicial)")
main$NN_FINAL  <- build_graph_dict(paramsF, sprintf(" (final tras %d época(s), batch)", n_epocas))
main$TITLE_INIT  <- "Red XOR - Inicial (modo batch, 4 patrones)"
main$TITLE_FINAL <- sprintf("Red XOR - Final tras %d época(s) (modo batch)", n_epocas)

# Tabla en consola
cat("\n=== Resumen general por época (BATCH) ===\n")
## 
## === Resumen general por época (BATCH) ===
print(round_df(train$history, 6), row.names = FALSE)
##  epoch       O1       w1       w2        w3       w4       w5       w6
##      1 0.580345 0.099905 0.499827 -0.700117 0.299877 0.197906 0.397115
##      2 0.578498 0.099814 0.499660 -0.700231 0.299760 0.195859 0.394295
##      3 0.576690 0.099726 0.499499 -0.700342 0.299649 0.193857 0.391538
##      4 0.574921 0.099642 0.499344 -0.700449 0.299542 0.191901 0.388842
##      5 0.573189 0.099561 0.499194 -0.700553 0.299440 0.189988 0.386207
##      6 0.571495 0.099483 0.499049 -0.700654 0.299344 0.188118 0.383632
##      7 0.569837 0.099408 0.498910 -0.700752 0.299252 0.186291 0.381116
##      8 0.568215 0.099336 0.498776 -0.700847 0.299164 0.184505 0.378657
##      9 0.566628 0.099267 0.498647 -0.700939 0.299081 0.182760 0.376254
##     10 0.565076 0.099201 0.498522 -0.701029 0.299002 0.181055 0.373906
##         b1        b2        b3    error
##  -0.000245 -0.000413 -0.004894 0.128150
##  -0.000482 -0.000813 -0.009682 0.128004
##  -0.000712 -0.001201 -0.014365 0.127864
##  -0.000934 -0.001576 -0.018945 0.127731
##  -0.001150 -0.001940 -0.023423 0.127603
##  -0.001359 -0.002292 -0.027802 0.127481
##  -0.001562 -0.002632 -0.032084 0.127364
##  -0.001758 -0.002962 -0.036270 0.127252
##  -0.001949 -0.003282 -0.040363 0.127146
##  -0.002133 -0.003591 -0.044363 0.127044
# --- Tabla "gt" multicolor (batch) ---
if (!requireNamespace("gt", quietly = TRUE)) install.packages("gt")
if (!requireNamespace("dplyr", quietly = TRUE)) install.packages("dplyr")
library(gt); library(dplyr)

pretty_history_multicolor_batch <- function(history, tasa_apren, n_epocas){
  df <- history %>%
    select(epoch, O1, w1, w2, w3, w4, w5, w6, b1, b2, b3, error) %>%
    mutate(epoch = as.integer(epoch))

  # redondeo consistente
  num_cols <- setdiff(names(df), "epoch")
  df[num_cols] <- lapply(df[num_cols], function(x) round(x, 6))

  # paleta fila por fila
  row_cols <- c("#FFF2CC", "#E2F0D9", "#DDEBF7", "#FCE4D6",
                "#EDE7F6", "#E2EFDA", "#F8CECC", "#D9E1F2")
  row_cols <- rep_len(row_cols, nrow(df))

  tbl <- gt(df) %>%
    tab_header(
      title = md("**Resumen de entrenamiento XOR (Batch)**"),
      subtitle = md(sprintf("Dataset: 4 patrones  •  LR=%.2f  •  Épocas=%d",
                            tasa_apren, n_epocas))
    ) %>%
    tab_style(style = cell_text(color = "white"),
              locations = list(cells_title(groups = "title"),
                               cells_title(groups = "subtitle"))) %>%
    cols_label(
      epoch = "Época",
      O1    = "O1 (promedio época)",
      error = "Error (MSE)"
    ) %>%
    cols_width(
      epoch ~ px(70),
      O1 ~ px(150),
      c(w1, w2, w3, w4, w5, w6) ~ px(95),
      c(b1, b2, b3) ~ px(70),
      error ~ px(120)
    ) %>%
    fmt_number(
      columns = c(O1, w1, w2, w3, w4, w5, w6, b1, b2, b3, error),
      decimals = 6, use_seps = FALSE
    ) %>%
    tab_options(
      table.border.top.color = "transparent",
      table.border.bottom.color = "transparent",
      heading.background.color = "#111827",
      heading.title.font.size = px(18),
      heading.subtitle.font.size = px(13),
      column_labels.background.color = "#f3f4f6",
      column_labels.font.weight = "bold",
      data_row.padding = px(6)
    ) %>%
    opt_table_font(font = c("Inter","Arial","Verdana","Sans-Serif")) %>%
    tab_source_note(md("Entrenamiento batch: gradientes promediados sobre los 4 patrones."))

  # coloreo por filas
  for (i in seq_len(nrow(df))) {
    tbl <- tab_style(
      tbl,
      style = cell_fill(color = row_cols[i]),
      locations = cells_body(rows = i, columns = everything())
    )
  }
  tbl
}

# Render
resumen_formal <- pretty_history_multicolor_batch(train$history, tasa_apren, n_epocas)
resumen_formal
Resumen de entrenamiento XOR (Batch)
Dataset: 4 patrones • LR=0.25 • Épocas=10
Época O1 (promedio época) w1 w2 w3 w4 w5 w6 b1 b2 b3 Error (MSE)
1 0.580345 0.099905 0.499827 −0.700117 0.299877 0.197906 0.397115 −0.000245 −0.000413 −0.004894 0.128150
2 0.578498 0.099814 0.499660 −0.700231 0.299760 0.195859 0.394295 −0.000482 −0.000813 −0.009682 0.128004
3 0.576690 0.099726 0.499499 −0.700342 0.299649 0.193857 0.391538 −0.000712 −0.001201 −0.014365 0.127864
4 0.574921 0.099642 0.499344 −0.700449 0.299542 0.191901 0.388842 −0.000934 −0.001576 −0.018945 0.127731
5 0.573189 0.099561 0.499194 −0.700553 0.299440 0.189988 0.386207 −0.001150 −0.001940 −0.023423 0.127603
6 0.571495 0.099483 0.499049 −0.700654 0.299344 0.188118 0.383632 −0.001359 −0.002292 −0.027802 0.127481
7 0.569837 0.099408 0.498910 −0.700752 0.299252 0.186291 0.381116 −0.001562 −0.002632 −0.032084 0.127364
8 0.568215 0.099336 0.498776 −0.700847 0.299164 0.184505 0.378657 −0.001758 −0.002962 −0.036270 0.127252
9 0.566628 0.099267 0.498647 −0.700939 0.299081 0.182760 0.376254 −0.001949 −0.003282 −0.040363 0.127146
10 0.565076 0.099201 0.498522 −0.701029 0.299002 0.181055 0.373906 −0.002133 −0.003591 −0.044363 0.127044
Entrenamiento batch: gradientes promediados sobre los 4 patrones. 
tabla_o1_epoca <- function(history, epoch, X, y, umbral = 0.5){
  if(!(epoch %in% history$epoch))
    stop("La época solicitada no existe en 'history'.")
  p <- history[history$epoch == epoch,
               c("w1","w2","w3","w4","w5","w6","b1","b2","b3")]
  p <- as.list(p)
  sigmoid <- function(z) 1/(1+exp(-z))
  z1 <- p$w1*X[,1] + p$w3*X[,2] + p$b1
  z2 <- p$w2*X[,1] + p$w4*X[,2] + p$b2
  h1 <- sigmoid(z1); h2 <- sigmoid(z2)
  z3 <- p$w5*h1 + p$w6*h2 + p$b3
  o1 <- sigmoid(z3)

  df <- data.frame(
    Patron = paste0("(", X[,1], ",", X[,2], ")"),
    y      = y,
    O1     = round(as.numeric(o1), 6),
    Error  = round(0.5*(y - as.numeric(o1))^2, 6),
    Pred   = as.integer(as.numeric(o1) >= umbral)
  )

  if (!requireNamespace("gt", quietly = TRUE)) install.packages("gt")
  library(gt)
  o1_mean <- mean(as.numeric(o1)); mse <- mean(0.5*(y - as.numeric(o1))^2)

  gt(df) %>%
    tab_header(
      title = md("**Salidas de la neurona O1 por patrón**"),
      subtitle = md(sprintf("Época = %d   •   Umbral = %.2f   •   O1̄ = %.4f   •   MSE = %.6f",
                            epoch, umbral, o1_mean, mse))
    ) %>%
    cols_label(y="y (verdad)", O1="O1 (ŷ)", Error="Error 0.5·(y−ŷ)^2", Pred="Clase pred.") %>%
    tab_options(
      heading.background.color = "#111827",
      table.border.top.color = "transparent",
      table.border.bottom.color = "transparent",
      column_labels.background.color = "#f3f4f6",
      column_labels.font.weight = "bold"
    )
}
epoca_final <- max(train$history$epoch, na.rm = TRUE)
tabla_o1_epoca(train$history, epoca_final, X, y, umbral = 0.5)
Salidas de la neurona O1 por patrón
Época = 10 • Umbral = 0.50 • O1̄ = 0.5636 • MSE = 0.126947
Patron y (verdad) O1 (ŷ) Error 0.5·(y−ŷ)^2 Clase pred.
(0,0) 0 0.557910 0.155632 1
(0,1) 1 0.557237 0.098020 1
(1,0) 1 0.570245 0.092345 1
(1,1) 0 0.568842 0.161791 1

Interpretación

La tabla muestra que, aun cuando el error promedio por época disminuye de manera sostenida, las salidas de la neurona \(𝑂_1\) tienden a concentrarse alrededor de un valor intermedio (cercano a 0.5) para los cuatro patrones de XOR. Esto indica que la red, en su configuración actual (2–2–1 con activación logística y entrenamiento batch), reduce el error pero no separa todavía de forma clara los casos donde la salida debería ser 0 o 1. En consecuencia, con un umbral típico (p. ej., 0.5) la predicción tiende a favorecer una misma clase para todos los patrones, reflejando insuficiente capacidad de representación o entrenamiento insuficiente para la no linealidad de XOR.

En términos prácticos, el comportamiento observado sugiere continuar el entrenamiento (más épocas), ajustar hiperparámetros (tasa de aprendizaje, inicialización), permitir y/o recalibrar los sesgos, o incrementar la capacidad del modelo (más neuronas en la capa oculta) para capturar la frontera de decisión no lineal propia del problema. A medida que el modelo mejore, se espera que las salidas de \(𝑂_1\) se alejen del valor intermedio y se aproximen a 0 en los patrones negativos y a 1 en los positivos, acompañado de una disminución consistente del error y de predicciones diferenciadas entre los cuatro casos.