Install Keras

install.packages("keras")
library(keras)
install_keras()
library(keras)
library(tidyr)
library(ggplot2)

FASHION_MNIST

fashion_mnist <- dataset_fashion_mnist()

c(train_images, train_labels) %<-% fashion_mnist$train
c(test_images, test_labels) %<-% fashion_mnist$test

dim(train_images)
## [1] 60000    28    28
length(train_labels)
## [1] 60000
table(train_labels)
## train_labels
##    0    1    2    3    4    5    6    7    8    9 
## 6000 6000 6000 6000 6000 6000 6000 6000 6000 6000
dim(test_images)
## [1] 10000    28    28
class_names = c('T-shirt/top',
                'Trouser',
                'Pullover',
                'Dress',
                'Coat', 
                'Sandal',
                'Shirt',
                'Sneaker',
                'Bag',
                'Ankle boot')
par(mfcol=c(5,5))
par(mar=c(0, 0, 1.5, 0), xaxs='i', yaxs='i')
for (i in 1:25) { 
  img <- train_images[i, , ]
  img <- t(apply(img, 2, rev)) 
  image(1:28, 1:28, img, col = gray((0:255)/255), xaxt = 'n', yaxt = 'n',
        main = paste(class_names[train_labels[i] + 1]))
}

Preprocessing

Training images are stored in an array of shape (60000, 28, 28) with each entry being an integer between 0 and 255. Scale the values between 0 and 1.

train_images <- train_images / 255
test_images <- test_images / 255

Set up the Network Architecture

model <- keras_model_sequential()
model %>%
  layer_flatten(input_shape = c(28, 28)) %>%
  layer_dense(units = 128, activation = 'relu') %>%
  layer_dense(units = 10, activation = 'softmax')

# Same as
# model %>%
#  layer_dense(units = 512, activation = "relu", input_shape = c(28 * 28)) %>%
#  layer_dense(units = 10, activation = "softmax")
model %>% compile(
  optimizer = 'rmsprop', 
  loss = 'sparse_categorical_crossentropy',
  metrics = c('accuracy')
)
summary(model)
## ___________________________________________________________________________
## Layer (type)                     Output Shape                  Param #     
## ===========================================================================
## flatten_1 (Flatten)              (None, 784)                   0           
## ___________________________________________________________________________
## dense_1 (Dense)                  (None, 128)                   100480      
## ___________________________________________________________________________
## dense_2 (Dense)                  (None, 10)                    1290        
## ===========================================================================
## Total params: 101,770
## Trainable params: 101,770
## Non-trainable params: 0
## ___________________________________________________________________________

Model Fit

During training, R will display * the loss of the network over the training data, and * the accuracy of the network over the training data.

model %>% fit(train_images, train_labels, epochs = 5)
# model %>% fit(train_images, train_labels, epochs = 5, batch_size = 128)

Prediction on Test Data

score <- model %>% evaluate(test_images, test_labels)

cat('Test loss:', score$loss, "\n")
## Test loss: 0.413027
cat('Test accuracy:', score$acc, "\n")
## Test accuracy: 0.8681
predictions <- model %>% predict(test_images)
round(predictions[1, ], dig=2)
##  [1] 0 0 0 0 0 0 0 0 0 1
test_labels[1]
## [1] 9
class_pred <- model %>% predict_classes(test_images)
class_pred[1]
## [1] 9
table(test_labels, class_pred)
##            class_pred
## test_labels   0   1   2   3   4   5   6   7   8   9
##           0 778   0  28  16   2   0 169   1   6   0
##           1   4 962   6  18   3   0   5   0   2   0
##           2  11   0 845   5  78   0  59   0   2   0
##           3  22   3  27 844  46   0  54   0   4   0
##           4   0   0 166  21 758   0  55   0   0   0
##           5   0   0   0   1   0 949   0  33   2  15
##           6  91   1 127  15  74   0 681   0  11   0
##           7   0   0   0   0   0  11   0 959   0  30
##           8   3   0   3   5   7  13   6   7 956   0
##           9   0   0   0   0   0  10   1  40   0 949
class_names[c(1, 7)]
## [1] "T-shirt/top" "Shirt"
class_names[c(3, 5, 7)]
## [1] "Pullover" "Coat"     "Shirt"