CNN: Ejemplo de Keras y FASHION-MNIST en R
Exploraremos un ejemplo práctico utilizando la biblioteca keras en R, pero esta vez con el conjunto de datos Fashion MNIST, que incluye imágenes de artículos de ropa, en lugar de dígitos escritos a mano. Este dataset proporciona una variedad de imágenes de ropa en escala de grises de 28 \times 28 píxeles, y se puede descargar directamente utilizando keras. Nuestro objetivo será implementar un modelo de red neuronal convolucional (CNN), que es particularmente adecuado para este tipo de datos de imágenes, para clasificar estos artículos de moda en diferentes categorías.
Para acceder a ejemplos y código original relacionado con keras, visitar Vignettes de Keras en CRAN.
Fashion-MNISTEl conjunto de datos Fashion MNIST es un excelente recurso para aquellos interesados en el procesamiento de imágenes, ofreciendo una alternativa más desafiante que el tradicional MNIST. Al igual que con MNIST, este conjunto de datos se incluye en la biblioteca keras y se puede cargar usando la función dataset_fashion_mnist(). Después de cargar los datos, procederemos a dividirlos en subconjuntos para entrenamiento (x_train, y_train) y prueba (x_test, y_test), preparando tanto las imágenes (input del modelo) como las etiquetas (output del modelo) para el entrenamiento y evaluación de nuestro modelo CNN.
Fashion MNIST es un conjunto de datos de imágenes de artículos de Zalando Research, que consta de un conjunto de entrenamiento de 60,000 ejemplos y un conjunto de prueba de 10,000 ejemplos. Cada ejemplo es una imagen en escala de grises de 28 \times 28 píxeles, asociada con una etiqueta de una de 10 clases diferentes. El propósito de Fashion MNIST es servir como una alternativa al conjunto de datos MNIST original para la evaluación de algoritmos de aprendizaje automático. Comparte el mismo tamaño de imagen y estructura de divisiones de entrenamiento y prueba.
A continuación, un ejemplo de cómo se ven los datos (cada clase ocupa tres filas):
# Librerías
library(tensorflow)
library(keras)Warning: package 'keras' was built under R version 4.3.3# Cargamos el dataset 'fashion MNIST', incluído en `Keras`
fashion_mnist <- dataset_fashion_mnist()
# Separamos en datos de entrenamiento
train_images <- fashion_mnist$train$x
train_labels <- fashion_mnist$train$y
test_images <- fashion_mnist$test$x
test_labels <- fashion_mnist$test$yEn este punto tenemos cuatro arreglos: Los arreglos train_images y train_labels son los datos de entrenamiento (es decir, los datos que el modelo usa para aprender). El modelo se prueba contra el conjunto de prueba: los arreglos test_images y test_labels. Cada imagen es un arreglo de 28 x 28, con valores de píxeles que varían entre 0 y 255. Las etiquetas son arreglos de enteros, que varían de 0 a 9. Estos corresponden a la clase de ropa que la imagen representa:
class_names <- c(
"Polera/top", "Pantalón", "Polerón", "Vestido", "Abrigo",
"Sandalia", "Camisa", "Zapatilla", "Bolso", "Bota"
)# Son 60.000 imagenes en el conjunto de entrenamiento, con cada imagen de tamaño 28 x 28 pixeles
dim(train_images)[1] 60000 28 28# Por lo tanto, hay 60.000 etiquetas
dim(train_labels)[1] 60000# Cada etiqueta posee un valor entero entre 0 y 9
train_labels[1:20] [1] 9 0 0 3 0 2 7 2 5 5 0 9 5 5 7 9 1 0 6 4Visualizamos algunas imagenes:
# Visualizar los datos como imagenes
par(mfcol=c(3,5))
par(mar=c(1, 1, 3, 1), xaxs='i', yaxs='i')
for (i in 1:15) {
im <- train_images[i,,]
im <- t(apply(im, 2, rev))
image(1:28, 1:28, im, col=gray(1-(0:255)/255),
xaxt='n', main=paste0(train_labels[i],
"\n (", class_names[train_labels[i]+1], ")"))
}
Los datos de etiquetas (labels) son un vector de enteros con valores que van del 0 al 9. Para preparar estos datos para el entrenamiento, codificamos los vectores en matrices de clases binarias utilizando la función de Keras to_categorical():
train_labels <- to_categorical(train_labels, 10)
test_labels <- to_categorical(test_labels, 10)# Inicializar los pesos de manera aleatoria usando semilla (opcional)
tensorflow::tf$random$set_seed(100)
target_size = dim(train_images)[2:3]
output_n = dim(train_labels)[2]
model <- keras_model_sequential(name = "Modelo_prueba") %>%
# Capa de convolución
layer_conv_2d(filters = 32,
kernel_size = c(3,3),
padding = "same",
activation = "relu",
input_shape = c(target_size, 1)
) %>%
layer_batch_normalization() %>%
# Capa Max Pooling
layer_max_pooling_2d(pool_size = c(2,2)) %>%
# Capa Flattening
layer_flatten() %>%
# Capa MLP (Dense Layer)
layer_dense(units = 128,
activation = "relu") %>%
layer_dropout(rate = 0.5) %>% # Añade capa dropout
# Capa MLP (Dense Layer)
layer_dense(units = 64,
activation = "relu") %>%
layer_dropout(rate = 0.5) %>% # Añade capa dropout
# Capa de salida (Output Layer)
layer_dense(units = output_n,
activation = "softmax",
name = "Output")Inicialización de pesos aleatorios: Se establece una semilla para asegurar la reproducibilidad de los resultados al inicializar los pesos de la red de manera aleatoria.
Configuración del tamaño de entrada y salida: target_size representa las dimensiones de las imágenes, y output_n es el número de clases (etiquetas) que la red deberá predecir.
Construcción del modelo:
output_n clases posibles.Visualizamos un resumen del modelo:
summary(model)Model: "Modelo_prueba"
________________________________________________________________________________
Layer (type) Output Shape Param # Trainable
================================================================================
conv2d (Conv2D) (None, 28, 28, 32) 320 Y
batch_normalization (BatchNo (None, 28, 28, 32) 128 Y
rmalization)
max_pooling2d (MaxPooling2D) (None, 14, 14, 32) 0 Y
flatten (Flatten) (None, 6272) 0 Y
dense_1 (Dense) (None, 128) 802944 Y
dropout_1 (Dropout) (None, 128) 0 Y
dense (Dense) (None, 64) 8256 Y
dropout (Dropout) (None, 64) 0 Y
Output (Dense) (None, 10) 650 Y
================================================================================
Total params: 812298 (3.10 MB)
Trainable params: 812234 (3.10 MB)
Non-trainable params: 64 (256.00 Byte)
________________________________________________________________________________tensorflow::tf$random$set_seed(100)
model %>%
compile(
loss = "categorical_crossentropy",
optimizer = optimizer_adam(learning_rate = 0.001, beta_1 = 0.9),
metrics = "accuracy"
)Semilla de Tensorflow: La función tf$random$set_seed(100) se utiliza para asegurar que los resultados sean reproducibles fijando una semilla para la inicialización aleatoria de los pesos en la red.
Compilación del modelo:
categorical_crossentropy como la función de pérdida. Esta función es adecuada cuando las etiquetas están codificadas como vectores one-hot (cada etiqueta es un vector donde solo un elemento es 1 y el resto son 0).optimizer_adam, que es un método de optimización basado en el descenso de gradiente estocástico adaptativo. Los parámetros como learning_rate y beta_1 pueden ajustarse para controlar la velocidad de aprendizaje y el momento, respectivamente.Nota:
sparse_categorical_crossentropy es otra función de pérdida que se puede utilizar en lugar de categorical_crossentropy cuando las etiquetas de clase están en formato de enteros. En contraposición, categorical_crossentropy requiere que las etiquetas estén en formato one-hot. El uso de sparse_categorical_crossentropy simplifica la gestión de las etiquetas ya que no requiere la conversión de etiquetas a formato one-hot, lo que es especialmente útil cuando se manejan muchas clases. Este tipo de adaptaciones permiten optimizar el manejo de la memoria y simplificar el preprocesamiento de los datos cuando se trabaja con un gran número de clases en tareas de clasificación.
# Entrenamiento del modelo
history <- model %>%
fit(
# Datos de entrenamiento
x = train_images,
y = train_labels,
# Épocas de entrenamiento
epochs = 10,
# validation data
validation_split = 0.2,
verbose = 2
)Epoch 1/10
1500/1500 - 18s - loss: 0.8994 - accuracy: 0.7026 - val_loss: 0.4131 - val_accuracy: 0.8608 - 18s/epoch - 12ms/step
Epoch 2/10
1500/1500 - 18s - loss: 0.5397 - accuracy: 0.8154 - val_loss: 0.3652 - val_accuracy: 0.8814 - 18s/epoch - 12ms/step
Epoch 3/10
1500/1500 - 19s - loss: 0.4583 - accuracy: 0.8453 - val_loss: 0.3203 - val_accuracy: 0.8891 - 19s/epoch - 12ms/step
Epoch 4/10
1500/1500 - 17s - loss: 0.4157 - accuracy: 0.8591 - val_loss: 0.3081 - val_accuracy: 0.8943 - 17s/epoch - 12ms/step
Epoch 5/10
1500/1500 - 18s - loss: 0.3891 - accuracy: 0.8657 - val_loss: 0.3115 - val_accuracy: 0.8874 - 18s/epoch - 12ms/step
Epoch 6/10
1500/1500 - 18s - loss: 0.3720 - accuracy: 0.8723 - val_loss: 0.2968 - val_accuracy: 0.8995 - 18s/epoch - 12ms/step
Epoch 7/10
1500/1500 - 18s - loss: 0.3470 - accuracy: 0.8797 - val_loss: 0.2943 - val_accuracy: 0.8976 - 18s/epoch - 12ms/step
Epoch 8/10
1500/1500 - 18s - loss: 0.3294 - accuracy: 0.8852 - val_loss: 0.2870 - val_accuracy: 0.9013 - 18s/epoch - 12ms/step
Epoch 9/10
1500/1500 - 19s - loss: 0.3233 - accuracy: 0.8882 - val_loss: 0.2933 - val_accuracy: 0.9039 - 19s/epoch - 13ms/step
Epoch 10/10
1500/1500 - 19s - loss: 0.3163 - accuracy: 0.8924 - val_loss: 0.2928 - val_accuracy: 0.9056 - 19s/epoch - 13ms/stepEntrenamiento del modelo: Se usa la función fit para entrenar el modelo. history es un objeto que guarda la historia del entrenamiento, incluyendo las métricas de desempeño como la pérdida y precisión, tanto para el entrenamiento como para la validación en cada época.
Datos de entrenamiento (x, y):
x = train_images son las imágenes que se utilizan para entrenar el modelo.y = train_labels son las etiquetas correspondientes a cada imagen, que indican la clase o categoría de la imagen.Épocas de entrenamiento (epochs): El modelo se entrenará pasando por el conjunto completo de datos de entrenamiento un total de 10 veces. Cada paso por completo del conjunto de datos se denomina una “época”.
Datos de validación (validation_split): Se reserva el 20% del conjunto de datos de entrenamiento para validar el modelo. Esto significa que este porcentaje no se utilizará para el entrenamiento directo sino para evaluar la generalización del modelo a nuevos datos no vistos durante el entrenamiento.
verbose: Controla la salida de información durante el entrenamiento, con 0 para ningún mensaje, 1 para mostrar una barra de progreso detallada, y 2 para mostrar una línea de resumen por cada época.
Mostramos el resultado del entrenamiento y algunas métricas:
plot(history)
Métricas generales del modelo:
model %>% evaluate(train_images, train_labels)1875/1875 - 5s - loss: 0.2196 - accuracy: 0.9252 - 5s/epoch - 3ms/step loss accuracy
0.2196127 0.9252000 Métricas generales del modelo:
model %>% evaluate(test_images, test_labels)313/313 - 1s - loss: 0.3115 - accuracy: 0.8982 - 822ms/epoch - 3ms/step loss accuracy
0.3115089 0.8982000 Predecimos los resultados del conjunto de prueba
pred <- model %>% predict(test_images)313/313 - 1s - 904ms/epoch - 3ms/step# Vector de probabilidades (una por cada clase)
pred[1, ] [1] 4.605564e-27 3.925003e-29 7.481576e-30 1.313085e-25 1.292148e-29
[6] 7.327493e-09 8.927177e-26 9.209271e-08 1.621343e-20 9.999999e-01# Cuál clase tiene mayor probabilidad?
which.max(pred[1, ])[1] 10Directamente predecimos las clases
class_pred <- model %>%
predict(test_images) %>%
k_argmax() %>%
as.numeric()313/313 - 1s - 1s/epoch - 4ms/steppredicciones = as.numeric(class_pred[1:10])Probamos las 15 primeras predicciones
class_names[as.numeric(class_pred[1:15])+1] [1] "Bota" "Polerón" "Pantalón" "Pantalón" "Camisa" "Pantalón"
[7] "Abrigo" "Camisa" "Sandalia" "Zapatilla" "Abrigo" "Sandalia"
[13] "Sandalia" "Vestido" "Abrigo" class_names[as.numeric(k_argmax(test_labels))[1:15]+1] [1] "Bota" "Polerón" "Pantalón" "Pantalón" "Camisa" "Pantalón"
[7] "Abrigo" "Camisa" "Sandalia" "Zapatilla" "Abrigo" "Sandalia"
[13] "Zapatilla" "Vestido" "Abrigo" par(mfrow=c(3,5))
par(mar=c(0, 0, 0, 0), xaxs='i', yaxs='i')
for (i in 1:15) {
im <- test_images[i,,]
im <- t(apply(im, 2, rev))
image(1:28, 1:28, im, col=gray(1-(0:255)/255),
xaxt='n')
}
library(ggplot2)
library(tidyverse)
data.frame(Estimado = as.factor(class_names[as.numeric(class_pred)+1]),
Observado = as.factor(class_names[as.numeric(k_argmax(test_labels))+1])) %>%
yardstick::conf_mat(truth = Observado,
estimate = Estimado,
dnn = c("Predicción", "Verdadero")) %>%
autoplot(type = "heatmap")+
theme(axis.text.x = element_text(angle = 20, vjust = 0.5, hjust=1),
axis.title.x = element_text(vjust = -2))
Parece que nuestro modelo logra clasificar relativamente bien los tipos de prendas, aunque se debe efectuar un análisis posterior respecto de las prendas mal clasificadas.