Actividad 6. Función XOR con una red neuronal

Universidad del Norte

Tiffany Mendoza Sampayo

Estadistica matemática 2025-03 | Septiembre 14, 2025

Planteamiento

El operador XOR genera una salida binaria a partir de dos entradas binarias. Su comportamiento se resume en la siguiente tabla:

Tabla de verdad de la función XOR
x1 x2 y
0 0 0
0 1 1
1 0 1
1 1 0

Modelo

Como referencia, tomaremos el siguiente modelo propuesto por el profesor Humberto Llinás en su documento Exclusive-OR (XOR).

XOR
XOR

Configuración inicial

Definimos la función de activación, los parámetros iniciales y el conjunto de datos a trabajar.

knitr::opts_chunk$set(echo = TRUE)
sigmoid <- function(z) 1/(1+exp(-z))
dsigmoid <- function(a) a*(1-a)

# datos de entrenamiento (ejemplo: fila 2 -> x1=0, x2=1, y=1)
entrada <- c(x1=0, x2=1)
objetivo <- 1

# parámetros iniciales
param <- 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
)

tasa_aprendizaje <- 0.2

Creamos una función que realiza el paso de propagación directa desde las entradas hasta la salida de la red.

forward_pass <- function(p, x){
  z1 <- p$w1*x["x1"] + p$w3*x["x2"] + p$b1
  a1 <- sigmoid(z1)
  
  z2 <- p$w2*x["x1"] + p$w4*x["x2"] + p$b2
  a2 <- sigmoid(z2)
  
  z3 <- p$w5*a1 + p$w6*a2 + p$b3
  y_hat <- sigmoid(z3)
  
  list(a1=a1, a2=a2, y_hat=y_hat, z1=z1, z2=z2, z3=z3)
}

Retropropagación

La siguiente función calcula los gradientes de cada parámetro utilizando la regla de la cadena y el error cuadrático medio.

backprop <- function(p, x, y, cache){
  error <- 0.5*(y - cache$y_hat)^2
  delta3 <- (cache$y_hat - y) * dsigmoid(cache$y_hat)
  
  dE_dw5 <- cache$a1 * delta3
  dE_dw6 <- cache$a2 * delta3
  dE_db3 <- delta3
  
  delta1 <- (p$w5*delta3) * dsigmoid(cache$a1)
  delta2 <- (p$w6*delta3) * dsigmoid(cache$a2)
  
  dE_dw1 <- x["x1"]*delta1
  dE_dw3 <- x["x2"]*delta1
  dE_db1 <- delta1
  
  dE_dw2 <- x["x1"]*delta2
  dE_dw4 <- x["x2"]*delta2
  dE_db2 <- delta2
  
  list(error=error,
       grads=list(
         w1=dE_dw1, w2=dE_dw2, w3=dE_dw3, w4=dE_dw4,
         w5=dE_dw5, w6=dE_dw6,
         b1=dE_db1, b2=dE_db2, b3=dE_db3))
}

Actualización de parámetros

update_params <- function(p, grads, lr){
  for (g in names(grads)){
    p[[g]] <- p[[g]] - lr*grads[[g]]
  }
  p
}

Entrenamiento (2 épocas)

Se ejecuta el ciclo de entrenamiento para observar cómo evolucionan los pesos, la salida y el error.

historial <- data.frame()
estado <- param

for (epoca in 1:2){
  fwd <- forward_pass(estado, entrada)
  bck <- backprop(estado, entrada, objetivo, fwd)
  estado <- update_params(estado, bck$grads, tasa_aprendizaje)
  
  registro <- data.frame(
    Época=epoca,
    Salida=round(fwd$y_hat,4),
    estado,
    Error=round(bck$error,5)
  )
  historial <- rbind(historial, registro)
}

Resultados

Evolución de la salida, error y parámetros en cada época
Época Salida w1 w2 w3 w4 w5 w6 b1 b2 b3 Error
x1 1 0.5735 0.1 0.5 -0.699075 0.302040 0.206923 0.411985 0.000925 0.002040 0.020864 0.09095
x11 2 0.5810 0.1 0.5 -0.698138 0.304094 0.213701 0.423726 0.001862 0.004094 0.041267 0.08780

La tabla anterior muestra la evolución de la salida de la red, el error y los pesos actualizados.

Referencias

  1. Exclusive-OR (XOR). Dr. rer. nat. Humberto LLinás Solano. https://rpubs.com/hllinas/Neural_Network_XOR