DL source code.R

##########################################################################
# Building a simple neural network

# import spreadsheet files
library(readr)
# deep learning package
library(keras)
# dynamic interactive tables
library(DT)

data <- read_csv("SimulatedBinaryClassificationDataset.csv",
                 col_names = TRUE)
summary(data)

# data.frame --> matrix
data  <- as.matrix(data)
# remove the row and col names, leaving only numerical values
dimnames(data) = NULL
mode(data)

# train and test split index
set.seed(123)
index <- sample(2,
                nrow(data),
                replace = TRUE,
                prob = c(0.9, 0.1))
table(index)

# data splitting
x_train <- data[index == 1, 1:10]
x_test <- data[index == 2, 1:10]
y_test_actual <- data[index == 2, 11]

# use teh to_categorical function in keras package for one-hot encoding
y_train <- to_categorical(data[index == 1, 11])
y_test <- to_categorical(data[index == 2, 11])

model <- keras_model_sequential()

model %>%
  # layer_dense means a densely connected layer
  layer_dense(name = "DeepLayer1",
              units = 10, # hyperparameter: the number of nodes
              activation = "relu",
              # the first layer need to have specification about the input dimension
              input_shape = c(10)) %>%
  layer_dense(name = "DeepLayer2",
              units = 10,
              activation = "relu") %>%
  layer_dense(name = "OutputLayer",
              units = 2,
              # softmax function will provide probabilities of the nodes
              activation = "softmax")

summary(model)

model %>% compile(
  # another way to calculate loss, besides mean-squared-error
  loss = "categorical_crossentropy", 
  # a special way of gradient descent
  optimizer = "adam",
  # measurement of model performance - using accuracy to measure
  metrics = c("accuracy")) 

history <- model %>%
  fit(x_train,
      y_train,
      # number of full forward & backward propagation
      # (i.e. run 10 times back and forth of all samples)
      epoch = 10, 
      # instead of propagating the whole dataset at one go, use smaller batches
      batch_size = 256, 
      # splitting the training set to test itself during training
      validation_split = 0.1, 
      verbose = 2)

# plot the training history
plot(history)

model %>%
  evaluate(x_test,
           # NOTE: here we are still using the one-hot encoded y_test
           y_test)

# form predictions
pred <- model %>%
  predict(x_test) %>%
  k_argmax()
# reference for converting tensor to R data types
# https://torch.mlverse.org/technical/tensors/
pred <- as.array(pred)
table(Predicted = pred,
      # NOTE: for confusion matrix, we are using the original y_test_actual, not encoded
      Actual = y_test_actual)
##########################################################################
# Applying regularization to deal with overfitting
library(keras)
library(readr)
library(tidyr)
library(tibble)
library(plotly)

# specify the number of feature variables for the dataset to be downloaded
num_words <- 5000
imdb <- dataset_imdb(num_words = num_words)

# train test split
c(train_data, train_labels) %<-% imdb$train
c(test_data, test_labels) %<-% imdb$test
# training and test data are both stored as lists
length(train_data)

# multi-hot encoding
multi_hot_sequences <- function(sequences, dimension){
  multi_hot <- matrix(0, 
                      # the number of samples in the sequences
                      # sequences are stored as lists
                      nrow = length(sequences), 
                      ncol = dimension)
  for(i in 1 : length(sequences)){
    # sequences[[i]] extracts the label of the words in the text sample i
    # which ever word is included in that sequence will be assigned 1 at row i
    multi_hot[i, sequences[[i]]] <- 1
  }
  multi_hot
}

train_data <- multi_hot_sequences(train_data, num_words)
test_data <- multi_hot_sequences(test_data, num_words)

baseline_model <-
  keras_model_sequential() %>%
  layer_dense(units = 16, activation = "relu", input_shape = num_words) %>%
  layer_dense(units = 16, activation = "relu") %>%
  layer_dense(units = 1, activation = "sigmoid")

baseline_model %>% compile(
  optimizer = "adam",
  loss = "binary_crossentropy",
  metrics = list("accuracy")
)

baseline_model %>% summary()

baseline_history <- baseline_model %>% fit(
  train_data,
  train_labels,
  epochs = 20,
  # recall: batch size controls the number of training samples to work through before updating parameters
  batch_size = 512,
  validation_data = list(test_data, test_labels),
  # get loss and accuracy reports
  verbose = 2
)

plot(baseline_history)

l2_model <-
  keras_model_sequential() %>%
  layer_dense(units = 16, activation = "relu", input_shape = num_words,
              # apply regularization in the layer_dense function's argument
              kernel_regularizer = regularizer_l2(l = 0.001)) %>%
  layer_dense(units = 16, activation = "relu",
              kernel_regularizer = regularizer_l2(l = 0.001)) %>%
  layer_dense(units = 1, activation = "sigmoid")

l2_model %>% compile(
  optimizer = "adam",
  loss = "binary_crossentropy",
  metrics = list("accuracy")
)

l2_model %>% summary()

l2_history <- l2_model %>% fit(
  train_data,
  train_labels,
  epoch = 20,
  batch_size = 512,
  validation_data = list(test_data, test_labels),
  verbose = 2
)

plot(l2_history)

drop_model <- keras_model_sequential() %>%
  layer_dense(units = 16, activation = "relu", input_shape = num_words) %>%
  # a new layer to specify the dropout rate
  layer_dropout(0.6) %>%
  layer_dense(units = 16, activation = "relu") %>%
  layer_dropout(0.6) %>%
  layer_dense(units = 1, activation = "sigmoid")

drop_model %>% compile(
  optimizer = "adam",
  loss = "binary_crossentropy",
  metrics = list("accuracy")
)

drop_model %>% summary()

drop_history <- drop_model %>% fit(
  train_data,
  train_labels,
  epoch = 20,
  batch_size = 512,
  validation_data = list(test_data, test_labels),
  verbose = 2
)

plot(drop_history)
##########################################################################
# Optimization of neural nets
library(keras)
library(readr)

train.import <- read_csv("ImprovementsTrain.csv")
test.import <- read_csv("ImprovementsTest.csv")

# recall that NN are constructed based on numerical matrices
# we need to cast dataframe into matrix and remove column names
train.import <- as.matrix(train.import)
dimnames(train.import) <- NULL
test.import <- as.matrix(test.import)
dimnames(test.import) <- NULL

# train & test sets
train_data <- train.import[, 1:12]
train_labels <- train.import[, 13]
test_data <- test.import[, 1:12]
test_labels <- test.import[, 13]

feature.means = vector(length = ncol(train_data))
for(i in 1:length(feature.means)){
  # calculate the mean of each column in the training set
  feature.means[i] = mean(train_data[, i])
}

feature.sds = vector(length = ncol(train_data))
for(i in 1:length(feature.sds)){
  # calculate the standard deviation of each column in the training set
  feature.sds[i] <- sd(train_data[, i])
}

# normalize the feature variables in the training set
train_data_normalized <- matrix(nrow = nrow(train_data),
                                ncol = ncol(train_data))
for(n in 1:ncol(train_data)){
  for(m in 1:nrow(train_data)){
    train_data_normalized[m, n] <- (train_data[m, n] - feature.means[n])/feature.sds[n]
  }
}

# normalize the feature variables in the testing set
test_data_normalized <- matrix(nrow = nrow(test_data),
                               ncol = ncol(test_data))
for(n in 1:ncol(test_data)){
  for(m in 1:nrow(test_data)){
    test_data_normalized[m, n] <- (test_data[m, n] - feature.means[n])/feature.sds[n]
  }
}

# use normal distribution to set the very first weights in tensor
init_w <- initializer_random_normal(mean = 0,
                                    stddev = 0.05,
                                    seed = 123)
# by default, all the bias terms are set to 0 initially
init_B <- initializer_zeros()

baseline_model <- keras_model_sequential() %>%
  layer_dense(units = 48,
              activation = "relu",
              # the initial weights for the NN
              kernel_initializer = init_w,
              input_shape = c(12)) %>%
  layer_dense(units = 48,
              activation = "relu") %>%
  layer_dense(units = 1,
              activation = "sigmoid")

summary(baseline_model)

baseline_model %>% compile(
  optimizer = optimizer_rmsprop(
    # learning rate (i.e. step size)
    lr = 0.001,
    # the decay factor (i.e. the weight to the previous gradient, beta)
    rho = 0.9
  ),
  loss = "binary_crossentropy",
  metrics = list("accuracy")
)

baseline_history <- baseline_model %>%
  fit(train_data_normalized,
      train_labels,
      epochs = 40,
      # conditions when to stop, save computation time
      # avoid scenario of training without improvements
      callbacks = list(callback_early_stopping(
        # use change in loss to determine whether to stop
        monitor = "loss",
        # wait for two runs, if unchanged in loss, then stop
        patience = 2
      )),
      batch_size = 512,
      validation_data = list(test_data_normalized, test_labels),
      verbose = 2)

plot(baseline_history)
##########################################################################
# Deep Neural Network for regression problem
library(readr)
library(keras)

setwd("~/Documents/Programming/R/Deep Learning with R/Datasets")
data.set <- read_csv("RegressionData.csv",
                     col_names = FALSE)
# transform dataframe to matrix
data.set <- as.matrix(data.set)
# remove column names
dimnames(data.set) <- NULL

# train test split
set.seed(123)
index <- sample(2,
                nrow(data.set),
                replace = TRUE,
                prob = c(0.8, 0.2))

x_train <- data.set[index == 1, 1:10]
x_test <- data.set[index == 2, 1:10]
y_train <- data.set[index == 1, 11]
y_test <- data.set[index == 2, 11]

# normalizing data
mean.train <- apply(x_train, 2, mean)
sd.train <- apply(x_train, 2, sd)
x_train <- scale(x_train)
# use the normalizing parameters from training set to normalize testing set
x_test <- scale(x_test,
                center = mean.train,
                scale = sd.train)

# creating the model
model <- keras_model_sequential() %>%
  layer_dense(units = 25,
              activation = "relu",
              input_shape = c(10)) %>%
  layer_dropout(0.2) %>%
  layer_dense(units = 25,
              activation = "relu") %>%
  layer_dropout(0.2) %>%
  layer_dense(units = 25,
              activation = "relu") %>%
  layer_dropout(0.2) %>%
  layer_dense(units = 1)

model %>% summary()

# compile the model
model %>% compile(
  # the metric for propagation
  loss = "mse",
  optimizer = optimizer_rmsprop(),
  # not for propagation, but for user feedback
  # letting us know the model's performance
  metrics = c("mean_absolute_error"))

# fitting the data
model_history <- model %>%
  fit(x_train,
      y_train,
      epoch = 50,
      batch_size = 32,
      validation_split = 0.1,
      callbacks = c(callback_early_stopping(monitor = "val_mean_absolute_error",
                                            patience = 5)),
      verbose = 2)

plot(model_history)

# testing the model
c(loss, mae) %<-% (model %>% evaluate(x_test, y_test, verbose = 0))
paste0("Mean Absolute Error on test set is:", mae)
##########################################################################
# Convolution Neural Network in R
library(keras)

# a dataset of numerous images of hand-written numbers from 0-9
mnist <- dataset_mnist()
x_train <- mnist$train$x
y_train <- mnist$train$y
x_test <- mnist$test$x
y_test <- mnist$test$y

dim(x_train)

img_row <- dim(x_train)[2]
img_col <- dim(x_test)[3]

# images should have three channels, but the data only has two, need transformation
# because this is gray-scale image, the third channel only has one layer
x_train <- array_reshape(x_train,
                         c(nrow(x_train),
                           img_row,
                           img_col, 1))
x_test <- array_reshape(x_test,
                        c(nrow(x_test),
                          img_row,
                          img_col, 1))
input_shape <- c(img_row, img_col, 1)

# there is one extra channel in x_train now
dim(x_train)

# normalize the datasets by dividing the number 255
# because the color gradient is from 0(black) to 255(white)
# dividing by 255 can transform the entries to values between 0 and 1
x_train <- x_train/255
x_test <- x_test/255

# use one-hot encoding to encode the y values
# y values are labels for number 0 to 9, thus we need 10 categories
y_train <- to_categorical(y_train, num_classes = 10)
y_test <- to_categorical(y_test, num_classes = 10)

model <- keras_model_sequential() %>%
  layer_conv_2d(
    # number of filters for transformation
    filters = 16,
    # size of the filters
    kernel_size = c(3,3),
    activation = 'relu',
    input_shape = input_shape) %>% 
  layer_max_pooling_2d(pool_size = c(2, 2)) %>% 
  layer_dropout(rate = 0.25) %>% 
  layer_flatten() %>% 
  layer_dense(units = 10,
              activation = 'relu') %>% 
  layer_dropout(rate = 0.5) %>% 
  layer_dense(units = 10,
              # for categorical prediction
              activation = 'softmax')

model %>% summary()

model %>% compile(
  loss = loss_categorical_crossentropy,
  optimizer = optimizer_adadelta(),
  metrics = c('accuracy')
)

model %>% fit(
  x_train, 
  y_train,
  batch_size = 128,
  epochs = 12,
  validation_split = 0.2
)

score <- model %>% evaluate(x_test,
                            y_test)
score