Ucrania
Ricardo R. Palma
2022-05-12
IntroducciĆ³n a las Redes Neuronales Artificiales en R
En el siguiente documento se intentarĆ” realizar una predicciĆ³n de la categoria de estado de salud de refugiados en funciĆ³n a una serie de caracterĆsticas relevadas a su arribo .
IntroducciĆ³n
En esta sesiĆ³n prĆ”ctica de programaciĆ³n en R, haremos una introducciĆ³n bĆ”sica a las Redes Neuronales Artificiales, e implementaremos con ellas un clasificador sobre el conjunto de datos Predicting a Pulsar Star, tal y como se utilizĆ³ anteriormente en la sesiĆ³n prĆ”ctica IntroducciĆ³n a los Modelos de ClasificaciĆ³n en R. Tanto Ć©ste como muchos otros conjuntos de datos reales y Ćŗtiles se encuentran diponibles en el portal Kaggle.
Redes Neuronales Artificiales
Las Redes Neuronales Artificiales son modelos computacionales inspirados en las neuronas biolĆ³gicas, y que estĆ”n conformadas por un conjunto de unidades de cĆ³mputo bĆ”sico (neuronas) las cuales estĆ”n conectadas entre ellas de mĆŗltiples maneras. Estas conexiones estarĆ”n definidas por unos pesos los cuales determinarĆ”n la fuerza o importancia de dichas conexiones, y durante el proceso de aprendizaje o entrenamiento de la red, serĆ”n estos pesos los que se ajustarĆ”n con el fin de producir la salida adecuada segĆŗn la entrada que se aplique a la red. En tĆ©rminos generales, las redes neuronales artificiales estĆ”n compuestas por una capa de entrada, una o mĆ”s capas ocultas, y una capa de salida como se observa en la siguiente figura:
Grafo de una Red Neuronal
Por su parte, en cada neurona se realiza el cĆ”lculo matemĆ”tico de la suma ponderada de las entradas con los pesos de la red, y luego se aplica sobre dicho resultado una funciĆ³n de activaciĆ³n, que producirĆ” la salida final de cada neurona y que servirĆ”n como valores de entrada de la siguiente capa de la red neuronal.
El proceso de aprendizaje de la red se logra gracias al algoritmo de PropagaciĆ³n hacia atrĆ”s o Backpropagation, que consiste en aplicar las entradas a la red, obtener una salida final en la Ćŗltima capa, comparar este resultado con el resultado esperado (aprendizaje supervisado), y luego ir modificando hacia atrĆ”s los pesos de la capa de salida, oculta y de entrada a fin de minimizar (a partir del Descenso del Gradiente) el error entre la salida deseada y la salida generada por la red neuronal.
En este ejercicio prĆ”ctico nos concentraremos en los detalles de la implementaciĆ³n de la red neuronal en R para un problema real, por lo que a efectos de una explicaciĆ³n mĆ”s detallada del tema, recomiendo leer el artĆculo Introduction to Neural Networks de Ben Gorman.
## Carga de bibliotecas
library(neuralnet) # regression con redes neuronales
library(nnet) # classification con nn
library(NeuralNetTools)
library(plyr) # Herramientas para tratamiento de tablas
library(kableExtra) # H para impresiĆ³n de tablas grandes
library(dplyr)##
## Attaching package: 'dplyr'## The following object is masked from 'package:kableExtra':
##
## group_rows## The following objects are masked from 'package:plyr':
##
## arrange, count, desc, failwith, id, mutate, rename, summarise,
## summarize## The following object is masked from 'package:neuralnet':
##
## compute## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionCarga de dataset
library(readr)
ucrania <- read_delim("https://themys.sid.uncu.edu.ar/rpalma/R-cran/Ucrania.csv",
delim = ";", escape_double = FALSE, locale = locale(date_names = "es",
decimal_mark = ",", grouping_mark = "."),
trim_ws = TRUE)## Rows: 1599 Columns: 13
## āā Column specification āāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāāā
## Delimiter: ";"
## dbl (13): X, Peso, Edad, Alimentacio, Nivel_Azucar, Hidratacion, Exposicion_...
##
## ā¹ Use `spec()` to retrieve the full column specification for this data.
## ā¹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Eliminamos la primer columna que sĆ³lo tiene el Ćndice
head(ucrania)## Error: 'num_ansi_colors' is not an exported object from 'namespace:cli'#wine <- select(wine, -X)
ucrania <- ucrania[ ,-1]
head(ucrania)## Error: 'num_ansi_colors' is not an exported object from 'namespace:cli'RevisiĆ³n del nombre de las columnas
str(ucrania)## tbl_df [1,599 Ć 12] (S3: tbl_df/tbl/data.frame)
## $ Peso : num [1:1599] 7.4 7.8 7.8 11.2 7.4 7.4 7.9 7.3 7.8 7.5 ...
## $ Edad : num [1:1599] 0.7 0.88 0.76 0.28 0.7 0.66 0.6 0.65 0.58 0.5 ...
## $ Alimentacio : num [1:1599] 0 0 0.04 0.56 0 0 0.06 0 0.02 0.36 ...
## $ Nivel_Azucar : num [1:1599] 1.9 2.6 2.3 1.9 1.9 1.8 1.6 1.2 2 6.1 ...
## $ Hidratacion : num [1:1599] 0.076 0.098 0.092 0.075 0.076 0.075 0.069 0.065 0.073 0.071 ...
## $ Exposicion_Temp : num [1:1599] 11 25 15 17 11 13 15 15 9 17 ...
## $ Dias_Marca : num [1:1599] 34 67 54 60 34 40 59 21 18 102 ...
## $ Hijos : num [1:1599] 0.998 0.997 0.997 0.998 0.998 ...
## $ Sobrepeso_Transp: num [1:1599] 3.51 3.2 3.26 3.16 3.51 3.51 3.3 3.39 3.36 3.35 ...
## $ Abrico : num [1:1599] 0.56 0.68 0.65 0.58 0.56 0.56 0.46 0.47 0.57 0.8 ...
## $ Ataque_Militar : num [1:1599] 9.4 9.8 9.8 9.8 9.4 9.4 9.4 10 9.5 10.5 ...
## $ quality : num [1:1599] 5 5 5 6 5 5 5 7 7 5 ...Tratamiento de variables categĆ³ricas
En este caso no se tienen variables categĆ³ricas, por lo que no es necesario este anĆ”lisis.
CorrelaciĆ³n entre variables
Observamos si existe correlaciĆ³n entre alguna de las variables del conjunto.
cor(ucrania)## Peso Edad Alimentacio Nivel_Azucar Hidratacion
## Peso 1.00000000 -0.256130895 0.67170343 0.114776724 0.093705186
## Edad -0.25613089 1.000000000 -0.55249568 0.001917882 0.061297772
## Alimentacio 0.67170343 -0.552495685 1.00000000 0.143577162 0.203822914
## Nivel_Azucar 0.11477672 0.001917882 0.14357716 1.000000000 0.055609535
## Hidratacion 0.09370519 0.061297772 0.20382291 0.055609535 1.000000000
## Exposicion_Temp -0.15379419 -0.010503827 -0.06097813 0.187048995 0.005562147
## Dias_Marca -0.11318144 0.076470005 0.03553302 0.203027882 0.047400468
## Hijos 0.66804729 0.022026232 0.36494718 0.355283371 0.200632327
## Sobrepeso_Transp -0.68297819 0.234937294 -0.54190414 -0.085652422 -0.265026131
## Abrico 0.18300566 -0.260986685 0.31277004 0.005527121 0.371260481
## Ataque_Militar -0.06166827 -0.202288027 0.10990325 0.042075437 -0.221140545
## quality 0.12405165 -0.390557780 0.22637251 0.013731637 -0.128906560
## Exposicion_Temp Dias_Marca Hijos Sobrepeso_Transp
## Peso -0.153794193 -0.11318144 0.66804729 -0.68297819
## Edad -0.010503827 0.07647000 0.02202623 0.23493729
## Alimentacio -0.060978129 0.03553302 0.36494718 -0.54190414
## Nivel_Azucar 0.187048995 0.20302788 0.35528337 -0.08565242
## Hidratacion 0.005562147 0.04740047 0.20063233 -0.26502613
## Exposicion_Temp 1.000000000 0.66766645 -0.02194583 0.07037750
## Dias_Marca 0.667666450 1.00000000 0.07126948 -0.06649456
## Hijos -0.021945831 0.07126948 1.00000000 -0.34169933
## Sobrepeso_Transp 0.070377499 -0.06649456 -0.34169933 1.00000000
## Abrico 0.051657572 0.04294684 0.14850641 -0.19664760
## Ataque_Militar -0.069408354 -0.20565394 -0.49617977 0.20563251
## quality -0.050656057 -0.18510029 -0.17491923 -0.05773139
## Abrico Ataque_Militar quality
## Peso 0.183005664 -0.06166827 0.12405165
## Edad -0.260986685 -0.20228803 -0.39055778
## Alimentacio 0.312770044 0.10990325 0.22637251
## Nivel_Azucar 0.005527121 0.04207544 0.01373164
## Hidratacion 0.371260481 -0.22114054 -0.12890656
## Exposicion_Temp 0.051657572 -0.06940835 -0.05065606
## Dias_Marca 0.042946836 -0.20565394 -0.18510029
## Hijos 0.148506412 -0.49617977 -0.17491923
## Sobrepeso_Transp -0.196647602 0.20563251 -0.05773139
## Abrico 1.000000000 0.09359475 0.25139708
## Ataque_Militar 0.093594750 1.00000000 0.47616632
## quality 0.251397079 0.47616632 1.00000000correlacion <- cor(ucrania)VisualizaciĆ³n de la matriz de correlaciĆ³n
library(ggplot2)
library(ggcorrplot)
ggcorrplot(correlacion, method ="circle")## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.
NormalizaciĆ³n de variables
normalize<-function(x){
return ( (x-min(x))/(max(x)-min(x)))
}
ucra_norm<-as.data.frame(lapply(ucrania,FUN=normalize))Muestreo para entrenamiento
Para generar un muestreo de una serie de datos podemos utilizar la funciĆ³n āsampleā, que nos genera un arreglo de nĆŗmeros aleatorios.
indice <- sample(2, nrow(ucra_norm), replace = TRUE, prob = c(0.9,0.1))
ucra_train <- ucra_norm[indice==1,]
ucra_test <- ucra_norm[indice==2,]Modelo de Neural Net
Una vez tengamos los datos de entrenamiento, podemos realizar el modelo. En la funciĆ³n āneuralnetā se deben pasar los parĆ”metros en el siguiente formato: variable_a_predecir~variables_fuente, y ademĆ”s los datos de entrenamiento.
#algorithm = 'backprop', 'rprop+', 'rprop-', 'sag', or 'slr'
strAlgorithm <- 'rprop+'
ucra_model <- neuralnet(quality~. , data = ucra_train, rep = 1, algorithm = strAlgorithm)
str(ucra_model)## List of 14
## $ call : language neuralnet(formula = quality ~ ., data = ucra_train, rep = 1, algorithm = strAlgorithm)
## $ response : num [1:1434, 1] 0.4 0.4 0.4 0.6 0.4 0.4 0.8 0.4 0.4 0.4 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:1434] "1" "2" "3" "4" ...
## .. ..$ : chr "quality"
## $ covariate : num [1:1434, 1:11] 0.248 0.283 0.283 0.584 0.248 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:1434] "1" "2" "3" "4" ...
## .. ..$ : chr [1:11] "Peso" "Edad" "Alimentacio" "Nivel_Azucar" ...
## $ model.list :List of 2
## ..$ response : chr "quality"
## ..$ variables: chr [1:11] "Peso" "Edad" "Alimentacio" "Nivel_Azucar" ...
## $ err.fct :function (x, y)
## ..- attr(*, "type")= chr "sse"
## $ act.fct :function (x)
## ..- attr(*, "type")= chr "logistic"
## $ linear.output : logi TRUE
## $ data :'data.frame': 1434 obs. of 12 variables:
## ..$ Peso : num [1:1434] 0.248 0.283 0.283 0.584 0.248 ...
## ..$ Edad : num [1:1434] 0.397 0.521 0.438 0.11 0.397 ...
## ..$ Alimentacio : num [1:1434] 0 0 0.04 0.56 0 0 0.02 0.36 0.08 0.36 ...
## ..$ Nivel_Azucar : num [1:1434] 0.0685 0.1164 0.0959 0.0685 0.0685 ...
## ..$ Hidratacion : num [1:1434] 0.107 0.144 0.134 0.105 0.107 ...
## ..$ Exposicion_Temp : num [1:1434] 0.141 0.338 0.197 0.225 0.141 ...
## ..$ Dias_Marca : num [1:1434] 0.0989 0.2155 0.1696 0.1908 0.0989 ...
## ..$ Hijos : num [1:1434] 0.568 0.494 0.509 0.582 0.568 ...
## ..$ Sobrepeso_Transp: num [1:1434] 0.606 0.362 0.409 0.331 0.606 ...
## ..$ Abrico : num [1:1434] 0.138 0.21 0.192 0.15 0.138 ...
## ..$ Ataque_Militar : num [1:1434] 0.154 0.215 0.215 0.215 0.154 ...
## ..$ quality : num [1:1434] 0.4 0.4 0.4 0.6 0.4 0.4 0.8 0.4 0.4 0.4 ...
## $ exclude : NULL
## $ net.result :List of 1
## ..$ : num [1:1434, 1] 0.422 0.429 0.438 0.52 0.422 ...
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ : chr [1:1434] "1" "2" "3" "4" ...
## .. .. ..$ : NULL
## $ weights :List of 1
## ..$ :List of 2
## .. ..$ : num [1:12, 1] -0.535 0.726 -3.619 -0.644 0.514 ...
## .. ..$ : num [1:2, 1] 0.368 0.436
## $ generalized.weights:List of 1
## ..$ : num [1:1434, 1:11] 0.14 0.156 0.174 0.288 0.14 ...
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ : chr [1:1434] "1" "2" "3" "4" ...
## .. .. ..$ : NULL
## $ startweights :List of 1
## ..$ :List of 2
## .. ..$ : num [1:12, 1] -0.2 -1.36 -0.357 -0.635 -1.777 ...
## .. ..$ : num [1:2, 1] -1.371 -0.357
## $ result.matrix : num [1:17, 1] 1.19e+01 8.24e-03 5.91e+03 -5.35e-01 7.26e-01 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:17] "error" "reached.threshold" "steps" "Intercept.to.1layhid1" ...
## .. ..$ : NULL
## - attr(*, "class")= chr "nn"Ploteo de la red Neuronal
Para visualizar el resultado de la red neuronal
plot(ucra_model, rep = "best")
EvaluaciĆ³n de la performance del modelo
Para la evaluaciĆ³n, utilizaremos los datos de prueba que habĆamos generado y compararemos la predicciĆ³n obtenida con los resultados reales
model_results <- neuralnet::compute(ucra_model,ucra_test[1:11])
predicted_quality <- model_results$net.result
predicted_quality[1:10]## [1] 0.4250361 0.4664744 0.4247423 0.4419067 0.4725562 0.4214149 0.4782579
## [8] 0.4263227 0.4860040 0.4406958Predicted quality Vs Actual quality of test data.
cor(predicted_quality,ucra_test$quality)## [,1]
## [1,] 0.5970554DesnormalizaciĆ³n de los resultados
Dado que hicimos la predicciones con los datos normalizados, ahora deberemos des-normalizarlos. Para esto nuevamente creamos una funciĆ³n.
str_max <- max(ucrania$quality)
str_min <- min(ucrania$quality)
unnormalize <- function(x, min, max) {
return( (max - min)*x + min )
}
ActualQuality_pred <- unnormalize(predicted_quality,str_min,str_max)
head(ActualQuality_pred)## [,1]
## 7 5.125181
## 8 5.332372
## 16 5.123711
## 24 5.209534
## 26 5.362781
## 29 5.107075Mejoramiento de la performance del modelo
Es posible mejorar la performance con el agregado de mĆ”s capas ocultas. Por defecto, āneuralnetā utiliza sĆ³lo una capa.
ucra_model2 <- neuralnet(quality~. , data = ucra_train, hidden=c(4,2), rep = 1, algorithm = strAlgorithm)
plot(ucra_model2 ,rep = "best")
Nueva evaluaciĆ³n de performance
model_results2 <- neuralnet::compute(ucra_model2,ucra_test[1:11])
predicted_quality2 <- model_results2$net.result
cor(predicted_quality2,ucra_test$quality)## [,1]
## [1,] 0.6075171