HW3 by ShriyankSomvanshi

Data Loading

library(tensorflow)
library(keras)
library(ggplot2)

# Load the Fashion-MNIST dataset
fashion_mnist <- dataset_fashion_mnist()

# Prepare data: reshape and normalize images
train_images <- array_reshape(fashion_mnist$train$x, c(60000, 28, 28, 1)) / 255
test_images <- array_reshape(fashion_mnist$test$x, c(10000, 28, 28, 1)) / 255

# One-hot encode labels
train_labels <- to_categorical(fashion_mnist$train$y, 10)
test_labels <- to_categorical(fashion_mnist$test$y, 10)

Visualize the data

# Load necessary library for visualization
library(gridExtra)

# Display first 9 images with their labels
par(mfrow = c(3, 3))
for (i in 1:9) {
  img <- train_images[i, , , 1]
  label <- which.max(train_labels[i, ]) - 1  # Convert one-hot label to original label
  image(1:28, 1:28, t(apply(img, 2, rev)), col = gray.colors(255), main = paste("Label:", label))
}

par(mfrow = c(1, 1))  # Reset layout

Data Augmentation

datagen <- image_data_generator(
  rotation_range = 15,
  width_shift_range = 0.1,
  height_shift_range = 0.1,
  horizontal_flip = TRUE
)
datagen %>% fit_image_data_generator(train_images)

Model 1 Basic CNN

model1 <- keras_model_sequential() %>%
  layer_conv_2d(filters = 32, kernel_size = c(3, 3), activation = "sigmoid", 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")

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

# Train Model 1
history1 <- model1 %>% fit(
  flow_images_from_data(train_images, train_labels, datagen, batch_size = 1000),
  steps_per_epoch = 60000 / 1000, 
  epochs = 20, 
  validation_data = list(test_images, test_labels),
  callbacks = list(callback_early_stopping(monitor = "val_loss", patience = 5))
)

## Epoch 1/20
## 60/60 - 16s - loss: 2.1686 - accuracy: 0.2184 - val_loss: 1.7202 - val_accuracy: 0.4134 - 16s/epoch - 266ms/step
## Epoch 2/20
## 60/60 - 15s - loss: 1.4845 - accuracy: 0.4985 - val_loss: 1.2191 - val_accuracy: 0.5743 - 15s/epoch - 258ms/step
## Epoch 3/20
## 60/60 - 17s - loss: 1.1688 - accuracy: 0.5910 - val_loss: 0.9743 - val_accuracy: 0.6599 - 17s/epoch - 286ms/step
## Epoch 4/20
## 60/60 - 19s - loss: 1.0253 - accuracy: 0.6328 - val_loss: 0.8628 - val_accuracy: 0.6905 - 19s/epoch - 316ms/step
## Epoch 5/20
## 60/60 - 19s - loss: 0.9480 - accuracy: 0.6513 - val_loss: 0.8161 - val_accuracy: 0.6911 - 19s/epoch - 312ms/step
## Epoch 6/20
## 60/60 - 17s - loss: 0.8903 - accuracy: 0.6697 - val_loss: 0.7953 - val_accuracy: 0.6995 - 17s/epoch - 287ms/step
## Epoch 7/20
## 60/60 - 17s - loss: 0.8549 - accuracy: 0.6764 - val_loss: 0.7594 - val_accuracy: 0.6960 - 17s/epoch - 279ms/step
## Epoch 8/20
## 60/60 - 18s - loss: 0.8202 - accuracy: 0.6890 - val_loss: 0.7431 - val_accuracy: 0.7072 - 18s/epoch - 295ms/step
## Epoch 9/20
## 60/60 - 17s - loss: 0.7903 - accuracy: 0.6956 - val_loss: 0.7075 - val_accuracy: 0.7261 - 17s/epoch - 279ms/step
## Epoch 10/20
## 60/60 - 18s - loss: 0.7706 - accuracy: 0.7050 - val_loss: 0.6700 - val_accuracy: 0.7456 - 18s/epoch - 298ms/step
## Epoch 11/20
## 60/60 - 19s - loss: 0.7472 - accuracy: 0.7105 - val_loss: 0.6940 - val_accuracy: 0.7417 - 19s/epoch - 309ms/step
## Epoch 12/20
## 60/60 - 19s - loss: 0.7342 - accuracy: 0.7188 - val_loss: 0.6630 - val_accuracy: 0.7333 - 19s/epoch - 318ms/step
## Epoch 13/20
## 60/60 - 18s - loss: 0.7202 - accuracy: 0.7228 - val_loss: 0.6264 - val_accuracy: 0.7503 - 18s/epoch - 303ms/step
## Epoch 14/20
## 60/60 - 17s - loss: 0.7027 - accuracy: 0.7293 - val_loss: 0.6474 - val_accuracy: 0.7371 - 17s/epoch - 282ms/step
## Epoch 15/20
## 60/60 - 20s - loss: 0.6894 - accuracy: 0.7332 - val_loss: 0.6280 - val_accuracy: 0.7491 - 20s/epoch - 327ms/step
## Epoch 16/20
## 60/60 - 20s - loss: 0.6794 - accuracy: 0.7400 - val_loss: 0.6095 - val_accuracy: 0.7712 - 20s/epoch - 340ms/step
## Epoch 17/20
## 60/60 - 17s - loss: 0.6690 - accuracy: 0.7424 - val_loss: 0.6276 - val_accuracy: 0.7531 - 17s/epoch - 286ms/step
## Epoch 18/20
## 60/60 - 17s - loss: 0.6616 - accuracy: 0.7431 - val_loss: 0.5973 - val_accuracy: 0.7698 - 17s/epoch - 288ms/step
## Epoch 19/20
## 60/60 - 17s - loss: 0.6516 - accuracy: 0.7467 - val_loss: 0.5808 - val_accuracy: 0.7812 - 17s/epoch - 281ms/step
## Epoch 20/20
## 60/60 - 18s - loss: 0.6446 - accuracy: 0.7497 - val_loss: 0.5834 - val_accuracy: 0.7754 - 18s/epoch - 297ms/step

Model 2 VGG-like CNN

model2_vgg <- keras_model_sequential() %>%
  # First Convolutional Block
  layer_conv_2d(filters = 32, kernel_size = c(3, 3), activation = "relu", input_shape = c(28, 28, 1)) %>%
  layer_conv_2d(filters = 32, kernel_size = c(3, 3), activation = "relu") %>%
  layer_max_pooling_2d(pool_size = c(2, 2)) %>%
  layer_dropout(0.25) %>%
  
  # Second Convolutional Block
  layer_conv_2d(filters = 64, kernel_size = c(3, 3), activation = "relu") %>%
  layer_conv_2d(filters = 64, kernel_size = c(3, 3), activation = "relu") %>%
  layer_max_pooling_2d(pool_size = c(2, 2)) %>%
  layer_dropout(0.25) %>%
  
  # Flatten and Dense Layers
  layer_flatten() %>%
  layer_dense(units = 256, activation = "relu") %>%
  layer_dropout(0.5) %>%
  layer_dense(units = 10, activation = "softmax")

model2_vgg %>% compile(
  optimizer = optimizer_adam(),
  loss = "categorical_crossentropy",
  metrics = c("accuracy")
)

# Train Model 2
history2_vgg <- model2_vgg %>% fit(
  flow_images_from_data(train_images, train_labels, datagen, batch_size = 1000),
  steps_per_epoch = 60000 / 1000, 
  epochs = 20, 
  validation_data = list(test_images, test_labels),
  callbacks = list(callback_early_stopping(monitor = "val_loss", patience = 5))
)

## Epoch 1/20
## 60/60 - 29s - loss: 1.3156 - accuracy: 0.5145 - val_loss: 0.7321 - val_accuracy: 0.7281 - 29s/epoch - 487ms/step
## Epoch 2/20
## 60/60 - 28s - loss: 0.8011 - accuracy: 0.6985 - val_loss: 0.6448 - val_accuracy: 0.7440 - 28s/epoch - 463ms/step
## Epoch 3/20
## 60/60 - 28s - loss: 0.7004 - accuracy: 0.7312 - val_loss: 0.5850 - val_accuracy: 0.7706 - 28s/epoch - 466ms/step
## Epoch 4/20
## 60/60 - 28s - loss: 0.6481 - accuracy: 0.7520 - val_loss: 0.5378 - val_accuracy: 0.7912 - 28s/epoch - 475ms/step
## Epoch 5/20
## 60/60 - 28s - loss: 0.6040 - accuracy: 0.7703 - val_loss: 0.4927 - val_accuracy: 0.8081 - 28s/epoch - 467ms/step
## Epoch 6/20
## 60/60 - 30s - loss: 0.5773 - accuracy: 0.7818 - val_loss: 0.4636 - val_accuracy: 0.8295 - 30s/epoch - 496ms/step
## Epoch 7/20
## 60/60 - 28s - loss: 0.5508 - accuracy: 0.7909 - val_loss: 0.4387 - val_accuracy: 0.8334 - 28s/epoch - 460ms/step
## Epoch 8/20
## 60/60 - 28s - loss: 0.5334 - accuracy: 0.8011 - val_loss: 0.4366 - val_accuracy: 0.8376 - 28s/epoch - 467ms/step
## Epoch 9/20
## 60/60 - 28s - loss: 0.5116 - accuracy: 0.8071 - val_loss: 0.4148 - val_accuracy: 0.8450 - 28s/epoch - 470ms/step
## Epoch 10/20
## 60/60 - 28s - loss: 0.4938 - accuracy: 0.8161 - val_loss: 0.4025 - val_accuracy: 0.8497 - 28s/epoch - 464ms/step
## Epoch 11/20
## 60/60 - 28s - loss: 0.4792 - accuracy: 0.8227 - val_loss: 0.3794 - val_accuracy: 0.8624 - 28s/epoch - 463ms/step
## Epoch 12/20
## 60/60 - 28s - loss: 0.4651 - accuracy: 0.8262 - val_loss: 0.3862 - val_accuracy: 0.8616 - 28s/epoch - 462ms/step
## Epoch 13/20
## 60/60 - 28s - loss: 0.4554 - accuracy: 0.8291 - val_loss: 0.3812 - val_accuracy: 0.8587 - 28s/epoch - 463ms/step
## Epoch 14/20
## 60/60 - 28s - loss: 0.4495 - accuracy: 0.8319 - val_loss: 0.3722 - val_accuracy: 0.8659 - 28s/epoch - 474ms/step
## Epoch 15/20
## 60/60 - 28s - loss: 0.4386 - accuracy: 0.8374 - val_loss: 0.3526 - val_accuracy: 0.8730 - 28s/epoch - 462ms/step
## Epoch 16/20
## 60/60 - 28s - loss: 0.4300 - accuracy: 0.8419 - val_loss: 0.3523 - val_accuracy: 0.8733 - 28s/epoch - 465ms/step
## Epoch 17/20
## 60/60 - 29s - loss: 0.4238 - accuracy: 0.8433 - val_loss: 0.3496 - val_accuracy: 0.8749 - 29s/epoch - 475ms/step
## Epoch 18/20
## 60/60 - 30s - loss: 0.4184 - accuracy: 0.8451 - val_loss: 0.3454 - val_accuracy: 0.8744 - 30s/epoch - 496ms/step
## Epoch 19/20
## 60/60 - 28s - loss: 0.4144 - accuracy: 0.8467 - val_loss: 0.3303 - val_accuracy: 0.8786 - 28s/epoch - 470ms/step
## Epoch 20/20
## 60/60 - 29s - loss: 0.4032 - accuracy: 0.8511 - val_loss: 0.3384 - val_accuracy: 0.8781 - 29s/epoch - 478ms/step

Model 3 CNN with Batch Norm

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

model3 %>% compile(
  optimizer = optimizer_adam(),
  loss = "categorical_crossentropy",
  metrics = c("accuracy")
)

# Train Model 3
history3 <- model3 %>% fit(
  flow_images_from_data(train_images, train_labels, datagen, batch_size = 1000),
  steps_per_epoch = 60000 / 1000, 
  epochs = 20, 
  validation_data = list(test_images, test_labels),
  callbacks = list(callback_early_stopping(monitor = "val_loss", patience = 5))
)

## Epoch 1/20
## 60/60 - 20s - loss: 0.8344 - accuracy: 0.6998 - val_loss: 2.3402 - val_accuracy: 0.1443 - 20s/epoch - 334ms/step
## Epoch 2/20
## 60/60 - 20s - loss: 0.5494 - accuracy: 0.7985 - val_loss: 2.7567 - val_accuracy: 0.1097 - 20s/epoch - 329ms/step
## Epoch 3/20
## 60/60 - 20s - loss: 0.4835 - accuracy: 0.8210 - val_loss: 2.9674 - val_accuracy: 0.1034 - 20s/epoch - 327ms/step
## Epoch 4/20
## 60/60 - 20s - loss: 0.4511 - accuracy: 0.8349 - val_loss: 2.7378 - val_accuracy: 0.1432 - 20s/epoch - 337ms/step
## Epoch 5/20
## 60/60 - 20s - loss: 0.4244 - accuracy: 0.8446 - val_loss: 2.6624 - val_accuracy: 0.1890 - 20s/epoch - 335ms/step
## Epoch 6/20
## 60/60 - 21s - loss: 0.4071 - accuracy: 0.8501 - val_loss: 2.1558 - val_accuracy: 0.3110 - 21s/epoch - 344ms/step
## Epoch 7/20
## 60/60 - 21s - loss: 0.3884 - accuracy: 0.8577 - val_loss: 1.4986 - val_accuracy: 0.4750 - 21s/epoch - 354ms/step
## Epoch 8/20
## 60/60 - 21s - loss: 0.3822 - accuracy: 0.8583 - val_loss: 1.0921 - val_accuracy: 0.5944 - 21s/epoch - 350ms/step
## Epoch 9/20
## 60/60 - 24s - loss: 0.3668 - accuracy: 0.8651 - val_loss: 0.6476 - val_accuracy: 0.7464 - 24s/epoch - 402ms/step
## Epoch 10/20
## 60/60 - 21s - loss: 0.3612 - accuracy: 0.8655 - val_loss: 0.4900 - val_accuracy: 0.8206 - 21s/epoch - 358ms/step
## Epoch 11/20
## 60/60 - 20s - loss: 0.3515 - accuracy: 0.8707 - val_loss: 0.4661 - val_accuracy: 0.8109 - 20s/epoch - 334ms/step
## Epoch 12/20
## 60/60 - 21s - loss: 0.3449 - accuracy: 0.8722 - val_loss: 0.3833 - val_accuracy: 0.8622 - 21s/epoch - 352ms/step
## Epoch 13/20
## 60/60 - 18s - loss: 0.3387 - accuracy: 0.8738 - val_loss: 0.3342 - val_accuracy: 0.8754 - 18s/epoch - 305ms/step
## Epoch 14/20
## 60/60 - 18s - loss: 0.3345 - accuracy: 0.8763 - val_loss: 0.3440 - val_accuracy: 0.8722 - 18s/epoch - 297ms/step
## Epoch 15/20
## 60/60 - 18s - loss: 0.3276 - accuracy: 0.8780 - val_loss: 0.4029 - val_accuracy: 0.8609 - 18s/epoch - 294ms/step
## Epoch 16/20
## 60/60 - 18s - loss: 0.3240 - accuracy: 0.8812 - val_loss: 0.3086 - val_accuracy: 0.8846 - 18s/epoch - 295ms/step
## Epoch 17/20
## 60/60 - 22s - loss: 0.3192 - accuracy: 0.8811 - val_loss: 0.3568 - val_accuracy: 0.8682 - 22s/epoch - 361ms/step
## Epoch 18/20
## 60/60 - 21s - loss: 0.3152 - accuracy: 0.8833 - val_loss: 0.3576 - val_accuracy: 0.8670 - 21s/epoch - 350ms/step
## Epoch 19/20
## 60/60 - 22s - loss: 0.3105 - accuracy: 0.8842 - val_loss: 0.3018 - val_accuracy: 0.8861 - 22s/epoch - 366ms/step
## Epoch 20/20
## 60/60 - 21s - loss: 0.3104 - accuracy: 0.8838 - val_loss: 0.3409 - val_accuracy: 0.8747 - 21s/epoch - 349ms/step

Evaluation of Models

score1 <- model1 %>% evaluate(test_images, test_labels)

## 313/313 - 1s - loss: 0.5834 - accuracy: 0.7754 - 770ms/epoch - 2ms/step

score2_vgg <- model2_vgg %>% evaluate(test_images, test_labels)

## 313/313 - 1s - loss: 0.3384 - accuracy: 0.8781 - 1s/epoch - 5ms/step

score3 <- model3 %>% evaluate(test_images, test_labels)

## 313/313 - 1s - loss: 0.3409 - accuracy: 0.8747 - 855ms/epoch - 3ms/step

cat("Model 1 Test Accuracy: ", score1[2], " | Test Loss: ", score1[1], "\n")

## Model 1 Test Accuracy:  0.7754  | Test Loss:  0.583362

cat("Model 2 (VGG-like) Test Accuracy: ", score2_vgg[2], " | Test Loss: ", score2_vgg[1], "\n")

## Model 2 (VGG-like) Test Accuracy:  0.8781  | Test Loss:  0.3384026

cat("Model 3 Test Accuracy: ", score3[2], " | Test Loss: ", score3[1], "\n")

## Model 3 Test Accuracy:  0.8747  | Test Loss:  0.3408526

Plotting Training and Validation History

# Plot Model 1 Training History
plot(history1) + 
  ggtitle("Model 1 - Basic CNN Training History") + 
  theme_minimal()

# Plot Model 2 with VGG-like architecture Training History
plot(history2_vgg) + 
  ggtitle("Model 2 - VGG-like CNN Training History") + 
  theme_minimal()

# Plot Model 3 Training History
plot(history3) + 
  ggtitle("Model 3 - CNN with Batch Norm Training History") + 
  theme_minimal()

Model Comparison

model_performance <- data.frame(
  Model = c("Model 1 (Basic CNN)", "Model 2 (VGG-like CNN)", "Model 3 (CNN with Batch Norm)"),
  Accuracy = c(score1[2], score2_vgg[2], score3[2]),
  Loss = c(score1[1], score2_vgg[1], score3[1])
)

# Display the comparison table
print(model_performance)

##                           Model Accuracy      Loss
## 1           Model 1 (Basic CNN)   0.7754 0.5833620
## 2        Model 2 (VGG-like CNN)   0.8781 0.3384026
## 3 Model 3 (CNN with Batch Norm)   0.8747 0.3408526

# Plot model accuracy
ggplot(model_performance, aes(x = Model, y = Accuracy, fill = Model)) +
  geom_bar(stat = "identity") +
  ggtitle("Model Accuracy Comparison") +
  theme_minimal()

# Plot model loss
ggplot(model_performance, aes(x = Model, y = Loss, fill = Model)) +
  geom_bar(stat = "identity") +
  ggtitle("Model Loss Comparison") +
  theme_minimal()

Results and Conclusion

#Based on the above analysis, Model 3 (CNN with Batch Norm) demonstrates the best performance, achieving the highest accuracy and lowest loss. The accuracy and loss curves for Model 3 indicate faster and more stable convergence. However, Models 1 and 2 might improve further if trained for more epochs, as their curves suggest they have not yet fully converged.