1. Environment configuration and library import

# If the virtual environment does not exist then create a
if (!reticulate::virtualenv_exists('new-env')) {
  reticulate::virtualenv_create('new-env')
}

# Ensure that TensorFlow is installed
tensorflow::install_tensorflow(envname = 'new-env')
## Using virtual environment "new-env" ...
## + "C:/Users/10207/OneDrive/文档/.virtualenvs/new-env/Scripts/python.exe" -m pip install --upgrade --no-user "tensorflow==2.16.*"
## 
## Installation complete.
# Activate the virtual environment
reticulate::use_virtualenv('new-env', required = TRUE)


# Load required libraries
suppressPackageStartupMessages({
  library(tensorflow)
  library(keras3)
  library(ggplot2)
})

2. Data loading and processing

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(keras3)
library(ggplot2)
library(magrittr)
#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))

### 3. Model 1: RMSprop optimiser

# 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 - 2s - 5ms/step - accuracy: 0.7495 - loss: 0.6794 - val_accuracy: 0.7701 - val_loss: 0.5768
## Epoch 2/20
## 329/329 - 1s - 4ms/step - accuracy: 0.8269 - loss: 0.4715 - val_accuracy: 0.8446 - val_loss: 0.4297
## Epoch 3/20
## 329/329 - 1s - 4ms/step - accuracy: 0.8437 - loss: 0.4279 - val_accuracy: 0.8211 - val_loss: 0.4870
## Epoch 4/20
## 329/329 - 1s - 4ms/step - accuracy: 0.8532 - loss: 0.3971 - val_accuracy: 0.8455 - val_loss: 0.4280
## Epoch 5/20
## 329/329 - 1s - 3ms/step - accuracy: 0.8607 - loss: 0.3830 - val_accuracy: 0.8325 - val_loss: 0.4244
## Epoch 6/20
## 329/329 - 1s - 3ms/step - accuracy: 0.8662 - loss: 0.3684 - val_accuracy: 0.8623 - val_loss: 0.3881
## Epoch 7/20
## 329/329 - 1s - 4ms/step - accuracy: 0.8690 - loss: 0.3561 - val_accuracy: 0.8590 - val_loss: 0.3750
## Epoch 8/20
## 329/329 - 1s - 3ms/step - accuracy: 0.8725 - loss: 0.3468 - val_accuracy: 0.8581 - val_loss: 0.3822
## Epoch 9/20
## 329/329 - 1s - 4ms/step - accuracy: 0.8747 - loss: 0.3403 - val_accuracy: 0.8758 - val_loss: 0.3528
## Epoch 10/20
## 329/329 - 1s - 4ms/step - accuracy: 0.8793 - loss: 0.3330 - val_accuracy: 0.8678 - val_loss: 0.3699
## Epoch 11/20
## 329/329 - 1s - 3ms/step - accuracy: 0.8811 - loss: 0.3254 - val_accuracy: 0.8760 - val_loss: 0.3441
## Epoch 12/20
## 329/329 - 1s - 4ms/step - accuracy: 0.8841 - loss: 0.3197 - val_accuracy: 0.8838 - val_loss: 0.3272
## Epoch 13/20
## 329/329 - 1s - 3ms/step - accuracy: 0.8846 - loss: 0.3161 - val_accuracy: 0.8759 - val_loss: 0.3596
## Epoch 14/20
## 329/329 - 1s - 4ms/step - accuracy: 0.8842 - loss: 0.3126 - val_accuracy: 0.8706 - val_loss: 0.3691
## Epoch 15/20
## 329/329 - 1s - 3ms/step - accuracy: 0.8868 - loss: 0.3056 - val_accuracy: 0.8752 - val_loss: 0.3531
## Epoch 16/20
## 329/329 - 1s - 4ms/step - accuracy: 0.8890 - loss: 0.3002 - val_accuracy: 0.8836 - val_loss: 0.3361
## Epoch 17/20
## 329/329 - 1s - 3ms/step - accuracy: 0.8891 - loss: 0.2990 - val_accuracy: 0.8817 - val_loss: 0.3465
## Epoch 18/20
## 329/329 - 1s - 4ms/step - accuracy: 0.8934 - loss: 0.2913 - val_accuracy: 0.8825 - val_loss: 0.3271
## Epoch 19/20
## 329/329 - 1s - 4ms/step - accuracy: 0.8949 - loss: 0.2922 - val_accuracy: 0.8796 - val_loss: 0.3490
## Epoch 20/20
## 329/329 - 1s - 4ms/step - accuracy: 0.8944 - loss: 0.2877 - val_accuracy: 0.8883 - val_loss: 0.3171
# Evaluating the model performance

evaluation1 <- model1 %>% evaluate(test_images, test_labels)
## 313/313 - 0s - 764us/step - accuracy: 0.8840 - loss: 0.3460
cat("Model 1 Accuracy:", evaluation1[[2]], "\n")
## Model 1 Accuracy: 0.3459964
#Plotting the model
plot(history1)+theme_bw()

### 4. Model 2: Nadam Optimiser

# Define the second model
model_two <- 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")

model_two %>% compile(
  optimizer = optimizer_nadam(),
  loss = "categorical_crossentropy", 
  metrics = c("accuracy")
)

# Training component of model 2
history_2 <- model_two %>% fit(
  x = train_images,  # Use of pre-processed data
  y = train_labels,  # Using one-hot encoded tags
  epochs = 20,
  batch_size = 128,
  validation_split = 0.2
)
## Epoch 1/20
## 375/375 - 3s - 9ms/step - accuracy: 0.7777 - loss: 0.6070 - val_accuracy: 0.8460 - val_loss: 0.4234
## Epoch 2/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8358 - loss: 0.4502 - val_accuracy: 0.8656 - val_loss: 0.3730
## Epoch 3/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8475 - loss: 0.4187 - val_accuracy: 0.8657 - val_loss: 0.3592
## Epoch 4/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8556 - loss: 0.3953 - val_accuracy: 0.8651 - val_loss: 0.3717
## Epoch 5/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8616 - loss: 0.3754 - val_accuracy: 0.8747 - val_loss: 0.3419
## Epoch 6/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8678 - loss: 0.3653 - val_accuracy: 0.8778 - val_loss: 0.3351
## Epoch 7/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8689 - loss: 0.3570 - val_accuracy: 0.8754 - val_loss: 0.3361
## Epoch 8/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8727 - loss: 0.3441 - val_accuracy: 0.8832 - val_loss: 0.3263
## Epoch 9/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8748 - loss: 0.3370 - val_accuracy: 0.8842 - val_loss: 0.3256
## Epoch 10/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8782 - loss: 0.3284 - val_accuracy: 0.8873 - val_loss: 0.3170
## Epoch 11/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8784 - loss: 0.3257 - val_accuracy: 0.8813 - val_loss: 0.3184
## Epoch 12/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8820 - loss: 0.3152 - val_accuracy: 0.8896 - val_loss: 0.3116
## Epoch 13/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8825 - loss: 0.3129 - val_accuracy: 0.8854 - val_loss: 0.3199
## Epoch 14/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8860 - loss: 0.3071 - val_accuracy: 0.8879 - val_loss: 0.3069
## Epoch 15/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8865 - loss: 0.3016 - val_accuracy: 0.8865 - val_loss: 0.3055
## Epoch 16/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8893 - loss: 0.2954 - val_accuracy: 0.8876 - val_loss: 0.3073
## Epoch 17/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8917 - loss: 0.2919 - val_accuracy: 0.8840 - val_loss: 0.3132
## Epoch 18/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8918 - loss: 0.2904 - val_accuracy: 0.8902 - val_loss: 0.3032
## Epoch 19/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8925 - loss: 0.2878 - val_accuracy: 0.8928 - val_loss: 0.2923
## Epoch 20/20
## 375/375 - 3s - 7ms/step - accuracy: 0.8931 - loss: 0.2856 - val_accuracy: 0.8925 - val_loss: 0.3004
# Assessment model 2
results_two <- model_two %>% evaluate(test_images, test_labels)
## 313/313 - 0s - 1ms/step - accuracy: 0.8875 - loss: 0.3273
cat("Accuracy of model 2:", results_two[[2]], "\n")
## Accuracy of model 2: 0.3273481
# Show training history
plot(history_2) + ggtitle("Model 2 Training History")

### 5. Model 3: Adamax Optimiser

# Define the third model
model_three <- 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 = "relu") %>%
  layer_dense(units = 10, activation = "softmax")

model_three %>% compile(
  optimizer = optimizer_adamax(),
  loss = "categorical_crossentropy", 
  metrics = c("accuracy")
)

# Create and train model 3
history_3 <- model_three %>% fit(
  x = train_images,
  y = train_labels,
  epochs = 20,
  batch_size = 128,
  validation_split = 0.2
)
## Epoch 1/20
## 375/375 - 4s - 11ms/step - accuracy: 0.7858 - loss: 0.5911 - val_accuracy: 0.8479 - val_loss: 0.4202
## Epoch 2/20
## 375/375 - 4s - 10ms/step - accuracy: 0.8422 - loss: 0.4345 - val_accuracy: 0.8580 - val_loss: 0.3857
## Epoch 3/20
## 375/375 - 4s - 10ms/step - accuracy: 0.8549 - loss: 0.3925 - val_accuracy: 0.8647 - val_loss: 0.3741
## Epoch 4/20
## 375/375 - 4s - 10ms/step - accuracy: 0.8643 - loss: 0.3683 - val_accuracy: 0.8698 - val_loss: 0.3504
## Epoch 5/20
## 375/375 - 4s - 10ms/step - accuracy: 0.8718 - loss: 0.3483 - val_accuracy: 0.8792 - val_loss: 0.3312
## Epoch 6/20
## 375/375 - 4s - 10ms/step - accuracy: 0.8774 - loss: 0.3329 - val_accuracy: 0.8822 - val_loss: 0.3247
## Epoch 7/20
## 375/375 - 4s - 10ms/step - accuracy: 0.8794 - loss: 0.3252 - val_accuracy: 0.8747 - val_loss: 0.3412
## Epoch 8/20
## 375/375 - 4s - 10ms/step - accuracy: 0.8832 - loss: 0.3150 - val_accuracy: 0.8804 - val_loss: 0.3259
## Epoch 9/20
## 375/375 - 4s - 10ms/step - accuracy: 0.8888 - loss: 0.2996 - val_accuracy: 0.8876 - val_loss: 0.3135
## Epoch 10/20
## 375/375 - 4s - 10ms/step - accuracy: 0.8898 - loss: 0.2943 - val_accuracy: 0.8826 - val_loss: 0.3299
## Epoch 11/20
## 375/375 - 4s - 9ms/step - accuracy: 0.8918 - loss: 0.2881 - val_accuracy: 0.8798 - val_loss: 0.3229
## Epoch 12/20
## 375/375 - 4s - 10ms/step - accuracy: 0.8955 - loss: 0.2819 - val_accuracy: 0.8892 - val_loss: 0.2996
## Epoch 13/20
## 375/375 - 4s - 10ms/step - accuracy: 0.8966 - loss: 0.2760 - val_accuracy: 0.8917 - val_loss: 0.2946
## Epoch 14/20
## 375/375 - 4s - 10ms/step - accuracy: 0.8992 - loss: 0.2664 - val_accuracy: 0.8866 - val_loss: 0.3060
## Epoch 15/20
## 375/375 - 4s - 10ms/step - accuracy: 0.9015 - loss: 0.2603 - val_accuracy: 0.8950 - val_loss: 0.2910
## Epoch 16/20
## 375/375 - 4s - 10ms/step - accuracy: 0.9028 - loss: 0.2582 - val_accuracy: 0.8901 - val_loss: 0.3032
## Epoch 17/20
## 375/375 - 4s - 10ms/step - accuracy: 0.9040 - loss: 0.2524 - val_accuracy: 0.8962 - val_loss: 0.2923
## Epoch 18/20
## 375/375 - 4s - 10ms/step - accuracy: 0.9067 - loss: 0.2470 - val_accuracy: 0.8947 - val_loss: 0.2983
## Epoch 19/20
## 375/375 - 4s - 10ms/step - accuracy: 0.9085 - loss: 0.2435 - val_accuracy: 0.8919 - val_loss: 0.2961
## Epoch 20/20
## 375/375 - 4s - 10ms/step - accuracy: 0.9088 - loss: 0.2394 - val_accuracy: 0.8932 - val_loss: 0.2904
# Assessment model 3
results_three <- model_three %>% evaluate(test_images, test_labels)
## 313/313 - 0s - 1ms/step - accuracy: 0.8883 - loss: 0.3122
cat("Accuracy of model 3:", results_three[[2]], "\n")
## Accuracy of model 3: 0.3121542
# Show training history
plot(history_3) + ggtitle("Model 3 Training History")