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.6811 - accuracy: 0.7510 - val_loss: 0.5340 - val_accuracy: 0.8028 - 3s/epoch - 10ms/step
## Epoch 2/20
## 329/329 - 2s - loss: 0.4778 - accuracy: 0.8255 - val_loss: 0.6705 - val_accuracy: 0.7789 - 2s/epoch - 7ms/step
## Epoch 3/20
## 329/329 - 2s - loss: 0.4302 - accuracy: 0.8447 - val_loss: 0.4298 - val_accuracy: 0.8447 - 2s/epoch - 7ms/step
## Epoch 4/20
## 329/329 - 2s - loss: 0.4010 - accuracy: 0.8532 - val_loss: 0.4007 - val_accuracy: 0.8514 - 2s/epoch - 7ms/step
## Epoch 5/20
## 329/329 - 2s - loss: 0.3849 - accuracy: 0.8599 - val_loss: 0.4030 - val_accuracy: 0.8518 - 2s/epoch - 7ms/step
## Epoch 6/20
## 329/329 - 2s - loss: 0.3678 - accuracy: 0.8647 - val_loss: 0.3388 - val_accuracy: 0.8753 - 2s/epoch - 7ms/step
## Epoch 7/20
## 329/329 - 2s - loss: 0.3547 - accuracy: 0.8702 - val_loss: 0.3786 - val_accuracy: 0.8619 - 2s/epoch - 7ms/step
## Epoch 8/20
## 329/329 - 2s - loss: 0.3444 - accuracy: 0.8739 - val_loss: 0.3808 - val_accuracy: 0.8583 - 2s/epoch - 7ms/step
## Epoch 9/20
## 329/329 - 2s - loss: 0.3352 - accuracy: 0.8754 - val_loss: 0.3539 - val_accuracy: 0.8727 - 2s/epoch - 7ms/step
## Epoch 10/20
## 329/329 - 2s - loss: 0.3304 - accuracy: 0.8790 - val_loss: 0.3937 - val_accuracy: 0.8557 - 2s/epoch - 7ms/step
## Epoch 11/20
## 329/329 - 2s - loss: 0.3250 - accuracy: 0.8801 - val_loss: 0.3594 - val_accuracy: 0.8736 - 2s/epoch - 7ms/step
## Epoch 12/20
## 329/329 - 2s - loss: 0.3224 - accuracy: 0.8815 - val_loss: 0.3422 - val_accuracy: 0.8767 - 2s/epoch - 7ms/step
## Epoch 13/20
## 329/329 - 2s - loss: 0.3143 - accuracy: 0.8841 - val_loss: 0.3587 - val_accuracy: 0.8707 - 2s/epoch - 7ms/step
## Epoch 14/20
## 329/329 - 2s - loss: 0.3086 - accuracy: 0.8873 - val_loss: 0.3735 - val_accuracy: 0.8587 - 2s/epoch - 7ms/step
## Epoch 15/20
## 329/329 - 2s - loss: 0.3045 - accuracy: 0.8890 - val_loss: 0.3374 - val_accuracy: 0.8836 - 2s/epoch - 7ms/step
## Epoch 16/20
## 329/329 - 2s - loss: 0.3017 - accuracy: 0.8885 - val_loss: 0.3606 - val_accuracy: 0.8709 - 2s/epoch - 7ms/step
## Epoch 17/20
## 329/329 - 2s - loss: 0.2998 - accuracy: 0.8892 - val_loss: 0.3755 - val_accuracy: 0.8621 - 2s/epoch - 7ms/step
## Epoch 18/20
## 329/329 - 2s - loss: 0.2946 - accuracy: 0.8908 - val_loss: 0.3294 - val_accuracy: 0.8869 - 2s/epoch - 7ms/step
## Epoch 19/20
## 329/329 - 2s - loss: 0.2940 - accuracy: 0.8929 - val_loss: 0.3221 - val_accuracy: 0.8868 - 2s/epoch - 7ms/step
## Epoch 20/20
## 329/329 - 2s - loss: 0.2895 - accuracy: 0.8944 - val_loss: 0.3303 - val_accuracy: 0.8869 - 2s/epoch - 7ms/step
# Evaluating the model performance

evaluation1 <- model1 %>% evaluate(test_images, test_labels)
## 313/313 - 0s - loss: 0.3614 - accuracy: 0.8784 - 451ms/epoch - 1ms/step
cat("Model 1 Accuracy:", evaluation1[[2]], "\n")
## Model 1 Accuracy: 0.8784
#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.1101 - accuracy: 0.7745 - val_loss: 0.0779 - val_accuracy: 0.8430 - 8s/epoch - 24ms/step
## Epoch 2/20
## 329/329 - 6s - loss: 0.0785 - accuracy: 0.8400 - val_loss: 0.0691 - val_accuracy: 0.8593 - 6s/epoch - 19ms/step
## Epoch 3/20
## 329/329 - 6s - loss: 0.0733 - accuracy: 0.8491 - val_loss: 0.0661 - val_accuracy: 0.8661 - 6s/epoch - 19ms/step
## Epoch 4/20
## 329/329 - 6s - loss: 0.0693 - accuracy: 0.8594 - val_loss: 0.0634 - val_accuracy: 0.8733 - 6s/epoch - 19ms/step
## Epoch 5/20
## 329/329 - 6s - loss: 0.0664 - accuracy: 0.8614 - val_loss: 0.0614 - val_accuracy: 0.8759 - 6s/epoch - 19ms/step
## Epoch 6/20
## 329/329 - 6s - loss: 0.0641 - accuracy: 0.8679 - val_loss: 0.0629 - val_accuracy: 0.8687 - 6s/epoch - 19ms/step
## Epoch 7/20
## 329/329 - 6s - loss: 0.0627 - accuracy: 0.8700 - val_loss: 0.0603 - val_accuracy: 0.8752 - 6s/epoch - 19ms/step
## Epoch 8/20
## 329/329 - 6s - loss: 0.0609 - accuracy: 0.8731 - val_loss: 0.0601 - val_accuracy: 0.8817 - 6s/epoch - 18ms/step
## Epoch 9/20
## 329/329 - 6s - loss: 0.0595 - accuracy: 0.8771 - val_loss: 0.0582 - val_accuracy: 0.8854 - 6s/epoch - 19ms/step
## Epoch 10/20
## 329/329 - 6s - loss: 0.0586 - accuracy: 0.8774 - val_loss: 0.0628 - val_accuracy: 0.8761 - 6s/epoch - 19ms/step
## Epoch 11/20
## 329/329 - 6s - loss: 0.0581 - accuracy: 0.8797 - val_loss: 0.0588 - val_accuracy: 0.8806 - 6s/epoch - 19ms/step
## Epoch 12/20
## 329/329 - 6s - loss: 0.0565 - accuracy: 0.8832 - val_loss: 0.0562 - val_accuracy: 0.8871 - 6s/epoch - 19ms/step
## Epoch 13/20
## 329/329 - 6s - loss: 0.0550 - accuracy: 0.8880 - val_loss: 0.0578 - val_accuracy: 0.8823 - 6s/epoch - 19ms/step
## Epoch 14/20
## 329/329 - 6s - loss: 0.0551 - accuracy: 0.8865 - val_loss: 0.0560 - val_accuracy: 0.8860 - 6s/epoch - 18ms/step
## Epoch 15/20
## 329/329 - 6s - loss: 0.0541 - accuracy: 0.8882 - val_loss: 0.0550 - val_accuracy: 0.8912 - 6s/epoch - 19ms/step
## Epoch 16/20
## 329/329 - 6s - loss: 0.0532 - accuracy: 0.8897 - val_loss: 0.0551 - val_accuracy: 0.8907 - 6s/epoch - 18ms/step
## Epoch 17/20
## 329/329 - 6s - loss: 0.0525 - accuracy: 0.8917 - val_loss: 0.0560 - val_accuracy: 0.8866 - 6s/epoch - 19ms/step
## Epoch 18/20
## 329/329 - 6s - loss: 0.0524 - accuracy: 0.8920 - val_loss: 0.0552 - val_accuracy: 0.8937 - 6s/epoch - 19ms/step
## Epoch 19/20
## 329/329 - 6s - loss: 0.0514 - accuracy: 0.8933 - val_loss: 0.0581 - val_accuracy: 0.8830 - 6s/epoch - 19ms/step
## Epoch 20/20
## 329/329 - 6s - loss: 0.0506 - accuracy: 0.8964 - val_loss: 0.0541 - val_accuracy: 0.8920 - 6s/epoch - 19ms/step
#Evaluating the model performance
evaluation2 <- model2 %>% evaluate(test_images, test_labels)
## 313/313 - 1s - loss: 0.0582 - accuracy: 0.8825 - 652ms/epoch - 2ms/step
cat("Model 2 Accuracy:", evaluation2[[2]], "\n")
## Model 2 Accuracy: 0.8825
#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 - 15s - loss: 0.5862 - accuracy: 0.7861 - val_loss: 0.4536 - val_accuracy: 0.8396 - 15s/epoch - 46ms/step
## Epoch 2/20
## 329/329 - 14s - loss: 0.4300 - accuracy: 0.8434 - val_loss: 0.3765 - val_accuracy: 0.8614 - 14s/epoch - 43ms/step
## Epoch 3/20
## 329/329 - 14s - loss: 0.3918 - accuracy: 0.8558 - val_loss: 0.3604 - val_accuracy: 0.8688 - 14s/epoch - 43ms/step
## Epoch 4/20
## 329/329 - 14s - loss: 0.3726 - accuracy: 0.8623 - val_loss: 0.3687 - val_accuracy: 0.8664 - 14s/epoch - 43ms/step
## Epoch 5/20
## 329/329 - 14s - loss: 0.3539 - accuracy: 0.8688 - val_loss: 0.3406 - val_accuracy: 0.8775 - 14s/epoch - 43ms/step
## Epoch 6/20
## 329/329 - 14s - loss: 0.3344 - accuracy: 0.8766 - val_loss: 0.3316 - val_accuracy: 0.8803 - 14s/epoch - 43ms/step
## Epoch 7/20
## 329/329 - 14s - loss: 0.3228 - accuracy: 0.8799 - val_loss: 0.3320 - val_accuracy: 0.8782 - 14s/epoch - 43ms/step
## Epoch 8/20
## 329/329 - 14s - loss: 0.3156 - accuracy: 0.8825 - val_loss: 0.3216 - val_accuracy: 0.8798 - 14s/epoch - 43ms/step
## Epoch 9/20
## 329/329 - 14s - loss: 0.3003 - accuracy: 0.8883 - val_loss: 0.3268 - val_accuracy: 0.8816 - 14s/epoch - 42ms/step
## Epoch 10/20
## 329/329 - 14s - loss: 0.2957 - accuracy: 0.8895 - val_loss: 0.3246 - val_accuracy: 0.8824 - 14s/epoch - 43ms/step
## Epoch 11/20
## 329/329 - 14s - loss: 0.2878 - accuracy: 0.8915 - val_loss: 0.3063 - val_accuracy: 0.8892 - 14s/epoch - 43ms/step
## Epoch 12/20
## 329/329 - 14s - loss: 0.2835 - accuracy: 0.8932 - val_loss: 0.3090 - val_accuracy: 0.8889 - 14s/epoch - 43ms/step
## Epoch 13/20
## 329/329 - 15s - loss: 0.2721 - accuracy: 0.8978 - val_loss: 0.3097 - val_accuracy: 0.8859 - 15s/epoch - 45ms/step
## Epoch 14/20
## 329/329 - 15s - loss: 0.2717 - accuracy: 0.8982 - val_loss: 0.3090 - val_accuracy: 0.8909 - 15s/epoch - 44ms/step
## Epoch 15/20
## 329/329 - 14s - loss: 0.2635 - accuracy: 0.8998 - val_loss: 0.3082 - val_accuracy: 0.8883 - 14s/epoch - 43ms/step
## Epoch 16/20
## 329/329 - 14s - loss: 0.2596 - accuracy: 0.9014 - val_loss: 0.3009 - val_accuracy: 0.8913 - 14s/epoch - 43ms/step
## Epoch 17/20
## 329/329 - 14s - loss: 0.2523 - accuracy: 0.9032 - val_loss: 0.3025 - val_accuracy: 0.8905 - 14s/epoch - 43ms/step
## Epoch 18/20
## 329/329 - 14s - loss: 0.2493 - accuracy: 0.9074 - val_loss: 0.2931 - val_accuracy: 0.8948 - 14s/epoch - 44ms/step
## Epoch 19/20
## 329/329 - 14s - loss: 0.2436 - accuracy: 0.9079 - val_loss: 0.2931 - val_accuracy: 0.8952 - 14s/epoch - 43ms/step
## Epoch 20/20
## 329/329 - 14s - loss: 0.2378 - accuracy: 0.9094 - val_loss: 0.3018 - val_accuracy: 0.8937 - 14s/epoch - 43ms/step
#Evaluating the model performance
evaluation3 <- model3 %>% evaluate(test_images, test_labels)
## 313/313 - 1s - loss: 0.3315 - accuracy: 0.8849 - 896ms/epoch - 3ms/step
cat("Model 3 Accuracy:", evaluation3[[2]], "\n")
## Model 3 Accuracy: 0.8849
#Plotting the model
plot(history3)+theme_bw()

Result: The Model 3 performs better than 1 and 2