1 Intro

Scotty adalah aplikasi ride-sharing sepeda motor yang beroperasi di beberapa kota besar di Turki. Seiring dengan berkembangnya popularitas scotty di Turki, seringkali pelanggan tidak mendapatkan driver, dikarenakan jumlah driver yang masih belum mencukupi.

pada laporan ini, akan dibuat sebuah model klasifikasi untuk memprediksi status cakupan driver tiap area dan tiap jam, apakah mencukupi (sufficient) atau tidak mencukupi (insufficient) selama 7 hari dari tanggal 3 Desember 2017 - 9 Desember 2017

1.1 Library

options(scipen = 999)

library(tidyverse)
library(lubridate)
library(stringr)
library(padr)
library(ggplot2)
library(caret)
library(rsample)
library(randomForest)
library(ggthemes)

2 Data Preprocessing

2.1 Read Data

scotty <- read_csv("data/data-train.csv")
head(scotty)

## # A tibble: 6 x 16
##   id    trip_id driver_id rider_id start_time          src_lat src_lon
##   <chr> <chr>   <chr>     <chr>    <dttm>                <dbl>   <dbl>
## 1 59d0… 59d005… 59a892c5… 59ad2d6… 2017-10-01 00:00:17    41.1    29.0
## 2 59d0… 59d006… 59a13556… 59ce930… 2017-10-01 00:02:34    40.9    29.1
## 3 59d0… <NA>    <NA>      59cd704… 2017-10-01 00:02:34    41.1    29.0
## 4 59d0… 59d006… 599dc0df… 59bd62c… 2017-10-01 00:03:29    41.0    29.0
## 5 59d0… 59d007… 59a58565… 59c17cd… 2017-10-01 00:04:24    41.1    29.0
## 6 59d0… 59d007… 59579d5f… 594afb1… 2017-10-01 00:05:32    41.0    28.9
## # … with 9 more variables: src_area <chr>, src_sub_area <chr>,
## #   dest_lat <dbl>, dest_lon <dbl>, dest_area <chr>, dest_sub_area <chr>,
## #   distance <dbl>, status <chr>, confirmed_time_sec <dbl>

Karena yang akan diklasifikasikan adalah perkiraan sufficient atau insufficient dari cakupan driver berdasarkan jam dan hari, maka data datetime perlu di floor kan terlebih dahulu mengikuti Jamnya

scotty2 <-scotty %>% 
  mutate(datetime = floor_date(start_time, unit = "hour"))

2.2 Aggregasi dan Padding Tanggal

Selanjutnya dilakukan aggregasi data berdasarkan area, waktu, dan status

scotty_agg <- scotty2 %>% 
  group_by(src_area, datetime, status) %>% 
  summarise(count = n()) %>% 
  ungroup()

head(scotty_agg)

## # A tibble: 6 x 4
##   src_area datetime            status    count
##   <chr>    <dttm>              <chr>     <int>
## 1 sxk3     2017-10-01 00:00:00 nodrivers     1
## 2 sxk3     2017-10-01 01:00:00 confirmed     1
## 3 sxk3     2017-10-01 01:00:00 nodrivers     1
## 4 sxk3     2017-10-01 03:00:00 nodrivers     1
## 5 sxk3     2017-10-01 04:00:00 nodrivers     1
## 6 sxk3     2017-10-01 07:00:00 nodrivers     1

selanjutnya dilakukan padding pada kolom datetime, agar interval tanggal pada setiap area sama. Interval dibuat setiap Jam

min_date <- min(scotty_agg$datetime)
max_date <- max(scotty_agg$datetime)

start_val <- make_datetime(
  year = year(min_date),
  month = month(min_date),
  day = day(min_date),
  hour = 0
)


end_val <- make_datetime(
  year = year(max_date),
  month = month(max_date),
  day = day(max_date),
  hour = 23
)

scotty_pad <- scotty_agg %>% 
  group_by(src_area, status) %>% 
  pad(start_val = start_val, end_val = end_val) %>% 
  ungroup()

## pad applied on the interval: hour

2.3 Replace NA

Mengganti data NA pada kolom count menjadi 0

scotty_pad <- scotty_pad %>% 
  replace_na(list(count = 0))

2.4 Mutasi Kolom dan Labelling Target

Jika status nodrivers = 0 maka coverage = sufficient, jika status nodrivers > 1 maka coverage = insufficient. Sementara jika status confirmed = 0, belum berarti tidak ada drivernya. bisa saja memang tidak ada pesanan. Dengan business rule ini status yang relevan dalam menentukan target adalah nodrivers, maka akan difilter status = nodrivers

dari kolom datetime, diekstrak beberapa kolom tambahan untuk membantu visualisasi data

scotty_clean1 <- scotty_pad %>% 
  filter(status == "nodrivers") %>% 
  mutate(weekday = factor(weekdays(datetime),
                          levels = c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")),
         hour = as.factor(hour(datetime)),
         src_area = as.factor(src_area)
         ) %>% 
  mutate(coverage = as.factor(ifelse(count > 0, "insufficient", "sufficient")))

3 Exploratory Data Analysis

3.1 Cek proporsi secara umum

scotty_clean2<- scotty_clean1 %>% 
  select(src_area, weekday, hour, coverage)

scotty_clean2 %>% 
  group_by(coverage) %>% 
  summarise(count = n()) %>% 
  ggplot(aes(x = coverage, y = count)) +
  geom_col(fill = "#2c3e50") +
  geom_point() +
  labs(y = NULL) +
  theme_economist()

scotty_clean2$coverage %>% 
  table() %>% 
  prop.table()

## .
## insufficient   sufficient 
##    0.5410053    0.4589947

Berdasarkan proporsi secara umum diatas, dapat disimpulkan jumlah kejadian Insufficient dan sufficient cukup seimbang,

selanjutnya akan dicek berdasarkan area nya

3.2 Cek Proporsi berdasarkan area

scotty_clean2 %>% 
  group_by(src_area, coverage) %>% 
  summarise(count = n()) %>% 
  ggplot(aes(x = src_area, y = count, fill = coverage)) +
  geom_col(position = "dodge") +
  labs(y = NULL,
       x = "Area") +
  theme_economist() +
  theme(legend.position = "bottom",
        legend.title = element_blank()) +
   scale_fill_economist()

Berdasarkan grafik diatas, dapat disimpulkan sebagai berikut :

Pada area sxk3, jumlah kejadian insufficient sedikit lebih banyak dibandingkan sufficient.
Pada area sxk8, jumlah kejadian sufficient jauh lebih banyak dibandingkan dengan jumlah kejadian insufficient
Pada area sxk9, kebalikan dengan area sxk8, jumlah kejadian insufficient jauh lebih banyak dibandingkan dengan kejadian sufficient

3.3 Heatmap

ggplot(scotty_clean2, aes(x = hour, y = weekday)) + geom_tile(aes(fill = coverage)) +
  theme_economist() +
  scale_fill_economist()+
  labs(x = "Hour",
       Y = NULL) +
  theme(legend.position = "bottom",
        legend.title = element_blank()) +
  facet_wrap(~src_area, nrow = 3)

Pada heatmap diatas dapat disimpulkan, bahwa tiap jam, pada hari, dan pada tiap area memiliki pola berbeda dalam hal cakupan driver

4 Model Fitting dan Evaluation

4.1 Cross Validation

Data awal di split menjadi 2, yaitu data Train dan data Test.

Proporsi yang digunakan 80:20

set.seed(100)
splitted <- rsample::initial_split(data = scotty_clean2, prop = 0.8, strata = "coverage")

scotty_train <- rsample::training(splitted)
scotty_test <- rsample::testing(splitted)

cek proporsi label

scotty_train$coverage %>% 
  table() %>% 
  prop.table()

## .
## insufficient   sufficient 
##    0.5410468    0.4589532

Seperti yang ditunjukan pada heatmap, tiap area memiliki pola waktu dan hari untuk kejadian yang berbeda - beda, sehingga semua kolom (src_area, weekday, hour) akan digunakan untuk memprediksi coverage

head(scotty_train)

## # A tibble: 6 x 4
##   src_area weekday hour  coverage    
##   <fct>    <fct>   <fct> <fct>       
## 1 sxk3     Sunday  0     insufficient
## 2 sxk3     Sunday  3     insufficient
## 3 sxk3     Sunday  5     sufficient  
## 4 sxk3     Sunday  6     sufficient  
## 5 sxk3     Sunday  7     insufficient
## 6 sxk3     Sunday  8     insufficient

Data preprocessing diawal sudah cukup untuk mempersiap kan data untuk dimasukkan ke dalam model, dan karena proporsi label coverage sudah cukup seimbang, maka tidak perlu dilakukan upSample atau dowmSample.

4.2 Modelling

Algoritma yang akan digunakan adalah Random Forest, dalam menset parameter pada random forest akan digunakan library caret

set.seed(417)
ctrl3 <- trainControl(method = "repeatedcv", number = 3 , repeats = 3, savePredictions = "final", predictionBounds = rep(0.1 ,
   F),adaptive = list(min = 5, alpha = 0.1, method =
   "gls", complete = TRUE),classProbs = T)

#scotty_forest3 <- train(coverage ~ ., data=scotty_train, method="rf", trControl = ctrl3)
#saveRDS(scotty_forest3, file = "scotty_forest3.rds")
scotty_forest3 <- read_rds("scotty_forest3.rds")
scotty_forest3

## Random Forest 
## 
## 3630 samples
##    3 predictor
##    2 classes: 'insufficient', 'sufficient' 
## 
## No pre-processing
## Resampling: Cross-Validated (3 fold, repeated 3 times) 
## Summary of sample sizes: 2420, 2421, 2419, 2420, 2420, 2420, ... 
## Resampling results across tuning parameters:
## 
##   mtry  Accuracy   Kappa    
##    2    0.7887973  0.5690840
##   16    0.7677713  0.5305741
##   31    0.7596899  0.5131055
## 
## Accuracy was used to select the optimal model using the largest value.
## The final value used for the model was mtry = 2.

scotty_forest3$finalModel$confusion

##              insufficient sufficient class.error
## insufficient         1727        237   0.1206721
## sufficient            512       1154   0.3073229

4.3 Confussion Matrix

scotty_predict3 <- predict(scotty_forest3, scotty_test, type = "prob")
threshold <- 0.4
scotty_predict.prob3 <- factor(ifelse(scotty_predict3[,"sufficient"] > threshold, "sufficient", "insufficient") )
caret::confusionMatrix(scotty_predict.prob3, scotty_test$coverage)

## Confusion Matrix and Statistics
## 
##               Reference
## Prediction     insufficient sufficient
##   insufficient          418        105
##   sufficient             72        311
##                                               
##                Accuracy : 0.8046              
##                  95% CI : (0.7773, 0.83)      
##     No Information Rate : 0.5408              
##     P-Value [Acc > NIR] : < 0.0000000000000002
##                                               
##                   Kappa : 0.6043              
##                                               
##  Mcnemar's Test P-Value : 0.01616             
##                                               
##             Sensitivity : 0.8531              
##             Specificity : 0.7476              
##          Pos Pred Value : 0.7992              
##          Neg Pred Value : 0.8120              
##              Prevalence : 0.5408              
##          Detection Rate : 0.4614              
##    Detection Prevalence : 0.5773              
##       Balanced Accuracy : 0.8003              
##                                               
##        'Positive' Class : insufficient        
##

Berdasarkan data accuracy model pada Train (0.79) dan Test (0.80), dapat disimpulkan bahwa model tidak overfit.

Sensitivity (True Positive Rate) adalah metric yang menunjukan persentase data insufficient yang benar diklasifikasikan, sementara specificity (True Negative Rate) menunjukan data sufficient yang benar diklasifikasikan. Jika ingin menaikkan score sensitivity, maka secara otomatis score specificity juga akan turun, begitu juga sebaliknya.

Sensitivity juga biasa disebut dengan Recall, semakin tinggi nilai recall berarti model memprediksi lebih banyak nilai false positive, dalam hal kasus ini yaitu daerah, hari, dan waktu yang aslinya sufficient, namun diprediksi insufficient.

Prediction adalah metric yang menunjukan true positive dibagi true positive ditambah false positive. yang berarti jika nilai prediction semakin besar, maka model memprediksi banyak nilai true positive, dalam kasus ini yaitu daerah, hari, dan waktu yang aslinya insufficient, tepat diprediksi insufficient.

Semakin besar nilai Recall, maka nilai Prediction akan semakin kecil. Dengan menggunakan threshold 40%, didapatkan hasil Recall (85%) dan hasil Prediction (80%) terbaik

Pada kasus ini kita ingin mendapatkan hasil recall yang baik, karena kita mengharapkan dapat mempersiapkan tindak lanjut untuk mengatasi area, dan hari, dan jam dimana terjadi insufficient driver

5 Data Submission

5.1 Read Data

scotty_sub.rf <- read_csv("data/data-submission.csv")

5.2 Mutasi Kolom

scotty_sub.rf3 <- scotty_sub.rf %>% 
  mutate(src_area = as.factor(src_area),
         weekday = factor(weekdays(datetime),
                          levels = c("Sunday", 
                                     "Monday", "Tuesday", 
                                     "Wednesday", "Thursday", 
                                     "Friday", "Saturday")),
         hour = as.factor(hour(datetime))) %>% 
  select(src_area, weekday, hour, coverage)

5.3 Prediksi

scotty_sub.rfprob <-  predict(scotty_forest3, scotty_sub.rf3, type = "prob")
threshold <- 0.4
scotty_sub.rf$coverage <- factor(ifelse(scotty_sub.rfprob[,"sufficient"] > threshold, "sufficient", "insufficient") )

5.4 Save as .CSV

write.csv(scotty_sub.rf, file = "data_submissionrf12.csv", row.names = F)

Scotty Drivers Coverage Classification

Windaru

15/12/2019