Para replicar las secciones de esta clase, primero debe descargar el
siguiente proyecto
de R y abrir el archivo clase-10.Rproj
.
require(pacman)
p_load(tidyverse,rio,janitor,skimr,
## libreria para redes neuralnet)
#### + 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
## susesion de fibonachi: https://www.rpubs.com/MauricioSF/558913#:~:text=La%20secuencia%20de%20Fibonacci%20es,%2C%20233%2C%20377%2C%20%E2%80%A6.
<- function(n) {
fib 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
<- 1:12
input
## output
<- rep(NA,length(input))
output 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
<- tibble("y"=output,"x"=input)
data 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
<- neuralnet(y ~ x,
nn_1 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
$act.fct nn_1
## function (x)
## {
## 1/(1 + exp(-x))
## }
## <bytecode: 0x7f89e8309440>
## <environment: 0x7f89e8304c60>
## attr(,"type")
## [1] "logistic"
## predicciones
$y data
## [1] 0 1 1 2 3 5 8 13 21 34 55 89
$net.result nn_1
## [[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
$y_nn1 <- nn_1$net.result[[1]]
dataggplot(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
<- neuralnet(y ~ x,
nn_2 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
$result.matrix nn_2
## [,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
<- data.frame("sse"=nn_2$result.matrix[1,] , n=1:10)
error ggplot(data=error , aes(x=n , y=sse)) +
geom_line(col="red") + geom_point(col="black") + theme_test()
### **3.1 prepare db**
rm(list=ls())
## load data
<- import("input/data_regresiones.rds")
db
## tibble to matrix
<- model.matrix(~.+I(bathrooms^2)+I(surface_total^2)+I(dist_cbd^2)-1-price , data = db)
df
## reescalar las variables
<- scale(x = df , center = T , scale = T)
df
## limpiar los nombres de las variables
<- as_tibble(df) %>% clean_names()
df $price <- db$price/1000000
df
## particionar la base de datos
set.seed(2104)
<- sample(x = nrow(df) , size = 0.2*nrow(df))
sample <- df[sample,]
test <- df[-sample,]
train
### **3.2 Fit model**
<- neuralnet(price ~.,
model_1 data = train[1:100,],
rep = 5,
hidden = c(2,2),
threshold = 0.05)
## **3.3 Computar el RMSE**
plot(model_1)