FORECASTING TIME SERIES WITH MULTIPLE SEASONAL

Introduction

Hallo thinkers, kali ini kita akan mencoba memecahkan masalah FORECASTING TIME SERIES WITH MULTIPLE SEASONAL. Sebelumnya kita perlu mengetahui nih apa sih itu time series?

Data time series merupakan data yang diperoleh dari amatan satu objek dari beberapa periode waktu. Contohnya Data dari nilai tukar dolar terhadap rupiah, karena data nilai tukar dicatat setiap waktu (bisa harian atau bulanan atau tahunan) namun hanya satu nilai tukar saja yaitu dolar terhadap rupiah.

Analisis Time Series Time Series adalah suatu peramalan nilai-nilai masa depan yang didasarkan pada nilai-nilai masa lampau suatu variabel dan atau kesalahan masa lampau. Model time series biasanya lebih sering digunakan untuk suatu peramalan/prediksi.

Data

Pada kali ini kita akan mencoba melakukan analisis Time Series menggunakan data yang bersumbar dari : https://data.cityofchicago.org/Public-Safety/Crimes-2001-to-present/ijzp-q8t2). Dimana data tersebut menyajikan berbagai jenis kejahatan yang terjadi tiap detik. Mulai dari Perampokan, pencurian kendaraan, narkotika ,dll.

##Libraries

Library yang dibutuhkan ialah :

forecast untuk melakukan forecast atau peramalan

data.table untuk membaca data dalam jumlah besar, karena data yang digunakan sangat besar

dplyr untuk praproses data

MLmetrics untuk melakukan evaluasi model

lubridate untuk manipulasi data

Membaca Data

Membaca data .csv dengan functionfread

crime <- fread("LBB TS ILMA/Crimes_-_2001_to_present.csv")

## Warning in fread("LBB TS ILMA/Crimes_-_2001_to_present.csv"):
## Stopped early on line 846998. Expected 22 fields but found 15.
## Consider fill=TRUE and comment.char=. First discarded non-empty line:
## <<10477076,HZ216268,04/07/2016 01:00:00 AM,032XX W LAWRENCE AVE,
## 0460,BATTERY,SIMPLE,SIDEWALK,false,false,1713,017,39,14,08B{>>

str(crime)

## Classes 'data.table' and 'data.frame':   846996 obs. of  22 variables:
##  $ ID                  : int  11718445 11718423 11718364 11718476 11718619 11718392 11718384 11718368 11718398 11718393 ...
##  $ Case Number         : chr  "JC301146" "JC301185" "JC301127" "JC301140" ...
##  $ Date                : chr  "06/10/2019 11:55:00 PM" "06/10/2019 11:55:00 PM" "06/10/2019 11:55:00 PM" "06/10/2019 11:50:00 PM" ...
##  $ Block               : chr  "022XX S SAWYER AVE" "003XX N PINE AVE" "033XX S MICHIGAN AVE" "057XX S ABERDEEN ST" ...
##  $ IUCR                : chr  "0312" "0890" "2093" "0497" ...
##  $ Primary Type        : chr  "ROBBERY" "THEFT" "NARCOTICS" "BATTERY" ...
##  $ Description         : chr  "ARMED:KNIFE/CUTTING INSTRUMENT" "FROM BUILDING" "FOUND SUSPECT NARCOTICS" "AGGRAVATED DOMESTIC BATTERY: OTHER DANG WEAPON" ...
##  $ Location Description: chr  "STREET" "APARTMENT" "NURSING HOME/RETIREMENT HOME" "RESIDENCE" ...
##  $ Arrest              : logi  FALSE FALSE TRUE FALSE FALSE FALSE ...
##  $ Domestic            : logi  FALSE TRUE FALSE TRUE FALSE FALSE ...
##  $ Beat                : int  1024 1523 211 712 1531 532 631 431 1722 2232 ...
##  $ District            : int  10 15 2 7 15 5 6 4 17 22 ...
##  $ Ward                : int  12 37 3 16 37 9 6 7 39 34 ...
##  $ Community Area      : int  30 25 35 68 25 53 44 51 14 73 ...
##  $ FBI Code            : chr  "03" "06" "18" "04B" ...
##  $ X Coordinate        : int  NA NA NA NA NA NA NA NA NA NA ...
##  $ Y Coordinate        : int  NA NA NA NA NA NA NA NA NA NA ...
##  $ Year                : int  2019 2019 2019 2019 2019 2019 2019 2019 2019 2019 ...
##  $ Updated On          : chr  "06/17/2019 04:16:37 PM" "06/17/2019 04:16:37 PM" "06/17/2019 04:16:37 PM" "06/17/2019 04:16:37 PM" ...
##  $ Latitude            : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ Longitude           : num  NA NA NA NA NA NA NA NA NA NA ...
##  $ Location            : chr  "" "" "" "" ...
##  - attr(*, ".internal.selfref")=<externalptr>

rmarkdown::paged_table(crime)

Dibawah ini kita akan memilih 2 kolom saja yang akan digunakan untuk melakukan analisis Time Series yaitu kolom Date (waktu terjadi kejadian crime) dan Primary Type (jenis jenis crime)

crimea1 <- crime %>% 
  select(Date, `Primary Type`)
head(crimea1)

##                      Date        Primary Type
## 1: 06/10/2019 11:55:00 PM             ROBBERY
## 2: 06/10/2019 11:55:00 PM               THEFT
## 3: 06/10/2019 11:55:00 PM           NARCOTICS
## 4: 06/10/2019 11:50:00 PM             BATTERY
## 5: 06/10/2019 11:47:00 PM             ROBBERY
## 6: 06/10/2019 11:45:00 PM MOTOR VEHICLE THEFT

Dibawah ini dilakukan perubahan format date yang tadinya myd_hms (month, day, year-hours,minutes,second) menjadi hanya ymd (year, monthm day)

crimea2 <- crimea1 %>% 
  mutate(Date = mdy_hms(Date),
         Date = as.Date(Date))
head(crimea2)

##         Date        Primary Type
## 1 2019-06-10             ROBBERY
## 2 2019-06-10               THEFT
## 3 2019-06-10           NARCOTICS
## 4 2019-06-10             BATTERY
## 5 2019-06-10             ROBBERY
## 6 2019-06-10 MOTOR VEHICLE THEFT

Dibawah ini akan dilakukan perhitungan jumlah kejadian setiap jenis crime

crime_jumlah <- crimea2 %>% 
group_by(`Primary Type`) %>% 
  summarise(count = n()) %>% 
  ungroup()

Pada data frame di atas dapat dketahui bahwa Primary Type yang paling banyak terjadi adalah THEFT. Oleh karena itu saya ingin mencoba untuk memprediksi kejahatan dengan Primary Type THEFT

crime_theft <- crime %>% 
  filter(`Primary Type`=="THEFT") %>% 
  select(Date, `Primary Type`)
head(crime_theft)

##                     Date Primary Type
## 1 06/10/2019 11:55:00 PM        THEFT
## 2 06/10/2019 11:21:00 PM        THEFT
## 3 06/10/2019 11:15:00 PM        THEFT
## 4 06/10/2019 11:00:00 PM        THEFT
## 5 06/10/2019 11:00:00 PM        THEFT
## 6 06/10/2019 11:00:00 PM        THEFT

crime_theft<- crime_theft %>% 
  mutate(Date = mdy_hms(Date),
         Date = as.Date(Date)) %>% 
  group_by(Date) %>% 
  summarise(count = n()) %>% 
  ungroup() %>% 
  arrange(Date)
head(crime_theft)

## # A tibble: 6 x 2
##   Date       count
##   <date>     <int>
## 1 2016-04-07   146
## 2 2016-04-08   150
## 3 2016-04-09   160
## 4 2016-04-10   145
## 5 2016-04-11   136
## 6 2016-04-12   156

Melihat kapan tanggal kejadian crime jenis THEFT pertama kali dan terakhir kali dalam data

range(crime_theft$Date)

## [1] "2016-04-07" "2019-06-10"

Dibawah ini merupakan visualisasi data crime jenis THEFT dari tahun 2016 hingga 2019

library(ggplot2)
library(plotly)

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

plot1 <- ggplot(crime_theft, aes(Date, count)) + geom_line() + scale_x_date("Year")  + ylab("Theft") +xlab("")+labs(title = "Plot Timeseries THEFT")
ggplotly(plot1)

Membuat Object Time Series

theft_ts <- ts(crime_theft$count, start = range(crime_theft$Date)[1], frequency = 30)

#Melakukan Decompose

Fungsi dari Proses Decompose adalah menguraikan 3 komponen time series yaitu :

Seasonal : Data Musiman, data dengan pola berulang dengan periode tetap.

Trend : ada 2 jenis, cenderung naik atau cenderung turun

Error : Data yang di tangkap oleh trend atau seasonal (data yang tidak bisa dijelaskan)

decompose(theft_ts) %>% 
  autoplot()

Pada gambar di atas grafik trend belum Smooth artinya masih ada seasonal yang belum ditangkap. Sehingga dapat dikatakan data kita mengandung MULTIPLE SEASONAL

Sehingga perlu dibuat object time series lain yang mengandung 2 periode yaitu periode bulanan dan tahunan

theft_ts2 <- msts(crime_theft$count, start = range(crime_theft$Date)[[1]], seasonal.periods = c(30,30*12))

Melakukan decompose untuk object theft_ts2 dengan function mstl (The Multiple Seasonal Trend Decomposition using Loess)

mstl(theft_ts2) %>% 
  autoplot()

Dari grafik decompose menggunakan function mstl di atas dapat diketahui sifat data yang digunakan

SEASONAL, YES
TREND, YES
ADDITIVE, YES

Menguji Data STASIONER atau Tidak

Data Stasioner adalah data yang bergerak atau berfluktuasi di sekitar rata- rata. Di bawah ini merupakan uji untuk mengetahui data itu stasioner atau tidak.

library(tseries)
adf.test(theft_ts2)

## Warning in adf.test(theft_ts2): p-value smaller than printed p-value

## 
##  Augmented Dickey-Fuller Test
## 
## data:  theft_ts2
## Dickey-Fuller = -4.5442, Lag order = 10, p-value = 0.01
## alternative hypothesis: stationary

Hipotesis
H0 : Data tidak stasioner
H1 : Data stasioner

Daerah kritis

pvalue > alpha gagal tolak H0

Keputusan

pvalue (0.01) < alpha (0.05) –> Tolak H0

Kesimpulan

Dengan menggunakan tingkat kepercayaan sebesar 95 % didapatkan tolak H0, dapat dikatakan Data stasioner

Membagi data menjadi 2 bagian yaitu train dan test data.

Train data : digunakan untuk melatih model

Test data : digunakan untuk validasi model

train <- theft_ts2 %>% head(-360)
test <- theft_ts2 %>% tail(360)

MODEL

HOLT WINTER

HOLT WINTER adalah metode yang digunakan untuk mengatasi adanya pola trend dan seasonal (musiman) dari suatu data runtun waktu, sehingga data yang pada umumnya bersifat tidak stasioner bisa diramalkan menggunakan metode ini, dengan kesalahan yang kecil.

Ada jenis model Holt Winter, yaitu :

Additive : Digunakan apabila tidak ada kecenderungan pola musiman bergantung pada ukuran data.
Multiplicative : Digunakan apabila adanya kecenderungan pola musiman bergantung pada ukuran data.

Melakukan analisis Holt Winter

model_holtwinter <- HoltWinters(train)


MAPE(model_holtwinter$fitted[,1], train)

## [1] 0.0919559

Dari hasil model diatas nilai MAPE data train yang dimiliki model_holtwinter sebesar 9,20 %

FORECASTING HOLT WINTER

Setelah didapatkan model Holt Winter di atas, kali ini dilakukan forecasting / peramalan untuk 360 hari kedepan.

forecast_holtwinter <- forecast(model_holtwinter, h = 30*12)
  autoplot(forecast_holtwinter) +
  autolayer(test)

Model STLM (Seasonal and Trend decomposition using Loess Model)

model_stlm <- train %>% 
  stlm(method = "arima", lambda = 0)
MAPE(model_stlm$fitted, train)

## [1] 0.06613044

Forecasting model STLM

forecasting_stlm <- forecast(model_stlm, h = 30*12)
forecasting_stlm %>% 
  autoplot() +
  autolayer(test)

MODEL EVALUATION

Membandingakan model terbaik antara HOLT WINTER dan STLM dengan membandingkan nilai MAPE (Mean Absolute Percentage Error)

Mencari nilai MAPE model HOLT WINTER Data Test

MAPE_holtwinter <- MAPE(forecast_holtwinter$mean, test)

Mencari nilai MAPE model STLM Data Test

MAPE_stlm <- MAPE(forecasting_stlm$mean, test)

Dari kedua model di atas didapatkan MAPE untuk model :

Holt Winter sebesar 16.30%

sedangkan untuk model

STLM sebesar 13.97%

Jadi dapat disimpulkan Model terbaik dalam peramalan data CRIME jenis THEFT pada data ini menggunakan model STLM.

Assumptions Checking

Dalam model time series perlu dilakukan dua uji asumsi yaitu :

1. Uji Asumsi Normalitas Residual

Untuk melihat apakah residual data berdistribusi normal atau tidak. Harapannya residual data berdistribusi normal.

hist(model_stlm$residual, breaks = 100)

Uji hipotesis untuk Asumsui Normalitas Residual

ks.test(model_stlm$residual,"pnorm", mean(model_stlm$residual), sd(model_stlm$residual))

## 
##  One-sample Kolmogorov-Smirnov test
## 
## data:  model_stlm$residual
## D = 0.035439, p-value = 0.2675
## alternative hypothesis: two-sided

Hipotesis

H0 : Residual berdistribusi normal

H1 : Residual tidak berdistribusi normal

Daerah kritis :

pvalue > alpha gagal tolak H0

Keputusan

pvalue(1) > alpha (0.05) –> Gagal Tolak H0

Kesimpulan

Dengan menggunakan tingkat kepercayaan sebesar 95 % didapatkan keputusan gagal tolak H0, dapat dikatakan bahwa Residual Data berdistribusi normal stasioner.

2. UJI ASUMSI AUTOKORELASI atau WHITE NOISE

Berfungsi untuk melihat apakah Residual terdapat korelasi residual antar waktunya. Yang diharapkan ialah tidak terdapat korelasi residual antar waktunya.

Box.test(model_stlm$residuals, type = "Ljung-Box")

## 
##  Box-Ljung test
## 
## data:  model_stlm$residuals
## X-squared = 0.021262, df = 1, p-value = 0.8841

Hipotesis

H0 : Residual tidak terdapat Autokorelasi (Residual bersifat white noise)

H1 : Residual terdapat Autokorelasi (Residual tidak bersifat white noise)

Daerah kritis :

pvalue > alpha gagal tolak H0

Keputusan

pvalue(0.88) > alpha (0.05) –> Gagal Tolak H0

Kesimpulan

Dengan menggunakan tingkat kepercayaan sebesar 95 % didapatkan keputusan gagal tolak H0, dapat dikatakan bahwa Residual Tidak terdapat Autokorelasi.

FORECASTING TIME SERIES WITH MULTIPLE SEASONAL

Hafizah Ilma

26 Juni 2019

Introduction

Data

Membaca Data

Menguji Data STASIONER atau Tidak

Model STLM (Seasonal and Trend decomposition using Loess Model)