El modelo que se empleó en la clase es una red neuronal que tiene dos entradas, dos neuronas ocultas y una neurona de salida. La función de activación utilizada es la sigmoide. La finalidad de este código es llevar a cabo n iteraciones del proceso de retropropagación, que tiene como objetivo el entrenamiento del algoritmo mediante la optimización de los pesos. Así, la red neuronal será capaz de aprender a asociar entradas arbitrarias con su salida correspondiente.

En este ejercicio a diferencia del realizado en Retropropagación en una red neuronal 2.0 se utiliza el método Batch Gradient Descent (BGD) que sigue la misma lógica básica del descenso por gradiente: calcular el error, ajustar los pesos y repetir el proceso hasta que el modelo aprenda. La diferencia clave es que, en lugar de trabajar con una sola muestra a la vez, aquí se usa todo el conjunto de entrenamiento en cada iteración.

El procedimiento funciona más o menos así: primero se pasa toda la información por el modelo y se obtiene el error global. Luego, con base en ese error, se calcula el gradiente y finalmente se ajustan los pesos. En otras palabras, no se van haciendo pequeños cambios después de cada ejemplo, sino que se espera a procesar todos los datos para luego hacer una actualización más completa y “promediada”.

En resumen, con BGD cada época significa procesar todos los ejemplos, calcular el error total y luego ajustar los pesos en función de ese resultado. Es un método más “seguro” en el sentido de que avanza de manera estable, aunque no siempre sea el más rápido.

Primero se inicializan los pesos de las aristas y los sesgos en 0:

#Pesos de las aristas
w1 <- 0.1
w2 <- 0.5
w3 <- -0.7
w4 <- 0.3
w5 <- 0.2
w6 <- 0.4

#Valor de los sesgos  
b1 <- 0
b2 <- 0
b3 <- 0
#Función de activación Sigmoide
funcion_activacion <- function(x) {
  1/(1 + exp(-x))
} 

#Derivada de la función de activación
deriv_activacion <- Deriv(funcion_activacion, "x" ) 

#Función que ejecuta una época
funcion_epoca <- function(x1,x2,i) {

  z1 = w1*x1 + w3*x2 + b1
  h1 = funcion_activacion(z1)

  z2 = w2*x1 + w4*x2 + b2
  h2 = funcion_activacion(z2)

  z3 = w5*h1 + w6*h2 + b3
  o1 = funcion_activacion(z3)
  
  return(list(z1=z1, h1=h1, z2=z2, h2=h2, z3=z3, o1=o1))
  
} 

#Función error total
funcion_error_total <- function(o_esp, o1) {
  0.5 * (o_esp-o1)^2
} 

#Derivada del error total 
deriv_error_total <- Deriv(funcion_error_total, "o1") 
#Función que genera al grafo
funcion_grafico <- function(x1,x2,x3,x4,x5,x6,salida, entrada1, entrada2){
  
  #Nodos
  nodes <- data.frame(
    name = c("X1","X2","H1","H2","O1","B1","B2"),
    label = c(paste("X1\n",entrada1),paste("X1\n",entrada2),"H1","H2",paste("O1\n",salida),"B1","B2"),
    type = c("input","input","hidden","hidden","output","bias","bias"),
    x = c(0,0,3.5,3.5,7,2,5),
    y = c(3,0,3,0,1.5,4,4)
  )
  
  #Aristas
  edges <- data.frame(
    from = c("X1","X1","X2","X2","H1","H2","B1","B1","B2"),
    to   = c("H1","H2","H1","H2","O1","O1","H1","H2","O1"),
    label= c(paste("W1 = ",x1),paste("W2 = ",x2),paste("W3 = ",x3)
             ,paste("W4 = ",x4),paste("W5 = ",x5),paste("W6 = ",x6),
             "B1 = 0","B2 = 0","B3 = 0"),
    color= c("black","black","black","black","black","black","#1874CD","#1874CD","#1874CD")
  )
  
  #Creación del grafo
  g <- graph_from_data_frame(edges, vertices = nodes)
  ggraph(g, layout = "manual", x = nodes$x, y = nodes$y) +
    
    #Aristas
    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'))+
    
    #Nodos
    geom_node_point(aes(shape = type, color = type, fill = type), size = 15, stroke = 1) +
    
    geom_node_text(aes(label = label, x = x, y = y), color="black", size=4, fontface="bold") +
    
    scale_shape_manual(values = c(
      input = 21, hidden = 21, output = 21, bias = 17  #21 es circulo, 17 es triangulo
    )) +
    
    scale_fill_manual(values=c("input"="#00CDCD","hidden"="#00CDCD","output"="#00CDCD","bias"="black")) +
    
    scale_color_manual(values = c(
      input = "black", hidden = "black", output = "black", bias = "grey"
    )) +
    
    guides(shape = "none", color = "none", fill = "none")+
    
    theme_void()
}

Al ejecutar el código se distinguen dos ciclos principales. El primero es un ciclo while que controla el número de épocas. Dentro de este, se inicializan las sumatorias de los gradientes para cada peso. A continuación, se desarrolla un segundo ciclo que recorre cada una de las entradas. En este punto, para cada entrada se ejecuta la época y el proceso de retropropagación, pero en lugar de actualizar inmediatamente los pesos, se van acumulando los gradientes obtenidos.

Una vez se procesan todas las entradas, los pesos se actualizan empleando el promedio de los gradientes acumulados, lo que permite obtener una estimación más equilibrada para el conjunto de salidas. Para este caso, se realizará una prueba utilizando 5 épocas.

M_ent <- matrix(c(0,0,0,
                  0,1,1,
                  1,1,0,
                  1,0,1), 
                  ncol = 3, byrow = TRUE)

num_epocas <- 5 
tasa_de_aprendizaje <- 0.25 

#En este ciclo realizamos las operaciones de retropropagación
k <- 1
while(k <= num_epocas){
  
  gradiente_w1 <- 0
  gradiente_w2 <- 0
  gradiente_w3 <- 0
  gradiente_w4 <- 0
  gradiente_w5 <- 0
  gradiente_w6 <- 0
  
   for (i in 1:4){ 
     
  print(funcion_grafico(w1,w2,w3,w4,w5,w6,M_ent[i,3],M_ent[i,1],M_ent[i,2]))  
     
  #El error y el valor de o1 (la salida)
  ep<-funcion_epoca(M_ent[i,1],M_ent[i,2], i)
  print(paste("El valor de o1 o salida de la época",k, "en la entrada",i, "es",ep$o1 ))
  
  print(paste("El error total para la red neuronal respecto al valor esperado en la época",k,"en la entrada",i, "es de",funcion_error_total(M_ent[i,3],ep$o1)))
  
  
  #Retropropagacion
  
  #Capa de salida
  deriv_z3 = deriv_error_total(M_ent[i,3], ep$o1)*deriv_activacion(ep$z3)
  
  deriv_w5 = deriv_z3*ep$h1
  deriv_w6 = deriv_z3*ep$h2
  
  gradiente_w5 = gradiente_w5 + deriv_w5
  gradiente_w6 = gradiente_w6 + deriv_w6
  
  #Capa oculta
  deriv_z1 = deriv_z3*w5*deriv_activacion(ep$z1)
  deriv_z2 = deriv_z3*w6*deriv_activacion(ep$z2)
  
  #neurona h1
  deriv_w1 = deriv_z1*M_ent[i,1]
  deriv_w3 = deriv_z1*M_ent[i,2]
  
  gradiente_w1 = gradiente_w1 + deriv_w1
  gradiente_w3 = gradiente_w3 + deriv_w3
  
  #neurona h2
  deriv_w2 = deriv_z2*M_ent[i,1]
  deriv_w4 = deriv_z2*M_ent[i,2]
  
  gradiente_w2 = gradiente_w2 + deriv_w2
  gradiente_w4 = gradiente_w4 + deriv_w4
  
   }
  
  #Se reemplazan los pesos
  w1 = w1 - tasa_de_aprendizaje*(gradiente_w1/4)
  w2 = w2 - tasa_de_aprendizaje*(gradiente_w2/4)
  w3 = w3 - tasa_de_aprendizaje*(gradiente_w3/4)
  w4 = w4 - tasa_de_aprendizaje*(gradiente_w4/4)
  w5 = w5 - tasa_de_aprendizaje*(gradiente_w5/4)
  w6 = w6 - tasa_de_aprendizaje*(gradiente_w6/4)
  
  k <- k+1
}

## [1] "El valor de o1 o salida de la época 1 en la entrada 1 es 0.574442516811659"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 1 en la entrada 1 es de 0.164992102560457"

## [1] "El valor de o1 o salida de la época 1 en la entrada 2 es 0.573498503710098"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 1 en la entrada 2 es de 0.0909517631687627"

## [1] "El valor de o1 o salida de la época 1 en la entrada 3 es 0.58585557419851"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 1 en la entrada 3 es de 0.171613376909733"

## [1] "El valor de o1 o salida de la época 1 en la entrada 4 es 0.587582280463471"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 1 en la entrada 4 es de 0.0850441876938554"

## [1] "El valor de o1 o salida de la época 2 en la entrada 1 es 0.573833897941841"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 2 en la entrada 1 es de 0.164642671213563"

## [1] "El valor de o1 o salida de la época 2 en la entrada 2 es 0.572918986033734"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 2 en la entrada 2 es de 0.0911990962452269"

## [1] "El valor de o1 o salida de la época 2 en la entrada 3 es 0.585184067504359"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 2 en la entrada 3 es de 0.171220196430473"

## [1] "El valor de o1 o salida de la época 2 en la entrada 4 es 0.586875567785365"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 2 en la entrada 4 es de 0.0853358982463321"

## [1] "El valor de o1 o salida de la época 3 en la entrada 1 es 0.573229770680062"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 3 en la entrada 1 es de 0.164296184996958"

## [1] "El valor de o1 o salida de la época 3 en la entrada 2 es 0.572343869922957"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 3 en la entrada 2 es de 0.0914448827962363"

## [1] "El valor de o1 o salida de la época 3 en la entrada 3 es 0.584517669724806"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 3 en la entrada 3 es de 0.170830453110259"

## [1] "El valor de o1 o salida de la época 3 en la entrada 4 es 0.586174104414647"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 3 en la entrada 4 es de 0.0856259359285098"

## [1] "El valor de o1 o salida de la época 4 en la entrada 1 es 0.572630111772971"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 4 en la entrada 1 es de 0.163952622454563"

## [1] "El valor de o1 o salida de la época 4 en la entrada 2 es 0.571773129314338"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 4 en la entrada 2 es de 0.0916891263886172"

## [1] "El valor de o1 o salida de la época 4 en la entrada 3 es 0.583856350351253"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 4 en la entrada 3 es de 0.170444118922742"

## [1] "El valor de o1 o salida de la época 4 en la entrada 4 es 0.585477862220103"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 4 en la entrada 4 es de 0.085914301354808"

## [1] "El valor de o1 o salida de la época 5 en la entrada 1 es 0.572034897844324"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 5 en la entrada 1 es de 0.163611962175883"

## [1] "El valor de o1 o salida de la época 5 en la entrada 2 es 0.571206738117783"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 5 en la entrada 2 es de 0.0919318307177958"

## [1] "El valor de o1 o salida de la época 5 en la entrada 3 es 0.583200078848992"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 5 en la entrada 3 es de 0.170061165984735"

## [1] "El valor de o1 o salida de la época 5 en la entrada 4 es 0.584786812953066"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 5 en la entrada 4 es de 0.0862009953488359"

Como se puede ver, a medida que cada época se lleva a cabo, el valor de salida se aproxima cada vez más al valor esperado (en este caso 1), y el error total disminuye, acercándose a 0. Esto permite determinar la eficacia del algoritmo de aprendizaje. Además, es importante destacar que un ejemplo con solo cinco iteraciones no es suficiente para demostrar la eficacia del algoritmo, aunque sí sirve como una ilustración de su funcionamiento.