red convolucional
Vamos a utilizar la librería
# 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)
Vamos a utilizar nuevamente el dataset de MNIST de la clase de fully connected layers
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
Recordemos 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)
}
El dato esta en un array de 3 dimensiones (imagen,ancho,largo). Como tenemos 60K imágenes, esto tiene la forma de :
dim(x_train)
[1] 60000 28 28
Dimensiones del problema:
Definamos como variables las siguientes dimensiones del problema (nos facilita la reutilización del código):
num_classes <- 10
img_rows <- 28
img_cols <- 28
En un problema normal de clasificación para Machine Learning tenemos 2 dimensiones: filas y columnas, donde la 1° representa las observaciones y la segunda la secuencia de features.
En el caso de las redes convolucionales necesitamos datos de 4 dimensiones:
x_train <- array_reshape(x_train, c(nrow(x_train), img_rows, img_cols, 1))
x_test <- array_reshape(x_test, c(nrow(x_test), img_rows, img_cols, 1))
input_shape <- c(img_rows, img_cols, 1)
x_train <- x_train / 255
x_test <- x_test / 255
cat('x_train_shape:', dim(x_train), '\n')
x_train_shape: 60000 28 28 1
cat(nrow(x_train), 'train samples\n')
60000 train samples
cat(nrow(x_test), 'test samples\n')
10000 test samples
datos de salida
necesitamos pasarlo a one-hot encoding esto se hace con la función to_categorical()
de Keras
y_train <- to_categorical(y_train, num_classes)
y_test <- to_categorical(y_test, num_classes)
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() %>%
layer_conv_2d(filters = 32, kernel_size = c(3,3), activation = 'relu',
input_shape = input_shape) %>%
layer_conv_2d(filters = 64, kernel_size = c(3,3), activation = 'relu') %>%
layer_max_pooling_2d(pool_size = c(2, 2)) %>%
layer_dropout(rate = 0.25) %>%
layer_flatten() %>%
layer_dense(units = 128, activation = 'relu') %>%
layer_dropout(rate = 0.5) %>%
layer_dense(units = num_classes, activation = 'softmax')
La arquitectura de esta red es básicamente la siguiente:
layer_conv_2d
convolución2
La capa de convoluciones construye pequeños filtros o kernels de la dimensión kernel_size()
que pasan por el input original realizando una convolución.
El filtro barre la imagen original, moviéndose de a strides()
posiciones. Por default se mueve de a 1 lugar.
Notemos que si el filtro es de 3x3 y el stride es 1, entonces la imagen original va a perder 2 pixels de largo y 2 pixels de ancho.
layer_max_pooling_2d
max pooling3
Es max pooling es una forma de reducir el tamaño de la matrix.
Al igual que la convolución, barre la imagen con una ventana de pool_size()
moviéndose de a stride()
posiciones, y devuelve el valor más alto.
Un pool_size()
de 2x2 nos reduce el tamaño de la imagen a la mitad.
layer_dropout
Dropout4
rate
proporción de los pesos. De esta forma, no se ajusta todo todo el tiempo, reduciendo los grados de libertad del modelo, y evitando el overfittinglayer_flatten
flatten5
layer_dense
dense
Para este modelo utilizamos las mismas dos funciones de activación que utilizamos en la FC nn:
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.
model
El modelo tiene 1.2 millones de parámetros para optimizar:
La primera capa convolucional tiene que entrenar los filtros. Como estos eran de 3x3, cada uno tiene 9 parámetros para entrenar + 1 bias por filtro
32* (3*3) +32
[1] 320
La segunda convolución tiene que entrenar kernels de 3x3 para 64 filtros 64∗(3∗3), para cada uno de los 32 filtros de la capa anterior, +1 bias por filtro
64*(3*3)*32 +64
[1] 18496
layer_max_pooling_2d
, layer_dropout
y layer_flatten
no entrenan parámetros.
cuando aplanamos. El shape pasa a:
12*12*64
[1] 9216
128*9216 +128
[1] 1179776
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 <- model %>% compile(
loss = "categorical_crossentropy",
optimizer = optimizer_adadelta(),
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 imágenes va a mirar en cada iteración del backpropagationvalidation_split
: Hacemos un split en train y validation para evaluar las métricas.epochs <- 12
batch_size <- 128
validation_split <- 0.2
fit_history <- model %>% fit(
x_train, y_train,
batch_size = batch_size,
epochs = epochs,
validation_split = validation_split
)
Mientras entrenamos el modelo, podemos ver la evolución en el gráfico interactivo que se genera en el viewer de Rstudio.
fit_history
Trained on 48,000 samples, validated on 12,000 samples (batch_size=128, epochs=12)
Final epoch (plot to see history):
acc: 0.9929
loss: 0.02294
val_acc: 0.9902
val_loss: 0.0382
fit()
nos devuelve un objeto que incluye las métricas de loss y accuracy.
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")
es importante guardar el modelo luego de entrenar, para poder reutilizarlo
model %>% save_model_hdf5("../Resultados/cnn_model.h5")
y para cargarlo
modelo_preentrenado <- load_model_hdf5("../Resultados/cnn_model.h5")
modelo_preentrenado
Model
_____________________________________________________________________________________________________________________
Layer (type) Output Shape Param #
=====================================================================================================================
conv2d_1 (Conv2D) (None, 26, 26, 32) 320
_____________________________________________________________________________________________________________________
conv2d_2 (Conv2D) (None, 24, 24, 64) 18496
_____________________________________________________________________________________________________________________
max_pooling2d_1 (MaxPooling2D) (None, 12, 12, 64) 0
_____________________________________________________________________________________________________________________
dropout_3 (Dropout) (None, 12, 12, 64) 0
_____________________________________________________________________________________________________________________
flatten_1 (Flatten) (None, 9216) 0
_____________________________________________________________________________________________________________________
dense_4 (Dense) (None, 128) 1179776
_____________________________________________________________________________________________________________________
dropout_4 (Dropout) (None, 128) 0
_____________________________________________________________________________________________________________________
dense_5 (Dense) (None, 10) 1290
=====================================================================================================================
Total params: 1,199,882
Trainable params: 1,199,882
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: 33s
96/10000 [..............................] - ETA: 16s
192/10000 [..............................] - ETA: 11s
288/10000 [..............................] - ETA: 9s
384/10000 [>.............................] - ETA: 9s
480/10000 [>.............................] - ETA: 8s
576/10000 [>.............................] - ETA: 7s
672/10000 [=>............................] - ETA: 7s
768/10000 [=>............................] - ETA: 7s
864/10000 [=>............................] - ETA: 7s
960/10000 [=>............................] - ETA: 6s
1056/10000 [==>...........................] - ETA: 6s
1152/10000 [==>...........................] - ETA: 6s
1248/10000 [==>...........................] - ETA: 6s
1344/10000 [===>..........................] - ETA: 6s
1440/10000 [===>..........................] - ETA: 5s
1536/10000 [===>..........................] - ETA: 5s
1632/10000 [===>..........................] - ETA: 5s
1728/10000 [====>.........................] - ETA: 5s
1824/10000 [====>.........................] - ETA: 5s
1920/10000 [====>.........................] - ETA: 5s
2016/10000 [=====>........................] - ETA: 5s
2112/10000 [=====>........................] - ETA: 5s
2208/10000 [=====>........................] - ETA: 5s
2304/10000 [=====>........................] - ETA: 5s
2400/10000 [======>.......................] - ETA: 4s
2496/10000 [======>.......................] - ETA: 4s
2592/10000 [======>.......................] - ETA: 4s
2688/10000 [=======>......................] - ETA: 4s
2784/10000 [=======>......................] - ETA: 4s
2880/10000 [=======>......................] - ETA: 4s
2976/10000 [=======>......................] - ETA: 4s
3072/10000 [========>.....................] - ETA: 4s
3168/10000 [========>.....................] - ETA: 4s
3264/10000 [========>.....................] - ETA: 4s
3360/10000 [=========>....................] - ETA: 4s
3456/10000 [=========>....................] - ETA: 4s
3552/10000 [=========>....................] - ETA: 4s
3648/10000 [=========>....................] - ETA: 4s
3744/10000 [==========>...................] - ETA: 3s
3840/10000 [==========>...................] - ETA: 3s
3936/10000 [==========>...................] - ETA: 3s
4032/10000 [===========>..................] - ETA: 3s
4096/10000 [===========>..................] - ETA: 3s
4192/10000 [===========>..................] - ETA: 3s
4288/10000 [===========>..................] - ETA: 3s
4384/10000 [============>.................] - ETA: 3s
4480/10000 [============>.................] - ETA: 3s
4576/10000 [============>.................] - ETA: 3s
4672/10000 [=============>................] - ETA: 3s
4768/10000 [=============>................] - ETA: 3s
4864/10000 [=============>................] - ETA: 3s
4960/10000 [=============>................] - ETA: 3s
5056/10000 [==============>...............] - ETA: 3s
5152/10000 [==============>...............] - ETA: 3s
5248/10000 [==============>...............] - ETA: 3s
5344/10000 [===============>..............] - ETA: 2s
5440/10000 [===============>..............] - ETA: 2s
5536/10000 [===============>..............] - ETA: 2s
5632/10000 [===============>..............] - ETA: 2s
5728/10000 [================>.............] - ETA: 2s
5824/10000 [================>.............] - ETA: 2s
5920/10000 [================>.............] - ETA: 2s
6016/10000 [=================>............] - ETA: 2s
6112/10000 [=================>............] - ETA: 2s
6208/10000 [=================>............] - ETA: 2s
6304/10000 [=================>............] - ETA: 2s
6400/10000 [==================>...........] - ETA: 2s
6496/10000 [==================>...........] - ETA: 2s
6592/10000 [==================>...........] - ETA: 2s
6688/10000 [===================>..........] - ETA: 2s
6784/10000 [===================>..........] - ETA: 2s
6880/10000 [===================>..........] - ETA: 1s
6976/10000 [===================>..........] - ETA: 1s
7072/10000 [====================>.........] - ETA: 1s
7168/10000 [====================>.........] - ETA: 1s
7264/10000 [====================>.........] - ETA: 1s
7360/10000 [=====================>........] - ETA: 1s
7424/10000 [=====================>........] - ETA: 1s
7520/10000 [=====================>........] - ETA: 1s
7616/10000 [=====================>........] - ETA: 1s
7712/10000 [======================>.......] - ETA: 1s
7776/10000 [======================>.......] - ETA: 1s
7872/10000 [======================>.......] - ETA: 1s
7968/10000 [======================>.......] - ETA: 1s
8064/10000 [=======================>......] - ETA: 1s
8160/10000 [=======================>......] - ETA: 1s
8256/10000 [=======================>......] - ETA: 1s
8352/10000 [========================>.....] - ETA: 1s
8448/10000 [========================>.....] - ETA: 0s
8544/10000 [========================>.....] - ETA: 0s
8640/10000 [========================>.....] - ETA: 0s
8736/10000 [=========================>....] - ETA: 0s
8832/10000 [=========================>....] - ETA: 0s
8928/10000 [=========================>....] - ETA: 0s
9024/10000 [==========================>...] - ETA: 0s
9120/10000 [==========================>...] - ETA: 0s
9216/10000 [==========================>...] - ETA: 0s
9312/10000 [==========================>...] - ETA: 0s
9408/10000 [===========================>..] - ETA: 0s
9504/10000 [===========================>..] - ETA: 0s
9600/10000 [===========================>..] - ETA: 0s
9696/10000 [============================>.] - ETA: 0s
9792/10000 [============================>.] - ETA: 0s
9888/10000 [============================>.] - ETA: 0s
9984/10000 [============================>.] - ETA: 0s
10000/10000 [==============================] - 6s 628us/step
$loss
[1] 0.02666184
$acc
[1] 0.9925
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
Otros recursos interesantes:
Visualización de una Red Fully conected para clasificación de dígitos