library(dplyr)
library(lubridate)
library(ggplot2)
library(padr)
library(tidyr)
library(GGally)
library(prophet)
library(plotly)
library(tidyverse)
library(zoo)
library(MLmetrics)
library(paletti)
library(glue)
library(gridExtra)
library(scales)
# Kustomisasi Tema Visualisasi
# Kustomisasi Warna dan Visualisasi chart
my_color <- c(
col1="#fcf800",
col2="#fce700",
col3="#fcdb03",
col4="#e3c502",
col5="#fcbe03",
col6="#fc9d03",
col7="#fc5d00"
)
my_theme_fill <- get_scale_fill(get_pal(my_color))
my_theme_color <- get_scale_color(get_pal(my_color))
my_theme_hex <- get_hex(my_color)
color_dark_text = "#222629"
# MY PLOT THEME
my_plot_theme <- function (base_size, base_family="Segoe UI Semibold"){
dark_color="#222629"
facet_header = "#78767647"
dark_text = "#222629"
half_line <- base_size/2
theme_algoritma <- theme(
plot.background = element_rect(fill= "#faf6e3", colour = "#faf6e3"), #background plot
plot.title = element_text(size = rel(1.5), margin = margin(b = half_line * 1.2),
color= dark_text, hjust = 0, family=base_family, face = "bold"),
plot.subtitle = element_text(size = rel(1.0), margin = margin(b = half_line * 1.2), color= dark_text, hjust=0),
plot.margin=unit(c(0.5,0.5,0.5,0.5),"cm"),
#plot.margin=unit(c(0.5,r=5,1,0.5),"cm"),
panel.background = element_rect(fill="#18181800",colour = "#e8e8e8"), #background chart
panel.border = element_rect(fill=NA,color = NA),
panel.grid.minor.x = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_line(color="#e8e8e8", linetype=2),
panel.grid.minor.y = element_blank(),
#panel.margin = unit(0.8*half_line, "mm"),
panel.margin.x = NULL,
panel.margin.y = NULL,
panel.ontop = FALSE,
panel.spacing = unit(1.2,"lines"),
legend.background = element_rect(fill="#18181800",colour = NA),
legend.text = element_text(size = rel(0.7),color=dark_text),
legend.title = element_text(colour = dark_text, size = base_size, lineheight = 0.8),
legend.box = NULL,
# text = element_text(colour = "white", size = base_size, lineheight = 0.9,
# angle = 0, margin = margin(), debug = FALSE),
axis.text = element_text(size = rel(0.8), color=dark_text),
axis.text.x = element_text(colour = dark_text, size = base_size, margin = margin(t = 0.8 * half_line/2)),
axis.text.y = element_text(colour = dark_text, size = base_size, margin = margin(r = 0.8 * half_line/2)),
axis.title.x = element_text(colour = dark_text, size = base_size, lineheight = 0.8,
margin = margin(t = 0.8 * half_line, b = 0.8 * half_line/2)),
axis.title.y = element_text(colour = dark_text, size = base_size, lineheight = 0.8,
angle = 90, margin = margin(r = 0.8 * half_line, l = 0.8 * half_line/2)),
axis.ticks = element_blank(),
strip.background = element_rect(fill=facet_header,colour = NA),
strip.text = element_text(colour = dark_text, size = rel(0.8)),
strip.text.x = element_text(margin = margin(t = half_line*0.8, b = half_line*0.8)),
strip.text.y = element_text(angle = -90, margin = margin(l = half_line, r = half_line)),
strip.switch.pad.grid = unit(0.1, "cm"),
strip.switch.pad.wrap = unit(0.1, "cm"),
complete = TRUE
)
}
Projek ini merupakan implementasi dari proposal E-Commerce Optimization Strategies yang sebelumnya telah dibuat. Proposal tersebut berisi tentang latar belakang projek hingga tujuan maupun luaran dari projek ini. Adapun projek ini terbagi menjadi beberapa bagian, yakni:
Personalized Product Recommendation
Pada bagian ini, kita akan berfokus pada Demand Forecasting. Alangkah baiknya pembaca untuk membaca secara berurutan dari proposal hingga bagian terakhir, sehingga dapat memahami dengan sempurna.
Forecasting atau Peramalan merujuk pada proses memprediksi peristiwa atau kondisi di masa depan. Berbicara tengtang peramalan, kita tidak merujuk pada ramalan dari para peramal atau tanda kutip “Dukun”, ramalan bintang dan sebagainya. Kita membahas terkait peramalan yang dilakukan berdasarkan data historis dan tren yang ada. Tujuan utama dari peramalan adalah untuk membantu individu atau organisasi dalam membuat keputusan yang lebih baik dan merencanakan langkah-langkah di masa depan.
Proses peramalan sering kali melibatkan analisis data historis untuk mengidentifikasi pola, tren, dan pola musiman yang dapat memberikan wawasan tentang bagaimana peristiwa atau variabel tertentu dapat berkembang di masa depan. Metode peramalan yang berbeda dapat digunakan tergantung pada jenis data yang tersedia dan jenis peristiwa yang diprediksi.
Metode peramalan dapat menjadi alat yang sangat berguna bagi organisasi dalam perencanaan strategis, manajemen rantai pasokan, pengelolaan persediaan, dan pengambilan keputusan yang lebih baik secara umum. Dengan menggunakan teknik peramalan yang tepat, organisasi dapat mengurangi ketidakpastian dan mengoptimalkan rencana bisnis mereka untuk mencapai kinerja yang lebih baik.
Peramalan permintaan (demand forecasting) adalah proses memperkirakan atau meramalkan jumlah produk atau layanan yang akan diminta oleh pelanggan di pasar pada masa mendatang. Tujuan peramalan permintaan adalah untuk membantu perusahaan atau organisasi dalam perencanaan produksi, manajemen persediaan, pengelolaan rantai pasokan, penentuan harga, dan strategi pemasaran. Dengan meramalkan permintaan dengan akurat, perusahaan dapat mengoptimalkan produksi dan persediaan mereka, menghindari kelebihan atau kekurangan persediaan, serta memastikan kepuasan pelanggan yang lebih baik. Hal ini juga dapat membantu dalam pengembangan strategi pemasaran yang lebih efektif dan penentuan harga yang tepat.
Prophet merupakan perangkat lunak (software) untuk peramalan (forecasting) yang dikembangkan oleh Facebook. Meskipun Prophet menggunakan teknik machine learning (ML) di balik proses peramalan, ia lebih tepatnya dianggap sebagai perangkat lunak daripada algoritma machine learning itu sendiri. Ini karena Prophet merupakan paket perangkat lunak atau perpustakaan Python yang menyediakan kerangka kerja untuk peramalan time series, terutama untuk peramalan dengan skala kecil hingga menengah.
Prophet memanfaatkan beberapa teknik statistik dan machine learning, seperti model regresi yang menggabungkan aspek linier dan non-linier, namun tidak secara eksplisit mengimplementasikan model-model ML yang kompleks seperti neural networks atau algoritma deep learning. Lebih tepatnya, Prophet menggunakan model penyesuaian yang dikembangkan secara khusus untuk peramalan time series dengan karakteristik tertentu, seperti efek musiman dan tren non-linier.
Beberapa fitur utama dari Prophet adalah:
Penyesuaian Otomatis: Prophet dapat secara otomatis menyesuaikan tren musiman, efek liburan, dan perubahan non-linier lainnya dalam data time series.
Penanganan Outlier yang Baik: Prophet memiliki kemampuan yang baik dalam menangani pencilan atau outlier yang sering muncul dalam data time series.
Skalabilitas yang Baik: Meskipun cocok untuk peramalan dengan skala kecil hingga menengah, Prophet dapat dengan mudah diperluas untuk menangani peramalan dengan skala yang lebih besar.
Fleksibilitas dalam Penyesuaian: Pengguna dapat menyesuaikan beberapa parameter model dan mengontrol bagaimana Prophet menyesuaikan tren dan efek lainnya dalam data.
Why Choose Prophet?
Prophet merupakan pilihan yang menguntungkan dalam demand forecasting untuk penjualan di e-commerce. Dengan fitur penyesuaian otomatis dan kemampuan yang baik dalam menangani outlier, Prophet dapat membantu menghasilkan peramalan yang lebih akurat untuk permintaan produk di e-commerce. Selain itu, model Prophet dapat dilakukan berbagai hyperparameter tuning untuk mengoptimasi akurasi hasil peramalan.
How to Use Prophet in R?
Library Prophet telah tersedia untuk bahasa R. Kita dapat melakukan instalasi dan langsung mengaplikasikan pada data time series yang kita pilih.
Mari kita panggil dataset yang telah kita lakukan cleaning pada tahap EDA & Data Preparation. Kemudian, kita akan lanjutkan feature selection.
data <- readRDS("data_clean.RDS")
data_ts <- data %>%
select(Date_of_Order, Category, SKU, Quantity)
data_ts
Mari kita coba lakukan eksplorasi kembali sebelum kita mulai melakukan peramalan.
quant_per_cat <- data_ts %>% group_by(Category) %>%
summarise(amount = sum(Quantity)) %>%
ggplot(aes(x = amount, y = reorder(Category, amount), fill = amount)) +
geom_col(aes(text = glue("Kategori: {Category}
Total Produk Terjual: {amount}"))) +
labs(title = "Total Pembelian Produk oleh Pelanggan pada Setiap Kategori Merchants",
y = NULL,
x = "Total Produk") +
scale_fill_gradient(low = my_color["col1"], high = my_color["col7"]) +
my_plot_theme(10)+
theme(legend.position = "none",
plot.title = element_text(size = rel(1.5), margin = margin(b = 10/2 * 1.2),
color= "#222629", hjust = 1, family = "Segoe UI Semibold",
face = "bold"))
ggplotly(quant_per_cat, tooltip = "text")
Kita ketahui bersama bahwa category Mobiles & Tablets menjadi yang paling banyak melakukan penjualan. Sedangkan Books menjadi kategori yang paling sedikit melakukan penjualan. Disini penjualan yang kita maksud ialah total jumlah barang yang terjual. Cukup menarik, dimana kategori yang berhubungan dengan fashion, Men’s Fashion & Women’s Fashion, masuk ke dalam peringkat lima besar.
Selanjutnya, mari kita coba lihat kebiasaan belanja pelanggan di e-commerce pakistan ini.
df_wday_habbit <- data %>%
select(Invoice_ID, Date_of_Order) %>%
distinct() %>%
mutate(month = month(Date_of_Order),
wday = wday(Date_of_Order,
week_start = getOption("lubridate.week.start", 1))) %>%
group_by(month, wday) %>%
summarise(total = n()) %>%
ungroup() %>%
group_by(wday) %>%
summarise(avg_wday_trans = as.integer(mean(total))) %>%
ungroup()
manual_weekly <- df_wday_habbit %>%
ggplot(aes(wday, avg_wday_trans))+
geom_bar(width=1, stat="identity", show.legend = FALSE, aes(fill=avg_wday_trans))+
labs(
title = "Daily Order Habbit",
x = "Day",
y = NULL)+
scale_x_continuous(breaks = c(1,2,3,4,5,6,7),
labels = c("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"))+
theme_minimal()+
theme(axis.title = element_blank(),
legend.position = "none",
plot.title = element_text(hjust = 0.5,size=12, face="bold"),
plot.subtitle = element_text(hjust = 0.5,size=10),
axis.text.y = element_blank(),
axis.text.x=element_text(size=11, face="bold"))+
scale_fill_gradient(low=my_theme_hex("col1") ,na.value = "#C0C0C0", high=my_theme_hex("col7"))+
coord_polar()
df_monthly_habbit <- data %>% select(Invoice_ID, Date_of_Order) %>%
distinct() %>%
mutate(month = month(Date_of_Order),
day = day(Date_of_Order)) %>%
group_by(month, day) %>%
summarise(total = n()) %>%
ungroup() %>%
group_by(day) %>%
summarise(avg_day_trans = as.integer(mean(total))) %>%
ungroup()
manual_monthly <- df_monthly_habbit %>%
ggplot(aes(x = as.factor(day),y= avg_day_trans))+
geom_bar(width=1, stat="identity", show.legend = FALSE, aes(fill=avg_day_trans))+
labs(
title = "Monthly Order Habbit",
x = "Date",
y = NULL)+
theme_minimal()+
theme(axis.title = element_blank(),
legend.position = "none",
plot.title = element_text(hjust = 0.5,size=12, face="bold"),
plot.subtitle = element_text(hjust = 0.5,size=10),
axis.text.y = element_blank(),
axis.text.x=element_text(size=11, face="bold"))+
scale_fill_gradient(low=my_theme_hex("col1") ,na.value = "#C0C0C0", high=my_theme_hex("col7"))+
coord_polar()
df_yearly_habbit <- data %>%
select(Invoice_ID, Date_of_Order) %>%
distinct() %>%
mutate(year=year(Date_of_Order),
month = month(Date_of_Order, label = T, abbr = TRUE)) %>%
group_by(year,month) %>%
summarise(total = n()) %>%
ungroup() %>%
group_by(month) %>%
summarise(avg_month_trans = as.integer(mean(total))) %>%
ungroup()
manual_yearly <- df_yearly_habbit %>%
ggplot(aes(month, avg_month_trans))+
geom_bar(width=1, stat="identity", show.legend = FALSE, aes(fill=avg_month_trans))+
labs(
title = "Yearly Order Habbit",
x = "Month",
y = NULL)+
# scale_x_continuous(breaks = c(1,2,3,4,5,6,7),
# labels = c("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"))+
theme_minimal()+
theme(axis.title = element_blank(),
legend.position = "none",
plot.title = element_text(hjust = 0.5,size=12, face="bold"),
plot.subtitle = element_text(hjust = 0.5,size=10),
axis.text.y = element_blank(),
axis.text.x=element_text(size=11, face="bold"))+
scale_fill_gradient(low=my_theme_hex("col1") ,na.value = "#C0C0C0", high=my_theme_hex("col7"))+
coord_polar()
gridExtra::grid.arrange(manual_weekly, manual_monthly, manual_yearly, ncol = 3)
Pelanggan pada e-commerce Pakistan ini, cenderung menyukai belanja pada hari jumat. Hari jumat sering menjadi bagian hari libur mingguan pada negara-negara mayoritas muslim. Keadaan itu yang memungkinan mendorong budaya hari belanja mingguan di negara Pakistan ini.
Dalam satu bulan, pelanggan e-commerce Pakistan cenderung melakukan belanja direntang tanggal 17-27. Permintaan pada tanggal-tenggal tersebut meningkat. Adapaun dalam satu tahun, bulan November menjadi primadona terjadinya transaksi dengan penjualan yang paling tinggi.
Demand forecasting pada e-commerce Pakistan ini, kita akan melakukannya terhadap tiap kategori merchant. Demand forecasting tidak dapat dilakukan terhadap tiap jenis produk yang mana diwakilkan oleh kolom SKU
, karena data penjualan tiap jenis produk tidak bersifat time series. Maksudnya, dalam periode dua tahun ini terdapat produk yang hanya satu kali pembelian saja, kemudian jika pada kategori yang paling banyak peminatnya, misal Mobiles & Tablets
, telah terdapat perubahan dan pembaruan series di tiap beberapa bulan, Sehingga, kurang relevan jika kita melakukan demand forecasting terhadap tiap jenis produk.
Mari kita coba lihat salah satu jenis produk di kategori merchant Books
dan Mobiles & Tablets
yang paling banyak penjualannya.
top_books <- data_ts %>% filter(Category == "Books") %>%
group_by(SKU) %>% summarise(Sales = n()) %>%
arrange(-Sales) %>% head(1) %>% as.character()
data_ts %>% filter(Category == "Books", SKU == top_books) %>%
pad(start_val = ymd("2016-07-01"),end_val = ymd("2018-08-28")) %>%
group_by(Date_of_Order) %>% summarise(Tot_Order = sum(Quantity)) %>%
mutate(Tot_Order = ifelse(is.na(Tot_Order), 0, Tot_Order)) %>%
ggplot(aes(x = Date_of_Order, y = Tot_Order)) +
geom_line(color = my_color["col5"]) +
labs(title = "Top Product Demand In Books Category",
subtitle = "March 2016 - August 2018",
caption = glue("top product: {top_books[1]}, tot. sales: {top_books[2]} item"),
x = NULL,
y = "Amount Sales") +
my_plot_theme(10)
top_mobtab <- data_ts %>% filter(Category == "Mobiles & Tablets") %>%
group_by(SKU) %>% summarise(Sales = n()) %>%
arrange(-Sales) %>% head(1) %>% as.character()
data_ts %>% filter(Category == "Mobiles & Tablets", SKU == top_mobtab) %>%
pad(start_val = ymd("2016-07-01"),end_val = ymd("2018-08-28")) %>%
group_by(Date_of_Order) %>% summarise(Tot_Order = sum(Quantity)) %>%
mutate(Tot_Order = ifelse(is.na(Tot_Order), 0, Tot_Order)) %>%
ggplot(aes(x = Date_of_Order, y = Tot_Order)) +
geom_line(color = my_color["col5"]) +
labs(title = "Top Product Demand In Mobiles & Tablets Category",
subtitle = "March 2016 - August 2018",
caption = glue("top product: {top_mobtab[1]}, tot. sales: {top_mobtab[2]} item"),
x = NULL,
y = "Amount Sales") +
my_plot_theme(10)
Sebagimana pejelasan sebelumnya, dapat kita lihat bersama bahwa penjualan jenis produk tertentu, meskipun produk yang paling banyak peminatnya, itu hanya ada pada rentang periode tertentu. Hal itu dikarenakan produk sudah terdapat pembaharuan. Sehingga, pelanggan akan membeli barang dengan spesifikasi yang terbaru.
Selanjutnya, sebelum kita melakukan demand forecasting pada tiap masing-masing kategori merchant, mari kita coba melakukan demand forecasting pada salah satu kategori terlebih dahulu. Kita akan coba mengevaluasi hasil pemodelan dengan model Prophet ini sebelum benar-benar mengaplikasikannya. Kita juga akan mencoba beberapa parameter tuning pada model Prophet kita untuk mengoptimalkan akurasi. Bilamana memang hasil Prophert memiliki eror yang besar, maka kita harus mempertimbangkan penggantian pembuatan model dengan algoritma forecasting yang lainnya.
Kita tidak mencoba membandingkan berbagai algoritma machine learning forecasting, namun kita mengevaluasi hasil Prophet lebih dulu. Pertimbangannya, kemudahan atau user-friendly dari model Prophet ini. Selain itu, cukup mudah untuk melakukan berbagai parameter tuning serta memiliki hasil akurasi yang baik.
Kita akan memilih kategori merchant dengan tingkat penjualan paling tinggi yakni Mobiles & Tabelts untuk mengevaluasi hasil pemodelan Prophet ini.
# Membuat dataframe untuk kategori Mobiles & Tablets
df_mobtab <- data_ts %>%
filter(Category == "Mobiles & Tablets") %>%
pad() %>%
group_by(Date_of_Order) %>%
summarise(Tot_Order = sum(Quantity)) %>%
rename("ds" = "Date_of_Order", "y" = "Tot_Order")
df_mobtab
Setelah kita mendapatkan jumlah penjualan item setiap harinya dari kategori merchant Mobiles & Tablets, kita akan membuat model Prophet tanpa tuning. Sebelumnya, kolom y
merepresentasikan jumlan item yang terjual dan kolom ds
merepresentasikan tanggal.
#> Length Class Mode
#> growth 1 -none- character
#> changepoints 25 POSIXct numeric
#> n.changepoints 1 -none- numeric
#> changepoint.range 1 -none- numeric
#> yearly.seasonality 1 -none- character
#> weekly.seasonality 1 -none- character
#> daily.seasonality 1 -none- character
#> holidays 0 -none- NULL
#> seasonality.mode 1 -none- character
#> seasonality.prior.scale 1 -none- numeric
#> changepoint.prior.scale 1 -none- numeric
#> holidays.prior.scale 1 -none- numeric
#> mcmc.samples 1 -none- numeric
#> interval.width 1 -none- numeric
#> uncertainty.samples 1 -none- numeric
#> specified.changepoints 1 -none- logical
#> start 1 POSIXct numeric
#> y.scale 1 -none- numeric
#> logistic.floor 1 -none- logical
#> t.scale 1 -none- numeric
#> changepoints.t 25 -none- numeric
#> seasonalities 2 -none- list
#> extra_regressors 0 -none- list
#> country_holidays 0 -none- NULL
#> stan.fit 4 -none- list
#> params 6 -none- list
#> history 5 tbl_df list
#> history.dates 789 POSIXct numeric
#> train.holiday.names 0 -none- NULL
#> train.component.cols 4 data.frame list
#> component.modes 2 -none- list
#> fit.kwargs 0 -none- list
Berdasarkan summary model Prophet dari data kategori merchant Moblies & Tablets, kita ketahui bersama bahwa data kita memiliki dua seasonality dan model tidak terdapat parameter tuning hari libur.
Model Evaluation in Prophet
Setelah kita membuat model, kita juga akan melakukan evaluasi dari model kita. Pada library Prophet telah disediakan mekanisme cross-validation
yang komprehensif. Fungsionalitas time series cross-validation yang disertakan dalam Prophet digunakan untuk mengukur kesalahan ramalan dengan menggunakan data historis. Hal ini dilakukan dengan memilih titik pemotongan dalam data historis, dan untuk masing-masing dari titik tersebut, model akan disesuaikan menggunakan data hanya sampai titik pemotongan tersebut. Kemudian, kita dapat membandingkan nilai ramalan dengan nilai aktual.
Agar dapat menggambarkan dengan baik terkait algoritma Cross-Validation dari model prophet ini, saya menyediakan gambar dibawah ini.
Okey, mari kita lakukan cross-validation pada model Prophet untuk kategori merchant Moblies & Tablets dengan horizon 180 hari atau setengah tahun.
cv_mobtab <- cross_validation(
model = mod_mobtab,
initial = 365,
period = 30,
horizon = 180,
units = "days"
)
pm_mobtab <- performance_metrics(df = cv_mobtab, rolling_window = 1)
pm_mobtab
Berdasarkan nilai Mean Absolute Percentage Error (MAPE), model kita memiliki akurasi yang sangat akurat dalam memprediksi karena persentase nilai rata-rata absolut eror hanya 2,01%. Kita juga dapat meninjau akurasi data kita dengan melihat nilai RMSE. Kita akan menormalisasi nilai RMSE dengan data maksimum dan minimum (range data) agar merepresentasikan akurasi dari model kita. Semakin mendekati nial 0, maka RMSE dari model kita rendah dan memiliki akurasi yang baik.
Kita tidak dapat memaknai dengan baik RMSE secara langsung jika tidak terdapat pembanding. Pada umumnya, RMSE digunakan dengan cara membandingkan berbagai model untuk menentukan model yang baik. Semakin kecil nilai RMSE, maka model semakin baik. Adapun jika kita memaknai secara langsung, maka semakin RMSE itu mendekati 0 berarti model semakin baik. Akan tetapi nilai RMSE sangat bias dengan range dari data. Rentang nilai RMSE ialah 0 - inf tergantung dengan range data. Oleh karena itu, agar kita dapat menilai apakah model memiliki nilai RMSE yang rendah atau akurasinya baik adalah dengan melakukan normalisasi.
#> [1] "norm_RMSE: 0.08"
Model kita memiliki nilai RMSE yang rendah atau akurasi yang baik. Selanjutnya, mari kita lakukan prediksi terhadap 180 hari setelah agustus 2018 atau periode maksimal data kita.
future <- make_future_dataframe(mod_mobtab, periods = 180)
fc_mobtab <- predict(mod_mobtab, future)
plot_fc_mobtab <- fc_mobtab %>%
filter(ds <= max(df_mobtab$ds)) %>%
ggplot(aes(x = ds, y = yhat)) +
geom_point(data = df_mobtab,
aes(x = as.POSIXct.Date(ds), y = y,
text = glue("Actual Data
Date: {ds}
Demand: {y}")),
color = "grey",
alpha = 0.5) +
geom_line(color = my_color["col4"]) +
geom_line(aes(text = glue("Model Fitted
Date: {ds}
Demand: {round(yhat, 0)}")),
color = my_color["col4"]) +
geom_ribbon(aes(ymax = yhat_upper,
ymin = yhat_lower,
fill = my_color["col2"],
text = NULL),
alpha = 0.2)+
geom_line(data = fc_mobtab %>% filter(ds >= max(df_mobtab$ds)),
aes(x = ds, y = yhat),
color = my_color["col7"]) +
geom_line(data = fc_mobtab %>% filter(ds >= max(df_mobtab$ds)),
aes(x = ds, y = yhat,
text = glue("Predicted Demand
Date: {ds}
Demand: {round(yhat, 0)}")),
color = my_color["col7"]) +
geom_ribbon(data = fc_mobtab %>% filter(ds >= max(df_mobtab$ds)),
aes(ymax = yhat_upper,
ymin = yhat_lower,
fill = my_color["col2"],
text = NULL),
alpha = 0.2)+
geom_point(aes(x = as.POSIXct(min(df_mobtab$ds), format = "%Y-%m-%d"), y = max(subset(df_mobtab)$y)*1.19),
color = "grey", size = 1.5) +
geom_point(aes(x = as.POSIXct(min(df_mobtab$ds),format = "%Y-%m-%d"), y = max(subset(df_mobtab)$y)*1.12),
color = my_color["col4"], size = 1.5) +
geom_point(aes(x = as.POSIXct(min(df_mobtab$ds),format = "%Y-%m-%d"), y = max(subset(df_mobtab)$y)*1.05),
color = my_color["col7"], size = 1.5) +
annotate("text", x = as.POSIXct(min(df_mobtab$ds) + 80, format = "%Y-%m-%d"),
y = max(subset(df_mobtab)$y)*1.19,
color = "black", label = " Actual data",
size = 3) +
annotate("text", x = as.POSIXct(min(df_mobtab$ds) + 80, format = "%Y-%m-%d"),
y = max(subset(df_mobtab)$y)*1.12,
color = "black", label = " Model fitted",
size = 3) +
annotate("text", x = as.POSIXct(min(df_mobtab$ds) + 80, format = "%Y-%m-%d"),
y = max(subset(df_mobtab)$y)*1.05,
color = "black", label = " Demand prediction",
size = 3) +
labs(title = glue("Demand Forecast: Mobiles & Tablets Cat. [without tuning]"),
y = "Demand",
x = "Date") +
my_plot_theme(10) +
theme(legend.position = "none")
ggplotly(plot_fc_mobtab, tooltip = "text") %>% config(displayModeBar = F)
Yups, hasil diatas merupakan plot dari data aktual dengan model serta hasil prediksi permintaan di tiap harinya hingga 180 hari ke depan.
Mari kita coba lihat trend dan seasonality dari model fitted kita.
Dapat kita ketahui bersama, berdasarkan hasil model Prophet tanpa adanya tuning bahwa trend dari penjualan di e-commerce Pakistan pada kategori merchant Mobiles & Tablets naik hingga kuartal tiga tahun 2018 dan kemudian mengalalmi penurunan secara terus menerus.
Seasonality mingguan dan tahunan yang ditangkap oleh model Prophet ini sama dengan kebiasaan belanja pada e-commrce Pakistan ini secara umum, yang telah kita dapatkan sebelumnya. Penjualan di kategori Mobiles & Tablet sangat tinggi di hari Jumat dan pada bulan November.
Mari kita lanjutkan dengan melakukan tuning terhadap model Prophet untuk kategori Mobiles & Tablets. Pada bagian pertama ini kita akan melakukan tuning dengan menambahkan hari libur. Pada Prophet telah disediakan metode uantuk menambahkan hari libur dari suatu negara tertentu. Prophet juga telah memiliki daftar har-hari tersebut.
hol_mobtab <- prophet(holidays = holidays <- c()) %>%
add_country_holidays(country_name = "PK") %>% # PK adalah kode negara Pakistan dari Prophet
fit.prophet(df_mobtab)
hol_mobtab$train.holiday.names
#> [1] "Kashmir Solidarity Day" "Pakistan Day"
#> [3] "Labor Day" "Shab e Mairaj"
#> [5] "Eid al-Fitr" "Independence Day"
#> [7] "Defence Day" "Death Anniversary of Quaid-e-Azam"
#> [9] "Feast of the Sacrifice" "Iqbal Day"
#> [11] "Mawlid" "Christmas Day"
#> [13] "Day of Ashura"
Setelah melakukan tuning, mari kita lakukan proses cross-validation dan evaluasi pada model kita.
cv_hol_mobtab <- cross_validation(hol_mobtab, initial = 365,
period = 30, horizon = 180, units = "days")
me_hol_mobtab <- performance_metrics(cv_hol_mobtab, rolling_window=1)
me_hol_mobtab
Setelah kita lakukan tuning holiday, kita mendapatakan nilai MAPE yang lebih kecil yakni 1,97%. Semakin kecil nilai MAPE maka semakin akurat hasil prediksi. Selanjutnya kita akan melihat nilai RMSE ternormalisasi.
#> [1] "norm_RMSE: 0.08"
Nilai RMSE ternormalisasi sama dengan model tanpa tuning, hal itu kemungkinan besar karena selisihnya tidak terlalu jauh sehingga hasil pembulatan memberikan nilai yang sama. Oleh karena itu, kita akan coba membandingkan nilai RMSE secara langsung
# paste0("RMSE model no tuning : ",round(pm_mobtab$rmse, 2))
# paste0("RMSE model holiday tuning : ",round(me_hol_mobtab$rmse,2))
glue("RMSE model no tuning : {round(pm_mobtab$rmse, 2)}
RMSE model holiday tuning : {round(me_hol_mobtab$rmse,2)}")
#> RMSE model no tuning : 328.13
#> RMSE model holiday tuning : 329.47
Ternyata, model tanpa tuning memiliki nilai RMSE yang lebih kecil daripada model dengan holiday tuning.
Selanjutnya, mari kita lakukan prediksi dan visualisasi hasil prediksi.
future <- make_future_dataframe(hol_mobtab, periods = 180)
fc_hol_mobtab <- predict(hol_mobtab, future)
plot_fc_hol_mobtab <- fc_hol_mobtab %>%
filter(ds <= max(df_mobtab$ds)) %>%
ggplot(aes(x = ds, y = yhat)) +
geom_point(data = df_mobtab,
aes(x = as.POSIXct.Date(ds), y = y,
text = glue("Actual Data
Date: {ds}
Demand: {y}")),
color = "grey",
alpha = 0.5) +
geom_line(color = my_color["col4"]) +
geom_line(aes(text = glue("Model Fitted
Date: {ds}
Demand: {round(yhat, 0)}")),
color = my_color["col4"]) +
geom_ribbon(aes(ymax = yhat_upper,
ymin = yhat_lower,
fill = my_color["col2"],
text = NULL),
alpha = 0.2)+
geom_line(data = fc_hol_mobtab %>% filter(ds >= max(df_mobtab$ds)),
aes(x = ds, y = yhat),
color = my_color["col7"]) +
geom_line(data = fc_hol_mobtab %>% filter(ds >= max(df_mobtab$ds)),
aes(x = ds, y = yhat,
text = glue("Predicted Demand
Date: {ds}
Demand: {round(yhat, 0)}")),
color = my_color["col7"]) +
geom_ribbon(data = fc_hol_mobtab %>% filter(ds >= max(df_mobtab$ds)),
aes(ymax = yhat_upper,
ymin = yhat_lower,
fill = my_color["col2"],
text = NULL),
alpha = 0.2)+
geom_point(aes(x = as.POSIXct(min(df_mobtab$ds), format = "%Y-%m-%d"), y = max(subset(df_mobtab)$y)*1.19),
color = "grey", size = 1.5) +
geom_point(aes(x = as.POSIXct(min(df_mobtab$ds),format = "%Y-%m-%d"), y = max(subset(df_mobtab)$y)*1.12),
color = my_color["col4"], size = 1.5) +
geom_point(aes(x = as.POSIXct(min(df_mobtab$ds),format = "%Y-%m-%d"), y = max(subset(df_mobtab)$y)*1.05),
color = my_color["col7"], size = 1.5) +
annotate("text", x = as.POSIXct(min(df_mobtab$ds) + 80, format = "%Y-%m-%d"),
y = max(subset(df_mobtab)$y)*1.19,
color = "black", label = " Actual data",
size = 3) +
annotate("text", x = as.POSIXct(min(df_mobtab$ds) + 80, format = "%Y-%m-%d"),
y = max(subset(df_mobtab)$y)*1.12,
color = "black", label = " Model fitted",
size = 3) +
annotate("text", x = as.POSIXct(min(df_mobtab$ds) + 80, format = "%Y-%m-%d"),
y = max(subset(df_mobtab)$y)*1.05,
color = "black", label = " Demand prediction",
size = 3) +
labs(title = glue("Demand Forecast: Mobiles & Tablets Cat. [holiday tuning]"),
y = "Demand",
x = "Date") +
my_plot_theme(10) +
theme(legend.position = "none")
ggplotly(plot_fc_hol_mobtab, tooltip = "text") %>% config(displayModeBar = F)
Selanjutnya, kita lihat trend dan seasonality dari model Prophet kita.
Kita dapatkan hasil trend dan periode musiman yang sama sebagaimana sebelumnya.
Mari kita coba lakukan tuning pada seasonality dari model kita. Kita akan mecoba menambahakan seasonality bulanan serta mencoba melakukan tuning seasonality weekly dan yearly. Cap cus…
Adding Monthly Seasonality
addmonth_mobtab <- prophet() %>%
add_seasonality(name = "monthly", period = 30.5, fourier.order = 10) %>%
fit.prophet(df_mobtab)
cv_addmonth_mobtab <- cross_validation(addmonth_mobtab, initial = 365,
period = 30, horizon = 180, units = "days")
me_addmonth_mobtab <- performance_metrics(cv_addmonth_mobtab, rolling_window=1)
me_addmonth_mobtab
Tuning Weekly Seasonality
tun7_mobtab <- prophet() %>%
add_seasonality(name = "weekly", period = 7, fourier.order = 10) %>%
add_seasonality(name = "monthly", period = 30.5, fourier.order = 10) %>%
fit.prophet(df_mobtab)
cv_tun7_mobtab <- cross_validation(tun7_mobtab, initial = 365,
period = 30, horizon = 180, units = "days")
me_tun7_mobtab <- performance_metrics(cv_tun7_mobtab, rolling_window=1)
me_tun7_mobtab
Tuning Yearly Seasonality
tunY_mobtab <- prophet() %>%
add_seasonality(name = "yearly", period = 365.25, fourier.order = 15) %>%
add_seasonality(name = "monthly", period = 30.5, fourier.order = 10) %>%
fit.prophet(df_mobtab)
cv_tunY_mobtab <- cross_validation(tunY_mobtab, initial = 365,
period = 30, horizon = 180, units = "days")
me_tunY_mobtab <- performance_metrics(cv_tunY_mobtab, rolling_window=1)
me_tunY_mobtab
Accuracy Model Comparison
# paste0("RMSE model no tuning : ",round(pm_mobtab$rmse,2))
# paste0("RMSE model holiday tuning : ",round(me_hol_mobtab$rmse,2))
# paste0("RMSE model seasonality tuning [add monthly] : ",round(me_addmonth_mobtab$rmse,2))
# paste0("RMSE model holiday tuning [add mothly + tune weekly] : ",round(me_tun7_mobtab$rmse,2))
# paste0("RMSE model holiday tuning [add mothly + tune weekly + tune yearly] : ",round(me_tunY_mobtab$rmse,2))
glue("RMSE model no tuning : {round(pm_mobtab$rmse,2)}
RMSE model holiday tuning : {round(me_hol_mobtab$rmse,2)}
RMSE model seasonality tuning [add monthly] : {round(me_addmonth_mobtab$rmse,2)}
RMSE model holiday tuning [add mothly + tune weekly] : {round(me_tun7_mobtab$rmse,2)}
RMSE model holiday tuning [add mothly + tune weekly + tune yearly] : {round(me_tunY_mobtab$rmse,2)}")
#> RMSE model no tuning : 328.13
#> RMSE model holiday tuning : 329.47
#> RMSE model seasonality tuning [add monthly] : 336.06
#> RMSE model holiday tuning [add mothly + tune weekly] : 336.33
#> RMSE model holiday tuning [add mothly + tune weekly + tune yearly] : 344.65
Dapat kita lihat bersama, tuning seasonality yang kita lakukan masih belum baik sehingga menurukan akurasi atau memeprbesar eror hasil prediksi kita.
Selanjutnya kita akan melakukan hyperparameter tuning. Kita dapat melakukan terhadap empat parameter dengan penjelasan sebagai berikut;
changepoint_prior_scale: Ini mungkin merupakan parameter yang paling berpengaruh. Ini menentukan fleksibilitas tren, dan khususnya seberapa besar perubahan tren pada titik perubahan tren. Jika terlalu kecil, tren akan kurang pas dan varians yang seharusnya dimodelkan dengan perubahan tren malah akan ditangani dengan istilah kebisingan. Jika terlalu besar, tren akan overfit dan dalam kasus paling ekstrim, kita bisa mendapatkan tren yang menangkap musiman tahunan. Defaultnya adalah 0.05 yang cocok untuk banyak seri waktu, tetapi hal ini dapat disesuaikan; rentang [0.001, 0.5] kemungkinan sudah tepat.
seasonality_prior_scale: Parameter ini mengontrol fleksibilitas musiman. Secara serupa, nilai besar memungkinkan musiman untuk menyesuaikan fluktuasi besar, sedangkan nilai kecil mengurangi besaran musiman. Defaultnya adalah 10., yang pada dasarnya tidak menerapkan regulasi. Hal ini karena kita jarang sekali melihat overfitting di sini (ada regularisasi bawaan dengan fakta bahwa ini dimodelkan dengan deret Fourier yang dipotong, sehingga pada dasarnya difilter dengan low-pass). Rentang yang wajar untuk menyesuaikannya kemungkinan adalah [0.01, 10]; ketika disetel ke 0.01, Anda akan menemukan bahwa besaran musiman dipaksa untuk sangat kecil. Ini kemungkinan juga masuk akal dalam skala log, karena pada dasarnya ini adalah penalti L2 seperti dalam regresi ridge.
holidays_prior_scale: Ini mengontrol fleksibilitas untuk menyesuaikan efek liburan. Sama seperti seasonality_prior_scale, defaultnya adalah 10.0 yang pada dasarnya tidak menerapkan regulasi, karena biasanya kita memiliki beberapa pengamatan liburan dan dapat melakukan pekerjaan yang baik dalam memperkirakan efek mereka. Ini juga bisa disesuaikan pada rentang [0.01, 10] seperti halnya seasonality_prior_scale.
seasonality_mode: Pilihan adalah [‘additive’, ‘multiplicative’]. Defaultnya adalah ‘additive’, tetapi banyak seri waktu bisnis akan memiliki musiman multiplicative. Ini dapat diidentifikasi dengan melihat seri waktu dan melihat apakah besarnya fluktuasi musiman bertambah dengan besarnya seri waktu (lihat dokumentasi di sini tentang musiman multiplicative), tetapi ketika itu tidak mungkin, hal ini dapat disesuaikan.
Pada kesempatan ini, kita akan melakukan hyperparameter tuning terhadap changepoint_prior_scale dan seasonality_prior_scale. Kita tidak menggunakan holiday_prior_scale karena model yang kita gunakan disini tidak mengkombinasikan dengan tuning hari libur. Kemudian, kita dapatkan bahwa data kita tidak terlihat bersifat multiplicative sehingga seasonality_mode tetap kita gunakan additive.
Pertama, mari kita buat table kombinasi nilai dari dua parameter tuning yang telah kita pilih.
param_grid <- list(
'changepoint_prior_scale'= c(0.001, 0.01, 0.1, 0.5),
'seasonality_prior_scale'= c(0.01, 0.1, 1.0, 10.0)
)
param_grid <- crossing(param_grid$changepoint_prior_scale,
param_grid$seasonality_prior_scale) %>%
rename("changepoint_prior_scale" = "param_grid$changepoint_prior_scale",
"seasonality_prior_scale" = "param_grid$seasonality_prior_scale")
param_grid
Sekarang, mari kita lakukan cross-validation dan evaluasi pada tiap model dengan hyperparameter tuning yang telah kita tetapkan.
rmse <- c()
mae <- c()
for (i in 1:nrow(param_grid)){
hp_mobtab <- prophet(changepoint.prior.scale = param_grid$changepoint_prior_scale[i],
seasonality.prior.scale = param_grid$seasonality_prior_scale[i]) %>%
fit.prophet(df_mobtab)
df_cv <- cross_validation(hp_mobtab, initial = 365,
period = 30, horizon = 180, units = "days")
df_me <- performance_metrics(df_cv,
metrics = c('rmse', 'mae'),
rolling_window=1)
rmse <- c(rmse, df_me$rmse)
mae <- c(mae, df_me$mae)
}
df_metrics <- data.frame(rmse, mae)
max_mobtab_dmd <- max(df_mobtab$y)
min_mobtab_dmd <- min(df_mobtab$y)
result_hp_mobtab <- param_grid %>% cbind(df_metrics) %>%
mutate(norm_rmse = round(rmse/(max_mobtab_dmd - min_mobtab_dmd),2))
saveRDS(result_hp_mobtab, "result_hp_mobtab.RDS")
Selanjutkan kita akan melihat nilai RMSE yang paling kecil dari beberapa spesifikasi hyperparameter tuning yang telah kita lakukan.
#> [1] 327.5654
Mari kita bandingkan dengan model default dan berbagai tuning yang telah kita lakukan sebelumnya.
# paste0("RMSE model no tuning : ",round(pm_mobtab$rmse,2))
# paste0("RMSE model holiday tuning : ",round(me_hol_mobtab$rmse,2))
# paste0("RMSE model seasonality tuning [add monthly] : ",round(me_addmonth_mobtab$rmse,2))
# paste0("RMSE model holiday tuning [add mothly + tune weekly] : ",round(me_tun7_mobtab$rmse,2))
# paste0("RMSE model holiday tuning [add mothly + tune weekly + tune yearly] : ",round(me_tunY_mobtab$rmse,2))
# paste0("RMSE model hyperparameter tuning : ",round(min(result_hp_mobtab$rmse),2))
glue("RMSE model no tuning : {round(pm_mobtab$rmse,2)}
RMSE model holiday tuning : {round(me_hol_mobtab$rmse,2)}
RMSE model seasonality tuning [add monthly] : {round(me_addmonth_mobtab$rmse,2)}
RMSE model holiday tuning [add mothly + tune weekly] : {round(me_tun7_mobtab$rmse,2)}
RMSE model holiday tuning [add mothly + tune weekly + tune yearly] : {round(me_tunY_mobtab$rmse,2)}
RMSE model hyperparameter tuning : {round(min(result_hp_mobtab$rmse),2)}")
#> RMSE model no tuning : 328.13
#> RMSE model holiday tuning : 329.47
#> RMSE model seasonality tuning [add monthly] : 336.06
#> RMSE model holiday tuning [add mothly + tune weekly] : 336.33
#> RMSE model holiday tuning [add mothly + tune weekly + tune yearly] : 344.65
#> RMSE model hyperparameter tuning : 327.57
Model dengan hyperparameter tuning yang kita lakukan telah dapat memperkecil eror hasil prediksi dan meningkatkan akurasi model.
Model Prophet dapat memprediksi terkait permintaan pada periode yang akan datang di kategori “Mobiles & Tablets” dengan akurasi yang sangat baik (MAPE: ± 2%). Nilai eror RMSE yang dihasilkan sangat rendah (RMSE ternormalisasi: <0,1). Oleh karena itu, modelling dengan menggunakan Prophet memadai untuk digunakan terhadap dataset Pakistan E-commerce ini.
Perlakuan tuning pada model mampu meng-adjust akurasi prediksi dengan baik. Pada kategori “Mobiles & Tablets” perlakuan tuning yang sesuai ialah holiday dan hyperparameter. Tuning seasonality masih belum mendapatkan nilai yang tepat agar dapat menghasilkan akurasi yang baik. Adapun yang terbaik adalah dengan hyperparameter tuning.
Kita telah mendapatkan pemahaman bahwa algoritma model Prophet memadai untuk melakukan prediksi dari dataset E-Commerce Pakistan ini, tepatnya pada kategori Mobiles & Tablets. Selain itu, tuning model juga mampu meningkatkan akurasi model dengan baik.
Sebagaimana yang dijelaskan sebelumnya, kita akan melakukan demand forecasting terhadap semua kategori merchant dari e-commerce Pakistan ini. Kita juga akan melakukan beberapa tuning terhadap tiap kategori dan memilih model dengan akurasi terbaik. Oleh karena itu, kita akan menggunakan konsep dari nested dataframe dan menggunakan package purr
agar dapat melakukan running secara otomatis terhadap tiap kategori dan nantinya dipilih model yang terbaik.
Pertama kita buat list data total penjualan item per harinya dari setiap kategori merchant.
#> [1] "Beauty & Grooming" "Women's Fashion" "Sweet & Bakers"
#> [4] "Mobiles & Tablets" "Appliances" "Home & Living"
#> [7] "Men's Fashion" "Kids & Baby" "Entertainment"
#> [10] "Computing" "Superstore" "Health & Sports"
#> [13] "Books" "School & Education"
category <- unique(data_ts$Category)
data <- c(NA*14)
df_category <- data.frame(category, data)
for (x in category){
df_category <- df_category %>%
mutate(data = ifelse(category == x,
list(data_ts %>%
filter(Category == x) %>% pad(start_val = ymd("2016-07-01"),
end_val = ymd("2018-08-28")) %>%
group_by(Date_of_Order) %>% summarise(Tot_Order = sum(Quantity)) %>%
rename("ds" = "Date_of_Order", "y" = "Tot_Order") %>%
mutate(y = na.fill(y, fill = 0))),
data
)
)
}
# df_category <- df_category %>% drop_na() %>% mutate(category = Category)
df_category
Selanjutnya kita akan membuat list model dan spesifikasi dari tuning model yang akan kita gunakan.
model_default <- list(
model_default = function(x) prophet(x),
holidays_tuning = function(x) prophet(holidays = holidays <- c()) %>%
add_country_holidays(country_name = 'PK') %>%
fit.prophet(x),
hyparam_tuning = function(x) prophet(changepoint.prior.scale = 0.010) %>%
fit.prophet(x)
) %>%
enframe(name = "model_name", value = "model_spec")
model_default
Kita lanjutkan membuat list spesifikasi cross-validation yang kita gunakan.
cross_valid <- list(
cross_valid = function(x) cross_validation(x, initial = 365,
period = 30, horizon = 180,
units = "days")
) %>%
enframe(name = "cross_valid", value = "cv_spec")
cross_valid
Kemudian, kita tambahkan juga terkait spesifikasi perhitungan evaluasi model kita.
metrics_eval <- list(
metrics_eval = function(x) performance_metrics(x, rolling_window=0.01)
) %>%
enframe(name = "metrics_eval", value = "me_spec")
metrics_eval
Setalah itu, kita menggabungkan semua list yang telah kita buat menjadi nested dataframe yang nantinya kita running modelling.
Yups, sekarang kita lakukan running dan lanjutkan dengan evaluasi dari tiap model.
running_all <-
# modelling
map2(.x = df_ready$data,
.y = df_ready$model_spec,
.f = ~exec(.y, .x)) %>%
# cross valid
map2(.y = df_ready$cv_spec,
.f = ~exec(.y, .x)) %>%
# metrics eval
map2(.y = df_ready$me_spec,
.f = ~exec(.y,.x))
cv <- c()
for (i in 1:nrow(df_ready)){
cv <- cv %>% rbind(running_all[[i]] %>% filter(horizon == 180) %>% select(rmse, mae) %>%
mutate(norm_rmse = round(rmse/(max(df_ready$data[[i]] %>% select(y)) - min(df_ready$data[[i]] %>% select(y))),2)))
}
result_all <- df_ready %>% cbind(cv)
saveRDS(result_all, "result_all.RDS")
result_all <- readRDS("result_all.RDS")
result_all %>%
select(category, model_name, rmse, mae, norm_rmse)
Kita akan memilih model terbaik dari tiap kategorinya, karena pada kesempatan ini kita telah melakukan tiga modelling pada tiap kategori.
min_rmse <- result_all %>%
group_by(category) %>%
summarise(rmse = min(rmse))
mod_best <- result_all %>%
filter(category %in% c(min_rmse$category) & rmse %in% c(min_rmse$rmse)) %>%
select(category, data, model_name, model_spec, rmse, mae, norm_rmse)
mod_best
Setelah kita dapatkan model yang terbaik dari tiap kategori, mari kita lakukan forecasting bersama.
ls_model <- list()
ls_forecast <- list()
for(i in 1:nrow(mod_best)){
model <- mod_best$model_spec[[i]](mod_best$data[[i]])
future <- make_future_dataframe(model, periods = 180)
forecast <- predict(model, future)
ls_model <- ls_model %>% rbind(list(model) %>% enframe(value = "model_value"))
ls_forecast <- ls_forecast %>% rbind(list(forecast) %>% enframe(value = "forecast_val"))
}
forecast_result <- mod_best %>% cbind(
ls_model %>% select(model_value),
ls_forecast %>% select(forecast_val)
)
saveRDS(forecast_result, "forecast_result.RDS")
Yeah.. kita telah menyelasaikan tugas kita untuk demand forecasting pada tiap kategorinya. Dapat kita lihat bersama terkait akurasi model dalam meprediksi ditiap kategorinya ialah sangat baik. Hal itu dapat kita lihat dari nilai RMSE yang rendah dengan melihat RMSE ternormalisasinya. Semakin mendekati 0 maka semakin kecil eror hasil prediksi. Kita tidak dapat membandingkan nilai RMSE antar kategorinya, karena memiliki nilai rentang data yang berbeda-beda. Sehingga cara yang terbaik adalah melihat niali RMSE ternormalisasinya.
Selanjutnya, mari kita buat beberapa profil dari tiap kategori merchant di e-commerce Pakistan ini.
kita akan membuat semua visualisasi Trend of Habit Order dari tiap kategori untuk menggambarkan secara spesifik kebiasaan belanja pelanggan dari tiap kategori.
data <- readRDS("data_clean.RDS")
weekly_trend <- list()
monthly_trend <- list()
yearly_trend <- list()
for (i in 1:nrow(forecast_result)){
df_wday_habbit <- data %>%
filter(Category == forecast_result$category[i]) %>% select(Invoice_ID, Date_of_Order) %>% distinct() %>%
mutate(month = month(Date_of_Order),
wday = wday(Date_of_Order, week_start = getOption("lubridate.week.start", 1))) %>%
group_by(month, wday) %>% summarise(total = n()) %>% ungroup() %>% group_by(wday) %>%
summarise(avg_wday_trans = as.integer(mean(total))) %>% ungroup()
manual_weekly <- df_wday_habbit %>%
ggplot(aes(wday, avg_wday_trans))+
geom_bar(width=1, stat="identity", show.legend = FALSE, aes(fill=avg_wday_trans))+
labs(
title = "Daily Order Habbit",
x = "Day",
y = NULL)+
scale_x_continuous(breaks = c(1,2,3,4,5,6,7),
labels = c("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"))+
theme_minimal()+
theme(axis.title = element_blank(),
legend.position = "none",
plot.title = element_text(hjust = 0.5,size=12, face="bold"),
plot.subtitle = element_text(hjust = 0.5,size=10),
axis.text.y = element_blank(),
axis.text.x=element_text(size=11, face="bold"))+
scale_fill_gradient(low=my_theme_hex("col1") ,na.value = "#C0C0C0", high=my_theme_hex("col7"))+
coord_polar()
df_monthly_habbit <- data %>%
filter(Category == forecast_result$category[i]) %>% select(Invoice_ID, Date_of_Order) %>% distinct() %>%
mutate(month = month(Date_of_Order), day = day(Date_of_Order)) %>%
group_by(month, day) %>% summarise(total = n()) %>% ungroup() %>% group_by(day) %>%
summarise(avg_day_trans = as.integer(mean(total))) %>% ungroup()
manual_monthly <- df_monthly_habbit %>% ggplot(aes(x = as.factor(day),y= avg_day_trans))+
geom_bar(width=1, stat="identity", show.legend = FALSE, aes(fill=avg_day_trans))+
labs(
title = "Monthly Order Habbit",
x = "Date",
y = NULL) + theme_minimal()+
theme(axis.title = element_blank(),
legend.position = "none",
plot.title = element_text(hjust = 0.5,size=12, face="bold"),
plot.subtitle = element_text(hjust = 0.5,size=10),
axis.text.y = element_blank(),
axis.text.x=element_text(size=11, face="bold"))+
scale_fill_gradient(low=my_theme_hex("col1"), na.value = "#C0C0C0", high=my_theme_hex("col7"))+
coord_polar()
df_yearly_habbit <- data %>% filter(Category == forecast_result$category[i]) %>%
select(Invoice_ID, Date_of_Order) %>% distinct() %>%
mutate(year=year(Date_of_Order), month = month(Date_of_Order, label = T, abbr = TRUE)) %>%
group_by(year,month) %>% summarise(total = n()) %>% ungroup() %>% group_by(month) %>%
summarise(avg_month_trans = as.integer(mean(total))) %>% ungroup()
manual_yearly <- df_yearly_habbit %>% ggplot(aes(month, avg_month_trans))+
geom_bar(width=1, stat="identity", show.legend = FALSE, aes(fill=avg_month_trans))+
labs(
title = "Yearly Order Habbit",
x = "Month",
y = NULL)+theme_minimal()+
theme(axis.title = element_blank(),
legend.position = "none",
plot.title = element_text(hjust = 0.5,size=12, face="bold"),
plot.subtitle = element_text(hjust = 0.5,size=10),
axis.text.y = element_blank(),
axis.text.x=element_text(size=11, face="bold"))+
scale_fill_gradient(low=my_theme_hex("col1") ,na.value = "#C0C0C0", high=my_theme_hex("col7"))+
coord_polar()
# plot <- grid.arrange(manual_weekly, manual_monthly, manual_yearly, ncol = 3)
weekly_trend <- weekly_trend %>% rbind(
list(manual_weekly) %>%
enframe(value = "weekly_trend")
)
monthly_trend <- monthly_trend %>% rbind(
list(manual_monthly) %>%
enframe(value = "monthly_trend")
)
yearly_trend <- yearly_trend %>% rbind(
list(manual_yearly) %>%
enframe(value = "yearly_trend")
)
}
mari kita coba pilih salah satu kategori, yakni “Women’s Fashion”.
grid.arrange(weekly_trend$weekly_trend[[14]], monthly_trend$monthly_trend[[14]],
yearly_trend$yearly_trend[[14]], ncol = 3)
Selanjutnya, kita akan mecoba menghitung total dari semua permintaan pada rentang waktu yang diprediksikan. Hasil prediksi yang bernilai negatif menunjukkan bahwa permintaan 0, karena tidak mungkin permintaan bernilai negatif. Mari kita pilih kategori “Women’s Fashion” kembali.
tot_demand <- round(sum(subset(forecast_result[forecast_result$category == "Women's Fashion",]$forecast_val[[1]], ds > max(data$Date_of_Order) & ds <= max(data$Date_of_Order)+180)$yhat[subset(forecast_result[forecast_result$category == "Women's Fashion",]$forecast_val[[1]], ds > max(data$Date_of_Order) & ds <= max(data$Date_of_Order)+180)$yhat > 0]))
tot_demand <- glue("{comma(tot_demand)} demands in 180 days")
tot_demand
#> 9,478 demands in 180 days
Kita akan coba mengetahui 7 top produk yang terjual paling banyak dari tiap kategori, sehingga menjadi referensi bagi merchant. Kita akan memberikan empat periode dari 7 top produk, yakni satu minggu sebelumnya, satu bulan sebelumnya, tiga bulan sebelumnya, serta 6 bulan sebelumnya. Pada kesempatan ini, saya hanya akan menunjukkan pada salah satu ketegori yakni “Women’s Fashion”
Last Week
data[data$Category == "Women's Fashion" & data$Date_of_Order >= max(data$Date_of_Order)-7,] %>%
group_by(SKU) %>% summarise(Demand = n()) %>% arrange(-Demand) %>% head(7)
Last Month
data[data$Category == "Women's Fashion" & data$Date_of_Order >= max(data$Date_of_Order)-30,] %>%
group_by(SKU) %>% summarise(Demand = n()) %>% arrange(-Demand) %>% head(7)
Last 3 Months
data[data$Category == "Women's Fashion" & data$Date_of_Order >= max(data$Date_of_Order)-91,] %>%
group_by(SKU) %>% summarise(Demand = n()) %>% arrange(-Demand) %>% head(7)
Last 6 Months
data[data$Category == "Women's Fashion" & data$Date_of_Order >= max(data$Date_of_Order)-182,] %>%
group_by(SKU) %>% summarise(Demand = n()) %>% arrange(-Demand) %>% head(7)
Perusahaan E-Commerce Pakistan ini memiliki 14 kategori merchants. Kategori merchant yang paling banyak melakukan penjualan ialah “Mobiles & Tablets”. Adapun yang paling sedikit melakukan penjualan ialah kategori “Books”. Kategori merchant yang berkaitan fashion termasuk dalam lima besar kategori yang banyak melakukan penjualan. Beberapa kategori teratas dari e-commerce ini bisa dijadikan sebagai strategi branding perusahaan agar dapat memikat para pelanggan untuk membeli kategori-kategori tersebut di e-commerce ini. Perusahaan dapat menjalin kerja sama yang baik dengan berbagai merchant yang termasuk kategori tersebut serta memperhatikan kesedian trend-trend produk yang diminati tiap periodenya. Tidak lain strategi ini untuk menghindari dari terjadinya kebangkrutan perusahaan mengingat kondisi buruk perusahaan yang kita dapatkan dari proses EDA sebelumnya.
Secara umum, pelanggan pada e-commerce pakistan ini melakukan transaksi di hari jumat. Jumlah penjualan item pada hari jumat terjadi sangat tinggi dibanding hari-hari lainnya. Dalam satu bulan, terdapat tanggal-tanggal yang penjualan item meningkat, yakni direntang tanggal 17-27.Adapaun dalam satu tahun, bulan November menjadi primadona terjadinya transaksi dengan penjualan yang paling tinggi. Oleh karena itu, merchant maupun tim supply chain dari perusahaan e-commerce pakistan ini harus mengantisipasi kesedian stock di periode-periode tersebut untuk menghindari kekecewaan pelanggan dan meningkatkan pendapatan perusahaan.
Penjaminan ketersedian stok dapat diatasi melalu prediksi permintaan item disatu kategori. Model Prophet yang digunakan pada projek ini mampu memprediksi permintaan dengan akurasi yang tinggi yakni MAPE bernilai ± 2%. Kemudian, nilai eror RMSE yang dihasilkan sangat rendah dengan dilihat dari hari normalisasi RMSE yang kurang dari 0,10, kecuali pada kategori “Books” yakni 0,12. Adapun kebanyakan prediksi model Prophet pada setiap kategori memiliki nilai RMSE kurang dari sama dengan 0,05. Oleh karena itu, hasil demand prediction yang diperolah dapat menjadi acuan dalam manajemen ketersedian stok.
Sekarang kita telah menyelesaikan semua bagian analisis hingga pembuatan model dari project ini. Selanjutnya kita menuju pada aplikas/dashboard yang menampilkan semua pekerjaan kita. Dashboard dapat digunakan bagi pemilik perusahaan, tim bussines development, marketing, supply chain, serta merchant-merchant yang berkerja sama dengan E-commerce Pakistan ini.
Adapun bagian-bagian dahsboard serta target user dan informasi yang tersedia adalah sebagai berikut:
Berikut link aplikasi yang telah dibuat.