Set-up Environment

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

Clean Data

First, we clean 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 as a loss function mean squared error, as optimizer ADAM with a learning rate of 0.001. 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 finetuned).

Notuce that the data is divided the following way: - 60% training data - 20% testing 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 absolut error of 3396420. This is most likly 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 outputs. 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)