Universidad del Norte
Tiffany Mendoza Sampayo
Estadística matemática 2025-03 | Octubre 1, 2025
El operador XOR genera una salida binaria a partir de dos entradas binarias. Su comportamiento se resume en la siguiente tabla:
xor_data <- data.frame(
x1 = c(0,0,1,1),
x2 = c(0,1,0,1),
y = c(0,1,1,0)
)
knitr::kable(
xor_data,
caption = "Tabla de verdad de la función XOR",
align = "c"
)| x1 | x2 | y |
|---|---|---|
| 0 | 0 | 0 |
| 0 | 1 | 1 |
| 1 | 0 | 1 |
| 1 | 1 | 0 |
A diferencia del desarrollo manual donde se trabajaba con una sola entrada a la vez, ahora se construye un modelo matricial que permite procesar todas las filas de la tabla XOR simultáneamente.
Se definen las funciones de activación, el conjunto de datos y los parámetros iniciales.
sigmoid <- function(z) 1/(1+exp(-z))
dsigmoid <- function(a) a*(1-a)
X <- matrix(c(0,0,
0,1,
1,0,
1,1), ncol=2, byrow=TRUE)
Y <- matrix(c(0,1,1,0), ncol=1)
param <- list(
W1 = matrix(c(0.1, -0.7,
0.5, 0.3), nrow=2, byrow=TRUE),
b1 = matrix(c(0,0), nrow=1, ncol=2),
W2 = matrix(c(0.2,0.4), nrow=2, ncol=1),
b2 = matrix(0, nrow=1, ncol=1)
)
tasa_aprendizaje <- 0.2La siguiente función calcula todas las activaciones de la red para todas las filas de X en paralelo.
forward_pass <- function(p, X){
Z1 <- X %*% p$W1 + matrix(rep(p$b1, nrow(X)), nrow=nrow(X), byrow=TRUE)
A1 <- sigmoid(Z1)
Z2 <- A1 %*% p$W2 + matrix(rep(p$b2, nrow(A1)), nrow=nrow(A1), byrow=TRUE)
A2 <- sigmoid(Z2)
list(Z1=Z1, A1=A1, Z2=Z2, A2=A2)
}La retropropagación se implementa de manera matricial, promediando los gradientes sobre todas las observaciones.
backprop <- function(p, X, Y, cache){
m <- nrow(X)
A1 <- cache$A1
A2 <- cache$A2
error <- sum(0.5 * (Y - A2)^2) / m
dZ2 <- (A2 - Y) * dsigmoid(A2)
dW2 <- t(A1) %*% dZ2 / m
db2 <- colSums(dZ2) / m
dZ1 <- (dZ2 %*% t(p$W2)) * dsigmoid(A1)
dW1 <- t(X) %*% dZ1 / m
db1 <- colSums(dZ1) / m
list(error=error, grads=list(W1=dW1, b1=db1, W2=dW2, b2=db2))
}update_params <- function(p, grads, lr){
p$W1 <- p$W1 - lr*grads$W1
p$b1 <- p$b1 - lr*grads$b1
p$W2 <- p$W2 - lr*grads$W2
p$b2 <- p$b2 - lr*grads$b2
p
}Ahora se entrena la red con todas las entradas XOR a la vez. Se almacenan el error promedio y las salidas predichas en cada época.
historial <- data.frame()
estado <- param
for (epoca in 1:4){
fwd <- forward_pass(estado, X)
bck <- backprop(estado, X, Y, fwd)
estado <- update_params(estado, bck$grads, tasa_aprendizaje)
registro <- data.frame(
Epoca = epoca,
Error = round(bck$error,6),
Salidas = paste(round(fwd$A2[,1],4), collapse=", "),
# Guardar pesos y sesgos
W1_11 = round(estado$W1[1,1],4), W1_12 = round(estado$W1[1,2],4),
W1_21 = round(estado$W1[2,1],4), W1_22 = round(estado$W1[2,2],4),
b1_1 = round(estado$b1[1,1],4), b1_2 = round(estado$b1[1,2],4),
W2_1 = round(estado$W2[1,1],4), W2_2 = round(estado$W2[2,1],4),
b2 = round(estado$b2[1,1],4)
)
historial <- rbind(historial, registro)
}knitr::kable(
historial,
caption = "Evolución de pesos, sesgos, salidas y error por época",
align = "c"
)| Epoca | Error | Salidas | W1_11 | W1_12 | W1_21 | W1_22 | b1_1 | b1_2 | W2_1 | W2_2 | b2 |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | 0.127681 | 0.5744, 0.5877, 0.5592, 0.5719 | 0.1000 | -0.7002 | 0.4999 | 0.2998 | -2e-04 | -0.0004 | 0.1979 | 0.3984 | -0.0036 |
| 2 | 0.127581 | 0.5731, 0.5862, 0.5578, 0.5705 | 0.0999 | -0.7004 | 0.4998 | 0.2996 | -3e-04 | -0.0008 | 0.1959 | 0.3967 | -0.0071 |
| 3 | 0.127484 | 0.5718, 0.5848, 0.5566, 0.5692 | 0.0999 | -0.7006 | 0.4998 | 0.2995 | -5e-04 | -0.0012 | 0.1939 | 0.3951 | -0.0106 |
| 4 | 0.127391 | 0.5705, 0.5834, 0.5553, 0.5678 | 0.0998 | -0.7007 | 0.4997 | 0.2993 | -6e-04 | -0.0016 | 0.1919 | 0.3936 | -0.0140 |
En la tabla se observa cómo el error disminuye gradualmente y las salidas estimadas se acercan a los valores esperados de la función XOR.