Deni Goktas

Shiny app with Keras backend

In this post I will build a web app that allows a company to predict a car’s auction price using a simple deep learning model. I will do this by using a Keras/Tensorflow backend and an R Shiny front end. You can find the app here!

Set-up Environment

library(tidyverse)
library(tensorflow)
library(keras)
install_keras(tensorflow = "1.12")

Clean Data

First, we clean the data and tokenize the auction data in order to be able to process the string data. The tokenizer is then saved to use later during prediction.

data <- read_csv(file = "Fugazi foogazi.csv") 
data <- data %>% select(price, id, car_id, make_id, 
                        model_id, month, quarter, 
                        auction) %>% drop_na 

data$auction[data %>% pull(auction) %>% is.na] <- "" 

text <- data$auction
tokenizer <-  text_tokenizer(num_words = 165) %>% 
  fit_text_tokenizer(text)

tokenizer %>% save_text_tokenizer("tokenizer")
tokenizer %>% save_text_tokenizer(
  "carSalesPrediction/tokenizer")
sequences <-  texts_to_sequences(tokenizer, text) 

word_index <-  tokenizer$word_index

maxlen <- sequences %>% 
  map(length) %>% 
  unlist %>%
  max

sequences_padded <-  pad_sequences(sequences, 
                                   maxlen = maxlen)

data <- data %>% select(price, id, car_id, 
                        make_id, model_id, 
                        month, quarter) %>% 
  as.matrix

data <- cbind(data, sequences_padded)

train <- data[1:round(0.8*nrow(data)),]
test <- data[round(0.8*nrow(data)):nrow(data),]


Y_train <- train[,1]
Y_test <-  test[,1]

X_train <- train[,-1]
X_test <- test[,-1]

Build Model

We build a convolutional neural network model. Here is the architecture of the model:

  1. Convolution layer
  2. Max Pool
  3. Convolution layer
  4. Max Pool
  5. GRU
  6. Dense layer
  7. Dense layer
  8. Output layer
#define model (CNN)
model1 <- keras_model_sequential()

model1 %>%
layer_conv_1d(filters = 100, kernel_size = 3, activation = "relu", input_shape = c(18,1)) %>% 
layer_max_pooling_1d(pool_size = 3, padding = "same")  %>% 
layer_conv_1d(filters = 64, kernel_size = 2, activation = "relu") %>% 
layer_max_pooling_1d(pool_size = 3, padding = "same")  %>%
layer_gru(units = 50, activation = "relu") %>% 
layer_dense(units = 32, activation = "relu") %>% 
layer_dense(units = 16, activation = "relu") %>% 
layer_dense(units = 1)

Compile Model

We compile the model, using mean squared error as the loss function and Adam with a learning rate of 0.001 as the optimizer. We decide to use mean absolute error as a metric to judge model accuracy. Below is a summary of the model.

#compile model 
model1 %>% 
  compile( loss = "mean_squared_error", 
optimizer = optimizer_adam(lr = 0.001), 
metrics = c("mean_absolute_error")
)
model1 <- load_model_hdf5(filepath = "Model1", compile = T) 
tokenizer <- load_text_tokenizer("tokenizer")
summary(model1)

Fit Model

We train our model; notice that the input is reshaped in order to fit into the input CNN layer. We decided to use 500 epochs and a batch size of 128 to train the model (the hyperparameters are fine-tuned).

Notice that the data is divided the following way:

  • 60% training data
  • 20% validation data
  • 20% testing data
model1 %>% 
  fit(X_train %>% array_reshape(list(nrow(X_train), 18, 1)), Y_train  %>% array_reshape(list(length(Y_train), 1)),
epochs = 500, batch_size = 128, validation_split = 0.2
)

Evaluate

We see that our model performs better than other feed forward neural networks, however it is still not extremely accurate. We get a mean absolute error of 3396420. This is most likely due to a lack of enough data, since the regression task is quite hard. However, the model can still allow us to have a broad idea of where the sale price will be. The model can be easily improved and retrained with more data.

model1 %>% evaluate(X_test %>% array_reshape(list(nrow(X_test), 18, 1)), Y_test  %>% array_reshape(list(length(Y_test), 1)))

Predict

model1 %>% predict_on_batch(X_test %>% array_reshape(list(nrow(X_test), 18, 1))) %>% array %>% head

Example of prediction on data: 204563.4 347945.5 159756.1 194211.9 201083.0 262050.0 # Save Model

model1 %>% save_model_hdf5(filepath = "carSalesPrediction/Model1")
model1 %>% save_model_hdf5(filepath = "Model1")

Other Models (ignore)

#Define Model (Feedforward NN)

model2 <- keras_model_sequential()
model2 %>%
layer_dense(units = 256, activation = "relu", input_shape = 18) %>% 
layer_dense(units = 128, activation = "relu") %>% 
layer_dense(units = 64, activation = "relu") %>% 
layer_dense(units = 1)
#compile model 
model2 %>% 
  compile( loss = "mean_squared_error", 
optimizer = optimizer_adam(lr = 0.002), 
metrics = c("mean_absolute_error")
)

summary(model2)
#train model
model2 %>% 
  fit(X_train, Y_train,
epochs = 100, batch_size = 30, validation_split = 0.2
)

The Keras app

First, we write a script that allows us to call the model and receive a prediction for different inputs. We store this script in a different .R file. Here is its content:

pred <- function(otherArgs, auction) {
  model <- load_model_hdf5(filepath = "Model1", compile = T) 
  tokenizer <- load_text_tokenizer("tokenizer")
  sequences <- texts_to_sequences(tokenizer, auction) 
  sequence_padded <- sequences %>% pad_sequences(maxlen = 12)
  X <- matrix(c(otherArgs, sequence_padded),nrow = 1)
  pred_Y <- model %>% predict_on_batch(X %>% array_reshape(list(nrow(X), 18, 1))) %>% array
  return(pred_Y)
}

pred(otherArgs = c(0,0,0,0,0,0), auction = "RM")

Then using this script, we create the Shiny app. Below is the code for the Shiny app:

library(keras)
#install_keras(tensorflow = "1.12")
library(tidyverse)
library(tensorflow)
library(shiny)

# Define UI for application
ui <- fluidPage(
   
   # Application title
   titlePanel("Sales Number Prediction"),
   
   # Sidebar
   sidebarLayout(
     sidebarPanel(numericInput("id", "ID", 0, 0),
                  numericInput("car_id", "Car ID", 0, 0),
                  numericInput("make_id", "Make ID", 0, 0),
                  numericInput("model_id", "Model ID", 0, 0),
                  numericInput("month", "Month", 0, 0),
                  numericInput("quarter", "Quarter", 0, 0),
                  selectInput("auction", "Auction", read_csv(file = "Fugazi foogazi.csv") %>% select(auction) %>% distinct %>% pull),
                  submitButton("Submit", "Predict")
                ),
   mainPanel(textOutput(outputId = "result"))
   )
)



# Define server logic required to draw a histogram
server <- function(input, output) {

  source("prediction.R")
  pred_Y <- reactive({pred(otherArgs = c(input$id, input$car_id, input$make_id, input$model_id, input$month, input$quarter), auction =input$auction)})
  output$result <- renderText(pred_Y())
}

# Run the application 
shinyApp(ui = ui, server = server)

All posts