Installing the required packages

https://tensorflow.rstudio.com/install/

remotes::install_github(“rstudio/tensorflow”)

reticulate::install_python()

install_tensorflow(envname = “r-tensorflow”)

install.packages(“keras”)

install_keras()

summary(cars)
##      speed           dist       
##  Min.   : 4.0   Min.   :  2.00  
##  1st Qu.:12.0   1st Qu.: 26.00  
##  Median :15.0   Median : 36.00  
##  Mean   :15.4   Mean   : 42.98  
##  3rd Qu.:19.0   3rd Qu.: 56.00  
##  Max.   :25.0   Max.   :120.00
library(tensorflow)
library(keras)
library(ggplot2)
#load mnist fashion data
mnist <- dataset_fashion_mnist()
# create a 60,000x28x28 tensor for the training images
train_images <- mnist$train$x
# create a 60,000-element vector for the training labels
train_labels <- mnist$train$y
# create a 10,000x28x28 tensor for the test images

test_images <- mnist$test$x
# create a 10,000-element vector for the test labels
test_labels <- mnist$test$y
# select the 400th training image
digit <- train_images[17,,]
# plot it!
plot(as.raster(digit, max = 301))

### Model 1: Balanced network with RMSprop optimizer

# Defining the model
model1 <- keras_model_sequential() %>%
  layer_dense(units = 512, activation = "relu", input_shape = c(28 * 28)) %>%
  layer_dropout(rate = 0.4) %>%
  layer_dense(units = 256, activation = "relu") %>%
  layer_dropout(rate = 0.3) %>%
  layer_dense(units = 128, activation = "relu") %>%
  layer_dense(units = 10, activation = "softmax")

model1 %>% compile(
  optimizer = optimizer_rmsprop(),
  loss = "categorical_crossentropy", 
  metrics = c("accuracy")
)

# Reshape and normalize images
train_images <- array_reshape(train_images, c(60000, 28 * 28)) / 255
test_images <- array_reshape(test_images, c(10000, 28 * 28)) / 255

# One-hot encoding of labels
train_labels <- to_categorical(train_labels)
test_labels <- to_categorical(test_labels)
# Defining class labels
class_labels <- c('T-shirt/top', 'Trouser', 'Pullover', 'Dress', 'Coat',
'Sandal', 'Shirt', 'Sneaker', 'Bag', 'Ankle boot')

# Training the model
history1 <- model1 %>% fit(
  train_images, train_labels, 
  epochs = 20, batch_size = 128, 
  validation_split = 0.3
)
## Epoch 1/20
## 329/329 - 3s - loss: 0.6746 - accuracy: 0.7505 - val_loss: 0.5904 - val_accuracy: 0.7743 - 3s/epoch - 10ms/step
## Epoch 2/20
## 329/329 - 2s - loss: 0.4715 - accuracy: 0.8275 - val_loss: 0.4331 - val_accuracy: 0.8368 - 2s/epoch - 7ms/step
## Epoch 3/20
## 329/329 - 2s - loss: 0.4272 - accuracy: 0.8444 - val_loss: 0.4613 - val_accuracy: 0.8291 - 2s/epoch - 7ms/step
## Epoch 4/20
## 329/329 - 2s - loss: 0.4018 - accuracy: 0.8533 - val_loss: 0.4197 - val_accuracy: 0.8437 - 2s/epoch - 7ms/step
## Epoch 5/20
## 329/329 - 2s - loss: 0.3857 - accuracy: 0.8590 - val_loss: 0.4393 - val_accuracy: 0.8436 - 2s/epoch - 7ms/step
## Epoch 6/20
## 329/329 - 2s - loss: 0.3691 - accuracy: 0.8655 - val_loss: 0.3976 - val_accuracy: 0.8574 - 2s/epoch - 7ms/step
## Epoch 7/20
## 329/329 - 2s - loss: 0.3567 - accuracy: 0.8699 - val_loss: 0.4001 - val_accuracy: 0.8569 - 2s/epoch - 7ms/step
## Epoch 8/20
## 329/329 - 2s - loss: 0.3468 - accuracy: 0.8723 - val_loss: 0.3628 - val_accuracy: 0.8620 - 2s/epoch - 7ms/step
## Epoch 9/20
## 329/329 - 2s - loss: 0.3397 - accuracy: 0.8764 - val_loss: 0.3637 - val_accuracy: 0.8672 - 2s/epoch - 7ms/step
## Epoch 10/20
## 329/329 - 2s - loss: 0.3314 - accuracy: 0.8778 - val_loss: 0.3361 - val_accuracy: 0.8797 - 2s/epoch - 7ms/step
## Epoch 11/20
## 329/329 - 2s - loss: 0.3268 - accuracy: 0.8804 - val_loss: 0.3402 - val_accuracy: 0.8791 - 2s/epoch - 7ms/step
## Epoch 12/20
## 329/329 - 2s - loss: 0.3198 - accuracy: 0.8845 - val_loss: 0.3283 - val_accuracy: 0.8837 - 2s/epoch - 7ms/step
## Epoch 13/20
## 329/329 - 2s - loss: 0.3132 - accuracy: 0.8850 - val_loss: 0.3352 - val_accuracy: 0.8797 - 2s/epoch - 7ms/step
## Epoch 14/20
## 329/329 - 2s - loss: 0.3108 - accuracy: 0.8862 - val_loss: 0.3423 - val_accuracy: 0.8727 - 2s/epoch - 7ms/step
## Epoch 15/20
## 329/329 - 2s - loss: 0.3074 - accuracy: 0.8878 - val_loss: 0.3471 - val_accuracy: 0.8693 - 2s/epoch - 7ms/step
## Epoch 16/20
## 329/329 - 2s - loss: 0.3015 - accuracy: 0.8896 - val_loss: 0.3403 - val_accuracy: 0.8734 - 2s/epoch - 7ms/step
## Epoch 17/20
## 329/329 - 2s - loss: 0.2989 - accuracy: 0.8908 - val_loss: 0.3471 - val_accuracy: 0.8799 - 2s/epoch - 7ms/step
## Epoch 18/20
## 329/329 - 2s - loss: 0.2972 - accuracy: 0.8920 - val_loss: 0.3288 - val_accuracy: 0.8869 - 2s/epoch - 7ms/step
## Epoch 19/20
## 329/329 - 2s - loss: 0.2913 - accuracy: 0.8943 - val_loss: 0.3285 - val_accuracy: 0.8868 - 2s/epoch - 7ms/step
## Epoch 20/20
## 329/329 - 2s - loss: 0.2868 - accuracy: 0.8948 - val_loss: 0.3285 - val_accuracy: 0.8867 - 2s/epoch - 7ms/step
# Evaluating the model performance

evaluation1 <- model1 %>% evaluate(test_images, test_labels)
## 313/313 - 0s - loss: 0.3565 - accuracy: 0.8792 - 437ms/epoch - 1ms/step
cat("Model 1 Accuracy:", evaluation1[[2]], "\n")
## Model 1 Accuracy: 0.8792
#Plotting the model
plot(history1)+theme_bw()

### Model 2: Slightly deeper network with Nadam optimizer

#Defining the model
model2 <- keras_model_sequential() %>%
  layer_dense(units = 1024, activation = "relu", input_shape = c(28 * 28)) %>%
  layer_dropout(rate = 0.5) %>%
  layer_dense(units = 512, activation = "relu") %>%
  layer_dropout(rate = 0.4) %>%
  layer_dense(units = 256, activation = "relu") %>%
  layer_dense(units = 10, activation = "softmax")

model2 %>% compile(
  optimizer = optimizer_nadam(),
  loss = "binary_crossentropy", 
  metrics = c("accuracy")
)
#Training the model
history2 <- model2 %>% fit(
  train_images, train_labels, 
  epochs = 20, batch_size = 128, 
  validation_split = 0.3
  )
## Epoch 1/20
## 329/329 - 8s - loss: 0.1105 - accuracy: 0.7734 - val_loss: 0.0775 - val_accuracy: 0.8416 - 8s/epoch - 24ms/step
## Epoch 2/20
## 329/329 - 6s - loss: 0.0787 - accuracy: 0.8390 - val_loss: 0.0734 - val_accuracy: 0.8503 - 6s/epoch - 19ms/step
## Epoch 3/20
## 329/329 - 6s - loss: 0.0736 - accuracy: 0.8497 - val_loss: 0.0656 - val_accuracy: 0.8646 - 6s/epoch - 19ms/step
## Epoch 4/20
## 329/329 - 6s - loss: 0.0694 - accuracy: 0.8574 - val_loss: 0.0694 - val_accuracy: 0.8555 - 6s/epoch - 19ms/step
## Epoch 5/20
## 329/329 - 6s - loss: 0.0671 - accuracy: 0.8629 - val_loss: 0.0626 - val_accuracy: 0.8721 - 6s/epoch - 19ms/step
## Epoch 6/20
## 329/329 - 6s - loss: 0.0643 - accuracy: 0.8672 - val_loss: 0.0610 - val_accuracy: 0.8768 - 6s/epoch - 19ms/step
## Epoch 7/20
## 329/329 - 6s - loss: 0.0629 - accuracy: 0.8699 - val_loss: 0.0594 - val_accuracy: 0.8777 - 6s/epoch - 19ms/step
## Epoch 8/20
## 329/329 - 6s - loss: 0.0615 - accuracy: 0.8712 - val_loss: 0.0615 - val_accuracy: 0.8701 - 6s/epoch - 19ms/step
## Epoch 9/20
## 329/329 - 6s - loss: 0.0593 - accuracy: 0.8780 - val_loss: 0.0587 - val_accuracy: 0.8813 - 6s/epoch - 19ms/step
## Epoch 10/20
## 329/329 - 6s - loss: 0.0586 - accuracy: 0.8803 - val_loss: 0.0590 - val_accuracy: 0.8799 - 6s/epoch - 19ms/step
## Epoch 11/20
## 329/329 - 6s - loss: 0.0586 - accuracy: 0.8790 - val_loss: 0.0574 - val_accuracy: 0.8846 - 6s/epoch - 19ms/step
## Epoch 12/20
## 329/329 - 6s - loss: 0.0568 - accuracy: 0.8849 - val_loss: 0.0576 - val_accuracy: 0.8822 - 6s/epoch - 19ms/step
## Epoch 13/20
## 329/329 - 6s - loss: 0.0552 - accuracy: 0.8859 - val_loss: 0.0572 - val_accuracy: 0.8801 - 6s/epoch - 19ms/step
## Epoch 14/20
## 329/329 - 6s - loss: 0.0545 - accuracy: 0.8876 - val_loss: 0.0563 - val_accuracy: 0.8823 - 6s/epoch - 19ms/step
## Epoch 15/20
## 329/329 - 6s - loss: 0.0542 - accuracy: 0.8893 - val_loss: 0.0559 - val_accuracy: 0.8880 - 6s/epoch - 19ms/step
## Epoch 16/20
## 329/329 - 6s - loss: 0.0536 - accuracy: 0.8887 - val_loss: 0.0556 - val_accuracy: 0.8879 - 6s/epoch - 19ms/step
## Epoch 17/20
## 329/329 - 6s - loss: 0.0519 - accuracy: 0.8950 - val_loss: 0.0558 - val_accuracy: 0.8878 - 6s/epoch - 19ms/step
## Epoch 18/20
## 329/329 - 6s - loss: 0.0526 - accuracy: 0.8911 - val_loss: 0.0545 - val_accuracy: 0.8917 - 6s/epoch - 20ms/step
## Epoch 19/20
## 329/329 - 6s - loss: 0.0511 - accuracy: 0.8930 - val_loss: 0.0548 - val_accuracy: 0.8891 - 6s/epoch - 19ms/step
## Epoch 20/20
## 329/329 - 6s - loss: 0.0498 - accuracy: 0.8966 - val_loss: 0.0541 - val_accuracy: 0.8911 - 6s/epoch - 19ms/step
#Evaluating the model performance
evaluation2 <- model2 %>% evaluate(test_images, test_labels)
## 313/313 - 1s - loss: 0.0592 - accuracy: 0.8814 - 592ms/epoch - 2ms/step
cat("Model 2 Accuracy:", evaluation2[[2]], "\n")
## Model 2 Accuracy: 0.8814
#Plotting the model
plot(history2)+theme_bw()

### Model 3: Deep network with Adamax optimizer

#Defining the model
model3 <- keras_model_sequential() %>%
  layer_dense(units = 2048, activation = "relu", input_shape = c(28 * 28)) %>%
  layer_dropout(rate = 0.5) %>%
  layer_dense(units = 1024, activation = "relu") %>%
  layer_dropout(rate = 0.4) %>%
  layer_dense(units = 512, activation = "tanh") %>%
  layer_dense(units = 10, activation = "softmax")

model3 %>% compile(
  optimizer = optimizer_adamax(),
  loss = "categorical_crossentropy", 
  metrics = c("accuracy")
)
#Training the model
history3 <- model3 %>% fit(
  train_images, train_labels, 
  epochs = 20, batch_size = 128, 
  validation_split = 0.3
)
## Epoch 1/20
## 329/329 - 16s - loss: 0.5829 - accuracy: 0.7857 - val_loss: 0.4526 - val_accuracy: 0.8321 - 16s/epoch - 49ms/step
## Epoch 2/20
## 329/329 - 15s - loss: 0.4330 - accuracy: 0.8419 - val_loss: 0.3848 - val_accuracy: 0.8594 - 15s/epoch - 44ms/step
## Epoch 3/20
## 329/329 - 15s - loss: 0.3935 - accuracy: 0.8563 - val_loss: 0.3552 - val_accuracy: 0.8691 - 15s/epoch - 45ms/step
## Epoch 4/20
## 329/329 - 15s - loss: 0.3701 - accuracy: 0.8626 - val_loss: 0.3410 - val_accuracy: 0.8758 - 15s/epoch - 46ms/step
## Epoch 5/20
## 329/329 - 14s - loss: 0.3466 - accuracy: 0.8714 - val_loss: 0.3409 - val_accuracy: 0.8759 - 14s/epoch - 43ms/step
## Epoch 6/20
## 329/329 - 14s - loss: 0.3387 - accuracy: 0.8739 - val_loss: 0.3723 - val_accuracy: 0.8643 - 14s/epoch - 43ms/step
## Epoch 7/20
## 329/329 - 14s - loss: 0.3290 - accuracy: 0.8766 - val_loss: 0.3180 - val_accuracy: 0.8842 - 14s/epoch - 43ms/step
## Epoch 8/20
## 329/329 - 14s - loss: 0.3136 - accuracy: 0.8834 - val_loss: 0.3174 - val_accuracy: 0.8843 - 14s/epoch - 43ms/step
## Epoch 9/20
## 329/329 - 14s - loss: 0.3028 - accuracy: 0.8863 - val_loss: 0.3336 - val_accuracy: 0.8792 - 14s/epoch - 43ms/step
## Epoch 10/20
## 329/329 - 14s - loss: 0.2975 - accuracy: 0.8892 - val_loss: 0.3053 - val_accuracy: 0.8882 - 14s/epoch - 42ms/step
## Epoch 11/20
## 329/329 - 15s - loss: 0.2886 - accuracy: 0.8917 - val_loss: 0.3044 - val_accuracy: 0.8906 - 15s/epoch - 47ms/step
## Epoch 12/20
## 329/329 - 14s - loss: 0.2829 - accuracy: 0.8936 - val_loss: 0.3138 - val_accuracy: 0.8878 - 14s/epoch - 43ms/step
## Epoch 13/20
## 329/329 - 14s - loss: 0.2778 - accuracy: 0.8942 - val_loss: 0.3057 - val_accuracy: 0.8884 - 14s/epoch - 43ms/step
## Epoch 14/20
## 329/329 - 14s - loss: 0.2719 - accuracy: 0.8970 - val_loss: 0.3107 - val_accuracy: 0.8875 - 14s/epoch - 43ms/step
## Epoch 15/20
## 329/329 - 14s - loss: 0.2652 - accuracy: 0.8998 - val_loss: 0.3067 - val_accuracy: 0.8917 - 14s/epoch - 43ms/step
## Epoch 16/20
## 329/329 - 14s - loss: 0.2602 - accuracy: 0.9019 - val_loss: 0.3035 - val_accuracy: 0.8912 - 14s/epoch - 43ms/step
## Epoch 17/20
## 329/329 - 14s - loss: 0.2540 - accuracy: 0.9037 - val_loss: 0.3015 - val_accuracy: 0.8928 - 14s/epoch - 43ms/step
## Epoch 18/20
## 329/329 - 14s - loss: 0.2491 - accuracy: 0.9058 - val_loss: 0.3048 - val_accuracy: 0.8916 - 14s/epoch - 43ms/step
## Epoch 19/20
## 329/329 - 14s - loss: 0.2458 - accuracy: 0.9073 - val_loss: 0.2998 - val_accuracy: 0.8909 - 14s/epoch - 43ms/step
## Epoch 20/20
## 329/329 - 14s - loss: 0.2411 - accuracy: 0.9079 - val_loss: 0.3072 - val_accuracy: 0.8912 - 14s/epoch - 42ms/step
#Evaluating the model performance
evaluation3 <- model3 %>% evaluate(test_images, test_labels)
## 313/313 - 1s - loss: 0.3356 - accuracy: 0.8798 - 945ms/epoch - 3ms/step
cat("Model 3 Accuracy:", evaluation3[[2]], "\n")
## Model 3 Accuracy: 0.8798
#Plotting the model
plot(history3)+theme_bw()

Result: The Model 3 performs better than 1 and 2