AUTOMATIZACIÓN DEL MODELO
# Dataset completo (4 patrones XOR)
xor_df <- data.frame(
x1 = c(0,0,1,1),
x2 = c(0,1,0,1),
y = c(0,1,1,0)
)
X <- as.matrix(xor_df[, c("x1","x2")]) # N x 2
y <- xor_df$y
N <- nrow(X)
num_epocas <- 30
lr <- 0.25
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
)
# Funciones aux
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
forward_batch <- function(X, y, p){
x1 <- X[,1]; x2 <- X[,2]
z1 <- p$w1*x1 + p$w3*x2 + p$b1
z2 <- p$w2*x1 + p$w4*x2 + p$b2
h1 <- sigmoid(z1); h2 <- sigmoid(z2)
z3 <- p$w5*h1 + p$w6*h2 + p$b3
o1 <- sigmoid(z3)
loss <- mean(0.5*(y - o1)^2) # MSE con 1/2
list(cache=list(x1=x1,x2=x2,h1=h1,h2=h2,o1=o1,y=y), loss=as.numeric(loss))
}
# BACKWARD
backward_batch <- function(cache, p){
with(cache, {
dE_dz3 <- (o1 - y) * (o1*(1 - o1))
g_w5 <- mean(dE_dz3 * h1)
g_w6 <- mean(dE_dz3 * h2)
g_b3 <- mean(dE_dz3)
dE_dz1 <- (dE_dz3 * p$w5) * (h1*(1 - h1))
dE_dz2 <- (dE_dz3 * p$w6) * (h2*(1 - h2))
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 ----------
step_update <- function(p, g, lr){
p$w1 <- p$w1 - lr*g$w1; p$w2 <- p$w2 - lr*g$w2
p$w3 <- p$w3 - lr*g$w3; p$w4 <- p$w4 - lr*g$w4
p$w5 <- p$w5 - lr*g$w5; p$w6 <- p$w6 - lr*g$w6
p$b1 <- p$b1 - lr*g$b1; p$b2 <- p$b2 - lr*g$b2; p$b3 <- p$b3 - lr*g$b3
p
}
# ---------- Entrenamiento ----------
train_epocas_batch <- function(X, y, p, lr, num_epocas){
history <- data.frame()
for (e in seq_len(num_epocas)){
fwd <- forward_batch(X, y, p)
grads <- backward_batch(fwd$cache, p)
p <- step_update(p, grads, lr)
history <- rbind(history, data.frame(
epoch = e,
O1 = mean(fwd$cache$o1),
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 = fwd$loss
))
}
list(params=p, history=history)
}
# ---------- Ejecutar ----------
params0 <- do.call(make_params, init_params)
train <- train_epocas_batch(X, y, params0, lr=lr, num_epocas=num_epocas)
# ---------- Mostrar en consola ----------
cat("\n=== Resumen ===\n")
##
## === Resumen ===
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
## 11 0.563558 0.099137 0.498402 -0.701116 0.298928 0.179389 0.371612
## 12 0.562074 0.099076 0.498287 -0.701200 0.298857 0.177761 0.369371
## 13 0.560623 0.099018 0.498176 -0.701282 0.298791 0.176171 0.367183
## 14 0.559204 0.098962 0.498069 -0.701362 0.298728 0.174618 0.365045
## 15 0.557818 0.098908 0.497966 -0.701439 0.298669 0.173101 0.362956
## 16 0.556462 0.098857 0.497867 -0.701515 0.298613 0.171618 0.360917
## 17 0.555137 0.098807 0.497772 -0.701588 0.298561 0.170171 0.358925
## 18 0.553841 0.098760 0.497681 -0.701659 0.298513 0.168757 0.356980
## 19 0.552576 0.098715 0.497593 -0.701728 0.298467 0.167376 0.355080
## 20 0.551339 0.098671 0.497509 -0.701795 0.298425 0.166028 0.353225
## 21 0.550130 0.098630 0.497428 -0.701860 0.298386 0.164711 0.351414
## 22 0.548949 0.098590 0.497351 -0.701924 0.298349 0.163425 0.349646
## 23 0.547795 0.098552 0.497277 -0.701985 0.298316 0.162170 0.347920
## 24 0.546668 0.098516 0.497206 -0.702045 0.298285 0.160944 0.346234
## 25 0.545566 0.098482 0.497137 -0.702104 0.298258 0.159747 0.344589
## 26 0.544491 0.098449 0.497072 -0.702161 0.298232 0.158579 0.342983
## 27 0.543440 0.098417 0.497010 -0.702216 0.298210 0.157438 0.341415
## 28 0.542413 0.098387 0.496950 -0.702270 0.298189 0.156324 0.339885
## 29 0.541410 0.098359 0.496893 -0.702322 0.298171 0.155237 0.338391
## 30 0.540431 0.098331 0.496839 -0.702373 0.298156 0.154175 0.336933
## 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
## -0.002312 -0.003890 -0.048273 0.126947
## -0.002486 -0.004180 -0.052095 0.126854
## -0.002654 -0.004461 -0.055830 0.126765
## -0.002818 -0.004732 -0.059480 0.126681
## -0.002976 -0.004995 -0.063047 0.126600
## -0.003130 -0.005249 -0.066533 0.126523
## -0.003279 -0.005495 -0.069939 0.126449
## -0.003423 -0.005733 -0.073266 0.126379
## -0.003564 -0.005963 -0.076518 0.126312
## -0.003700 -0.006186 -0.079694 0.126248
## -0.003832 -0.006401 -0.082797 0.126187
## -0.003961 -0.006610 -0.085829 0.126129
## -0.004085 -0.006811 -0.088790 0.126073
## -0.004206 -0.007006 -0.091683 0.126020
## -0.004324 -0.007195 -0.094508 0.125970
## -0.004438 -0.007377 -0.097268 0.125922
## -0.004549 -0.007553 -0.099964 0.125876
## -0.004657 -0.007724 -0.102597 0.125832
## -0.004762 -0.007888 -0.105168 0.125790
## -0.004864 -0.008047 -0.107680 0.125750