eXclusive OR (XOR) es una operación lógica booleana muy utilizada en criptografía y en la generación de bits de paridad para la comprobación de errores y la tolerancia a fallos. XOR compara dos bits de entrada y genera un bit de salida. La lógica es sencilla. Si los bits son iguales, el resultado es 0. Si los bits son diferentes, el resultado es 1.

El ejemplo que se trabajo en clase se trata de una red neuronal con dos inputs, dos neuronas ocultas y una neurona de salida, con la función Sigmoide como función de activación. Este código fue desarrollado con el objetivo de ejecutar automaticamente n-iteraciones del proceso de retropropagación para 4 entradas distintas, que busca el entrenamiento del algoritmo optimizando los pesos para que la red neuronal pueda aprender a asignar entradas arbitrarias con su respecctiva salida.

Se utilizaron las librerías ‘igraph’, ‘ggraph’ y ‘ggplot2’ para la graficación de la red neuronal, y la librería Deriv para las derivadas parciales que se requieren para el proceso de retropropagación.

Inicialmente se asignan los pesos iniciales de cada aristas y los sesgos, para el ejemplo se trabajo con los valores iniciales que se pueden observar, y con 0 sesgos:

#Ingrese el valor de cada arista
w1 <- 0.1
w2 <- 0.5
w3 <- -0.7
w4 <- 0.3
w5 <- 0.2
w6 <- 0.4

#Ingrese el valor de los sesgos  
b1 <<- 0
b2 <<- 0
b3 <<- 0


k <<- 1

#Función de activación Sigmoide
f_activacion <- function(x) {
  1/(1 + exp(-x))
} 

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

#Función que ejecuta una época
f_epoca <- function(x1,x2) {
  
  #h1
  z1 = w1*x1 + w3*x2 + b1
  h1 = f_activacion(z1)
  #h2
  z2 = w2*x1 + w4*x2 + b2
  h2 = f_activacion(z2)
  #o1
  z3 = w5*h1 + w6*h2 + b3
  o1 = f_activacion(z3)
  
  return(list(z1=z1, h1=h1, z2=z2, h2=h2, z3=z3, o1=o1))
  
} 

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

#Derivada del error total 
df_error_total <- Deriv(f_error_total, "o1") 

#Función que genera al grafo
f_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","green","green","green")
  )
  
  #Creación del grafo
  g <- graph_from_data_frame(edges, vertices = nodes)
  
  #Graficación
  
  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"="#F52754","hidden"="#F52754","output"="#F52754","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 momento de ejecutar el código se declara una matriz 4X3 la donde cada fila representa una entrada, las columnas 1 y 2 representan la entrada de x1 y x2 respectivamente, la columna 3 representa el valor esperado para cada entrada y por último se otorga el valor del número de epocas que se quiere observar. Este algoritmo utiliza el método ‘Batch Gradient Descent’ el cual consiste en actualizar los pesos de la red una vez por época utilizando un promedio del gradiente de cada arista por entrada obtenido tras la retropropagación, al final de la epocas se usa este promedio para actualizar cada respectivo peso. Para este ejemplo se realizara un prueba con 5 épocas:

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



num4 <- 5 #Digite el número de épocas que quiere ver
tasa_de_aprendizaje <- 0.25 #Digite la tasa de aprendizaje


#Este ciclo se encarga de la transición entre épocas
while(k <= num4){
  print("NUEVA EPOCA")
  
  #Sumatoria de cada gradiente con su respectiva arista
  grad_w1 <- grad_w2 <- grad_w3 <- grad_w4 <- grad_w5 <- grad_w6 <- 0
  
  #Inicio de ejecución por entrada
  for (i in 1:4){
  #grafico de la epoca  
  print(f_grafico(w1,w2,w3,w4,w5,w6,
                  matrizEntradas[i,3],matrizEntradas[i,1],matrizEntradas[i,2]))  
  
  
  salida <- f_epoca(matrizEntradas[i,1],matrizEntradas[i,2]) 
  print(paste("La salida de la época", k, "Correspondiente a la entrada ",i,
              "Es la siguiente: ", salida$o1 ))
  
  error <- f_error_total(matrizEntradas[i,3],salida$o1)
  print(paste("El error respecto al valor esperado en la época ", k, 
              "Correspondiente a la entrada ",i, "fue de: ", error))
  
  
  #Retropropagacion
  #Output layer
  dfz3 = df_error_total(matrizEntradas[i,3], salida$o1)*df_activacion(salida$z3)
  
  dfw5 = dfz3*salida$h1
  dfw6 = dfz3*salida$h2
  
  #Se almacenan los valores de cada gradiente
  grad_w5 = grad_w5 + dfw5
  grad_w6 = grad_w6 + dfw6 
  
  #Hidden layer
  dfz1 = dfz3*w5*df_activacion(salida$z1)
  dfz2 = dfz3*w6*df_activacion(salida$z2)
  
  #neurona h1
  dfw1 = dfz1*matrizEntradas[i,1]
  dfw3 = dfz1*matrizEntradas[i,2]
  
  #Se almacenan los valores de cada gradiente
  grad_w1 = grad_w1 + dfw1
  grad_w3 = grad_w3 + dfw3
  
  #neurona h2
  dfw2 = dfz2*matrizEntradas[i,1]
  dfw4 = dfz2*matrizEntradas[i,2]
  
  #Se almacenan los valores de cada gradiente
  grad_w2 = grad_w2 + dfw2
  grad_w4 = grad_w4 + dfw4
  
  }
  #Se actualizan los pesos una vez finalizada la época
  paste("los pesos actualizados son los siguientes: ")
  w1 = w1 - tasa_de_aprendizaje*(grad_w1/4)
  w2 = w2 - tasa_de_aprendizaje*(grad_w2/4)
  w3 = w3 - tasa_de_aprendizaje*(grad_w3/4)
  w4 = w4 - tasa_de_aprendizaje*(grad_w4/4)
  w5 = w5 - tasa_de_aprendizaje*(grad_w5/4)
  w6 = w6 - tasa_de_aprendizaje*(grad_w6/4)
  
  
  k <- k+1
}
## [1] "NUEVA EPOCA"

## [1] "La salida de la época 1 Correspondiente a la entrada  1 Es la siguiente:  0.574442516811659"
## [1] "El error respecto al valor esperado en la época  1 Correspondiente a la entrada  1 fue de:  0.164992102560457"

## [1] "La salida de la época 1 Correspondiente a la entrada  2 Es la siguiente:  0.573498503710098"
## [1] "El error respecto al valor esperado en la época  1 Correspondiente a la entrada  2 fue de:  0.0909517631687627"

## [1] "La salida de la época 1 Correspondiente a la entrada  3 Es la siguiente:  0.58585557419851"
## [1] "El error respecto al valor esperado en la época  1 Correspondiente a la entrada  3 fue de:  0.171613376909733"

## [1] "La salida de la época 1 Correspondiente a la entrada  4 Es la siguiente:  0.587582280463471"
## [1] "El error respecto al valor esperado en la época  1 Correspondiente a la entrada  4 fue de:  0.0850441876938554"
## [1] "NUEVA EPOCA"

## [1] "La salida de la época 2 Correspondiente a la entrada  1 Es la siguiente:  0.573833897941841"
## [1] "El error respecto al valor esperado en la época  2 Correspondiente a la entrada  1 fue de:  0.164642671213563"

## [1] "La salida de la época 2 Correspondiente a la entrada  2 Es la siguiente:  0.572918986033734"
## [1] "El error respecto al valor esperado en la época  2 Correspondiente a la entrada  2 fue de:  0.0911990962452269"

## [1] "La salida de la época 2 Correspondiente a la entrada  3 Es la siguiente:  0.585184067504359"
## [1] "El error respecto al valor esperado en la época  2 Correspondiente a la entrada  3 fue de:  0.171220196430473"

## [1] "La salida de la época 2 Correspondiente a la entrada  4 Es la siguiente:  0.586875567785365"
## [1] "El error respecto al valor esperado en la época  2 Correspondiente a la entrada  4 fue de:  0.0853358982463321"
## [1] "NUEVA EPOCA"

## [1] "La salida de la época 3 Correspondiente a la entrada  1 Es la siguiente:  0.573229770680062"
## [1] "El error respecto al valor esperado en la época  3 Correspondiente a la entrada  1 fue de:  0.164296184996958"

## [1] "La salida de la época 3 Correspondiente a la entrada  2 Es la siguiente:  0.572343869922957"
## [1] "El error respecto al valor esperado en la época  3 Correspondiente a la entrada  2 fue de:  0.0914448827962363"

## [1] "La salida de la época 3 Correspondiente a la entrada  3 Es la siguiente:  0.584517669724806"
## [1] "El error respecto al valor esperado en la época  3 Correspondiente a la entrada  3 fue de:  0.170830453110259"

## [1] "La salida de la época 3 Correspondiente a la entrada  4 Es la siguiente:  0.586174104414647"
## [1] "El error respecto al valor esperado en la época  3 Correspondiente a la entrada  4 fue de:  0.0856259359285098"
## [1] "NUEVA EPOCA"

## [1] "La salida de la época 4 Correspondiente a la entrada  1 Es la siguiente:  0.572630111772971"
## [1] "El error respecto al valor esperado en la época  4 Correspondiente a la entrada  1 fue de:  0.163952622454563"

## [1] "La salida de la época 4 Correspondiente a la entrada  2 Es la siguiente:  0.571773129314338"
## [1] "El error respecto al valor esperado en la época  4 Correspondiente a la entrada  2 fue de:  0.0916891263886172"

## [1] "La salida de la época 4 Correspondiente a la entrada  3 Es la siguiente:  0.583856350351253"
## [1] "El error respecto al valor esperado en la época  4 Correspondiente a la entrada  3 fue de:  0.170444118922742"

## [1] "La salida de la época 4 Correspondiente a la entrada  4 Es la siguiente:  0.585477862220103"
## [1] "El error respecto al valor esperado en la época  4 Correspondiente a la entrada  4 fue de:  0.085914301354808"
## [1] "NUEVA EPOCA"

## [1] "La salida de la época 5 Correspondiente a la entrada  1 Es la siguiente:  0.572034897844324"
## [1] "El error respecto al valor esperado en la época  5 Correspondiente a la entrada  1 fue de:  0.163611962175883"

## [1] "La salida de la época 5 Correspondiente a la entrada  2 Es la siguiente:  0.571206738117783"
## [1] "El error respecto al valor esperado en la época  5 Correspondiente a la entrada  2 fue de:  0.0919318307177958"

## [1] "La salida de la época 5 Correspondiente a la entrada  3 Es la siguiente:  0.583200078848992"
## [1] "El error respecto al valor esperado en la época  5 Correspondiente a la entrada  3 fue de:  0.170061165984735"

## [1] "La salida de la época 5 Correspondiente a la entrada  4 Es la siguiente:  0.584786812953066"
## [1] "El error respecto al valor esperado en la época  5 Correspondiente a la entrada  4 fue de:  0.0862009953488359"

Aunque se observa como en algunas entradas no hay una mejora en la estimación, esto también se debe a que en 5 iteraciones no se espera observar un cambio tan visible, se requiere una mayor cifra de iteraciones para observar plenamente la efectividad del algoritmo, sin embargo las 5 epocas mostradas funciona para ejemplificar el funcionamiento del algoritmo