KERAS

# devtools::install_github("rstudio/keras")
library(keras)
# install_keras()
library(tidyverse)

── Attaching packages ──────────────────────────────────────────────────────────────────────────── tidyverse 1.2.1 ──
✔ ggplot2 3.0.0     ✔ purrr   0.2.5
✔ tibble  1.4.2     ✔ dplyr   0.7.7
✔ tidyr   0.8.1     ✔ stringr 1.3.1
✔ readr   1.1.1     ✔ forcats 0.3.0
── Conflicts ─────────────────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()

library(knitr)

Mnist

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):

• número de clases
• largo de las imágenes
• ancho de las imágenes

num_classes <- 10
img_rows <- 28
img_cols <- 28

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

y_train <- to_categorical(y_train, num_classes)
y_test <- to_categorical(y_test, num_classes)

Definción del modelo

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.

• En la primera capa tenemos que aclarar el input_shape.
• Las capas se agregan con pipes %>%
• La última capa tiene la misma cantidad de unidades que categorías nuestro output. La salida del modelo es un vector que asigna una probabilidad a cada una da las categorías
• En cada capa tenemos que definir una función de activación
• Además agregamos una regularización 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 modelo

model <- 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:

1. Convolución: 32 filtros (se achica la imagen original, y se multiplica en 32)
2. Convolución: 64 filtros (se vuelve a achicar y cada resultado del filtro se multiplica por 64)
3. max_pooling: Se achican las imágenes
4. dropout: se regulariza para evitar overfitting
5. flatten: Se aplanan los inputs para poder pasarlos a una red densa
6. dense: capa densa con 128 neuronas
7. dropout: se vuelve a regularizar
8. dense : capa de salida, con tantas neuronas como clases y una activación softmax (para que devuelva probabilidades)

layer_conv_2d

convolución²

• 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 pooling³

• 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

Dropout⁴

• El dropout es un método de regularización donde para cada iteración del backpropagation, anula el ajuste para una 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 overfitting

layer_flatten

flatten⁵

• Esta layer lo único que hace es un reshape para que los datos puedan ser utilizados por una capa densa.

layer_dense

dense

• La capa densa es una fully connected layer que recibe como input el producto aplanado de las capas previas.

Funciones de activación

Para este modelo utilizamos las mismas dos funciones de activación que utilizamos en la FC nn:

• Rectified Linear Unit: \[f(x)=max(0,x)\]
• Softmax : \[ f(x)=\frac{e^{x_i}}{\sum_{j=1}^n e^{x_j}}\]

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.

Parametros entrenables del modelo

model

• Cada vez que el modelo pasa por una convolución

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

• La primera capa densa tienen que conectar 9216 nodos con los 128, más los 128 bias.
• La capa de salida tiene que conectar los 128 nodos con los 10 de salida, más 10 bias

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')
)

Entrenamiento

Para ajustar el modelo usamos la función fit(), acá necesitamos pasar los siguientes parámetros:

• El array con los datos de entrenamiento
• El array con los outputs
• epochs: Cuantas veces va a recorrer el dataset de entrenamiento
• batch_size: de a cuantas imágenes va a mirar en cada iteración del backpropagation
• validation_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

Tensor Flow Playground