Identification and Comparison between the Deep Learning Models

# Load required libraries
library(keras)
library(tensorflow)
library(ggplot2)

Fashion MNIST dataset Loading, Normalization and Labeling

fashion_mnist <- dataset_fashion_mnist()

# Split into training and test sets
c(c(train_images, train_labels), c(test_images, test_labels)) %<-% fashion_mnist

# Normalize the images to the range [0, 1]
train_images <- train_images / 255
test_images <- test_images / 255

# One-hot encode the labels
train_labels <- to_categorical(train_labels, 10)
test_labels <- to_categorical(test_labels, 10)

# Flatten the images into 1D vectors for Feed-forward and Multilayer Neural Network
train_images_flat <- array_reshape(train_images, c(nrow(train_images), 28 * 28))
test_images_flat <- array_reshape(test_images, c(nrow(test_images), 28 * 28))

Model 1: Two-Layer Feed-forward Neural Network (FFNN)

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

# Compile the model
ffnn_model %>% compile(
  optimizer = 'adam',
  loss = 'categorical_crossentropy',
  metrics = c('accuracy')
)

# Train the FFNN model
history_ffnn <- ffnn_model %>% fit(
  train_images_flat, train_labels,
  epochs = 20,
  batch_size = 128,
  validation_split = 0.1
)

## Epoch 1/20
## 422/422 - 2s - loss: 0.5668 - accuracy: 0.8053 - val_loss: 0.4640 - val_accuracy: 0.8347 - 2s/epoch - 4ms/step
## Epoch 2/20
## 422/422 - 1s - loss: 0.3978 - accuracy: 0.8595 - val_loss: 0.3760 - val_accuracy: 0.8635 - 907ms/epoch - 2ms/step
## Epoch 3/20
## 422/422 - 1s - loss: 0.3555 - accuracy: 0.8728 - val_loss: 0.3678 - val_accuracy: 0.8680 - 1s/epoch - 3ms/step
## Epoch 4/20
## 422/422 - 1s - loss: 0.3272 - accuracy: 0.8811 - val_loss: 0.3494 - val_accuracy: 0.8762 - 1s/epoch - 3ms/step
## Epoch 5/20
## 422/422 - 1s - loss: 0.3092 - accuracy: 0.8874 - val_loss: 0.3393 - val_accuracy: 0.8738 - 1s/epoch - 3ms/step
## Epoch 6/20
## 422/422 - 1s - loss: 0.2933 - accuracy: 0.8929 - val_loss: 0.3585 - val_accuracy: 0.8768 - 1s/epoch - 3ms/step
## Epoch 7/20
## 422/422 - 1s - loss: 0.2841 - accuracy: 0.8966 - val_loss: 0.3237 - val_accuracy: 0.8822 - 1s/epoch - 3ms/step
## Epoch 8/20
## 422/422 - 1s - loss: 0.2707 - accuracy: 0.9002 - val_loss: 0.3488 - val_accuracy: 0.8790 - 1s/epoch - 3ms/step
## Epoch 9/20
## 422/422 - 1s - loss: 0.2614 - accuracy: 0.9042 - val_loss: 0.3203 - val_accuracy: 0.8843 - 1s/epoch - 3ms/step
## Epoch 10/20
## 422/422 - 1s - loss: 0.2524 - accuracy: 0.9073 - val_loss: 0.3141 - val_accuracy: 0.8858 - 1s/epoch - 3ms/step
## Epoch 11/20
## 422/422 - 1s - loss: 0.2442 - accuracy: 0.9084 - val_loss: 0.3099 - val_accuracy: 0.8878 - 1s/epoch - 3ms/step
## Epoch 12/20
## 422/422 - 1s - loss: 0.2358 - accuracy: 0.9125 - val_loss: 0.3211 - val_accuracy: 0.8877 - 1s/epoch - 3ms/step
## Epoch 13/20
## 422/422 - 1s - loss: 0.2300 - accuracy: 0.9142 - val_loss: 0.3305 - val_accuracy: 0.8847 - 1s/epoch - 3ms/step
## Epoch 14/20
## 422/422 - 1s - loss: 0.2215 - accuracy: 0.9181 - val_loss: 0.3094 - val_accuracy: 0.8892 - 1s/epoch - 3ms/step
## Epoch 15/20
## 422/422 - 1s - loss: 0.2154 - accuracy: 0.9197 - val_loss: 0.3227 - val_accuracy: 0.8898 - 1s/epoch - 3ms/step
## Epoch 16/20
## 422/422 - 1s - loss: 0.2089 - accuracy: 0.9221 - val_loss: 0.3246 - val_accuracy: 0.8902 - 1s/epoch - 3ms/step
## Epoch 17/20
## 422/422 - 1s - loss: 0.2048 - accuracy: 0.9236 - val_loss: 0.3330 - val_accuracy: 0.8888 - 1s/epoch - 3ms/step
## Epoch 18/20
## 422/422 - 1s - loss: 0.1967 - accuracy: 0.9262 - val_loss: 0.3237 - val_accuracy: 0.8918 - 1s/epoch - 3ms/step
## Epoch 19/20
## 422/422 - 1s - loss: 0.1897 - accuracy: 0.9292 - val_loss: 0.3323 - val_accuracy: 0.8930 - 1s/epoch - 3ms/step
## Epoch 20/20
## 422/422 - 1s - loss: 0.1853 - accuracy: 0.9312 - val_loss: 0.3308 - val_accuracy: 0.8918 - 1s/epoch - 3ms/step

# Evaluate FFNN
score_ffnn <- ffnn_model %>% evaluate(test_images_flat, test_labels)

## 313/313 - 0s - loss: 0.3445 - accuracy: 0.8878 - 410ms/epoch - 1ms/step

cat('FFNN Model - Test loss:', score_ffnn[1], ' - Test accuracy:', score_ffnn[2], '\n')

## FFNN Model - Test loss: 0.3444632  - Test accuracy: 0.8878

#Plot Training History
plot(history_ffnn) + theme_bw() +ggtitle ("Model 1 - Feed-forward Neural Network (FFNN)")

Model 2: Multilayer Perceptron (MLP)

mlp_model <- keras_model_sequential() %>%
  layer_dense(units = 512, activation = 'relu', input_shape = c(28 * 28)) %>%
  layer_dropout(rate = 0.2) %>%
  layer_dense(units = 256, activation = 'relu') %>%
  layer_dropout(rate = 0.2) %>%
  layer_dense(units = 10, activation = 'softmax')

# Compile the MLP model
mlp_model %>% compile(
  optimizer = 'adam',
  loss = 'categorical_crossentropy',
  metrics = c('accuracy')
)

# Train the MLP model
history_mlp <- mlp_model %>% fit(
  train_images_flat, train_labels,
  epochs = 20,
  batch_size = 128,
  validation_split = 0.1
)

## Epoch 1/20
## 422/422 - 4s - loss: 0.5429 - accuracy: 0.8059 - val_loss: 0.4170 - val_accuracy: 0.8420 - 4s/epoch - 10ms/step
## Epoch 2/20
## 422/422 - 3s - loss: 0.3919 - accuracy: 0.8576 - val_loss: 0.3596 - val_accuracy: 0.8733 - 3s/epoch - 8ms/step
## Epoch 3/20
## 422/422 - 3s - loss: 0.3541 - accuracy: 0.8699 - val_loss: 0.3478 - val_accuracy: 0.8802 - 3s/epoch - 6ms/step
## Epoch 4/20
## 422/422 - 2s - loss: 0.3300 - accuracy: 0.8780 - val_loss: 0.3423 - val_accuracy: 0.8735 - 2s/epoch - 6ms/step
## Epoch 5/20
## 422/422 - 3s - loss: 0.3188 - accuracy: 0.8824 - val_loss: 0.3233 - val_accuracy: 0.8793 - 3s/epoch - 7ms/step
## Epoch 6/20
## 422/422 - 3s - loss: 0.3008 - accuracy: 0.8890 - val_loss: 0.3281 - val_accuracy: 0.8802 - 3s/epoch - 7ms/step
## Epoch 7/20
## 422/422 - 3s - loss: 0.2906 - accuracy: 0.8921 - val_loss: 0.3231 - val_accuracy: 0.8815 - 3s/epoch - 7ms/step
## Epoch 8/20
## 422/422 - 3s - loss: 0.2816 - accuracy: 0.8939 - val_loss: 0.3159 - val_accuracy: 0.8857 - 3s/epoch - 7ms/step
## Epoch 9/20
## 422/422 - 3s - loss: 0.2703 - accuracy: 0.8990 - val_loss: 0.3123 - val_accuracy: 0.8822 - 3s/epoch - 7ms/step
## Epoch 10/20
## 422/422 - 3s - loss: 0.2646 - accuracy: 0.8997 - val_loss: 0.3159 - val_accuracy: 0.8873 - 3s/epoch - 7ms/step
## Epoch 11/20
## 422/422 - 3s - loss: 0.2561 - accuracy: 0.9035 - val_loss: 0.2984 - val_accuracy: 0.8915 - 3s/epoch - 7ms/step
## Epoch 12/20
## 422/422 - 3s - loss: 0.2510 - accuracy: 0.9042 - val_loss: 0.3128 - val_accuracy: 0.8863 - 3s/epoch - 7ms/step
## Epoch 13/20
## 422/422 - 3s - loss: 0.2436 - accuracy: 0.9074 - val_loss: 0.3314 - val_accuracy: 0.8833 - 3s/epoch - 7ms/step
## Epoch 14/20
## 422/422 - 3s - loss: 0.2378 - accuracy: 0.9108 - val_loss: 0.3157 - val_accuracy: 0.8900 - 3s/epoch - 7ms/step
## Epoch 15/20
## 422/422 - 3s - loss: 0.2328 - accuracy: 0.9121 - val_loss: 0.3067 - val_accuracy: 0.8922 - 3s/epoch - 7ms/step
## Epoch 16/20
## 422/422 - 3s - loss: 0.2330 - accuracy: 0.9129 - val_loss: 0.3250 - val_accuracy: 0.8862 - 3s/epoch - 7ms/step
## Epoch 17/20
## 422/422 - 3s - loss: 0.2223 - accuracy: 0.9162 - val_loss: 0.3197 - val_accuracy: 0.8890 - 3s/epoch - 7ms/step
## Epoch 18/20
## 422/422 - 3s - loss: 0.2195 - accuracy: 0.9180 - val_loss: 0.3138 - val_accuracy: 0.8933 - 3s/epoch - 7ms/step
## Epoch 19/20
## 422/422 - 3s - loss: 0.2152 - accuracy: 0.9178 - val_loss: 0.3077 - val_accuracy: 0.8957 - 3s/epoch - 7ms/step
## Epoch 20/20
## 422/422 - 3s - loss: 0.2068 - accuracy: 0.9202 - val_loss: 0.3226 - val_accuracy: 0.8920 - 3s/epoch - 7ms/step

# Evaluate MLP
score_mlp <- mlp_model %>% evaluate(test_images_flat, test_labels)

## 313/313 - 0s - loss: 0.3271 - accuracy: 0.8894 - 398ms/epoch - 1ms/step

cat('MLP Model - Test loss:', score_mlp[1], ' - Test accuracy:', score_mlp[2], '\n')

## MLP Model - Test loss: 0.3271038  - Test accuracy: 0.8894

#Plot Training History
plot(history_mlp) + theme_bw() +ggtitle ("Model 2 - Multilayer Perception (MLP)")

Model 3: Convolutional Neural Network (CNN)

cnn_model <- keras_model_sequential() %>%
  layer_conv_2d(filters = 32, kernel_size = c(3, 3), activation = 'relu', input_shape = c(28, 28, 1)) %>%
  layer_max_pooling_2d(pool_size = c(2, 2)) %>%
  layer_conv_2d(filters = 64, kernel_size = c(3, 3), activation = 'relu') %>%
  layer_max_pooling_2d(pool_size = c(2, 2)) %>%
  layer_flatten() %>%
  layer_dense(units = 128, activation = 'relu') %>%
  layer_dense(units = 10, activation = 'softmax')

# Compile the CNN model
cnn_model %>% compile(
  optimizer = 'adam',
  loss = 'categorical_crossentropy',
  metrics = c('accuracy')
)

# Train the CNN model
history_cnn <- cnn_model %>% fit(
  train_images, train_labels,
  epochs = 20,
  batch_size = 128,
  validation_split = 0.1
)

## Epoch 1/20
## 422/422 - 8s - loss: 0.5622 - accuracy: 0.7990 - val_loss: 0.4077 - val_accuracy: 0.8540 - 8s/epoch - 19ms/step
## Epoch 2/20
## 422/422 - 6s - loss: 0.3710 - accuracy: 0.8674 - val_loss: 0.3676 - val_accuracy: 0.8677 - 6s/epoch - 15ms/step
## Epoch 3/20
## 422/422 - 6s - loss: 0.3241 - accuracy: 0.8831 - val_loss: 0.3163 - val_accuracy: 0.8860 - 6s/epoch - 15ms/step
## Epoch 4/20
## 422/422 - 6s - loss: 0.2900 - accuracy: 0.8947 - val_loss: 0.2935 - val_accuracy: 0.8900 - 6s/epoch - 15ms/step
## Epoch 5/20
## 422/422 - 6s - loss: 0.2647 - accuracy: 0.9033 - val_loss: 0.2755 - val_accuracy: 0.8998 - 6s/epoch - 15ms/step
## Epoch 6/20
## 422/422 - 6s - loss: 0.2441 - accuracy: 0.9105 - val_loss: 0.2880 - val_accuracy: 0.8898 - 6s/epoch - 15ms/step
## Epoch 7/20
## 422/422 - 6s - loss: 0.2274 - accuracy: 0.9166 - val_loss: 0.2589 - val_accuracy: 0.9058 - 6s/epoch - 15ms/step
## Epoch 8/20
## 422/422 - 7s - loss: 0.2092 - accuracy: 0.9231 - val_loss: 0.2418 - val_accuracy: 0.9132 - 7s/epoch - 16ms/step
## Epoch 9/20
## 422/422 - 7s - loss: 0.1949 - accuracy: 0.9292 - val_loss: 0.2353 - val_accuracy: 0.9187 - 7s/epoch - 17ms/step
## Epoch 10/20
## 422/422 - 7s - loss: 0.1813 - accuracy: 0.9330 - val_loss: 0.2511 - val_accuracy: 0.9068 - 7s/epoch - 16ms/step
## Epoch 11/20
## 422/422 - 6s - loss: 0.1698 - accuracy: 0.9370 - val_loss: 0.2535 - val_accuracy: 0.9122 - 6s/epoch - 15ms/step
## Epoch 12/20
## 422/422 - 6s - loss: 0.1529 - accuracy: 0.9433 - val_loss: 0.2341 - val_accuracy: 0.9190 - 6s/epoch - 15ms/step
## Epoch 13/20
## 422/422 - 6s - loss: 0.1401 - accuracy: 0.9479 - val_loss: 0.2499 - val_accuracy: 0.9172 - 6s/epoch - 15ms/step
## Epoch 14/20
## 422/422 - 6s - loss: 0.1300 - accuracy: 0.9513 - val_loss: 0.2652 - val_accuracy: 0.9143 - 6s/epoch - 15ms/step
## Epoch 15/20
## 422/422 - 6s - loss: 0.1212 - accuracy: 0.9550 - val_loss: 0.2493 - val_accuracy: 0.9157 - 6s/epoch - 15ms/step
## Epoch 16/20
## 422/422 - 6s - loss: 0.1079 - accuracy: 0.9601 - val_loss: 0.2673 - val_accuracy: 0.9205 - 6s/epoch - 15ms/step
## Epoch 17/20
## 422/422 - 6s - loss: 0.0995 - accuracy: 0.9628 - val_loss: 0.2719 - val_accuracy: 0.9163 - 6s/epoch - 15ms/step
## Epoch 18/20
## 422/422 - 7s - loss: 0.0917 - accuracy: 0.9667 - val_loss: 0.3012 - val_accuracy: 0.9083 - 7s/epoch - 16ms/step
## Epoch 19/20
## 422/422 - 6s - loss: 0.0829 - accuracy: 0.9690 - val_loss: 0.2877 - val_accuracy: 0.9120 - 6s/epoch - 15ms/step
## Epoch 20/20
## 422/422 - 7s - loss: 0.0741 - accuracy: 0.9729 - val_loss: 0.2838 - val_accuracy: 0.9165 - 7s/epoch - 17ms/step

# Evaluate CNN
score_cnn <- cnn_model %>% evaluate(test_images, test_labels)

## 313/313 - 1s - loss: 0.3050 - accuracy: 0.9168 - 610ms/epoch - 2ms/step

cat('CNN Model - Test loss:', score_cnn[1], ' - Test accuracy:', score_cnn[2], '\n')

## CNN Model - Test loss: 0.3050397  - Test accuracy: 0.9168

#Plot Training History
plot(history_cnn) + theme_bw() +ggtitle ("Model 3 - Convolutional Neural Network (CNN)")

Visualization: Compare Accuracies and Losses Across Models

# Collect the accuracy and loss histories for all models
history_ffnn_acc <- data.frame(
  epoch = 1:20,
  train_acc = history_ffnn$metrics$accuracy,
  val_acc = history_ffnn$metrics$val_accuracy,
  model = 'FFNN'
)

history_mlp_acc <- data.frame(
  epoch = 1:20,
  train_acc = history_mlp$metrics$accuracy,
  val_acc = history_mlp$metrics$val_accuracy,
  model = 'MLP'
)

history_cnn_acc <- data.frame(
  epoch = 1:20,
  train_acc = history_cnn$metrics$accuracy,
  val_acc = history_cnn$metrics$val_accuracy,
  model = 'CNN'
)

# Combine data into a single dataframe for easy plotting
history_combined_acc <- rbind(history_ffnn_acc, history_mlp_acc, history_cnn_acc)

# Plot Training Accuracy
ggplot(history_combined_acc, aes(x = epoch, y = train_acc, color = model)) +
  geom_line() +
  labs(title = 'Training Accuracy Across Models', x = 'Epoch', y = 'Training Accuracy') +
  theme_minimal()

# Plot Validation Accuracy
ggplot(history_combined_acc, aes(x = epoch, y = val_acc, color = model)) +
  geom_line() +
  labs(title = 'Validation Accuracy Across Models', x = 'Epoch', y = 'Validation Accuracy') +
  theme_minimal()

# Collect the loss histories for all models
history_ffnn_loss <- data.frame(
  epoch = 1:20,
  train_loss = history_ffnn$metrics$loss,
  val_loss = history_ffnn$metrics$val_loss,
  model = 'FFNN'
)

history_mlp_loss <- data.frame(
  epoch = 1:20,
  train_loss = history_mlp$metrics$loss,
  val_loss = history_mlp$metrics$val_loss,
  model = 'MLP'
)

history_cnn_loss <- data.frame(
  epoch = 1:20,
  train_loss = history_cnn$metrics$loss,
  val_loss = history_cnn$metrics$val_loss,
  model = 'CNN'
)

# Combine loss data into a single dataframe
history_combined_loss <- rbind(history_ffnn_loss, history_mlp_loss, history_cnn_loss)

# Plot Training Loss
ggplot(history_combined_loss, aes(x = epoch, y = train_loss, color = model)) +
  geom_line() +
  labs(title = 'Training Loss Across Models', x = 'Epoch', y = 'Training Loss') +
  theme_minimal()

# Plot Validation Loss
ggplot(history_combined_loss, aes(x = epoch, y = val_loss, color = model)) +
  geom_line() +
  labs(title = 'Validation Loss Across Models', x = 'Epoch', y = 'Validation Loss') +
  theme_minimal()

Final Comparison and Best Model Selection

results <- data.frame(
  model = c('FFNN', 'MLP', 'CNN'),
  test_accuracy = c(score_ffnn[2], score_mlp[2], score_cnn[2]),
  test_loss = c(score_ffnn[1], score_mlp[1], score_cnn[1])
)

# Print the results
cat("\n### Final Comparison Results\n")

## 
## ### Final Comparison Results

print(results)

##   model test_accuracy test_loss
## 1  FFNN        0.8878 0.3444632
## 2   MLP        0.8894 0.3271038
## 3   CNN        0.9168 0.3050397

# Identify the best-performing model based on accuracy
best_model_index <- which.max(results$test_accuracy)
best_model <- results$model[best_model_index]
cat("The best-performing model is:", best_model, "with a test accuracy of", results$test_accuracy[best_model_index], "\n")

## The best-performing model is: CNN with a test accuracy of 0.9168