[0.] Configuración inicial

Para replicar las secciones de esta clase, primero debe descargar el siguiente proyecto de R y abrir el archivo clase-10.Rproj.

0.0 Instalar/llamar las librerías de la clase

require(pacman)
p_load(tidyverse,rio,janitor,skimr,
       neuralnet) ## libreria para redes

[1.] Introduccion

1.1 Elementos de una red neuronal

#### + Neuronas
# Los nodos de una red neuronal reciben el nombre de neurona
# Las neuronas se agrupan en capas

#### + Capas: una red neuronal tiene a lo menos 3 capas
# Input
# Output
# A lo menor una capa oculta

#### + Pesos/Coeficientes
# Son las ponderaciones que la red le asigna a cada neurona
# Resalta la importancia de la conexion en entre las neuronas

#### + Sesgo/Constante:
# Cada neurona tiene un sesgo (menor en la capa de input)

#### + Funcion de activacion:
# Define si una neurona se prende o no
# Las funciones de activacion agregan componentes no lineales a una red
# Funcion de escalon: {1 if x > 0 & 0 if x < 0} ; No suavisa el ajuste y en x == 0 no tiene derivada
# Funciones sigmoides (tienen forma de S) logistica: 1/(1 + e-x) ; desvanecimiento de gradiente y alto costo compuacional
# ReLU: Rectified Linear Unit - max{0,x} ; simple y bajo costo computacional, pero neuronas muertas
# Leaky ReLU: - max{0.01x,x} ; Evita las neuronas muertas pero desvanece el gradiente
# PReLU: Parametric ReLU - {x if x > 0 | ax if x <= 0}

#### + Optimizador: Algoritmo que le indica a la red como ajustar ajustar pesos y sesgos para que aprenda y no desaprenda
# tasa de aprendizaje (LR - learning rate): que tanto ajustar pesos y sesgos
# Con LR pequeña e aprendizaje es lento
# Con LR grande el aprendizaje es rapido pero se puede pasar del numero esperado
# Número de vueltas (veces en las que evalua los datos para hacer el ajuste)

#### + Funcion de perdida:
# Para medir que tan bien lo esta haciendo la red
# RMSE: Raiz del Error Cuadratico Medio 

### **1.2 Hiperparametos de una red neuronal** ###

# Numero de capas
# Numero de neuronas en la capa
# Otimizador
# Tasa de aprendizaje
# Numero de vueltas
# Funcion de activacion

### **1.3 Algoritmo de una red neuronal** ###

# 1. Tener el vector de inputs y el vector de outputs
# 2. Iniciar la red con valores aleatorios de pesos y sesgos
# 3. Hacer la prediccion (generar un output) para cada input
# 4. Comparar predicciones con valores observados 
# 5. Ajustar pesos y sesgos por backpropagation 
# 6. Repite pasos 3, 4 y 5

[2.] Red Neuronal Basica

2.1 Modelo basico

## susesion de fibonachi: https://www.rpubs.com/MauricioSF/558913#:~:text=La%20secuencia%20de%20Fibonacci%20es,%2C%20233%2C%20377%2C%20%E2%80%A6.
fib <- function(n) {
       if (n == 1) {return(0)}
       else if(n == 2) {return(1)}
       else if(n > 2) {return(fib(n - 1) + fib(n - 2))}
}
fib(12)
## [1] 89
## input
input <- 1:12

## output
output <- rep(NA,length(input))
output
##  [1] NA NA NA NA NA NA NA NA NA NA NA NA
for (i in 1:12){output[i] <- fib(i)}
output
##  [1]  0  1  1  2  3  5  8 13 21 34 55 89
## data
data <- tibble("y"=output,"x"=input) 
data
## # A tibble: 12 × 2
##        y     x
##    <dbl> <int>
##  1     0     1
##  2     1     2
##  3     1     3
##  4     2     4
##  5     3     5
##  6     5     6
##  7     8     7
##  8    13     8
##  9    21     9
## 10    34    10
## 11    55    11
## 12    89    12
## fit model
nn_1 <- neuralnet(y ~ x,
                  data = data,
                  rep = 1, 
                  hidden = c(4), #  N neuronas por capa oculta 
                  threshold = 0.05,   # RL
                  algorithm = "rprop+", # "Resilient Backpropagation"
                  err.fct = "sse" # fucnion de perdida
)
## plot model
plot(nn_1) ## azul=sesgo ; negro=pesos
## funcion de activacion
nn_1$act.fct
## function (x) 
## {
##     1/(1 + exp(-x))
## }
## <bytecode: 0x7f89e8309440>
## <environment: 0x7f89e8304c60>
## attr(,"type")
## [1] "logistic"
## predicciones
data$y
##  [1]  0  1  1  2  3  5  8 13 21 34 55 89
nn_1$net.result
## [[1]]
##             [,1]
##  [1,]  0.4396133
##  [2,]  0.6809681
##  [3,]  1.0923804
##  [4,]  1.7899449
##  [5,]  2.9623605
##  [6,]  4.9062319
##  [7,]  8.0686783
##  [8,] 13.1072988
##  [9,] 21.0524793
## [10,] 33.8235248
## [11,] 55.0971203
## [12,] 88.9793048
## plot observados vs predichos
data$y_nn1 <- nn_1$net.result[[1]]
ggplot(data=data , aes(x=y,y=y_nn1)) + 
geom_point(col="blue") + theme_test()

## rmse
with(data = data , sqrt(mean( (y-y_nn1)^2 )))
## [1] 0.1866136
## computar predicciones
compute(nn_1,tibble("x"=13))
## $neurons
## $neurons[[1]]
##         x
## [1,] 1 13
## 
## $neurons[[2]]
##      [,1]      [,2]      [,3]      [,4]     [,5]
## [1,]    1 0.5519606 0.8070788 0.6995073 0.445361
## 
## 
## $net.result
##          [,1]
## [1,] 131.3214
fib(13)
## [1] 144
### **2.2 Aumentar el numero de repeticiones**

## fit model
nn_2 <- neuralnet(y ~ x,
                  data = data,
                  rep = 10, 
                  hidden = c(4), #  N neuronas por capa oculta 
                  threshold = 0.05,   # RL
                  algorithm = "rprop+", # "Resilient Backpropagation"
                  err.fct = "sse" # fucnion de perdida
)

## variacion en el erro
nn_2$result.matrix
##                                [,1]          [,2]          [,3]          [,4]
## error                  2.035850e-01     0.2945322    0.24668377    0.23894490
## reached.threshold      4.984150e-02     0.0498920    0.04555652    0.04596766
## steps                  2.393700e+04 14283.0000000 9733.00000000 9625.00000000
## Intercept.to.1layhid1 -1.444807e+01   -14.4306474   -5.59801074  -15.39143406
## x.to.1layhid1          1.218660e+00     1.1084916    0.56083376    1.31579859
## Intercept.to.1layhid2  7.706152e+00   -11.9036895   13.33859417    1.52030317
## x.to.1layhid2         -8.466281e-01     1.0205401   -1.06378647    0.10442931
## Intercept.to.1layhid3  1.829783e+01   -12.7607706  -13.54346396   18.14714972
## x.to.1layhid3         -1.451926e+00     0.9853163    1.07851185   -1.46020409
## Intercept.to.1layhid4 -4.598264e-02     5.4831998  -12.30268601    7.66219461
## x.to.1layhid4          5.999981e-02    -0.5945562    0.99664142   -0.83722809
## Intercept.to.y         4.314590e+01    34.5806441   27.56154800   37.11695244
## 1layhid1.to.y          8.511662e+01    80.6717609   46.99755407   67.15083623
## 1layhid2.to.y         -2.944906e+01    48.0999529  -27.39774877   43.31866465
## 1layhid3.to.y         -3.262193e+01    42.8421865   61.48644488  -40.38255947
## 1layhid4.to.y          3.759587e+01   -34.3379742   52.08769252  -32.94132776
##                                [,5]          [,6]          [,7]          [,8]
## error                  1.945181e-01  1.556069e-01  2.205504e-01    0.17868557
## reached.threshold      4.731759e-02  4.927152e-02  4.570434e-02    0.04899236
## steps                  2.951800e+04  3.921200e+04  1.625400e+04 3207.00000000
## Intercept.to.1layhid1 -1.701720e+01  1.857816e+01 -1.526913e+01    4.74244916
## x.to.1layhid1          1.311073e+00 -1.974660e+00  1.202138e+00   -0.60124864
## Intercept.to.1layhid2 -1.537327e+01 -5.753936e+00 -1.290979e+01  -15.05758686
## x.to.1layhid2          1.169945e+00  5.141203e-01  1.056001e+00    1.25554707
## Intercept.to.1layhid3 -5.779865e+00 -1.670329e+01 -5.748732e+00  -17.07909095
## x.to.1layhid3          5.370038e-01  1.396673e+00  5.459967e-01    1.41928301
## Intercept.to.1layhid4  1.310476e+01  1.681150e+01  1.312036e+01   12.39121240
## x.to.1layhid4         -1.149191e+00 -1.323859e+00 -1.059107e+00   -1.29392300
## Intercept.to.y         2.888386e+01  3.579326e+01  2.548809e+01   38.82712118
## 1layhid1.to.y          8.291699e+01 -3.249514e+00  5.524851e+01  -19.58526034
## 1layhid2.to.y          3.881606e+01  7.712033e+01  4.714695e+01   40.27674007
## 1layhid3.to.y          6.616127e+01  5.854066e+01  5.985991e+01   66.12039221
## 1layhid4.to.y         -2.880167e+01 -3.258048e+01 -2.536471e+01  -19.17116960
##                                [,9]         [,10]
## error                  2.327307e-01  1.774826e-01
## reached.threshold      4.834384e-02  4.824819e-02
## steps                  1.586100e+04  2.431800e+04
## Intercept.to.1layhid1 -5.712751e+00 -5.497751e+00
## x.to.1layhid1          5.532187e-01  5.179941e-01
## Intercept.to.1layhid2 -1.333504e+01 -1.328965e+01
## x.to.1layhid2          1.070883e+00  1.020529e+00
## Intercept.to.1layhid3 -1.288540e+01 -1.086066e+01
## x.to.1layhid3          1.044811e+00  9.245868e-01
## Intercept.to.1layhid4 -1.429308e+01 -1.563615e+01
## x.to.1layhid4          1.135718e+00  1.201623e+00
## Intercept.to.y         1.476959e-01  2.139955e-02
## 1layhid1.to.y          5.512538e+01  5.567913e+01
## 1layhid2.to.y          4.344281e+01  4.667052e+01
## 1layhid3.to.y          4.042219e+01  3.787598e+01
## 1layhid4.to.y          4.725327e+01  7.977273e+01
## plot
error <- data.frame("sse"=nn_2$result.matrix[1,] , n=1:10)
ggplot(data=error , aes(x=n , y=sse)) + 
geom_line(col="red") + geom_point(col="black") + theme_test()

[3.] Aplicacion: Precio de las viviendas

### **3.1 prepare db**
rm(list=ls())

## load data
db <- import("input/data_regresiones.rds")

## tibble to matrix
df <- model.matrix(~.+I(bathrooms^2)+I(surface_total^2)+I(dist_cbd^2)-1-price , data = db)

## reescalar las variables
df <- scale(x = df , center = T , scale = T)

## limpiar los nombres de las variables
df <- as_tibble(df) %>% clean_names()
df$price <- db$price/1000000

## particionar la base de datos
set.seed(2104)
sample <- sample(x = nrow(df) , size = 0.2*nrow(df))
test <- df[sample,]
train <- df[-sample,]

### **3.2 Fit model**
model_1 <- neuralnet(price ~.,
                     data = train[1:100,],
                     rep = 5, 
                     hidden = c(2,2),
                     threshold = 0.05)

## **3.3 Computar el RMSE**
plot(model_1)