# install.packages("keras")
# library("keras")
# install_keras(tensorflow = "gpu")
# install.packages("pROC")

Load Libraries

library(keras)
library(pROC)
## Type 'citation("pROC")' for a citation.

Prepare Data

imdb <- dataset_imdb(num_words = 10000)
c(train_data, train_labels) %<-% imdb$train
c(test_data, test_labels) %<-% imdb$test

maxlen = 256
train_data <- pad_sequences(train_data, maxlen = maxlen)
test_data <- pad_sequences(test_data, maxlen = maxlen)

Approach I: RNN

  • Specify Network Architecture
model1 <- keras_model_sequential() %>%
  layer_embedding(input_dim = 10000, output_dim = 32) %>%
  layer_simple_rnn(units = 32) %>%
  layer_dense(units = 1, activation = "sigmoid")
  • Specify Loss and Optimizer
model1 %>% compile(
  optimizer = "rmsprop",
  loss = "binary_crossentropy",
  metrics = c("acc")
)
summary(model1)
## ___________________________________________________________________________
## Layer (type)                     Output Shape                  Param #     
## ===========================================================================
## embedding_1 (Embedding)          (None, None, 32)              320000      
## ___________________________________________________________________________
## simple_rnn_1 (SimpleRNN)         (None, 32)                    2080        
## ___________________________________________________________________________
## dense_1 (Dense)                  (None, 1)                     33          
## ===========================================================================
## Total params: 322,113
## Trainable params: 322,113
## Non-trainable params: 0
## ___________________________________________________________________________
  • Model Fitting and Evaluation
history <- model1 %>% fit(
  train_data, train_labels,
  epochs = 10,
  batch_size = 128
)

plot(history)

predictions <- model1 %>% predict(test_data)
table(test_labels, predictions>0.5)
##            
## test_labels FALSE  TRUE
##           0 10088  2412
##           1  2031 10469
1 - mean(test_labels != (predictions>0.5))
## [1] 0.82228
roc(test_labels, as.vector(predictions))
## 
## Call:
## roc.default(response = test_labels, predictor = as.vector(predictions))
## 
## Data: as.vector(predictions) in 12500 controls (test_labels 0) < 12500 cases (test_labels 1).
## Area under the curve: 0.8897

Approach II: LSTM

  • Specify Network Architecture
model2 <- keras_model_sequential() %>%
  layer_embedding(input_dim = 10000, output_dim = 32) %>%
  layer_lstm(units = 32) %>%
  layer_dense(units = 1, activation = "sigmoid")
  • Specify Loss Function and Optimizer
model2 %>% compile(
  optimizer = "rmsprop",
  loss = "binary_crossentropy",
  metrics = c("acc")
)

summary(model2)
## ___________________________________________________________________________
## Layer (type)                     Output Shape                  Param #     
## ===========================================================================
## embedding_2 (Embedding)          (None, None, 32)              320000      
## ___________________________________________________________________________
## lstm_1 (LSTM)                    (None, 32)                    8320        
## ___________________________________________________________________________
## dense_2 (Dense)                  (None, 1)                     33          
## ===========================================================================
## Total params: 328,353
## Trainable params: 328,353
## Non-trainable params: 0
## ___________________________________________________________________________
  • Model Fitting and Evaluation
history <- model2 %>% fit(
  train_data, train_labels,
  epochs = 10,
  batch_size = 128
)

plot(history)

predictions <- model2 %>% predict(test_data)
table(test_labels, predictions>0.5) ## accuracy = 0.86584
##            
## test_labels FALSE  TRUE
##           0 10616  1884
##           1  1470 11030
roc(test_labels, as.vector(predictions))
## 
## Call:
## roc.default(response = test_labels, predictor = as.vector(predictions))
## 
## Data: as.vector(predictions) in 12500 controls (test_labels 0) < 12500 cases (test_labels 1).
## Area under the curve: 0.9376