Library

library(dplyr)
library(data.table)
library(lubridate)

Eksplorasi Data

Terdapat data pengiriman dalam satu minggu weekday dari tanggal 11-Dec-2017 hingga 15-Dec-2017. Data tersebut dapat kita input dengan cara di bawah ini :

ship_data <- fread("input_data/datasample.csv")
glimpse(ship_data)
## Observations: 999,933
## Variables: 2
## $ to_address   <chr> "JL. RAYA PASIR PUTIH NO. 6 RT 05/RW 03 (DEPAN TO...
## $ booking_date <chr> "15-12-17", "15-12-17", "15-12-17", "15-12-17", "...

Kita mendapatkan sejumlah hampir satu juta row data shipment untuk rentang waktu satu minggu itu. Di dalam data tersebut terdapat dua feature, yaitu to_address yang berarti alamat tujuan pengiriman dan booking_date yang berarti tanggal pengiriman dilakukan.

Dari summary di atas, kita dapat melihat bahwa booking_date masih bertipe karakter, oleh karena itu mari kita rubah menjadi bertipe tanggal/date.

ship_data <- ship_data %>% 
  mutate_at(vars(booking_date),dmy)

glimpse(ship_data)
## Observations: 999,933
## Variables: 2
## $ to_address   <chr> "JL. RAYA PASIR PUTIH NO. 6 RT 05/RW 03 (DEPAN TO...
## $ booking_date <date> 2017-12-15, 2017-12-15, 2017-12-15, 2017-12-15, ...
distinct(ship_data,booking_date)
##   booking_date
## 1   2017-12-15
## 2   2017-12-14
## 3   2017-12-13
## 4   2017-12-12
## 5   2017-12-11

Kolom yang berisi data tanggal telah berhasil kita rubah ke tipe date dengan tanggal pengiriman berkisar dari 11-15 Dec 2017.

Dari sini dapat kita asumsikan bahwa pengiriman hanya aktif selama weekday dan tidak ada pengiriman saat weekend (Sabtu / Minggu).

Selanjutnya apakah terdapat data na / nan. Mari kita cek :

sum(is.na(ship_data$to_address))
## [1] 0
sum(is.na(ship_data$booking_date))
## [1] 0

Tidak terdapat data na / nan. Bagaimana kalau data yang hanya berisi space (tidak terbaca sebagai na).

head(ship_data[ship_data$to_address == "",])
##    to_address booking_date
## 39              2017-12-15
## 63              2017-12-15
## 80              2017-12-15
## 84              2017-12-15
## 86              2017-12-15
## 88              2017-12-15
tail(ship_data[ship_data$to_address == "",])
##        to_address booking_date
## 998693              2017-12-11
## 998725              2017-12-11
## 998755              2017-12-11
## 999262              2017-12-11
## 999304              2017-12-11
## 999853              2017-12-11
count(ship_data[ship_data$to_address == "",])
## # A tibble: 1 x 1
##       n
##   <int>
## 1  6199

Terdapat 6199 data yang tidak memiliki alamat tujuan pengiriman meskipun terdapat tanggal pengiriman. Kita bisa memberi flag data tersebut atau bisa kita hilangkan saja. Karena kita punya hampir satu juta sampel dan saya tidak dapat menggali info tambahan mengenai data tersebut maka untuk analisis ini data tersebut akan kita hilangkan saja karena pengaruhnya yang kurang signifikan.

ship_data_cln <- ship_data[ship_data$to_address != "",]
count(ship_data_cln[ship_data_cln$to_address == "",])
## # A tibble: 1 x 1
##       n
##   <int>
## 1     0

Seandainya selain alamat ada feature lain yang mengindikasikan regional tiap alamat (ex : provinsi/kotamadya/kabupaten) kita bisa melakukan eksplorasi di daerah mana pengiriman banyak dilakukan. Memang dalam alamat ada beberapa yang mencirikan regional tersebut, tetapi bisa jadi terlalu banyak variasi yang akan cukup sulit untuk melakukan extraksi tiap-tiap regional tersebut dari hampir satu juta data.

Oleh karena itu untuk tahap ini, yang akan kita lakukan hanya melihat jumlah pengiriman di tiap harinya.

ship_pre_ml <- ship_data_cln %>% 
  group_by(booking_date) %>% 
  summarise(Amount = n())

ship_pre_ml
## # A tibble: 5 x 2
##   booking_date Amount
##   <date>        <int>
## 1 2017-12-11   329917
## 2 2017-12-12   379839
## 3 2017-12-13   248022
## 4 2017-12-14    35633
## 5 2017-12-15      323
summary(ship_pre_ml)
##   booking_date            Amount      
##  Min.   :2017-12-11   Min.   :   323  
##  1st Qu.:2017-12-12   1st Qu.: 35633  
##  Median :2017-12-13   Median :248022  
##  Mean   :2017-12-13   Mean   :198747  
##  3rd Qu.:2017-12-14   3rd Qu.:329917  
##  Max.   :2017-12-15   Max.   :379839
plot(ship_pre_ml$booking_date,ship_pre_ml$Amount,
     main = "Jumlah Kiriman Selama Week Day 11-15 Des 2017",
     xlab = "Hari",
     ylab = "Jumlah Kiriman",
     type = "l")

Dapat kita lihat bahwa tingkat pengiriman sangat tinggi di awal week day hingga pertengahan weekday akan tetapi memasuki kamis hingga jumat tingkat pengiriman menurun drastis sekali. Bisa jadi hal ini disebabkan order yang diterima di akhir minggu akan ditampung terlebih dahulu dan tidak ada aktifitas pengiriman selama weekend, oleh karena itu ketika mulai memasuki weekday tingkat pengiriman meningkat drastis.

Lalu metode machine learning apa yang dapat kita coba terapkan untuk menggambarkan Pola di atas ?

Dengan anggapan tren pengiriman tiap minggu akan seperti di atas, kita dapat coba membuat model regresi linear dari data tersebut.

Machine Learning (Linear Regression)

Dengan data yang sudah kita proses sebelumnya kita dapat menganggap jumlah kiriman sebagi dependent variable dan hari dalam weekday menjadi feature independent variablenya.

Sebelum melakukan pemodelan, saya akan merubah bentuk tanggal tersebut ke dalam nilai numerik : Senin ~ 1 Selasa ~ 2 Rabu ~ 3 Kamis ~ 4 Jumat ~ 5

ship_ml <- ship_pre_ml %>% 
  mutate(
    DayNo = case_when(
      ship_pre_ml$booking_date == "2017-12-11" ~ 1,
      ship_pre_ml$booking_date == "2017-12-12" ~ 2,
      ship_pre_ml$booking_date == "2017-12-13" ~ 3,
      ship_pre_ml$booking_date == "2017-12-14" ~ 4,
      ship_pre_ml$booking_date == "2017-12-15" ~ 5,
      TRUE ~ NaN
    )
  ) 

summary(ship_ml)
##   booking_date            Amount           DayNo  
##  Min.   :2017-12-11   Min.   :   323   Min.   :1  
##  1st Qu.:2017-12-12   1st Qu.: 35633   1st Qu.:2  
##  Median :2017-12-13   Median :248022   Median :3  
##  Mean   :2017-12-13   Mean   :198747   Mean   :3  
##  3rd Qu.:2017-12-14   3rd Qu.:329917   3rd Qu.:4  
##  Max.   :2017-12-15   Max.   :379839   Max.   :5
ship_lrm <- lm(Amount~DayNo,ship_ml)
summary(ship_lrm)
## 
## Call:
## lm(formula = Amount ~ DayNo, data = ship_ml)
## 
## Residuals:
##      1      2      3      4      5 
## -69509  80753  49275 -62774   2255 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)   
## (Intercept)   499765      80620   6.199  0.00846 **
## DayNo        -100339      24308  -4.128  0.02579 * 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 76870 on 3 degrees of freedom
## Multiple R-squared:  0.8503, Adjusted R-squared:  0.8004 
## F-statistic: 17.04 on 1 and 3 DF,  p-value: 0.02579

Dari model tersebut didapatkan nilai Rsquared yang cukup tinggi yaitu 0.8503. Kita dapat melihat DayNo memiliki koefisien senilai -100339, artinya penambahan satu hari weekday akan menurunkan tingkat pengiriman sejumlah 100339.

conf_interval <- predict(ship_lrm, data.frame(DayNo=ship_ml$DayNo),interval = "confidence", level = 0.90)
conf_interval
##        fit          lwr      upr
## 1 399425.6  259301.7647 539549.4
## 2 299086.2  200003.6859 398168.7
## 3 198746.8  117846.2660 279647.3
## 4  98407.4    -675.1141 197489.9
## 5  -1932.0 -142055.8353 138191.8
plot(ship_ml$DayNo,ship_ml$Amount,
     main = "Jumlah Kiriman Selama Week Day Prediksi Machine Learning",
     xlab = "Hari",
     ylab = "Jumlah Kiriman",
     type = "l")
abline(499765, -100339, col="blue")
matlines(ship_ml$DayNo, conf_interval[,2:3], col = "red", lty=2)

Dari prediksi machine learning dengan plot confidence intervalnya yang sebesar 90 persen, kita dapat memperkirakan jumlah pengiriman yang dilakukan setiap minggunya. Dikarenakan linear regression merupakan sebuah fungsi garis lurus ada suatu waktu tebakan pengiriman berupa negatif, karena secara kenyataan tidak ada pengiriman negatif, nilai negatif ini dapat diartikan sama sekali tidak ada pengiriman atau nol.

Dari confidence sebesar 90 persen kita dapat melihat adanya kemungkinan pengiriman terbesar mencapai 540 ribuan pengiriman di hari pertama atau awal weekday dan pada akhir weekday (jumat) diperkirakan kemungkinan pengiriman bisa mencapai 138 ribuan pengiriman.