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.2053 - accuracy: 0.1977 - val_loss: 1.7560 - val_accuracy: 0.4616 - 16s/epoch - 272ms/step
## Epoch 2/20
## 60/60 - 17s - loss: 1.4961 - accuracy: 0.4858 - val_loss: 1.1285 - val_accuracy: 0.6070 - 17s/epoch - 287ms/step
## Epoch 3/20
## 60/60 - 19s - loss: 1.1523 - accuracy: 0.5874 - val_loss: 1.0286 - val_accuracy: 0.6368 - 19s/epoch - 324ms/step
## Epoch 4/20
## 60/60 - 19s - loss: 1.0269 - accuracy: 0.6251 - val_loss: 0.8699 - val_accuracy: 0.6857 - 19s/epoch - 309ms/step
## Epoch 5/20
## 60/60 - 18s - loss: 0.9541 - accuracy: 0.6464 - val_loss: 0.8024 - val_accuracy: 0.6987 - 18s/epoch - 307ms/step
## Epoch 6/20
## 60/60 - 19s - loss: 0.8975 - accuracy: 0.6640 - val_loss: 0.8079 - val_accuracy: 0.6845 - 19s/epoch - 309ms/step
## Epoch 7/20
## 60/60 - 18s - loss: 0.8663 - accuracy: 0.6726 - val_loss: 0.8180 - val_accuracy: 0.6743 - 18s/epoch - 302ms/step
## Epoch 8/20
## 60/60 - 19s - loss: 0.8272 - accuracy: 0.6837 - val_loss: 0.7344 - val_accuracy: 0.7129 - 19s/epoch - 312ms/step
## Epoch 9/20
## 60/60 - 19s - loss: 0.8036 - accuracy: 0.6932 - val_loss: 0.7216 - val_accuracy: 0.7057 - 19s/epoch - 320ms/step
## Epoch 10/20
## 60/60 - 20s - loss: 0.7739 - accuracy: 0.7014 - val_loss: 0.6747 - val_accuracy: 0.7365 - 20s/epoch - 331ms/step
## Epoch 11/20
## 60/60 - 20s - loss: 0.7563 - accuracy: 0.7112 - val_loss: 0.7268 - val_accuracy: 0.7074 - 20s/epoch - 330ms/step
## Epoch 12/20
## 60/60 - 19s - loss: 0.7328 - accuracy: 0.7177 - val_loss: 0.6701 - val_accuracy: 0.7308 - 19s/epoch - 317ms/step
## Epoch 13/20
## 60/60 - 18s - loss: 0.7145 - accuracy: 0.7258 - val_loss: 0.6330 - val_accuracy: 0.7535 - 18s/epoch - 306ms/step
## Epoch 14/20
## 60/60 - 18s - loss: 0.6968 - accuracy: 0.7298 - val_loss: 0.6170 - val_accuracy: 0.7593 - 18s/epoch - 302ms/step
## Epoch 15/20
## 60/60 - 18s - loss: 0.6827 - accuracy: 0.7344 - val_loss: 0.6034 - val_accuracy: 0.7692 - 18s/epoch - 305ms/step
## Epoch 16/20
## 60/60 - 19s - loss: 0.6651 - accuracy: 0.7426 - val_loss: 0.5946 - val_accuracy: 0.7697 - 19s/epoch - 321ms/step
## Epoch 17/20
## 60/60 - 21s - loss: 0.6574 - accuracy: 0.7454 - val_loss: 0.5918 - val_accuracy: 0.7637 - 21s/epoch - 345ms/step
## Epoch 18/20
## 60/60 - 19s - loss: 0.6411 - accuracy: 0.7528 - val_loss: 0.5922 - val_accuracy: 0.7735 - 19s/epoch - 319ms/step
## Epoch 19/20
## 60/60 - 18s - loss: 0.6334 - accuracy: 0.7549 - val_loss: 0.5733 - val_accuracy: 0.7789 - 18s/epoch - 307ms/step
## Epoch 20/20
## 60/60 - 19s - loss: 0.6238 - accuracy: 0.7585 - val_loss: 0.6026 - val_accuracy: 0.7626 - 19s/epoch - 317ms/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 - 32s - loss: 1.2915 - accuracy: 0.5243 - val_loss: 0.7467 - val_accuracy: 0.7202 - 32s/epoch - 526ms/step
## Epoch 2/20
## 60/60 - 30s - loss: 0.7993 - accuracy: 0.6997 - val_loss: 0.6272 - val_accuracy: 0.7516 - 30s/epoch - 496ms/step
## Epoch 3/20
## 60/60 - 34s - loss: 0.7081 - accuracy: 0.7301 - val_loss: 0.5752 - val_accuracy: 0.7716 - 34s/epoch - 575ms/step
## Epoch 4/20
## 60/60 - 32s - loss: 0.6474 - accuracy: 0.7539 - val_loss: 0.5511 - val_accuracy: 0.7870 - 32s/epoch - 533ms/step
## Epoch 5/20
## 60/60 - 34s - loss: 0.6125 - accuracy: 0.7657 - val_loss: 0.5071 - val_accuracy: 0.8093 - 34s/epoch - 566ms/step
## Epoch 6/20
## 60/60 - 31s - loss: 0.5822 - accuracy: 0.7780 - val_loss: 0.4735 - val_accuracy: 0.8180 - 31s/epoch - 519ms/step
## Epoch 7/20
## 60/60 - 36s - loss: 0.5604 - accuracy: 0.7873 - val_loss: 0.4748 - val_accuracy: 0.8210 - 36s/epoch - 592ms/step
## Epoch 8/20
## 60/60 - 32s - loss: 0.5314 - accuracy: 0.7990 - val_loss: 0.4357 - val_accuracy: 0.8352 - 32s/epoch - 538ms/step
## Epoch 9/20
## 60/60 - 31s - loss: 0.5117 - accuracy: 0.8057 - val_loss: 0.4339 - val_accuracy: 0.8403 - 31s/epoch - 516ms/step
## Epoch 10/20
## 60/60 - 31s - loss: 0.4997 - accuracy: 0.8123 - val_loss: 0.4065 - val_accuracy: 0.8499 - 31s/epoch - 509ms/step
## Epoch 11/20
## 60/60 - 29s - loss: 0.4869 - accuracy: 0.8172 - val_loss: 0.4081 - val_accuracy: 0.8492 - 29s/epoch - 491ms/step
## Epoch 12/20
## 60/60 - 37s - loss: 0.4709 - accuracy: 0.8232 - val_loss: 0.3788 - val_accuracy: 0.8610 - 37s/epoch - 611ms/step
## Epoch 13/20
## 60/60 - 39s - loss: 0.4615 - accuracy: 0.8268 - val_loss: 0.3729 - val_accuracy: 0.8651 - 39s/epoch - 654ms/step
## Epoch 14/20
## 60/60 - 36s - loss: 0.4534 - accuracy: 0.8298 - val_loss: 0.3508 - val_accuracy: 0.8722 - 36s/epoch - 598ms/step
## Epoch 15/20
## 60/60 - 32s - loss: 0.4493 - accuracy: 0.8328 - val_loss: 0.3670 - val_accuracy: 0.8670 - 32s/epoch - 535ms/step
## Epoch 16/20
## 60/60 - 35s - loss: 0.4385 - accuracy: 0.8360 - val_loss: 0.3403 - val_accuracy: 0.8785 - 35s/epoch - 578ms/step
## Epoch 17/20
## 60/60 - 35s - loss: 0.4221 - accuracy: 0.8432 - val_loss: 0.3451 - val_accuracy: 0.8757 - 35s/epoch - 581ms/step
## Epoch 18/20
## 60/60 - 33s - loss: 0.4161 - accuracy: 0.8443 - val_loss: 0.3315 - val_accuracy: 0.8830 - 33s/epoch - 549ms/step
## Epoch 19/20
## 60/60 - 33s - loss: 0.4163 - accuracy: 0.8454 - val_loss: 0.3351 - val_accuracy: 0.8771 - 33s/epoch - 547ms/step
## Epoch 20/20
## 60/60 - 36s - loss: 0.4061 - accuracy: 0.8500 - val_loss: 0.3237 - val_accuracy: 0.8833 - 36s/epoch - 596ms/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 - 22s - loss: 0.8254 - accuracy: 0.6980 - val_loss: 2.3306 - val_accuracy: 0.2298 - 22s/epoch - 365ms/step
## Epoch 2/20
## 60/60 - 22s - loss: 0.5615 - accuracy: 0.7927 - val_loss: 2.7219 - val_accuracy: 0.1765 - 22s/epoch - 374ms/step
## Epoch 3/20
## 60/60 - 20s - loss: 0.4903 - accuracy: 0.8178 - val_loss: 2.9911 - val_accuracy: 0.1446 - 20s/epoch - 339ms/step
## Epoch 4/20
## 60/60 - 21s - loss: 0.4553 - accuracy: 0.8303 - val_loss: 2.9156 - val_accuracy: 0.1716 - 21s/epoch - 355ms/step
## Epoch 5/20
## 60/60 - 23s - loss: 0.4279 - accuracy: 0.8410 - val_loss: 2.4160 - val_accuracy: 0.2515 - 23s/epoch - 390ms/step
## Epoch 6/20
## 60/60 - 25s - loss: 0.4137 - accuracy: 0.8477 - val_loss: 1.6863 - val_accuracy: 0.4332 - 25s/epoch - 425ms/step
## Epoch 7/20
## 60/60 - 23s - loss: 0.4054 - accuracy: 0.8495 - val_loss: 0.9835 - val_accuracy: 0.6580 - 23s/epoch - 379ms/step
## Epoch 8/20
## 60/60 - 26s - loss: 0.3862 - accuracy: 0.8572 - val_loss: 0.6724 - val_accuracy: 0.7577 - 26s/epoch - 434ms/step
## Epoch 9/20
## 60/60 - 23s - loss: 0.3777 - accuracy: 0.8587 - val_loss: 0.6230 - val_accuracy: 0.7681 - 23s/epoch - 381ms/step
## Epoch 10/20
## 60/60 - 22s - loss: 0.3637 - accuracy: 0.8653 - val_loss: 0.4115 - val_accuracy: 0.8441 - 22s/epoch - 360ms/step
## Epoch 11/20
## 60/60 - 21s - loss: 0.3585 - accuracy: 0.8669 - val_loss: 0.3982 - val_accuracy: 0.8480 - 21s/epoch - 348ms/step
## Epoch 12/20
## 60/60 - 21s - loss: 0.3535 - accuracy: 0.8682 - val_loss: 0.3656 - val_accuracy: 0.8554 - 21s/epoch - 355ms/step
## Epoch 13/20
## 60/60 - 24s - loss: 0.3469 - accuracy: 0.8710 - val_loss: 0.3917 - val_accuracy: 0.8481 - 24s/epoch - 398ms/step
## Epoch 14/20
## 60/60 - 23s - loss: 0.3416 - accuracy: 0.8732 - val_loss: 0.3305 - val_accuracy: 0.8779 - 23s/epoch - 378ms/step
## Epoch 15/20
## 60/60 - 24s - loss: 0.3355 - accuracy: 0.8758 - val_loss: 0.3176 - val_accuracy: 0.8822 - 24s/epoch - 406ms/step
## Epoch 16/20
## 60/60 - 23s - loss: 0.3342 - accuracy: 0.8774 - val_loss: 0.3266 - val_accuracy: 0.8791 - 23s/epoch - 391ms/step
## Epoch 17/20
## 60/60 - 21s - loss: 0.3272 - accuracy: 0.8793 - val_loss: 0.3710 - val_accuracy: 0.8613 - 21s/epoch - 354ms/step
## Epoch 18/20
## 60/60 - 23s - loss: 0.3262 - accuracy: 0.8775 - val_loss: 0.3476 - val_accuracy: 0.8762 - 23s/epoch - 376ms/step
## Epoch 19/20
## 60/60 - 23s - loss: 0.3162 - accuracy: 0.8823 - val_loss: 0.3212 - val_accuracy: 0.8839 - 23s/epoch - 388ms/step
## Epoch 20/20
## 60/60 - 24s - loss: 0.3146 - accuracy: 0.8831 - val_loss: 0.3117 - val_accuracy: 0.8850 - 24s/epoch - 392ms/step

Evaluation of Models

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

## 313/313 - 1s - loss: 0.6026 - accuracy: 0.7626 - 770ms/epoch - 2ms/step

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

## 313/313 - 2s - loss: 0.3237 - accuracy: 0.8833 - 2s/epoch - 6ms/step

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

## 313/313 - 1s - loss: 0.3117 - accuracy: 0.8850 - 1s/epoch - 3ms/step

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

## Model 1 Test Accuracy:  0.7626  | Test Loss:  0.6026172

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

## Model 2 (VGG-like) Test Accuracy:  0.8833  | Test Loss:  0.3237033

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

## Model 3 Test Accuracy:  0.885  | Test Loss:  0.3116535

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.7626 0.6026172
## 2        Model 2 (VGG-like CNN)   0.8833 0.3237033
## 3 Model 3 (CNN with Batch Norm)   0.8850 0.3116535

# 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.