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.

Primero se asignan los pesos iniciales de cada aristas y los sesgos para cada entrada. En este caso se organizaron dentro de una matriz donde cada fila representa una entrada distinta.

#Pesos de las aristas
M_pesos <- matrix(c(0.1,0.5,-0.7,0.3,0.2,0.4,
                    0.1,0.5,-0.7,0.3,0.2,0.4,
                    0.1,0.5,-0.7,0.3,0.2,0.4,
                    0.1,0.5,-0.7,0.3,0.2,0.4),
                    ncol = 6, byrow = TRUE)

#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 = M_pesos[i,1]*x1 + M_pesos[i,3]*x2 + b1
  h1 = funcion_activacion(z1)

  z2 = M_pesos[i,2]*x1 + M_pesos[i,4]*x2 + b2
  h2 = funcion_activacion(z2)

  z3 = M_pesos[i,5]*h1 + M_pesos[i,6]*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 define una matriz de 4x3, donde cada fila corresponde a una entrada. Las dos primeras columnas representan las variables de entrada x1 y x2, mientras que la tercera columna contiene el valor esperado asociado a cada caso. Además, se especifica el número de épocas que se desean observar.

Posteriormente, el código entra en un ciclo iterativo que recorre cada época. En cada una de ellas, la red neuronal se inicializa con los pesos actuales, se calcula la salida obtenida y se muestra el error total. A continuación, se lleva a cabo internamente el proceso de retropropagación, mediante el cual se ajustan los pesos de la red. Este procedimiento se ejecuta dentro de otro ciclo que controla qué entrada se está procesando en la época correspondiente. De esta manera, en cada época se evalúan todas las entradas y se actualizan los pesos de acuerdo con los resultados obtenidos.

Para ilustrar el proceso, en este ejemplo 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){
   for (i in 1:4){ 
     
  print(funcion_grafico(M_pesos[i,1],M_pesos[i,2],M_pesos[i,3],M_pesos[i,4],M_pesos[i,5],M_pesos[i,6], 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
  
  act5 = M_pesos[i,5] - tasa_de_aprendizaje*deriv_w5
  act6 = M_pesos[i,6] - tasa_de_aprendizaje*deriv_w6 
  
  #Capa oculta
  deriv_z1 = deriv_z3*M_pesos[i,5]*deriv_activacion(ep$z1)
  deriv_z2 = deriv_z3*M_pesos[i,6]*deriv_activacion(ep$z2)
  
  #neurona h1
  deriv_w1 = deriv_z1*M_ent[i,1]
  deriv_w3 = deriv_z1*M_ent[i,2]
  act1 = M_pesos[i,1] - tasa_de_aprendizaje*deriv_w1
  act3 = M_pesos[i,3] - tasa_de_aprendizaje*deriv_w3
  
  #neurona h2
  deriv_w2 = deriv_z2*M_ent[i,1]
  deriv_w4 = deriv_z2*M_ent[i,2]
  
  act2 = M_pesos[i,2] - tasa_de_aprendizaje*deriv_w2
  act4 = M_pesos[i,4] -tasa_de_aprendizaje*deriv_w4
  
  #Se reemplazan los pesos
  M_pesos[i,1] = act1
  M_pesos[i,2] = act2
  M_pesos[i,3] = act3
  M_pesos[i,4] = act4
  M_pesos[i,5] = act5
  M_pesos[i,6] = act6
  
  }
  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.570145936717972"
## [1] "El error total para la red neuronal respecto al valor esperado en la época 2 en la entrada 1 es de 0.162533194578007"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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.