MNIST Data
library(tensorflow)
library(keras)
library(ggplot2)
# Load Fashion-MNIST dataset
fashion_mnist <- dataset_fashion_mnist()
train_images <- fashion_mnist$train$x
train_labels <- fashion_mnist$train$y
test_images <- fashion_mnist$test$x
test_labels <- fashion_mnist$test$y
# Preprocess the data
train_images <- array_reshape(train_images, c(60000, 28 * 28))
train_images <- train_images / 255
test_images <- array_reshape(test_images, c(10000, 28 * 28))
test_images <- test_images / 255
# Convert labels to categorical
train_labels <- to_categorical(train_labels)
test_labels <- to_categorical(test_labels)
# Define Model 1: Basic Network
model1 <- keras_model_sequential() %>%
layer_dense(units = 512, activation = "relu", input_shape = c(28 * 28)) %>%
layer_dense(units = 10, activation = "softmax")
model1 %>% compile(
optimizer = "rmsprop",
loss = "categorical_crossentropy",
metrics = c("accuracy")
)
# Train Model 1
history1 <- model1 %>% fit(
train_images, train_labels,
epochs = 20, batch_size = 1000,
validation_split = 0.1
)
## Epoch 1/20
## 54/54 - 1s - loss: 0.8971 - accuracy: 0.7020 - val_loss: 0.5690 - val_accuracy: 0.7933 - 861ms/epoch - 16ms/step
## Epoch 2/20
## 54/54 - 0s - loss: 0.5759 - accuracy: 0.7940 - val_loss: 0.5109 - val_accuracy: 0.8148 - 358ms/epoch - 7ms/step
## Epoch 3/20
## 54/54 - 0s - loss: 0.5042 - accuracy: 0.8205 - val_loss: 0.5989 - val_accuracy: 0.7872 - 343ms/epoch - 6ms/step
## Epoch 4/20
## 54/54 - 0s - loss: 0.4581 - accuracy: 0.8354 - val_loss: 0.4485 - val_accuracy: 0.8328 - 367ms/epoch - 7ms/step
## Epoch 5/20
## 54/54 - 0s - loss: 0.4263 - accuracy: 0.8453 - val_loss: 0.4618 - val_accuracy: 0.8228 - 342ms/epoch - 6ms/step
## Epoch 6/20
## 54/54 - 0s - loss: 0.4023 - accuracy: 0.8544 - val_loss: 0.4120 - val_accuracy: 0.8550 - 336ms/epoch - 6ms/step
## Epoch 7/20
## 54/54 - 0s - loss: 0.3812 - accuracy: 0.8620 - val_loss: 0.4090 - val_accuracy: 0.8480 - 338ms/epoch - 6ms/step
## Epoch 8/20
## 54/54 - 0s - loss: 0.3663 - accuracy: 0.8673 - val_loss: 0.3718 - val_accuracy: 0.8693 - 349ms/epoch - 6ms/step
## Epoch 9/20
## 54/54 - 0s - loss: 0.3511 - accuracy: 0.8721 - val_loss: 0.3609 - val_accuracy: 0.8743 - 359ms/epoch - 7ms/step
## Epoch 10/20
## 54/54 - 0s - loss: 0.3415 - accuracy: 0.8761 - val_loss: 0.3783 - val_accuracy: 0.8608 - 354ms/epoch - 7ms/step
## Epoch 11/20
## 54/54 - 0s - loss: 0.3292 - accuracy: 0.8788 - val_loss: 0.3413 - val_accuracy: 0.8747 - 333ms/epoch - 6ms/step
## Epoch 12/20
## 54/54 - 0s - loss: 0.3172 - accuracy: 0.8834 - val_loss: 0.4081 - val_accuracy: 0.8415 - 344ms/epoch - 6ms/step
## Epoch 13/20
## 54/54 - 0s - loss: 0.3104 - accuracy: 0.8853 - val_loss: 0.3552 - val_accuracy: 0.8713 - 351ms/epoch - 6ms/step
## Epoch 14/20
## 54/54 - 0s - loss: 0.3021 - accuracy: 0.8895 - val_loss: 0.3249 - val_accuracy: 0.8805 - 337ms/epoch - 6ms/step
## Epoch 15/20
## 54/54 - 0s - loss: 0.2954 - accuracy: 0.8906 - val_loss: 0.3307 - val_accuracy: 0.8822 - 329ms/epoch - 6ms/step
## Epoch 16/20
## 54/54 - 0s - loss: 0.2857 - accuracy: 0.8956 - val_loss: 0.3319 - val_accuracy: 0.8837 - 342ms/epoch - 6ms/step
## Epoch 17/20
## 54/54 - 0s - loss: 0.2817 - accuracy: 0.8958 - val_loss: 0.3481 - val_accuracy: 0.8677 - 356ms/epoch - 7ms/step
## Epoch 18/20
## 54/54 - 0s - loss: 0.2725 - accuracy: 0.9001 - val_loss: 0.3214 - val_accuracy: 0.8843 - 347ms/epoch - 6ms/step
## Epoch 19/20
## 54/54 - 0s - loss: 0.2685 - accuracy: 0.9000 - val_loss: 0.3130 - val_accuracy: 0.8833 - 344ms/epoch - 6ms/step
## Epoch 20/20
## 54/54 - 0s - loss: 0.2629 - accuracy: 0.9024 - val_loss: 0.3302 - val_accuracy: 0.8817 - 346ms/epoch - 6ms/step
# Define Model 2: Network with Dropout
model2 <- keras_model_sequential() %>%
layer_dense(units = 512, activation = "relu", input_shape = c(28 * 28)) %>%
layer_dropout(rate = 0.4) %>%
layer_dense(units = 512, activation = "relu") %>%
layer_dropout(rate = 0.3) %>%
layer_dense(units = 10, activation = "softmax")
model2 %>% compile(
optimizer = "rmsprop",
loss = "categorical_crossentropy",
metrics = c("accuracy")
)
# Train Model 2
history2 <- model2 %>% fit(
train_images, train_labels,
epochs = 20, batch_size = 1000,
validation_split = 0.1
)
## Epoch 1/20
## 54/54 - 1s - loss: 0.8902 - accuracy: 0.6798 - val_loss: 0.6253 - val_accuracy: 0.7738 - 1s/epoch - 20ms/step
## Epoch 2/20
## 54/54 - 1s - loss: 0.5781 - accuracy: 0.7889 - val_loss: 0.4649 - val_accuracy: 0.8282 - 641ms/epoch - 12ms/step
## Epoch 3/20
## 54/54 - 1s - loss: 0.4955 - accuracy: 0.8163 - val_loss: 0.4288 - val_accuracy: 0.8427 - 650ms/epoch - 12ms/step
## Epoch 4/20
## 54/54 - 1s - loss: 0.4530 - accuracy: 0.8337 - val_loss: 0.4179 - val_accuracy: 0.8475 - 636ms/epoch - 12ms/step
## Epoch 5/20
## 54/54 - 1s - loss: 0.4260 - accuracy: 0.8440 - val_loss: 0.3733 - val_accuracy: 0.8645 - 635ms/epoch - 12ms/step
## Epoch 6/20
## 54/54 - 1s - loss: 0.4000 - accuracy: 0.8531 - val_loss: 0.3663 - val_accuracy: 0.8680 - 641ms/epoch - 12ms/step
## Epoch 7/20
## 54/54 - 1s - loss: 0.3877 - accuracy: 0.8571 - val_loss: 0.3823 - val_accuracy: 0.8595 - 640ms/epoch - 12ms/step
## Epoch 8/20
## 54/54 - 1s - loss: 0.3693 - accuracy: 0.8627 - val_loss: 0.3605 - val_accuracy: 0.8622 - 641ms/epoch - 12ms/step
## Epoch 9/20
## 54/54 - 1s - loss: 0.3611 - accuracy: 0.8662 - val_loss: 0.3778 - val_accuracy: 0.8612 - 641ms/epoch - 12ms/step
## Epoch 10/20
## 54/54 - 1s - loss: 0.3511 - accuracy: 0.8688 - val_loss: 0.3294 - val_accuracy: 0.8825 - 658ms/epoch - 12ms/step
## Epoch 11/20
## 54/54 - 1s - loss: 0.3410 - accuracy: 0.8739 - val_loss: 0.3413 - val_accuracy: 0.8765 - 632ms/epoch - 12ms/step
## Epoch 12/20
## 54/54 - 1s - loss: 0.3324 - accuracy: 0.8766 - val_loss: 0.3210 - val_accuracy: 0.8838 - 645ms/epoch - 12ms/step
## Epoch 13/20
## 54/54 - 1s - loss: 0.3229 - accuracy: 0.8799 - val_loss: 0.3259 - val_accuracy: 0.8830 - 636ms/epoch - 12ms/step
## Epoch 14/20
## 54/54 - 1s - loss: 0.3146 - accuracy: 0.8830 - val_loss: 0.3377 - val_accuracy: 0.8803 - 644ms/epoch - 12ms/step
## Epoch 15/20
## 54/54 - 1s - loss: 0.3068 - accuracy: 0.8864 - val_loss: 0.3473 - val_accuracy: 0.8678 - 637ms/epoch - 12ms/step
## Epoch 16/20
## 54/54 - 1s - loss: 0.3058 - accuracy: 0.8852 - val_loss: 0.3371 - val_accuracy: 0.8757 - 641ms/epoch - 12ms/step
## Epoch 17/20
## 54/54 - 1s - loss: 0.2979 - accuracy: 0.8874 - val_loss: 0.3180 - val_accuracy: 0.8852 - 640ms/epoch - 12ms/step
## Epoch 18/20
## 54/54 - 1s - loss: 0.2963 - accuracy: 0.8890 - val_loss: 0.3502 - val_accuracy: 0.8745 - 634ms/epoch - 12ms/step
## Epoch 19/20
## 54/54 - 1s - loss: 0.2894 - accuracy: 0.8922 - val_loss: 0.3144 - val_accuracy: 0.8858 - 638ms/epoch - 12ms/step
## Epoch 20/20
## 54/54 - 1s - loss: 0.2812 - accuracy: 0.8941 - val_loss: 0.3188 - val_accuracy: 0.8828 - 651ms/epoch - 12ms/step
# Define Model 3: Modified Architecture
model3 <- keras_model_sequential() %>%
layer_dense(units = 1024, activation = "relu", input_shape = c(28 * 28)) %>%
layer_dropout(rate = 0.3) %>%
layer_dense(units = 512, activation = "relu") %>%
layer_dropout(rate = 0.3) %>%
layer_dense(units = 256, activation = "relu") %>%
layer_dense(units = 10, activation = "softmax")
model3 %>% compile(
optimizer = "rmsprop",
loss = "categorical_crossentropy",
metrics = c("accuracy")
)
# Train Model 3
history3 <- model3 %>% fit(
train_images, train_labels,
epochs = 20, batch_size = 1000,
validation_split = 0.1
)
## Epoch 1/20
## 54/54 - 1s - loss: 0.9918 - accuracy: 0.6403 - val_loss: 0.6774 - val_accuracy: 0.7315 - 1s/epoch - 25ms/step
## Epoch 2/20
## 54/54 - 1s - loss: 0.5966 - accuracy: 0.7777 - val_loss: 0.5612 - val_accuracy: 0.8088 - 1s/epoch - 19ms/step
## Epoch 3/20
## 54/54 - 1s - loss: 0.5063 - accuracy: 0.8128 - val_loss: 0.4515 - val_accuracy: 0.8357 - 1s/epoch - 19ms/step
## Epoch 4/20
## 54/54 - 1s - loss: 0.4707 - accuracy: 0.8270 - val_loss: 0.4041 - val_accuracy: 0.8503 - 1s/epoch - 19ms/step
## Epoch 5/20
## 54/54 - 1s - loss: 0.4295 - accuracy: 0.8390 - val_loss: 0.4102 - val_accuracy: 0.8530 - 1s/epoch - 19ms/step
## Epoch 6/20
## 54/54 - 1s - loss: 0.4051 - accuracy: 0.8475 - val_loss: 0.4182 - val_accuracy: 0.8365 - 1s/epoch - 21ms/step
## Epoch 7/20
## 54/54 - 1s - loss: 0.3838 - accuracy: 0.8561 - val_loss: 0.3701 - val_accuracy: 0.8672 - 1s/epoch - 19ms/step
## Epoch 8/20
## 54/54 - 1s - loss: 0.3711 - accuracy: 0.8619 - val_loss: 0.3526 - val_accuracy: 0.8703 - 1s/epoch - 19ms/step
## Epoch 9/20
## 54/54 - 1s - loss: 0.3520 - accuracy: 0.8683 - val_loss: 0.3385 - val_accuracy: 0.8753 - 1s/epoch - 19ms/step
## Epoch 10/20
## 54/54 - 1s - loss: 0.3436 - accuracy: 0.8697 - val_loss: 0.3552 - val_accuracy: 0.8617 - 1s/epoch - 19ms/step
## Epoch 11/20
## 54/54 - 1s - loss: 0.3320 - accuracy: 0.8756 - val_loss: 0.3369 - val_accuracy: 0.8733 - 1s/epoch - 19ms/step
## Epoch 12/20
## 54/54 - 1s - loss: 0.3268 - accuracy: 0.8756 - val_loss: 0.3397 - val_accuracy: 0.8698 - 1s/epoch - 19ms/step
## Epoch 13/20
## 54/54 - 1s - loss: 0.3147 - accuracy: 0.8804 - val_loss: 0.3787 - val_accuracy: 0.8512 - 1s/epoch - 19ms/step
## Epoch 14/20
## 54/54 - 1s - loss: 0.3061 - accuracy: 0.8846 - val_loss: 0.3544 - val_accuracy: 0.8678 - 1s/epoch - 19ms/step
## Epoch 15/20
## 54/54 - 1s - loss: 0.2974 - accuracy: 0.8880 - val_loss: 0.3151 - val_accuracy: 0.8862 - 1s/epoch - 19ms/step
## Epoch 16/20
## 54/54 - 1s - loss: 0.2897 - accuracy: 0.8897 - val_loss: 0.3293 - val_accuracy: 0.8738 - 1s/epoch - 19ms/step
## Epoch 17/20
## 54/54 - 1s - loss: 0.2877 - accuracy: 0.8908 - val_loss: 0.3070 - val_accuracy: 0.8877 - 1s/epoch - 19ms/step
## Epoch 18/20
## 54/54 - 1s - loss: 0.2812 - accuracy: 0.8921 - val_loss: 0.3922 - val_accuracy: 0.8632 - 1s/epoch - 19ms/step
## Epoch 19/20
## 54/54 - 1s - loss: 0.2757 - accuracy: 0.8947 - val_loss: 0.3027 - val_accuracy: 0.8880 - 1s/epoch - 19ms/step
## Epoch 20/20
## 54/54 - 1s - loss: 0.2666 - accuracy: 0.8974 - val_loss: 0.3301 - val_accuracy: 0.8818 - 1s/epoch - 19ms/step
# Evaluate all models on test data
score1 <- model1 %>% evaluate(test_images, test_labels)
## 313/313 - 0s - loss: 0.3530 - accuracy: 0.8730 - 248ms/epoch - 794us/step
score2 <- model2 %>% evaluate(test_images, test_labels)
## 313/313 - 0s - loss: 0.3472 - accuracy: 0.8774 - 304ms/epoch - 971us/step
score3 <- model3 %>% evaluate(test_images, test_labels)
## 313/313 - 0s - loss: 0.3534 - accuracy: 0.8702 - 328ms/epoch - 1ms/step
# Compare results and print the performance of each model
cat("Model 1 - Test Accuracy:", score1[["accuracy"]], "\n")
## Model 1 - Test Accuracy: 0.873
cat("Model 2 - Test Accuracy:", score2[["accuracy"]], "\n")
## Model 2 - Test Accuracy: 0.8774
cat("Model 3 - Test Accuracy:", score3[["accuracy"]], "\n")
## Model 3 - Test Accuracy: 0.8702
# Plot training history
plot(history1) + theme_bw() + ggtitle("Model 1 - Training History")
plot(history2) + theme_bw() + ggtitle("Model 2 - Training History")
plot(history3) + theme_bw() + ggtitle("Model 3 - Training History")
# Select the best performing model based on the highest test accuracy
best_model <- which.max(c(score1[["accuracy"]], score2[["accuracy"]], score3[["accuracy"]]))
cat("Best Performing Model is Model", best_model, "\n")
## Best Performing Model is Model 2
# Save results in RMD and HTML files
rmarkdown::render("DL02.RMD")
##
##
## processing file: DL02.RMD
## | | | 0% | |.......................... | 50% | |....................................................| 100% [unnamed-chunk-3]
## output file: DL02.knit.md
## "C:/Program Files/RStudio/resources/app/bin/quarto/bin/tools/pandoc" +RTS -K512m -RTS DL02.knit.md --to html4 --from markdown+autolink_bare_uris+tex_math_single_backslash --output DL02.html --lua-filter "C:\Users\xuw12\AppData\Local\R\win-library\4.4\rmarkdown\rmarkdown\lua\pagebreak.lua" --lua-filter "C:\Users\xuw12\AppData\Local\R\win-library\4.4\rmarkdown\rmarkdown\lua\latex-div.lua" --embed-resources --standalone --section-divs --template "C:/Users/xuw12/AppData/Local/R/win-library/4.4/prettydoc/resources/templates/cayman.html" --highlight-style pygments --mathjax --variable "mathjax-url=https://mathjax.rstudio.com/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML" --include-in-header "C:\Users\xuw12\AppData\Local\Temp\RtmpCspBAp\rmarkdown-str99c201b1547.html" --css DL02_files/style.css
##
## Output created: DL02.html