Vamos a utilizar la librería
Keras utiliza como backend TensorFlow. Para poner todo en funcionamiento necesitamos instalar ambas cosas. Para eso usamos la función install_keras()
que realiza una instalación por default de basada en el CPU.
Si tienen una GPU (procesador gráfico), las redes funcionan mucho más rápido, porque la GPU permite optimizar las operaciones matriciales. Pero necesitan instalar keras para que corra en el lenguaje de la GPU ( CUDA )
# devtools::install_github("rstudio/keras")
library(keras)
# install_keras()
library(tidyverse)
[30m── [1mAttaching packages[22m ──────────────────────────────────────────────────────────────────────────── tidyverse 1.2.1 ──[39m
[30m[32m✔[30m [34mggplot2[30m 3.0.0 [32m✔[30m [34mpurrr [30m 0.2.5
[32m✔[30m [34mtibble [30m 1.4.2 [32m✔[30m [34mdplyr [30m 0.7.7
[32m✔[30m [34mtidyr [30m 0.8.1 [32m✔[30m [34mstringr[30m 1.3.1
[32m✔[30m [34mreadr [30m 1.1.1 [32m✔[30m [34mforcats[30m 0.3.0[39m
[30m── [1mConflicts[22m ─────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
[31m✖[30m [34mdplyr[30m::[32mfilter()[30m masks [34mstats[30m::filter()
[31m✖[30m [34mdplyr[30m::[32mlag()[30m masks [34mstats[30m::lag()[39m
library(knitr)
Este es un problema clásico, de juguete, que sirve desde hace muchos años como benchmark para clasificación de imágenes. Tiene 60.000 imágenes, de 28x28, de números escritos a mano.
mnist <- dataset_mnist()
Using TensorFlow backend.
x_train <- mnist$train$x
y_train <- mnist$train$y
x_test <- mnist$test$x
y_test <- mnist$test$y
Veamos la pinta de los datos
datos de entrada
matrix.rotate <- function(img) {
t(apply(img, 2, rev))
}
par(mfrow=c(3, 3))
for (idx in 1:9) {
label <- y_train[idx]
image(matrix.rotate(x_train[idx,,]), col = grey(level = seq(1, 0, by=-1/255)), axes=F, main=label)
}
Pará pará pará… vos me querés decir que ahora cada observación es una matriz de 28x28?
SI
En estadística y Machine Learning estamos acostumbrados a pensar cada observación como una fila, con features en las columnas. Si queremos representar una imagen tenemos que aplanarla. Esto significa que tendríamos 28x28=784 features. Probablemente a continuación necesitaríamos una técnica de reducción de la dimensionalidad, y por ahí seguimos…
En las redes neuronales esto cambia. Si bien en el modelo de hoy (Fully conected layers) la capa de entrada sigue teniendo 784 nodos, la estructura de la red permite captar muy bien las relaciones no lineales propias de una imagen.
Incluso más, cuando veamos las Convolutional Neural Networks, vamos a utilizar imagenes a color, lo que implica 3 matrices para los 3 canales de color (RGB)
¿qué pinta tiene un gráfico desde el punto de vista matricial?
kable(data.frame(x_train[1,,]))
X1 | X2 | X3 | X4 | X5 | X6 | X7 | X8 | X9 | X10 | X11 | X12 | X13 | X14 | X15 | X16 | X17 | X18 | X19 | X20 | X21 | X22 | X23 | X24 | X25 | X26 | X27 | X28 |
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 3 | 18 | 18 | 18 | 126 | 136 | 175 | 26 | 166 | 255 | 247 | 127 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 30 | 36 | 94 | 154 | 170 | 253 | 253 | 253 | 253 | 253 | 225 | 172 | 253 | 242 | 195 | 64 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 49 | 238 | 253 | 253 | 253 | 253 | 253 | 253 | 253 | 253 | 251 | 93 | 82 | 82 | 56 | 39 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 18 | 219 | 253 | 253 | 253 | 253 | 253 | 198 | 182 | 247 | 241 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 80 | 156 | 107 | 253 | 253 | 205 | 11 | 0 | 43 | 154 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 14 | 1 | 154 | 253 | 90 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 139 | 253 | 190 | 2 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 11 | 190 | 253 | 70 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 35 | 241 | 225 | 160 | 108 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 81 | 240 | 253 | 253 | 119 | 25 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 45 | 186 | 253 | 253 | 150 | 27 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 16 | 93 | 252 | 253 | 187 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 249 | 253 | 249 | 64 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 46 | 130 | 183 | 253 | 253 | 207 | 2 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 39 | 148 | 229 | 253 | 253 | 253 | 250 | 182 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 24 | 114 | 221 | 253 | 253 | 253 | 253 | 201 | 78 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 23 | 66 | 213 | 253 | 253 | 253 | 253 | 198 | 81 | 2 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 18 | 171 | 219 | 253 | 253 | 253 | 253 | 195 | 80 | 9 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 55 | 172 | 226 | 253 | 253 | 253 | 253 | 244 | 133 | 11 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 136 | 253 | 253 | 253 | 212 | 135 | 132 | 16 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
Cada valor representa a un pixel, y su valor es su representación en la escala de grises (de 0 a 255). Es decir, cuando mayor es el valor, eso es un pixel más oscuro.
El dato esta en un array de 3 dimensiones (imagen,ancho,largo). Como tenemos 60K imagenes, esto tiene la forma de :
dim(x_train)
[1] 60000 28 28
Es decir, nuestros datos ahora conforman un Tensor:
Como mencionabamos arriba lo primero es un reshape de los datos:
# reshape
x_train <- array_reshape(x_train, c(nrow(x_train), 28*28)) #la primera dimensión es tan larga como la cantidad de observaciones, la segunda dimensión es la matriz aplanada (28*28)
x_test <- array_reshape(x_test, c(nrow(x_test), 28*28))
# rescale
x_train <- x_train / 255
x_test <- x_test / 255
obs: esto lo podríamos hacer con dim <-
, pero sería menos performante.
datos de salida
y_train %>% head(.)
[1] 5 0 4 1 9 2
Es un vector de integers entre 0-9.
Dada la implementación de las redes, necesitamos pasarlo a one-hot encoding esto se hace con la función to_categorical()
de Keras
y_train <- to_categorical(y_train, 10)
y_test <- to_categorical(y_test, 10)
¿qué pinta tiene esto?
y_train %>% head(.)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 0 0 0 0 0 1 0 0 0 0
[2,] 1 0 0 0 0 0 0 0 0 0
[3,] 0 0 0 0 1 0 0 0 0 0
[4,] 0 1 0 0 0 0 0 0 0 0
[5,] 0 0 0 0 0 0 0 0 0 1
[6,] 0 0 1 0 0 0 0 0 0 0
Para armar el modelo primero definimos el tipo de modelo. Para eso usamos keras_model_sequential()
que nos permite simplemente apilar capas de la red.
%>%
layer_droput(x)
que lo que hace es, en cada iteración del ajuste, ignorar el x% de las conexiones. Esto evita el sobreajuste del modelomodel <- keras_model_sequential()
model %>%
layer_dense(units = 256, activation = 'relu', input_shape = c(784)) %>%
layer_dropout(rate = 0.4) %>%
layer_dense(units = 128, activation = 'relu') %>%
layer_dropout(rate = 0.3) %>%
layer_dense(units = 10, activation = 'softmax')
Para este modelo utilizamos dos funciones de activación:
Definidas en código y gráficamente:
relu <- function(x) ifelse(x >= 0, x, 0)
softmax <- function(x) exp(x) / sum(exp(x))
data.frame(x= seq(from=-1, to=1, by=0.1)) %>%
mutate(softmax = softmax(x),
relu = relu(x)) %>%
gather(variable,value,2:3) %>%
ggplot(., aes(x=x, y=value, group=variable, colour=variable))+
geom_line(size=1) +
ggtitle("ReLU & Softmax")+
theme_minimal()
ReLu es la función de activación que más se utiliza en la actualidad.
Si queremos ver un resumen del modelo:
summary(model)
El modelo tiene 235,146 parámetros para optimizar:
En la primera capa oculta tenemos 256 nodos que se conectan con cada nodo de la capa de entrada (784), además de un bias para cada nodo:
784*256+256
[1] 200960
La capa de droput es una regularización y no ajusta ningún parámetro
la capa densa 2 se conecta con los 256 nodos de la primera capa:
128*256+128
[1] 32896
La tercera capa
128*10+10
[1] 1290
Luego necesitamos compilar el modelo indicando la función de loss, qué tipo de optimizador utilizar, y qué métricas nos importan
model %>% compile(
loss = 'categorical_crossentropy',
optimizer = optimizer_rmsprop(),
metrics = c('accuracy')
)
Para ajustar el modelo usamos la función fit()
, acá necesitamos pasar los siguientes parámetros:
epochs
: Cuantas veces va a recorrer el dataset de entrenamientobatch_size
: de a cuantas imagenes va a mirar en cada iteración del backpropagationvalidation_split
: Hacemos un split en train y validation para evaluar las métricas.fit_history <- model %>% fit(
x_train, y_train,
epochs = 30, batch_size = 128,
validation_split = 0.2
)
Mientras entrenamos el modelo, podemos ver la evolución en el gráfico interactivo que se genera en el viewer de Rstudio.
fit()
nos devuelve un objeto que incluye las métricas de loss y accuracy
fit_history
Trained on 48,000 samples, validated on 12,000 samples (batch_size=128, epochs=30)
Final epoch (plot to see history):
acc: 0.9869
loss: 0.04941
val_acc: 0.9797
val_loss: 0.1132
Este objeto lo podemos graficar con plot()
y nos devuelve un objeto de ggplot, sobre el que podemos seguir trabajando
plot(fit_history)+
theme_minimal()+
labs(title= "Evolución de Loss y Accuracy en train y validation")
Noten que el modelo entrenado, con el que podemos predecir, sigue siendo
model
.
es importante guardar el modelo luego de entrenar, para poder reutilizarlo
model %>% save_model_hdf5("../Resultados/fc_model.h5")
y para cargarlo
modelo_preentrenado <- load_model_hdf5("../Resultados/fc_model.h5")
modelo_preentrenado
Model
_____________________________________________________________________________________________________________________
Layer (type) Output Shape Param #
=====================================================================================================================
dense_4 (Dense) (None, 256) 200960
_____________________________________________________________________________________________________________________
dropout_3 (Dropout) (None, 256) 0
_____________________________________________________________________________________________________________________
dense_5 (Dense) (None, 128) 32896
_____________________________________________________________________________________________________________________
dropout_4 (Dropout) (None, 128) 0
_____________________________________________________________________________________________________________________
dense_6 (Dense) (None, 10) 1290
=====================================================================================================================
Total params: 235,146
Trainable params: 235,146
Non-trainable params: 0
_____________________________________________________________________________________________________________________
Si queremos evaluar el modelo sobre el conjunto de test (distinto del de validación) podemos usar la función evaluate()
modelo_preentrenado %>% evaluate(x_test, y_test)
32/10000 [..............................] - ETA: 24s
608/10000 [>.............................] - ETA: 2s
1088/10000 [==>...........................] - ETA: 1s
1760/10000 [====>.........................] - ETA: 1s
2464/10000 [======>.......................] - ETA: 0s
3072/10000 [========>.....................] - ETA: 0s
3648/10000 [=========>....................] - ETA: 0s
4320/10000 [===========>..................] - ETA: 0s
5184/10000 [==============>...............] - ETA: 0s
5952/10000 [================>.............] - ETA: 0s
6688/10000 [===================>..........] - ETA: 0s
7712/10000 [======================>.......] - ETA: 0s
8832/10000 [=========================>....] - ETA: 0s
9888/10000 [============================>.] - ETA: 0s
10000/10000 [==============================] - 1s 79us/step
$loss
[1] 0.1080166
$acc
[1] 0.9803
Para obtener las predicciones sobre un nuevo conjunto de datos utilizamos predict_classes()
modelo_preentrenado %>% predict_classes(x_test) %>% head(.)
[1] 7 2 1 0 4 1
Visualización de una Red Fully conected para clasificación de dígitos