sessionInfo()
## R version 4.3.0 (2023-04-21)
## Platform: aarch64-apple-darwin20 (64-bit)
## Running under: macOS Ventura 13.5.2
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRblas.0.dylib 
## LAPACK: /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRlapack.dylib;  LAPACK version 3.11.0
## 
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
## 
## time zone: America/Chicago
## tzcode source: internal
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## loaded via a namespace (and not attached):
##  [1] digest_0.6.33   R6_2.5.1        fastmap_1.1.1   xfun_0.39      
##  [5] cachem_1.0.8    knitr_1.42      htmltools_0.5.5 rmarkdown_2.21 
##  [9] cli_3.6.1       sass_0.4.6      jquerylib_0.1.4 compiler_4.3.0 
## [13] rstudioapi_0.14 tools_4.3.0     evaluate_0.20   bslib_0.4.2    
## [17] yaml_2.3.7      rlang_1.1.1     jsonlite_1.8.4
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.3     ✔ readr     2.1.4
## ✔ forcats   1.0.0     ✔ stringr   1.5.0
## ✔ ggplot2   3.4.3     ✔ tibble    3.2.1
## ✔ lubridate 1.9.2     ✔ tidyr     1.3.0
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

We apply neural network for handwritten digit recognition in this lab.

Data

We use the MNIST database (Modified National Institute of Standards and Technology database) is a large database of handwritten digits (\(28 \times 28\)) that is commonly used for training and testing machine learning algorithms.

You can prepare the data by the following code

library(keras)
# you may need to install python
# reticulate::install_python(version = "3.11")
# you may need to install Keras
# install_keras()
mnist <- dataset_mnist(path = "mnist.npz")
x_train <- mnist$train$x
y_train <- mnist$train$y
x_test <- mnist$test$x
y_test <- mnist$test$y

Training set:

dim(x_train)
## [1] 60000    28    28
dim(y_train)
## [1] 60000

Let’s take a look over the first 10 images in the training set.

for (i in 1:10) {
  (image(t(x_train[i, 28:1,]), useRaster=TRUE, axes=FALSE, col=grey(seq(0, 1, length = 256)), main = y_train[i]))
}

Vectorize \(28 \times 28\) images into \(784\)-vectors and scale entries to [0, 1]:

# reshape
x_train <- array_reshape(x_train, c(nrow(x_train), 784))
x_test <- array_reshape(x_test, c(nrow(x_test), 784))
# rescale
x_train <- x_train / 255
x_test <- x_test / 255
dim(x_train)
## [1] 60000   784
dim(x_test)
## [1] 10000   784

Encode \(y\) as binary class matrix:

y_train <- to_categorical(y_train, 10)
y_test <- to_categorical(y_test, 10)
dim(y_train)
## [1] 60000    10
dim(y_test)
## [1] 10000    10
head(y_train)
##      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,]    0    0    0    0    0    1    0    0    0     0
## [2,]    1    0    0    0    0    0    0    0    0     0
## [3,]    0    0    0    0    1    0    0    0    0     0
## [4,]    0    1    0    0    0    0    0    0    0     0
## [5,]    0    0    0    0    0    0    0    0    0     1
## [6,]    0    0    1    0    0    0    0    0    0     0

Q1

Fit a multinomial logit regression model to the training set and test the accuracy with the test set. Plot the first 10 digits in the test set and compare with their predicted value.

mlogit <- keras_model_sequential() 
mlogit %>% 
  layer_dense(units = 10, activation = 'softmax', input_shape = c(784))
summary(mlogit)
## Model: "sequential"
## ________________________________________________________________________________
##  Layer (type)                       Output Shape                    Param #     
## ================================================================================
##  dense (Dense)                      (None, 10)                      7850        
## ================================================================================
## Total params: 7850 (30.66 KB)
## Trainable params: 7850 (30.66 KB)
## Non-trainable params: 0 (0.00 Byte)
## ________________________________________________________________________________
# compile model
mlogit %>% compile(
  loss = 'categorical_crossentropy',
  optimizer = optimizer_rmsprop(),
  metrics = c('accuracy')
)
# fit model
mlogit_history <- mlogit %>% fit(
  x_train, y_train, 
  epochs = 20, batch_size = 128, 
  validation_split = 0.2
)
## Epoch 1/20
## 375/375 - 3s - loss: 0.6597 - accuracy: 0.8380 - val_loss: 0.3567 - val_accuracy: 0.9039 - 3s/epoch - 9ms/step
## Epoch 2/20
## 375/375 - 3s - loss: 0.3499 - accuracy: 0.9043 - val_loss: 0.3054 - val_accuracy: 0.9150 - 3s/epoch - 8ms/step
## Epoch 3/20
## 375/375 - 3s - loss: 0.3148 - accuracy: 0.9122 - val_loss: 0.2904 - val_accuracy: 0.9184 - 3s/epoch - 8ms/step
## Epoch 4/20
## 375/375 - 3s - loss: 0.2993 - accuracy: 0.9170 - val_loss: 0.2813 - val_accuracy: 0.9230 - 3s/epoch - 8ms/step
## Epoch 5/20
## 375/375 - 3s - loss: 0.2896 - accuracy: 0.9189 - val_loss: 0.2743 - val_accuracy: 0.9234 - 3s/epoch - 8ms/step
## Epoch 6/20
## 375/375 - 3s - loss: 0.2831 - accuracy: 0.9210 - val_loss: 0.2721 - val_accuracy: 0.9254 - 3s/epoch - 8ms/step
## Epoch 7/20
## 375/375 - 3s - loss: 0.2782 - accuracy: 0.9221 - val_loss: 0.2683 - val_accuracy: 0.9265 - 3s/epoch - 8ms/step
## Epoch 8/20
## 375/375 - 3s - loss: 0.2743 - accuracy: 0.9242 - val_loss: 0.2670 - val_accuracy: 0.9271 - 3s/epoch - 8ms/step
## Epoch 9/20
## 375/375 - 3s - loss: 0.2712 - accuracy: 0.9240 - val_loss: 0.2654 - val_accuracy: 0.9279 - 3s/epoch - 8ms/step
## Epoch 10/20
## 375/375 - 3s - loss: 0.2684 - accuracy: 0.9252 - val_loss: 0.2639 - val_accuracy: 0.9292 - 3s/epoch - 8ms/step
## Epoch 11/20
## 375/375 - 3s - loss: 0.2667 - accuracy: 0.9257 - val_loss: 0.2613 - val_accuracy: 0.9295 - 3s/epoch - 8ms/step
## Epoch 12/20
## 375/375 - 3s - loss: 0.2646 - accuracy: 0.9276 - val_loss: 0.2629 - val_accuracy: 0.9293 - 3s/epoch - 8ms/step
## Epoch 13/20
## 375/375 - 3s - loss: 0.2627 - accuracy: 0.9278 - val_loss: 0.2621 - val_accuracy: 0.9308 - 3s/epoch - 8ms/step
## Epoch 14/20
## 375/375 - 3s - loss: 0.2616 - accuracy: 0.9282 - val_loss: 0.2613 - val_accuracy: 0.9295 - 3s/epoch - 8ms/step
## Epoch 15/20
## 375/375 - 3s - loss: 0.2605 - accuracy: 0.9287 - val_loss: 0.2617 - val_accuracy: 0.9305 - 3s/epoch - 8ms/step
## Epoch 16/20
## 375/375 - 3s - loss: 0.2590 - accuracy: 0.9290 - val_loss: 0.2605 - val_accuracy: 0.9302 - 3s/epoch - 8ms/step
## Epoch 17/20
## 375/375 - 3s - loss: 0.2583 - accuracy: 0.9291 - val_loss: 0.2616 - val_accuracy: 0.9293 - 3s/epoch - 8ms/step
## Epoch 18/20
## 375/375 - 3s - loss: 0.2571 - accuracy: 0.9296 - val_loss: 0.2614 - val_accuracy: 0.9300 - 3s/epoch - 8ms/step
## Epoch 19/20
## 375/375 - 3s - loss: 0.2564 - accuracy: 0.9298 - val_loss: 0.2603 - val_accuracy: 0.9315 - 3s/epoch - 8ms/step
## Epoch 20/20
## 375/375 - 3s - loss: 0.2555 - accuracy: 0.9306 - val_loss: 0.2605 - val_accuracy: 0.9316 - 3s/epoch - 8ms/step
# Evaluate model performance on the test data:
mlogit %>% evaluate(x_test, y_test)
## 313/313 - 2s - loss: 0.2704 - accuracy: 0.9275 - 2s/epoch - 5ms/step
##      loss  accuracy 
## 0.2704467 0.9275000

Generate predictions on new data:

y_predict <- mlogit %>% predict(x_test) %>% k_argmax() %>% as.array()
## 313/313 - 0s - 320ms/epoch - 1ms/step
for (i in 1:10) {
  (image(t(mnist$test$x[i, 28:1,]), useRaster=TRUE, axes=FALSE, col=grey(seq(0, 1, length = 256)), main = y_predict[i]))
}

Q2

Fit a multi-layer neural network and perform the task in Q0 again.

You can refer to this example code. https://tensorflow.rstudio.com/guide/keras/examples/mnist_mlp/

Q3

Fit a convolutional neural network and perform the same task in Q0.

You can refer to this example code. https://tensorflow.rstudio.com/guide/keras/examples/mnist_cnn/

Q4

Summarize the prediction accuracy and runtime differences between these models.