knitr::opts_chunk$set(echo = TRUE)

library(DiagrammeR)

Introducción

El problema XOR compara dos bits de entrada y devuelve un único bit de salida.
Cuando ambos bits son iguales, la salida es 0; en cambio, si son diferentes, la salida es 1.
Este comportamiento puede resumirse en la siguiente tabla:

tabla <- data.frame(
  x1 = c(0,1,1,0),
  x2 = c(0,0,1,1),
  y  = c(0,1,0,1)
)
tabla
##   x1 x2 y
## 1  0  0 0
## 2  1  0 1
## 3  1  1 0
## 4  0  1 1

Descripción del ejercicio

Se construirá una red neuronal con dos entradas (x1 y x2), dos neuronas ocultas y una neurona de salida.
Para simplificar, solo se ejecutarán dos épocas de entrenamiento.
La función de activación empleada será la logística (sigmoide) y el método de aprendizaje será la retropropagación.

El propósito es mostrar cómo la red procesa la información a partir de los pesos y sesgos iniciales, para luego ajustar su capacidad de predicción.

Pesos y sesgos iniciales

Los valores con los que se iniciará el proceso son:

  • W1 = 0.1
  • W2 = 0.5
  • W3 = 0.7
  • W4 = 0.3
  • W5 = 0.2
  • W6 = 0.4
  • b1 = 0
  • b2 = 0
  • b3 = 0
grViz("
digraph NN {
  rankdir=LR
  graph [splines=straight]

  # Nodos de entrada (círculos gris claro)
  x1 [label='x1', shape=circle, style=filled, fillcolor=gray90, width=0.7]
  x2 [label='x2', shape=circle, style=filled, fillcolor=gray90, width=0.7]

  # Nodos ocultos (círculos blancos con borde negro)
  h1 [label='h1', shape=circle, style=filled, fillcolor=white, width=0.7]
  h2 [label='h2', shape=circle, style=filled, fillcolor=white, width=0.7]

  # Nodo de salida (triángulo rojo claro)
  y  [label='y', shape=triangle, style=filled, fillcolor=lightcoral, width=0.8]

  # Sesgos como cuadrados azules
  b1 [label='b1=0', shape=square, style=filled, fillcolor=lightblue, width=0.5]
  b2 [label='b2=0', shape=square, style=filled, fillcolor=lightblue, width=0.5]
  b3 [label='b3=0', shape=square, style=filled, fillcolor=lightblue, width=0.5]

  # Conexiones con etiquetas más pequeñas
  edge [fontsize=9]

  x1 -> h1 [label='W1=0.1']
  x1 -> h2 [label='W2=0.5']
  x2 -> h1 [label='W3=0.7']
  x2 -> h2 [label='W4=0.3']
  h1 -> y  [label='W5=0.2']
  h2 -> y  [label='W6=0.4']

  b1 -> h1 [fontsize=9]
  b2 -> h2 [fontsize=9]
  b3 -> y  [fontsize=9]
}
")
# Definimos función de activación
f_activacion <- function(x) 1 / (1 + exp(-x))

# Definimos derivada de la sigmoide
df_activacion <- function(x) {
  g <- f_activacion(x)
  g * (1 - g)
}

# Error total
f_error_total <- function(o_esp, o1) {
  0.5 * (o_esp - o1)^2
}

# Datos de ejemplo (x1=0, x2=1, esperado=1)
x1 <- 0
x2 <- 1
y_esp <- 1

# Pesos iniciales
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 <- 0.25

Función de forward (paso hacia adelante)

forward <- function(x1,x2,w1,w2,w3,w4,w5,w6,b1,b2,b3){
  z1 <- w1*x1 + w3*x2 + b1
  h1 <- f_activacion(z1)
  z2 <- w2*x1 + w4*x2 + b2
  h2 <- f_activacion(z2)
  z3 <- w5*h1 + w6*h2 + b3
  o1 <- f_activacion(z3)
  return(list(z1=z1,h1=h1,z2=z2,h2=h2,z3=z3,o1=o1))
}

Primera época

# Forward
salida <- forward(x1,x2,w1,w2,w3,w4,w5,w6,b1,b2,b3)
print(paste("Época 1 - salida:", round(salida$o1,6)))
## [1] "Época 1 - salida: 0.573499"
error <- f_error_total(y_esp, salida$o1)
print(paste("Época 1 - error:", round(error,6)))
## [1] "Época 1 - error: 0.090952"
# Backpropagation
dfz3 <- (salida$o1 - y_esp) * df_activacion(salida$z3)
dfw5 <- dfz3 * salida$h1
dfw6 <- dfz3 * salida$h2
dfz1 <- dfz3 * w5 * df_activacion(salida$z1)
dfz2 <- dfz3 * w6 * df_activacion(salida$z2)
dfw1 <- dfz1 * x1
dfw3 <- dfz1 * x2
dfw2 <- dfz2 * x1
dfw4 <- dfz2 * x2

# Actualización
w1 <- w1 - tasa*dfw1
w2 <- w2 - tasa*dfw2
w3 <- w3 - tasa*dfw3
w4 <- w4 - tasa*dfw4
w5 <- w5 - tasa*dfw5
w6 <- w6 - tasa*dfw6

print(paste("Pesos después de época 1:", 
            round(c(w1,w2,w3,w4,w5,w6),4)))
## [1] "Pesos después de época 1: 0.1"     "Pesos después de época 1: 0.5"    
## [3] "Pesos después de época 1: -0.6988" "Pesos después de época 1: 0.3026" 
## [5] "Pesos después de época 1: 0.2087"  "Pesos después de época 1: 0.415"

segunda epoca

# Forward
salida <- forward(x1,x2,w1,w2,w3,w4,w5,w6,b1,b2,b3)
print(paste("Época 2 - salida:", round(salida$o1,6)))
## [1] "Época 2 - salida: 0.57638"
error <- f_error_total(y_esp, salida$o1)
print(paste("Época 2 - error:", round(error,6)))
## [1] "Época 2 - error: 0.089727"
# Backpropagation
dfz3 <- (salida$o1 - y_esp) * df_activacion(salida$z3)
dfw5 <- dfz3 * salida$h1
dfw6 <- dfz3 * salida$h2
dfz1 <- dfz3 * w5 * df_activacion(salida$z1)
dfz2 <- dfz3 * w6 * df_activacion(salida$z2)
dfw1 <- dfz1 * x1
dfw3 <- dfz1 * x2
dfw2 <- dfz2 * x1
dfw4 <- dfz2 * x2

# Actualización
w1 <- w1 - tasa*dfw1
w2 <- w2 - tasa*dfw2
w3 <- w3 - tasa*dfw3
w4 <- w4 - tasa*dfw4
w5 <- w5 - tasa*dfw5
w6 <- w6 - tasa*dfw6

print(paste("Pesos después de época 2:", 
            round(c(w1,w2,w3,w4,w5,w6),4)))
## [1] "Pesos después de época 2: 0.1"     "Pesos después de época 2: 0.5"    
## [3] "Pesos después de época 2: -0.6976" "Pesos después de época 2: 0.3052" 
## [5] "Pesos después de época 2: 0.2172"  "Pesos después de época 2: 0.4299"
# --- Definición del grafo ---
library(igraph)
## 
## Attaching package: 'igraph'
## The following objects are masked from 'package:DiagrammeR':
## 
##     count_automorphisms, get_edge_ids
## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum
## The following object is masked from 'package:base':
## 
##     union
library(ggraph)
## Loading required package: ggplot2
## 
## Attaching package: 'ggraph'
## The following object is masked from 'package:DiagrammeR':
## 
##     get_edges
library(grid)

f_grafico <- function(x1,x2,x3,x4,x5,x6){
  nodes <- data.frame(
    name  = c("X1","X2","H1","H2","O1","B1","B2"),
    label = c("X1=0","X2=1","H1","H2","O1","B1","B2"),
    type  = c("input","input","hidden","hidden","output","bias","bias"),
    x     = c(0,0,3.5,3.5,7,2.5,2.5),
    y     = c(3,0,3,0,1.5,5.4,4)
  )
  edges <- data.frame(
    from  = c("X1","X1","X2","X2","H1","H2","B1","B2"),
    to    = c("H1","H2","H1","H2","O1","O1","H1","H2"),
    label = c(paste("W1=",x1), paste("W2=",x2), paste("W3=",x3),
              paste("W4=",x4), paste("W5=",x5), paste("W6=",x6),
              "B1=0","B2=0"),
    color = c(rep("black",6),"green","green")
  )
  g <- graph_from_data_frame(edges, vertices = nodes)
  ggraph(g, layout = "manual", x = nodes$x, y = nodes$y) +
    geom_edge_link(aes(label=label, color=I(color)),
                   angle_calc='along', label_dodge=unit(2.5,'mm'),
                   label_size=3, label_pos=0.3,
                   arrow=arrow(length=unit(3,'mm'), type="closed"),
                   end_cap=circle(16,'pt')) +
    geom_node_point(aes(shape=type, fill=type), size=12) +
    geom_node_text(aes(label=label), color="black", size=4, fontface="bold") +
    theme_void()
}

# --- Código de las épocas (usando tu forward + backprop simplificado) ---
# Definimos datos y pesos iniciales
f_activacion <- function(x) 1/(1+exp(-x))
df_activacion <- function(x){ g<-f_activacion(x); g*(1-g) }
x1<-0; x2<-1; y_esp<-1
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<-0.25

forward <- function(x1,x2,w1,w2,w3,w4,w5,w6,b1,b2,b3){
  z1 <- w1*x1 + w3*x2 + b1; h1<-f_activacion(z1)
  z2 <- w2*x1 + w4*x2 + b2; h2<-f_activacion(z2)
  z3 <- w5*h1 + w6*h2 + b3; o1<-f_activacion(z3)
  list(z1=z1,h1=h1,z2=z2,h2=h2,z3=z3,o1=o1)
}

# Función auxiliar para una época con grafo
una_epoca <- function(epoca,w1,w2,w3,w4,w5,w6){
  salida<-forward(x1,x2,w1,w2,w3,w4,w5,w6,b1,b2,b3)
  print(f_grafico(w1,w2,w3,w4,w5,w6))  # Dibuja grafo
  cat("\nÉpoca",epoca,"Salida=",round(salida$o1,6),"\n")
  
  # Retroprop
  dfz3 <- (salida$o1 - y_esp)*df_activacion(salida$z3)
  dfw5 <- dfz3*salida$h1; dfw6 <- dfz3*salida$h2
  dfz1 <- dfz3*w5*df_activacion(salida$z1)
  dfz2 <- dfz3*w6*df_activacion(salida$z2)
  dfw1 <- dfz1*x1; dfw3 <- dfz1*x2
  dfw2 <- dfz2*x1; dfw4 <- dfz2*x2
  w1 <- w1 - tasa*dfw1
  w2 <- w2 - tasa*dfw2
  w3 <- w3 - tasa*dfw3
  w4 <- w4 - tasa*dfw4
  w5 <- w5 - tasa*dfw5
  w6 <- w6 - tasa*dfw6
  return(list(w1=w1,w2=w2,w3=w3,w4=w4,w5=w5,w6=w6))
}

# --- Ejecutar época 1 y 2 ---
pesos <- una_epoca(1,w1,w2,w3,w4,w5,w6)

## 
## Época 1 Salida= 0.573499
pesos <- una_epoca(2,pesos$w1,pesos$w2,pesos$w3,pesos$w4,pesos$w5,pesos$w6)

## 
## Época 2 Salida= 0.57638