Fuente Hernández, F. “Redes neuronales con neuralnet”. Consultado el 31 de mayo de 2019.

Wikipedia. “Red neuronal artificial”. Consultado el 7 de junio de 2019

file <- "https://raw.githubusercontent.com/fhernanb/datos/master/propelente"
datos <- read.table(file=file, header=TRUE) 
head(datos) # Muestra las 6 primeras filas
##   Resistencia  Edad
## 1     2158.70 15.50
## 2     1678.15 23.75
## 3     2316.00  8.00
## 4     2061.30 17.00
## 5     2207.50  5.50
## 6     1708.30 19.00

Diagrama de dispersión

#install.packages("ggplot2", dependencies = TRUE)   # Se instala una sola vez
library(ggplot2)                                   # Se carga cada session
ggplot(datos, aes(x=Edad, y=Resistencia)) + geom_point()

#install.packages("neuralnet", dependencies = TRUE) # Se instala una sola vez
library(neuralnet)                                 # Se carga cada session

Creación de la red neuronal Antes de crear la red es necesario escalar las variables para evitar el efecto de la escala de las variables. Existen varias formas de escalar pero se usará una transformación para pasar los valores de las variables al intervalo (0,1).

Con el siguiente código se va convertir los datos originales a datos escalados y se almacenarán en el objeto scaled.

maxs <- apply(datos, 2, max) # Máximo valor de las variables
mins <- apply(datos, 2, min) # Mínimo valor de las variables
scaled <- as.data.frame(scale(datos, center=mins, scale=maxs-mins))

A continuación, se comparan las primeras 6 filas de datos y de scaled para ver lo que sucedió.

head(cbind(datos, scaled))
##   Resistencia  Edad Resistencia      Edad
## 1     2158.70 15.50  0.49234158 0.5869565
## 2     1678.15 23.75  0.00000000 0.9456522
## 3     2316.00  8.00  0.65350136 0.2608696
## 4     2061.30 17.00  0.39255161 0.6521739
## 5     2207.50  5.50  0.54233902 0.1521739
## 6     1708.30 19.00  0.03088981 0.7391304

En la siguiente figura se muestra el diagrama de dispersión para las variables escaladas. Al comparar ambos gráficos de dispersión (con datos y con scaled) se observa el mismo patrón en la nube de puntos, la única diferencia es que ahora los valores de las variables (Y y X) están en (0,1).

#install.packages("gridExtra", dependencies = TRUE) # Se instala una sola vez
require(gridExtra)                                 # Se carga cada session
## Loading required package: gridExtra
plot1 <- ggplot(datos, aes(x=Edad, y=Resistencia)) + geom_point()
plot2 <- ggplot(scaled, aes(x=Edad, y=Resistencia)) + geom_point()
grid.arrange(plot1, plot2, ncol=2)

Ahora bien, la primera red neuronal a considerar se llamará mod1 y tendrá una capa con un solo nodo. El código para crear la red es el siguiente.

library(neuralnet)
mod1 <- neuralnet(Resistencia ~ Edad, data=scaled, hidden=c(1), threshold=0.01)

Recuerde que:

hidden: es un vector de enteros que especifica el número de neuronas ocultas (vértices) en cada capa. threshold: un valor numérico que especifica el umbral para los derivados parciales de la función de error como criterio de parada. Además, se puede construir un dibujo con la red ajustada usando la función plot sobre el objeto mod1, véase:

plot(mod1, rep="best")

El objeto mod1 tiene varios elementos en su interior, éstos se pueden ver usando el código siguiente:

names(mod1)
##  [1] "call"                "response"            "covariate"          
##  [4] "model.list"          "err.fct"             "act.fct"            
##  [7] "linear.output"       "data"                "exclude"            
## [10] "net.result"          "weights"             "generalized.weights"
## [13] "startweights"        "result.matrix"

El elemento act.fct es la función de activación (logística por defecto) y el elemento weights contiene los pesos mostrados en la anterior figura. Estos dos elementos serán útiles más adelante. A continuación el código para explorar lo que hay dentro de estos dos elementos.

mod1$act.fct # Activation function
## function (x) 
## {
##     1/(1 + exp(-x))
## }
## <bytecode: 0x00000000158862c8>
## <environment: 0x0000000015882d90>
## attr(,"type")
## [1] "logistic"
unlist(mod1$weights)  # Obtener en formas de vector los weigths=pesos
## [1]  0.1961139 -1.6052845 -0.4197824  2.4329635

Predicción

En este ejemplo la base de datos tiene solo 20 observaciones y por esta razón el conjunto de entrenamiento y conjunto de prueba son el mismo.

En el código mostrado a continuación se crea el conjunto de prueba test solo con la covariable Edad proveniente de la base scaled. La función compute permite predecir los valores Resistencia para la informacion disponible en test teniendo como referencia una red neuronal entrenada, en este caso vamos a usar mod1.

test <- data.frame(Edad = scaled$Edad)
myprediction <- compute(x=mod1, covariate=test)

El objeto myprediction tiene varios elementos y uno de ellos es $net.result que contiene las predicciones. A continuación vamos a explorar los 5 primeros valores.

myprediction$net.result[1:5]
## [1] 0.36282336 0.09235129 0.66182764 0.30831310 0.76740696

El elemento $net.result del objeto myprediction tiene la respuesta estimada pero en la forma escalada, por esta razón es necesario aplicar la transformación inversa para obtener el resultado en la escala original. A continuación el código necesario para retornar a la escala original.

yhat_red <- myprediction$net.result * (max(datos$Resistencia)-min(datos$Resistencia))+min(datos$Resistencia)
datos$yhat_red <- yhat_red
yhat_red[1:5] # Para ver los primeros 5 valores estimados
## [1] 2032.284 1768.289 2324.127 1979.079 2427.178

Para comparar los resultados obtenidos con la red neuronal podemos dibujar los valores observados y contra los valores estimados de la variable respuesta. A continuación, se muestra el código para crear el gráfico de dispersión al cual se le agrega un línea recta a 45 grados como referencia; entre más cerca este un punto de la línea, significa que la respuesta estimada y son cercanos.

ggplot(datos, aes(x=Resistencia, y=yhat_red)) + geom_point() +
  geom_abline(intercept=0, slope=1, color="blue", linetype="dashed", size=1.5)

Red neuronal con dos capas

Como ilustración vamos a construir una segunda red con dos capas, la primera con 2 nodos y la segunda con 3 nodos, a continuación el código.

mod3 <- neuralnet(Resistencia ~ Edad, data=scaled, 
                  hidden=c(2, 3), threshold=0.01)
plot(mod3, rep="best")

joseb <- neuralnet(Resistencia ~ Edad, data=scaled, 
                  hidden=c(7, 15, 8, 4), threshold=0.01)

plot(joseb, rep="best")

error de 0.05355

joseb2 <- neuralnet(Resistencia ~ Edad, data=scaled, 
                  hidden=c(10, 6, 4, 2, 2), threshold=0.01)

plot(joseb2, rep="best")

joseb2 <- neuralnet(Resistencia ~ Edad, data=scaled, 
                  hidden=c(50, 120, 45, 12, 5), threshold=0.01)

plot(joseb2, rep="best")