Universidad del Norte
Tiffany Mendoza Sampayo
Estadistica matemática 2025-03 | Septiembre 14, 2025
El operador XOR genera una salida binaria a partir de dos entradas binarias. Su comportamiento se resume en la siguiente tabla:
x1 | x2 | y |
---|---|---|
0 | 0 | 0 |
0 | 1 | 1 |
1 | 0 | 1 |
1 | 1 | 0 |
Como referencia, tomaremos el siguiente modelo propuesto por el profesor Humberto Llinás en su documento Exclusive-OR (XOR).
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)
}
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))
}
update_params <- function(p, grads, lr){
for (g in names(grads)){
p[[g]] <- p[[g]] - lr*grads[[g]]
}
p
}
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)
}
É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.