Naive Bayes, Decision Tree, Random Forest dan Regresi
Klasifikasi Harga Ponsel
Bakti Siregar, S.Si., M.Sc
February 21, 2021
Email : dsciencelabs@outlook.com
Instagram : https://www.instagram.com/dsciencelabs
RPubs : https://rpubs.com/dsciencelabs/
Github : https://github.com/dsciencelabs/
Telegram : @dsciencelabs
Department : Business Statistics
Address : ARA Center, Matana University Tower
Jl. CBD Barat Kav, RT.1, Curug Sangereng, Kelapa Dua, Tangerang, Banten 15810.
1 Latar Belakang
Suatu perusahaan seluler yang sedang berkembang ingin meningkatkan penjualan dan mampu bersaing degan perusahaan seluler yang sudah mendunia seperti Apple, Samsung dll. Kendalanya yang ditemukan adalah bagaimana langkah untuk memperkirakan klasifikasi harga ponsel yang diproduksi perusahaannya? Tentu, dengan persaingan yang kompetitif ini perusahaan tersebut tidak ingin berasumsi begitu saja, sehingga dilakukan pengumpulan data penjualan ponsel dari berbagai perusahaan. Hal ini dilakukan ingin mengetahui hubungan antara fitur-fitur ponsel tersebut (misalnya: - RAM, Memori Internal, dll) untuk menentukan klasifikasi harga jualnya, sehingga dapat melakukan pemasaran ke masing-masing segmen customer dengan lebih efektif. Perusahaan juga sudah mengumpulkan data penjualan ponselnya dengan dengan membagi klasifikasi harga low cost, medium cost, high cost dan very high cost. Dengan data historikal ini, perusahaan membutuhkan bantuan untuk merprediksi klasifikasi harga untuk setiap ponsel yang sudah diproduksi.
2 Persiapan Data
Silahkan download Dataset di Kaggle
2.1 Packages
Berikut ini dilampirkan beberapa packages yang digunakan, silahkan untuk melakukan installasi packages terlebih dahulu jika diperlukan.
library(tidyverse)
library(yardstick)
library(data.table)
library(paletti)
library(GGally)
library(ggplot2)
library(plotly)
library(rsample) # Initial Split
library(partykit)
library(rpart) # Decision Tree
library(rpart.plot) # Decision Tree
library(caret) # Confussion Matrix
library(randomForest) # random forest
# install.packages("devtools")
# library(devtools)
# devtools::install_github('skinner927/reprtree')
library(reprtree)
library(e1071) # naive bayes
library(nnet) # multinomial logistic regression
library(gridExtra)
library(grid)
library(knitr)
library(kableExtra)
library(cowplot)
library(formattable)
#COLORS
library(ggthemes)
library(paletti)
# WARNA
mycolorfill = c(
light_blue="#2f4b7c",
smooth_blue ="#4B87CB",
light_purple ="#665191",
dark_pink="#a05195",
light_pink="#d45087",
light_red="#f95d6a",
dark_orange="#ff6347",
semi_orange="#e79658",
orange="#dda15a",
cream="#b59378",
dark_cream="#A57F5F",
choc="#85664B",
dark_choc="#6b5340",
light_orange="#ff7c43"
)
#viz_palette(mycolorfill)
mycolor_fill <- get_scale_fill(get_pal(mycolorfill))
mycolor_color <- get_scale_color(get_pal(mycolorfill))
mycolor_hex <- get_hex(mycolorfill)2.2 Import Data
Dataset ini terdiri dari 2000 data dengan 21 variabel
phone <- read.csv("data_input/phone.csv")
data.frame("total.data" = dim(phone)[1],
"total.variabel" = dim(phone)[2])## total.data total.variabel
## 1 2000 2110 Data teratas
## battery_power blue clock_speed dual_sim fc four_g int_memory m_dep mobile_wt
## 1 842 0 2.2 0 1 0 7 0.6 188
## 2 1021 1 0.5 1 0 1 53 0.7 136
## 3 563 1 0.5 1 2 1 41 0.9 145
## 4 615 1 2.5 0 0 0 10 0.8 131
## 5 1821 1 1.2 0 13 1 44 0.6 141
## 6 1859 0 0.5 1 3 0 22 0.7 164
## 7 1821 0 1.7 0 4 1 10 0.8 139
## 8 1954 0 0.5 1 0 0 24 0.8 187
## 9 1445 1 0.5 0 0 0 53 0.7 174
## 10 509 1 0.6 1 2 1 9 0.1 93
## n_cores pc px_height px_width ram sc_h sc_w talk_time three_g touch_screen
## 1 2 2 20 756 2549 9 7 19 0 0
## 2 3 6 905 1988 2631 17 3 7 1 1
## 3 5 6 1263 1716 2603 11 2 9 1 1
## 4 6 9 1216 1786 2769 16 8 11 1 0
## 5 2 14 1208 1212 1411 8 2 15 1 1
## 6 1 7 1004 1654 1067 17 1 10 1 0
## 7 8 10 381 1018 3220 13 8 18 1 0
## 8 4 0 512 1149 700 16 3 5 1 1
## 9 7 14 386 836 1099 17 1 20 1 0
## 10 5 15 1137 1224 513 19 10 12 1 0
## wifi price_range
## 1 1 1
## 2 0 2
## 3 0 2
## 4 0 2
## 5 0 1
## 6 0 1
## 7 1 3
## 8 1 0
## 9 0 0
## 10 0 02.3 Deskripsi Variabel
Berikut ini deskripsi dari masing-masing variabel dari dataset ini:
| Variable | Description | Nilai |
|---|---|---|
| battery_power | Kapasitas baterai (mAh) | mAH |
| blue | Support Bluetooth | Ya: 1, Tidak: 0 |
| clock_speed | Kecepatan microprocessor | GHz |
| dual_sim | Support Dual Sim | Ya: 1, Tidak: 0 |
| fc | Resolusi Kamera Depan | Megapixel |
| four_g | Support 4G | Ya: 1, Tidak: 0 |
| int_memory | Kapasitas Memori internal | Gigabyte |
| m_dep | Ketebelan device | Centimeter |
| mobile_wt | Berat Device | Gram |
| n_cores | Jumlah Core dari processor | Satuan Angka |
| pc | Resolusi Kamera Utama | Megapixel |
| px_height | Resolusi Tinggi Layar | Pixel |
| px_width | Resolusi Lebar Layar | Pixel |
| ram | Kapasitas RAM | Megabyte |
| sc_h | Tinggi Layar | Centimeter |
| sc_w | Lebar Layar | Centimeter |
| talk_time | Total waktu pemakaian normal | Jam |
| three_g | Support 3G | Ya: 1, Tidak: 0 |
| touch_screen | Support layar sentuh | Ya: 1, Tidak: 0 |
| wifi | Support Wifi | Ya: 1, Tidak: 0 |
| price_range | Kelas harga Target Variabel | low cost:0, medium cost:1, high cost:2 dan very high cost:3 |
3 Pembersihan Data
3.1 Struktur Data
Berikut ini struktur dataset yang ada:
## Rows: 2,000
## Columns: 21
## $ battery_power <int> 842, 1021, 563, 615, 1821, 1859, 1821, 1954, 1445, 50...
## $ blue <int> 0, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 0, 1, 0, 0, 0, 0,...
## $ clock_speed <dbl> 2.2, 0.5, 0.5, 2.5, 1.2, 0.5, 1.7, 0.5, 0.5, 0.6, 2.9...
## $ dual_sim <int> 0, 1, 1, 0, 0, 1, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1,...
## $ fc <int> 1, 0, 2, 0, 13, 3, 4, 0, 0, 2, 0, 5, 2, 7, 13, 3, 1, ...
## $ four_g <int> 0, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 0, 1, 0, 1, 1,...
## $ int_memory <int> 7, 53, 41, 10, 44, 22, 10, 24, 53, 9, 9, 33, 33, 17, ...
## $ m_dep <dbl> 0.6, 0.7, 0.9, 0.8, 0.6, 0.7, 0.8, 0.8, 0.7, 0.1, 0.1...
## $ mobile_wt <int> 188, 136, 145, 131, 141, 164, 139, 187, 174, 93, 182,...
## $ n_cores <int> 2, 3, 5, 6, 2, 1, 8, 4, 7, 5, 5, 8, 4, 4, 1, 2, 8, 3,...
## $ pc <int> 2, 6, 6, 9, 14, 7, 10, 0, 14, 15, 1, 18, 17, 11, 17, ...
## $ px_height <int> 20, 905, 1263, 1216, 1208, 1004, 381, 512, 386, 1137,...
## $ px_width <int> 756, 1988, 1716, 1786, 1212, 1654, 1018, 1149, 836, 1...
## $ ram <int> 2549, 2631, 2603, 2769, 1411, 1067, 3220, 700, 1099, ...
## $ sc_h <int> 9, 17, 11, 16, 8, 17, 13, 16, 17, 19, 5, 14, 18, 7, 1...
## $ sc_w <int> 7, 3, 2, 8, 2, 1, 8, 3, 1, 10, 2, 9, 0, 1, 9, 15, 9, ...
## $ talk_time <int> 19, 7, 9, 11, 15, 10, 18, 5, 20, 12, 7, 13, 2, 4, 3, ...
## $ three_g <int> 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1,...
## $ touch_screen <int> 0, 1, 1, 0, 1, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1,...
## $ wifi <int> 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 0, 1, 1, 1, 1, 0,...
## $ price_range <int> 1, 2, 2, 2, 1, 1, 3, 0, 0, 0, 3, 3, 1, 2, 0, 0, 3, 3,...Berdasarkan struktur data diatas, terdapat variabel-variabel yang tipe datanya perlu disesuaikan lagi berdasar sifat datanya sesuai dengan deskripsi variabel yang sudah dijelaskan adalah:
- blue : di-konversi dari integer menjadi factor/kategorik
- dual_sim : di-konversi dari integer menjadi factor/kategorik
- four_g : di-konversi dari integer menjadi factor/kategorik
- three_g : di-konversi dari integer menjadi factor/kategorik
- touch_screen : di-konversi dari integer menjadi factor/kategorik
- wifi : di-konversi dari integer menjadi factor/kategorik
- price_range : di-konversi dari integer menjadi factor/kategorik dengan level low cost, medium cost, high cost, very high cost
phone <- phone %>%
mutate(
blue = as.factor(blue),
dual_sim = as.factor(dual_sim),
four_g = as.factor(four_g),
three_g = as.factor(three_g),
touch_screen = as.factor(touch_screen),
wifi = as.factor(wifi),
price_range = as.factor(price_range),
price_range = sapply(price_range, switch,"low cost","medium cost", "high cost","very high cost"),
price_range = ordered(price_range, levels=c("low cost","medium cost", "high cost","very high cost"))
)Berikut ini diperlihatkan struktur dataset setelah dilakukan penyesuaian struktur datanya:
## Rows: 2,000
## Columns: 21
## $ battery_power <int> 842, 1021, 563, 615, 1821, 1859, 1821, 1954, 1445, 50...
## $ blue <fct> 0, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 0, 1, 0, 0, 0, 0,...
## $ clock_speed <dbl> 2.2, 0.5, 0.5, 2.5, 1.2, 0.5, 1.7, 0.5, 0.5, 0.6, 2.9...
## $ dual_sim <fct> 0, 1, 1, 0, 0, 1, 0, 1, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1,...
## $ fc <int> 1, 0, 2, 0, 13, 3, 4, 0, 0, 2, 0, 5, 2, 7, 13, 3, 1, ...
## $ four_g <fct> 0, 1, 1, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 0, 1, 0, 1, 1,...
## $ int_memory <int> 7, 53, 41, 10, 44, 22, 10, 24, 53, 9, 9, 33, 33, 17, ...
## $ m_dep <dbl> 0.6, 0.7, 0.9, 0.8, 0.6, 0.7, 0.8, 0.8, 0.7, 0.1, 0.1...
## $ mobile_wt <int> 188, 136, 145, 131, 141, 164, 139, 187, 174, 93, 182,...
## $ n_cores <int> 2, 3, 5, 6, 2, 1, 8, 4, 7, 5, 5, 8, 4, 4, 1, 2, 8, 3,...
## $ pc <int> 2, 6, 6, 9, 14, 7, 10, 0, 14, 15, 1, 18, 17, 11, 17, ...
## $ px_height <int> 20, 905, 1263, 1216, 1208, 1004, 381, 512, 386, 1137,...
## $ px_width <int> 756, 1988, 1716, 1786, 1212, 1654, 1018, 1149, 836, 1...
## $ ram <int> 2549, 2631, 2603, 2769, 1411, 1067, 3220, 700, 1099, ...
## $ sc_h <int> 9, 17, 11, 16, 8, 17, 13, 16, 17, 19, 5, 14, 18, 7, 1...
## $ sc_w <int> 7, 3, 2, 8, 2, 1, 8, 3, 1, 10, 2, 9, 0, 1, 9, 15, 9, ...
## $ talk_time <int> 19, 7, 9, 11, 15, 10, 18, 5, 20, 12, 7, 13, 2, 4, 3, ...
## $ three_g <fct> 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1,...
## $ touch_screen <fct> 0, 1, 1, 0, 1, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1,...
## $ wifi <fct> 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 1, 0, 1, 1, 1, 1, 0,...
## $ price_range <ord> medium cost, high cost, high cost, high cost, medium ...3.2 Data yang Hilang
Tidak terdapat missing value pada dataset ini.
## battery_power blue clock_speed dual_sim fc
## 0 0 0 0 0
## four_g int_memory m_dep mobile_wt n_cores
## 0 0 0 0 0
## pc px_height px_width ram sc_h
## 0 0 0 0 0
## sc_w talk_time three_g touch_screen wifi
## 0 0 0 0 0
## price_range
## 03.3 Data Duplikat
Tidak terdapat duplikat value pada dataset ini.
## jumlah.seluruh.data jumlah.data.unik
## 1 2000 2000Kerena sudah tidak ada lagi data yang bermasalah, selanjutnya data yang sudah dibersihkan disimpan untuk kemperluan proses selanjutnya.
4 Analisis Eksplorasi Data
phone %>% group_by(price_range) %>% summarise(freq=n()) %>%
ggplot( aes(x="", y=freq, fill=price_range)) +
geom_bar(stat="identity", width=1)+
coord_polar("y", start=0) +
geom_text(aes(label = paste0(round((freq/sum(freq))*100), "%")),
position = position_stack(vjust = 0.5),color="white")+
scale_fill_manual(values=c(mycolor_hex("dark_cream"),
mycolor_hex("smooth_blue"),
mycolor_hex("light_purple"),
mycolor_hex("light_red"))) +
labs(x = NULL, y = NULL, fill = "Price Range", title = "Data Proportion by Price Range")+
theme_classic() +
theme(axis.line = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.title=element_text(size=9,face="bold"),
legend.position = "right"
)
Berdasarkan chart diatas, dataset yang dikumpulkan oleh Perushaan memiliki porsi kelas target yang balance, dimana masing-masing Price Range memiliki proporsi 25%. Proporsi kelas target yang seimbang sangat membantu proses pemodelan. Kemudian, bagaimana korelasi setiap variabel nya?
# corelation between predictors
ggcorr(phone,label = T, size=3, label_size = 3, hjust=0.95,
layout.exp = 3,low = mycolor_hex("dark_cream"), high = mycolor_hex("light_red"))+
labs(
title="Matriks Korelasi untuk setiap Variabel"
)+
theme_minimal()+
theme(
plot.title = element_text(hjust = 0.5),
axis.title=element_text(size=8,face="bold"),
axis.text.y=element_blank()
)
Matriks korelasi diatas menunjukan sebagaian besar variabel bersifat independen atau tidak saling berkorelasi, kecuali:
* sc_w dan sc_h memiliki korelasi positif sebesar 0.5
* px_width dan px_height memiliki korelasi positif sebesar 0.5
* fc dan pcmemiliki korelasi positif sebesar 0.6
5 Split Data (Train dan Test)
Dari 2000 data observasi, saya membagi 80% sebagai data train dan 20% sebagai data test. Data train digunakan untuk melakukan pemodelan dan data test dianggap sebagai unseen data yang digunakan untuk menguji seberapa baik model yang dibuat. Dapat dilihat pada chart dibawah, setiap target variable memiliki proporsi data train dan data test yang seimbang. Setiap target variable memiliki data train sebanyak 401 observasi dan memiliki data test sebanyak 99 observasi. Karena proporsi kelas target sudah sesuai maka dapat langsung dilanjutkan ke tahap pemodelan.
set.seed(123)
split <- initial_split(phone, prop = 0.8, strata = "price_range")
phone_train <- training(split)
phone_test <- testing(split)
df_split <- rbind(
data.frame(table(phone_train$price_range),"type"="train"),
data.frame(table(phone_test$price_range),"type"="test")) %>%
mutate(
Var1 = as.factor(Var1),
type = as.factor(type)
)
ggplot(df_split, aes(x=Var1,y=Freq, fill=type))+
geom_col(position = "dodge")+
geom_text(aes(label=Freq, y=Freq+20), size=3, position = position_dodge(width = 1))+
labs(x = "Price Class",
y = "Frequency",
fill = "Data",
title = "Price Range: Proportion Train vs Test")+
theme_minimal()+
theme(
axis.title=element_text(size=9,face="bold"),
axis.text.x=element_text(size=10),
axis.text.y=element_text(size=10)
)+
scale_fill_manual(values=c(mycolor_hex("light_red"),
mycolor_hex("light_blue"))) 
6 Pemodelan
Seperti yang dijelaskan pada intro diawal, Perushaan ingin memprediksi sebuah ponsel masuk ke kelas harga low cost, medium cost, high cost atau very high cost. Berdasarkan dataset yang dimiliki, maka yang menjadi target variabel untuk diprediksi adalah price_range. Proses pemodelan kali ini mengunakan beberapa metode klasifikasi yaitu Naive Bayes, Decision Tree, Random Forest dan Multinomial Logistic Regression.
# Fungsi ini digunakan untuk menampilkan hasil confussion matrix
# Fungsi ini digunakan untuk menampilkan hasil confussion matrix
ggplotConfusionMatrix <- function(my_title,dat_type,cfm,low_color,high_color){
my_subtitle <- paste("Data:",dat_type," ",
"Accuracy:", paste(round((cfm$overall[1])*100,2),"%"),
" ",
"Kappa:", paste(round((cfm$overall[2])*100,2),"%"))
plot <- ggplot(data = as.data.frame(cfm$table),aes(x = Reference, y = Prediction)) +
geom_tile(aes(fill = log(Freq)), colour = "white") +
geom_text(aes(x = Reference, y = Prediction, label = Freq),color="white") +
labs(
title = my_title,
subtitle = my_subtitle,
x = "Actual",
y = "Prediction"
)+
theme_minimal()+
theme(
title = element_text(size=14),
axis.title=element_text(size=12, face="bold"),
axis.text.x=element_text(size=12),
axis.text.y=element_text(size=12),
legend.position = "none"
) +
scale_fill_gradient(low=low_color,na.value = "#C0C0C0", high=high_color)
return(plot)
}
# Fungsi ini digunakan untuk menampilkan metrics summary
summaryMatrix <- function(data_train, v_actual_train, v_prediction_train, header_color_train,
data_test, v_actual_test, v_prediction_test, header_color_test){
sm_train <- data_train %>%
summarise(
accuracy = paste(round((accuracy_vec(v_actual_train, v_prediction_train))*100,2),"%"),
sensitivity = paste(round((sens_vec(v_actual_train, v_prediction_train))*100,2),"%"),
specificity = paste(round((spec_vec(v_actual_train, v_prediction_train))*100,2),"%"),
precision = paste(round((precision_vec(v_actual_train, v_prediction_train))*100,2),"%")
)
sm_test <- data_test %>%
summarise(
accuracy = paste(round((accuracy_vec(v_actual_test, v_prediction_test))*100,2),"%"),
sensitivity = paste(round((sens_vec(v_actual_test, v_prediction_test))*100,2),"%"),
specificity = paste(round((spec_vec(v_actual_test, v_prediction_test))*100,2),"%"),
precision = paste(round((precision_vec(v_actual_test, v_prediction_test))*100,2),"%")
)
sm <- rbind(sm_train,sm_test)
sm <- cbind(data.frame(data=c("data train","data test")),sm)
sm %>%
mutate(
data = color_tile(mycolor_hex("dark_choc"),mycolor_hex("light_blue"))(data)
) %>%
kable("html", escape = F, align = "c") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"), full_width = F) %>%
column_spec(1, bold = T, color = "white") %>%
column_spec(column = 1:5, width = "18em") %>%
# column_spec(column = 1:4, background = header_color_train) %>%
# column_spec(column = 5:8, background = header_color_test) %>%
add_header_above(c("Metrics Summary Data Train vs Test" = 5))
}6.1 Naive Bayes
Naive Bayes
Metode Naive Bayes memiliki asumsi awal yaitu semua variabel bersifat independen atau tidak saling berkorelasi. Pada matriks korelasi diatas menunjukan beberapa variabel memiliki korelasi, sehingga dapat disimpulkan bahwa metode Naive Bayes akan kurang maksimal untuk case kalsifikasi ini. Namun, mari kita tetap kita coba. Berikut hasilnya:
# Model Fitting
nvb_model <- naiveBayes(price_range ~ ., phone_train, laplace = 1)
# Predict Data Train
nvb_probability_train <- predict(nvb_model, phone_train, type = "raw")
nvb_prediction_train <- predict(nvb_model, phone_train, type = "class")
# Data Predict
nvb_result_train <- cbind(phone_train, price_range_prediction=nvb_prediction_train,
round(nvb_probability_train,3))
nvb_result_train <- nvb_result_train[,c(21,22,23,24,25,26)] %>%
setnames("price_range", "price_range_actual") %>%
arrange(price_range_actual) %>%
mutate(
no=seq(1:nrow(phone_train))
) %>%
select(7,1,2,3,4,5,6)
# Predict Data Test
nvb_probability <- predict(nvb_model, phone_test, type = "raw")
nvb_prediction <- predict(nvb_model, phone_test, type = "class")
# Data Predict
nvb_result <- cbind(phone_test, price_range_prediction=nvb_prediction,
round(nvb_probability,3))
nvb_result <- nvb_result[,c(21,22,23,24,25,26)] %>%
setnames("price_range", "price_range_actual") %>%
arrange(price_range_actual) %>%
mutate(
no=seq(1:nrow(phone_test))
) %>%
select(7,1,2,3,4,5,6)
data.table(nvb_result)## no price_range_actual price_range_prediction low cost medium cost
## 1: 1 low cost low cost 0.875 0.124
## 2: 2 low cost medium cost 0.453 0.509
## 3: 3 low cost low cost 0.916 0.082
## 4: 4 low cost low cost 0.986 0.014
## 5: 5 low cost low cost 0.967 0.033
## ---
## 392: 392 very high cost very high cost 0.000 0.001
## 393: 393 very high cost high cost 0.000 0.216
## 394: 394 very high cost very high cost 0.000 0.000
## 395: 395 very high cost very high cost 0.000 0.000
## 396: 396 very high cost very high cost 0.000 0.000
## high cost very high cost
## 1: 0.000 0.000
## 2: 0.038 0.000
## 3: 0.001 0.000
## 4: 0.000 0.000
## 5: 0.000 0.000
## ---
## 392: 0.269 0.730
## 393: 0.702 0.083
## 394: 0.074 0.926
## 395: 0.119 0.881
## 396: 0.165 0.835Data diatas merupakan hasil prediksi metode Naive Bayes terhadap data tes. price_range_actual merupakan data sebenarnya dan price_range_prediction merupakan data hasil prediksi, kemudian Data low cost, medium cost, high cost dan very high cost merupakan nilai probability terhadap setiap kelas dari target variabel. Sehingga, hasil prediksi pada price_range_prediction diambil berdasarkan nilai probability yang paling tinggi. Dapat dilihat pada data diatas, hasil prediksi masih banyak tidak sesuai dengan nilai aktualnya. Selain itu, terdapat data yang nilai probability kelas target nya cenderung tidak jauh berbeda antara satu dan lainnya, misalkan data nomor 2,20 dan 28. Hal ini menunjukan tingkat akurasi hasil prediksi yang kurang maksimal. Mari kita cek hasil evaluasinya menggunakan Confussion Matrix:
# Evaluation
# TRAIN FITTED VALUE
# PREDICT TEST
cm_bayes_train <- confusionMatrix(
data = nvb_result_train$price_range_prediction,
reference =nvb_result_train$price_range_actual
)
ggplotConfusionMatrix(my_title = "Naive Bayes: Model Evaluation on Data Train vs Data Test using Confussion Matrix",
dat_type="Train",
cfm=cm_bayes_train,
low_color=mycolor_hex("smooth_blue"),
high_color =mycolor_hex("light_blue")) -> nvb1
# PREDICT TEST
cm_bayes <- confusionMatrix(
data = nvb_result$price_range_prediction,
reference =nvb_result$price_range_actual
)
ggplotConfusionMatrix(my_title = "",
dat_type="Test",
cfm=cm_bayes,
low_color=mycolor_hex("dark_pink"),
high_color =mycolor_hex("light_red")) -> nvb2
grid.arrange(nvb1, nvb2, ncol = 2)
summaryMatrix(data_train=nvb_result_train,
v_actual_train = nvb_result_train$price_range_actual,
v_prediction_train = nvb_result_train$price_range_prediction,
data_test=nvb_result,
v_actual_test = nvb_result$price_range_actual,
v_prediction_test = nvb_result$price_range_prediction
)| data | accuracy | sensitivity | specificity | precision |
|---|---|---|---|---|
| data train | 81.36 % | 81.36 % | 93.79 % | 81.42 % |
| data test | 83.84 % | 83.84 % | 94.61 % | 85.08 % |
Hasil evaluasi pada Confussion Matrix diatas menunjukan model Naive Bayes yang sudah dibuat memiliki tingkat akurasi 83.84% dalam memprediksi kelas harga. Jika dilihat, hasil prediksi dan aktual yang ditebak benar memang menunjukan selisih yang cukup besar. Hasil Prediksi pada harga kelas Low Cost meleset sebanyak 15 ponsel, hasil prediksi harga kelas Medium Cost meleset sebanyak 15 ponsel, hasil prediksi harga kelas High Cost meleset 22 ponsel dan hasil prediksi Harga kelas Very Hight Cost meleset 12 ponsel. Mari kita coba metode Decision Tree.
6.2 Decision Tree
Decision Tree
Decision tree merupakan suatu metode klasifikasi yang menggunakan struktur pohon, dimana setiap node merepresentasikan atribut dan cabangnya merepresentasikan nilai dari atribut, sedangkan daunnya digunakan untuk merepresentasikan kelas. Decision tree merupakan metode klasifikasi yang cukup powerfull karena memperbolehkan antar prediktornya saling berkorelasi, prediktor juga dapat berupa data numerik ataupun kategorik dan cukup interpretabale
# Model Fitting
dtree_model <- ctree(formula = price_range ~ .,
data = phone_train)
# Predict data train
dtree_prediction_train <- predict(dtree_model,phone_train)
dtree_probability_train <- predict(dtree_model,phone_train, type="prob")
dtree_probability_train <- data.frame(matrix(unlist(dtree_probability_train),
nrow=nrow(phone_train), byrow=T),stringsAsFactors=FALSE)
colnames(dtree_probability_train) <- c("low_price","medium_price","high_price","very_high_price")
# Train Data Predict
dtree_result_train <- cbind(phone_train, price_range_prediction=dtree_prediction_train,
round(dtree_probability_train,3))
dtree_result_train <- dtree_result_train[,c(21,22,23,24,25,26)] %>%
setnames("price_range", "price_range_actual") %>%
arrange(price_range_actual) %>%
mutate(
no=seq(1:nrow(phone_train))
) %>%
select(7,1,2,3,4,5,6)
# Predict data test
dtree_prediction <- predict(dtree_model,phone_test)
dtree_probability <- predict(dtree_model,phone_test, type="prob")
dtree_probability <- data.frame(matrix(unlist(dtree_probability),
nrow=nrow(phone_test), byrow=T),stringsAsFactors=FALSE)
colnames(dtree_probability) <- c("low_price","medium_price","high_price","very_high_price")
# Test Data Predict
dtree_result <- cbind(phone_test, price_range_prediction=dtree_prediction,
round(dtree_probability,3))
dtree_result <- dtree_result[,c(21,22,23,24,25,26)] %>%
setnames("price_range", "price_range_actual") %>%
arrange(price_range_actual) %>%
mutate(
no=seq(1:nrow(phone_test))
) %>%
select(7,1,2,3,4,5,6)
data.table(dtree_result)## no price_range_actual price_range_prediction low_price medium_price
## 1: 1 low cost low cost 0.000 0.000
## 2: 2 low cost medium cost 0.000 0.000
## 3: 3 low cost low cost 0.179 0.043
## 4: 4 low cost low cost 0.982 0.000
## 5: 5 low cost low cost 1.000 1.000
## ---
## 392: 392 very high cost high cost 0.995 0.955
## 393: 393 very high cost high cost 0.908 0.000
## 394: 394 very high cost very high cost 0.643 0.000
## 395: 395 very high cost very high cost 0.000 0.500
## 396: 396 very high cost high cost 0.000 0.995
## high_price very_high_price
## 1: 0.000 0.000
## 2: 0.000 0.000
## 3: 0.000 0.000
## 4: 0.000 0.956
## 5: 0.000 0.000
## ---
## 392: 0.908 0.000
## 393: 0.000 0.012
## 394: 0.129 0.000
## 395: 0.150 0.955
## 396: 0.000 0.107Data diatas merupakan hasil prediksi metode Decision Tree terhadap data tes. price_range_actual merupakan data sebenarnya dan price_range_prediction merupakan data hasil prediksi, kemudian Data low cost, medium cost, high cost dan very high cost merupakan nilai probability terhadap setiap kelas dari target variabel. Sehingga, hasil prediksi pada price_range_prediction diambil berdasarkan nilai probability yang paling tinggi. Dapat dilihat bahwa hasil prediksi memang masih banyak yang belum sesuai, namun jika dilihat dari pola nilai probability kelas target nya cenderung jauh berbeda antara satu dan lainnya jika dibandingkan dengan metode Naive Bayes. Mari kita cek hasil evaluasinya menggunakan Confussion Matrix:
# Evaluation
cfm_dtree_train <- confusionMatrix(
data =dtree_result_train$price_range_prediction,
reference =dtree_result_train$price_range_actual
)
ggplotConfusionMatrix(my_title = "Decision Tree: Model Evaluation on Data Train vs Data Test using Confussion Matrix",
dat_type="Train",
cfm=cfm_dtree_train,
low_color=mycolor_hex("smooth_blue"),
high_color =mycolor_hex("light_blue")) -> dtree_p1
cfm_dtree <- confusionMatrix(
data =dtree_result$price_range_prediction,
reference =dtree_result$price_range_actual
)
ggplotConfusionMatrix(my_title = "",
dat_type="Test",
cfm=cfm_dtree,
low_color=mycolor_hex("dark_pink"),
high_color =mycolor_hex("light_red")) -> dtree_p2
grid.arrange(dtree_p1, dtree_p2, ncol = 2)
| data | accuracy | sensitivity | specificity | precision |
|---|---|---|---|---|
| data train | 90.09 % | 90.09 % | 96.7 % | 90.29 % |
| data test | 86.11 % | 86.11 % | 95.37 % | 86.7 % |
Hasil evaluasi model Decision Tree menggunakan Confussion Matrix diatas menunjukan Tingkat akurasi hasil klasifikasi lumayan bagus, dimana tingkat akurasi pada data train sebesar 90.21% dan tingkat akurasi pada data test sebesar 86.36%. Namun, Hasil prediksi dan aktual yang ditebak benar memang masih menunjukan selisih yang cukup besar. Hasil Prediksi data test pada harga kelas Low Cost meleset sebanyak 10 ponsel, hasil prediksi harga kelas Medium Cost meleset sebanyak 15 ponsel, hasil prediksi harga kelas High Cost meleset 17 ponsel dan hasil prediksi Harga kelas Very Hight Cost meleset 13 ponsel. Namun, dapat kita simpulkan bahwa metode Decision Tree lebih baik daripada metode Naive Bayes untuk case ini. Mari kita coba tunning untuk mengurangi. Meskipun begitu dapat dikatakan model ini adalah underfit model dengan selisih tingkat akurasi sebesar 3.85%.
Menurut saya pribadi selisih ini masih cukup besar, sehingga dapat kita lakukan pruning pada model yang sudah dibuat. Pruning merupakan bagian dari proses pembentukan decision tree. Saat pembentukan decision tree, beberapa node merupakan outlier maupun hasil dari noise data. Penerapan pruning pada decision tree, dapat mengurangi outlier maupun noise data pada decision tree awal sehingga dapat meningkatkan akurasi pada klasifikasi data. Algoritma Pruning sendiri memiliki kriteria value yaitu:
- mincriterion: Nilainya adalah 1 - Alpha. Bekerja sebagai “regulator” untuk kedalaman pohon. Semakin kecil nilainya maka semakin kompleks pohon yang dihasilkan. Misal mincriterion = 0.8, maka p-value < 0.2 yang digunakan untuk melakukan split/memecah node.
- minsplit: Jumlah observasi minimal pada pada node sebelum melakukan split. Misal minsplit = 50, maka node tersebut tidak akan dipecah jika observasi yang terdapat di dalam node < 50.
- minbucket: jumlah observasi minimal pada terminal node. Misal minbucket = 3, maka setiap terminal node yang terbentuk harus mempunyai minimal 3 observasi.
Saya sudah mencoba beberapa nilai untuk masing-masing mincriterion, minsplit dan minbucket terhadap model tree yang sudah dibuat, namun tidak saya cantumkan semua disini. Dari hasil percobaan yang saya lakukan didapat pruning terbaik dengan kriteria mincriterion = 0.92 minsplit = 16. Mari kita lihat hasilnya:
# Model Decision Tress & Pruning
dtree_model <- ctree(formula = price_range ~ .,
data = phone_train,
control = ctree_control(mincriterion = 0.92, minsplit = 16))
# Predict data train
dtree_prediction_train <- predict(dtree_model,phone_train)
dtree_probability_train <- predict(dtree_model,phone_train, type="prob")
dtree_probability_train <- data.frame(matrix(unlist(dtree_probability_train),
nrow=nrow(phone_train), byrow=T),stringsAsFactors=FALSE)
colnames(dtree_probability_train) <- c("low_price","medium_price","high_price","very_high_price")
# Train Data Predict
dtree_result_train <- cbind(phone_train, price_range_prediction=dtree_prediction_train,
round(dtree_probability_train,3))
dtree_result_train <- dtree_result_train[,c(21,22,23,24,25,26)] %>%
setnames("price_range", "price_range_actual") %>%
arrange(price_range_actual) %>%
mutate(
no=seq(1:nrow(phone_train))
) %>%
select(7,1,2,3,4,5,6)
# Predict data test
dtree_prediction <- predict(dtree_model,phone_test)
dtree_probability <- predict(dtree_model,phone_test, type="prob")
dtree_probability <- data.frame(matrix(unlist(dtree_probability),
nrow=nrow(phone_test), byrow=T),stringsAsFactors=FALSE)
colnames(dtree_probability) <- c("low_price","medium_price","high_price","very_high_price")
# Test Data Predict
dtree_result <- cbind(phone_test, price_range_prediction=dtree_prediction,
round(dtree_probability,3))
dtree_result <- dtree_result[,c(21,22,23,24,25,26)] %>%
setnames("price_range", "price_range_actual") %>%
arrange(price_range_actual) %>%
mutate(
no=seq(1:nrow(phone_test))
) %>%
select(7,1,2,3,4,5,6)
# Evaluation (Pruning)
cfm_dtree_train <- confusionMatrix(
data =dtree_result_train$price_range_prediction,
reference =dtree_result_train$price_range_actual
)
ggplotConfusionMatrix(my_title = "Pruning Decision Tree: Model Evaluation on Data Train vs Data Test using Confussion Matrix",
dat_type="Train",
cfm=cfm_dtree_train,
low_color=mycolor_hex("smooth_blue"),
high_color =mycolor_hex("light_blue")) -> dtree_p1
cfm_dtree <- confusionMatrix(
data =dtree_result$price_range_prediction,
reference =dtree_result$price_range_actual
)
ggplotConfusionMatrix(my_title = "",
dat_type="Test",
cfm=cfm_dtree,
low_color=mycolor_hex("dark_pink"),
high_color =mycolor_hex("light_red")) -> dtree_p2
grid.arrange(dtree_p1, dtree_p2, ncol = 2)
| data | accuracy | sensitivity | specificity | precision |
|---|---|---|---|---|
| data train | 90.59 % | 90.59 % | 96.86 % | 90.76 % |
| data test | 87.63 % | 87.63 % | 95.88 % | 88.12 % |
Berdasar hasil evaluasi diatas, model decision tree dengan penerapan pruning yang dibuat mengalami peningkatan akurasi meskipun kurang signifikan. Tingkat akurasi pada data train sebesar 90.59% atau meningkat 0.38% dan tingkat akurasi pada data test sebesar 87.63% atau meningkat 1.27%. Model ini masih underfit, namun selisih tingkat akurasinya juga menurun menjadi 2.96% atau menurun 0.89%. Meskipun begitu perubahan tidak signifikan, dapat dikatan pruning yang dilakukan dapat meningkatan performa model Decision Tree sebelumnya. Hasil ini memang masih kurang baik, maka mari kita coba menggunakan metode Random Forest.
6.3 Random Forest
Random Forest
Random forest merupakan metode klasifikasi berbasis ensamble method dan dibangun dari beberapa decision tree yang berbeda karakteristiknya. Ensamble method sendiri merupakan dimana terdapat beberapa model berbeda yang dilatih untuk memecahkan masalah yang sama dan digabungkan untuk mendapatkan hasil terbaik. Penerapannya pada random forest yaitu metode Random Forest akan membangun beberapa Decision Tree yang dimana setiap membangun 1 tree digunakan observasi dan prediktor yang berbeda dari hasil sampling untuk dilatih dan mencari hasil terbaik. Performa model Random Forest ini akan kurang baik apabila data prediktor memiliki variansi rendah atau variansinya mendekati 0(nol). Maka, sebelum melakukan pemodelan mari kita cek variansinya dahulu:
# each factor has been converted before
nzero_var <- nearZeroVar(phone)
# exclude each variable that has low variance
#phone_rf <- phone[,-nzero_var]
#ncol(phone_rf)Hasil pengecekan menggunakan fungsi nearZeroVar diatas menunjukan tidak ada prediktor yang memiliki variansi rendah, sehingga dapat dilanjutkan ke proses pemodelan.
6.3.1 Model Random Forest
Model random forest akan memulai dengan inisialisasi random, maka perlu dilakukan set.seed supaya nilai yang dihasilkan konsisten. Berikut penerapan metode random forest menggunakan 500 tree.
set.seed(777)
rf_origin_model <- randomForest(price_range ~ .,
data = phone_train,
importance=TRUE,
ntree = 1000)
rf_origin_model##
## Call:
## randomForest(formula = price_range ~ ., data = phone_train, importance = TRUE, ntree = 1000)
## Type of random forest: classification
## Number of trees: 1000
## No. of variables tried at each split: 4
##
## OOB estimate of error rate: 11.66%
## Confusion matrix:
## low cost medium cost high cost very high cost class.error
## low cost 384 17 0 0 0.04239401
## medium cost 34 334 33 0 0.16708229
## high cost 0 47 330 24 0.17705736
## very high cost 0 0 32 369 0.07980050Informasi diatas merupakan informasi terkait model Random Forest yang dibuat. Model yang dibuat menggunakan 1000 tree dan jumlah variabel yang dicoba setiap percabangan ada 4 variabel. Lalu dari seluruh percobaan tersebut didapatkan nilai OOB (Out Of Box) dengan estimasi error rate pada data train sebesar 11.66%. Perlu kita ketahui, semakin banyak jumlah tree pada model Random Forest maka akan semakin berat komputasi yang dilakukan, maka dari itu perlu kita lihat jumlah Tree yang optimal untuk diterapkan pada model.
plot(rf_origin_model, main="Random Forest")
legend("topright", colnames(rf_origin_model$err.rate),col=1:6,cex=0.8,fill=1:6)
Grafik diatas menunjukan jumlah Tree dan Estimasi Error yang didapatkan. Dari 1000 tree yang dibuat, dapat dilihat nilai error menggunakan 370 sudah tergolong error minimum dari 1000 tree. Oleh karena itu, pada model random forest ini akan menggunakan 370 tree saja, sehingga beban komputasi berkurang.
set.seed(777)
rf_origin_model <- randomForest(price_range ~ .,
data = phone_train,
importance=TRUE,
ntree = 370)
rf_origin_model##
## Call:
## randomForest(formula = price_range ~ ., data = phone_train, importance = TRUE, ntree = 370)
## Type of random forest: classification
## Number of trees: 370
## No. of variables tried at each split: 4
##
## OOB estimate of error rate: 11.6%
## Confusion matrix:
## low cost medium cost high cost very high cost class.error
## low cost 384 17 0 0 0.04239401
## medium cost 34 333 34 0 0.16957606
## high cost 0 42 332 27 0.17206983
## very high cost 0 0 32 369 0.07980050Informasi diatas merupakan informasi terkait model Random Forest yang dibuat menggunakan 370 tree. Model dengan 370 tree menghasilkan nilai OOB (Out Of Box) dengan estimasi error rate sebesat 11.76%, yang dimana error ini relatif sama apabila menggunakan 1000 tree. Oleh karena, itu mari kita coba melakukan prediksi menggunakan model ini.
# Predict to data Train
rf_origin_result_train <- cbind(phone_train, price_range_prediction=rf_origin_model$predicted,
round(rf_origin_model$votes,3))
# Data Predict
rf_origin_result_train <- rf_origin_result_train[,c(21,22,23,24,25,26)] %>%
setnames("price_range", "price_range_actual") %>%
arrange(price_range_actual) %>%
mutate(
no=seq(1:nrow(phone_train))
) %>%
select(7,1,2,3,4,5,6)
# Predict to Data Test
rf_prediction <- predict(rf_origin_model, phone_test)
rf_probability <- predict(rf_origin_model, phone_test, type="prob")
# Data Predict
rf_origin_result <- cbind(phone_test, price_range_prediction=rf_prediction,
round(rf_probability,3))
rf_origin_result <- rf_origin_result[,c(21,22,23,24,25,26)] %>%
setnames("price_range", "price_range_actual") %>%
arrange(price_range_actual) %>%
mutate(
no=seq(1:nrow(phone_test))
) %>%
select(7,1,2,3,4,5,6)
data.table(rf_origin_result)## no price_range_actual price_range_prediction low cost medium cost
## 1: 1 low cost low cost 0.703 0.189
## 2: 2 low cost low cost 0.646 0.262
## 3: 3 low cost low cost 0.776 0.165
## 4: 4 low cost low cost 0.849 0.105
## 5: 5 low cost low cost 0.862 0.089
## ---
## 392: 392 very high cost high cost 0.054 0.116
## 393: 393 very high cost high cost 0.046 0.184
## 394: 394 very high cost very high cost 0.041 0.095
## 395: 395 very high cost very high cost 0.030 0.092
## 396: 396 very high cost high cost 0.057 0.135
## high cost very high cost
## 1: 0.073 0.035
## 2: 0.073 0.019
## 3: 0.035 0.024
## 4: 0.019 0.027
## 5: 0.043 0.005
## ---
## 392: 0.424 0.405
## 393: 0.411 0.359
## 394: 0.162 0.703
## 395: 0.227 0.651
## 396: 0.459 0.349Data diatas merupakan hasil prediksi metode Random Forest menggunakan 170 tree terhadap data tes. price_range_actual merupakan data sebenarnya dan price_range_prediction merupakan data hasil prediksi, kemudian Data low cost, medium cost, high cost dan very high cost merupakan nilai probability terhadap setiap kelas dari target variabel. Sehingga, hasil prediksi pada price_range_prediction diambil berdasarkan nilai probability yang paling tinggi. Mari kita cek hasil evaluasinya menggunakan Confussion Matrix:
# Model Evaluation Random Forest with 370 tree
cfm_rf_origin_train <- confusionMatrix(
data =rf_origin_result_train$price_range_prediction,
reference =rf_origin_result_train$price_range_actual
)
ggplotConfusionMatrix(my_title = "Random Forest: Model Evaluation on Data Train vs Data Test using Confussion Matrix",
dat_type="Train",
cfm=cfm_rf_origin_train,
low_color=mycolor_hex("smooth_blue"),
high_color =mycolor_hex("light_blue")) -> rf_p1
cfm_rf_origin <- confusionMatrix(
data =rf_origin_result$price_range_prediction,
reference =rf_origin_result$price_range_actual
)
ggplotConfusionMatrix(my_title = "",
dat_type="Test",
cfm=cfm_rf_origin,
low_color=mycolor_hex("dark_pink"),
high_color =mycolor_hex("light_red")) -> rf_p2
grid.arrange(rf_p1, rf_p2, ncol = 2)
| data | accuracy | sensitivity | specificity | precision |
|---|---|---|---|---|
| data train | 88.4 % | 88.4 % | 96.13 % | 88.35 % |
| data test | 89.39 % | 89.39 % | 96.46 % | 89.89 % |
Hasil evaluasi model Random Forest menggunakan Confussion Matrix diatas menunjukan Tingkat akurasi hasil klasifikasi lumayan bagus, dimana tingkat akurasi pada data train sebesar 88.4% dan tingkat akurasi pada data test sebesar 89.14%. Dapat dilihat juga, hasil klasifikasi data test pada harga kelas Low Cost meleset sebanyak 8 ponsel, hasil prediksi harga kelas Medium Cost meleset sebanyak 9 ponsel, hasil prediksi harga kelas High Cost meleset 15 ponsel dan hasil prediksi Harga kelas Very Hight Cost meleset 11 ponsel. Namun, dapat kita simpulkan bahwa metode Random Forest ini lebih baik daripada metode Naive Bayes dan metode Decision Tree yang sudah dicoba sebelumnya. Selain itu model Random Forest ini dapat dikatakan Fit karena selisih akurasi klasifikasi pada data train dan data test cukup kecil yaitu 0.74%. Mari kita coba Random Forest mengunakan K-Fold Cross Validation.
6.3.2 K-Fold Cross Validation
K-Fold Cross Validation adalah adalah salah satu metode Cross Validation yang membuat lipatan/partisi data sebanyak K dan mengulangi (meng-iterasi) experimennya sebanyak K juga. Pada pembagian train dan test sebelumnya, kita membagi data train sebanyak 1604 observasi. Misalkan kita menggunakan nilai K=10, berarti kita membagi 1604 data menjadi 10 partisi yang masing-masing memiliki 160 s.d. 161 data. Setelah melakukan 10 partisi, metode ini akan membagi 1 partisi sebagai data test dan 9 partisi lainnya menjadi data train untuk dilakukan iterasi sebanyak 10 kali. Dalam proses iterasi, setiap partisi akan mengalami proses sebagai data test dan data train sampai jumlah iterasi terpenuhi dengan syarat setiap iterasi menggunakan partisi data test dan partisi data train yang berbeda. Berikut ilustrasinya jika menggunakan K=5:
sumber: http://ethen8181.github.io/machine-learning/model_selection/model_selection.html
Beirkut pemodelan Random Forest dengan K-Fold Cross Validation menggunakan K=10
# Random Forest method with K-Fold Cross Validation using K=10
set.seed(777)
kf_control <- trainControl(method = 'repeatedcv', number = 10, repeats = 10)
rf_model <- train(price_range ~.,
data = phone_train,
method = "rf",
trControl= kf_control)
wd <- as.character(getwd())
saveRDS(object=rf_model, file=paste(paste(wd,"/model/",sep = ""),"phone_rf_kfold.rds",sep=""))Chunk dari model diatas tidak dirunning karena memakan waktu yang cukup lama. Hasil model ini disimpan dalam RDS sehingga bisa langsung di load. berikut hasilnya:
rf_kfold_model <- readRDS("model/phone_rf_kfold.rds")
#rf_model$finalModel[c("call", "confusion","oob.times")]
rf_kfold_model$finalModel##
## Call:
## randomForest(x = x, y = y, mtry = param$mtry)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 11
##
## OOB estimate of error rate: 9.98%
## Confusion matrix:
## low cost medium cost high cost very high cost class.error
## low cost 381 20 0 0 0.04987531
## medium cost 23 352 26 0 0.12219451
## high cost 0 29 347 25 0.13466334
## very high cost 0 0 37 364 0.09226933Data diatas merupakan informasi terkait model Random Forest dengan menerapkan K-Fold yang sudah dibuat. Model yang dibuat menggunakan 500 tree dan jumlah variabel yang dicoba setiap percabangan ada 11 variabel. Model ini mendapat nilai OOB (Out Of Box) dengan estimasi error rate pada data train sebesar 9.98%, yang dimana nilai error lebih kecil daripada model Random Forest yang dibuat sebelumnya (poin 6.3.1). Jika dilihat, hal yang jelas berbeda dari model random forest sebelumnya yaitu jumlah variabel/prediktor yang digunakan. Pada model sebelumnya hanya menggunakan 4 variabel, dan pada model ini menggunakan 11 variabel pada pada setiap partisinya. Pertanyaannya mengapa?
Kita tidak menentukan jumlah prediktor pada saat membuat model random forest ini, sehingga model akan memilih prediktor secara acak dan melakukan pembelajaran pada proses iterasi yang dilakukan, yang kemudian mencari akurasi optimum. Dapat dilihat pada plot diatas, akurasi optimum terletak ketika menggunakan 11 prediktor. Mari kita lihat, prediktor apa yang memiliki pengaruh besar pada model ini?
## rf variable importance
##
## Overall
## ram 100.00000
## battery_power 16.84609
## px_height 9.38821
## px_width 9.34513
## mobile_wt 3.18797
## int_memory 2.00165
## talk_time 1.63678
## pc 1.54560
## sc_w 1.46031
## sc_h 1.34155
## m_dep 1.24207
## clock_speed 1.18554
## fc 1.14131
## n_cores 1.02768
## four_g1 0.02808
## wifi1 0.02437
## dual_sim1 0.01995
## touch_screen1 0.01816
## three_g1 0.00683
## blue1 0.00000Data diatas ditampilkan berurutan mulai dari variabel yang paling penting/berpengaruh dalam menentukan kelas harga. Dari 20 variabel prediktor yang kita punya, ram merupakan variabel yang paling penting dan blue1 merupakan variabel yang paling tidak penting. Mari kita coba lihat hasil prediksi model ini terhadap data tes.
# Predict to data Train
rf_kfold_prediction_train <- predict(rf_kfold_model, phone_train)
rf_kfold_probability_train <- predict(rf_kfold_model, phone_train, type = "prob")
rf_kfold_result_train <- cbind(phone_train, price_range_prediction=rf_kfold_prediction_train,
round(rf_kfold_probability_train,3))
# Data Predict
rf_kfold_result_train <- rf_kfold_result_train[,c(21,22,23,24,25,26)] %>%
setnames("price_range", "price_range_actual") %>%
arrange(price_range_actual) %>%
mutate(
no=seq(1:nrow(phone_train))
) %>%
select(7,1,2,3,4,5,6)
# Predict to Data Test
rf_kfold_prediction <- predict(rf_kfold_model, phone_test)
rf_kfold_probability <- predict(rf_kfold_model, phone_test, type="prob")
# Data Predict
rf_kfold_result <- cbind(phone_test, price_range_prediction=rf_kfold_prediction,
round(rf_kfold_probability,3))
rf_kfold_result <- rf_kfold_result[,c(21,22,23,24,25,26)] %>%
setnames("price_range", "price_range_actual") %>%
arrange(price_range_actual) %>%
mutate(
no=seq(1:nrow(phone_test))
) %>%
select(7,1,2,3,4,5,6)
data.table(rf_kfold_result)## no price_range_actual price_range_prediction low cost medium cost
## 1: 1 low cost low cost 0.934 0.066
## 2: 2 low cost low cost 0.658 0.334
## 3: 3 low cost low cost 0.950 0.048
## 4: 4 low cost low cost 0.990 0.008
## 5: 5 low cost low cost 0.992 0.006
## ---
## 392: 392 very high cost very high cost 0.000 0.004
## 393: 393 very high cost high cost 0.000 0.052
## 394: 394 very high cost very high cost 0.000 0.002
## 395: 395 very high cost very high cost 0.000 0.004
## 396: 396 very high cost high cost 0.000 0.014
## high cost very high cost
## 1: 0.000 0.000
## 2: 0.008 0.000
## 3: 0.000 0.002
## 4: 0.002 0.000
## 5: 0.000 0.002
## ---
## 392: 0.480 0.516
## 393: 0.496 0.452
## 394: 0.058 0.940
## 395: 0.164 0.832
## 396: 0.522 0.464Data diatas merupakan hasil prediksi metode Random Forest yang menerapkan K-Fold Cross Validation terhadap data tes. price_range_actual merupakan data sebenarnya dan price_range_prediction merupakan data hasil prediksi, kemudian Data low cost, medium cost, high cost dan very high cost merupakan nilai probability terhadap setiap kelas dari target variabel. Sehingga, hasil prediksi pada price_range_prediction diambil berdasarkan nilai probability yang paling tinggi. Mari kita cek hasil evaluasinya menggunakan Confussion Matrix:
# Model Evaluation Random Forest using K-Fold Cross Validation K=10
cfm_rf_kfold_train <- confusionMatrix(
data =rf_kfold_result_train$price_range_prediction,
reference =rf_kfold_result_train$price_range_actual
)
ggplotConfusionMatrix(my_title = "Random Forest with K-Fold: Model Evaluation on Data Train vs Data Test using Confussion Matrix",
dat_type="Train",
cfm=cfm_rf_kfold_train,
low_color=mycolor_hex("smooth_blue"),
high_color =mycolor_hex("light_blue")) -> kfold_p1
cfm_rf_kfold <- confusionMatrix(
data =rf_kfold_result$price_range_prediction,
reference =rf_kfold_result$price_range_actual
)
ggplotConfusionMatrix(my_title = "",
dat_type="Test",
cfm=cfm_rf_kfold,
low_color=mycolor_hex("dark_pink"),
high_color =mycolor_hex("light_red")) -> kfold_p2
grid.arrange(kfold_p1, kfold_p2, ncol = 2)
| data | accuracy | sensitivity | specificity | precision |
|---|---|---|---|---|
| data train | 100 % | 100 % | 100 % | 100 % |
| data test | 92.17 % | 92.17 % | 97.39 % | 92.39 % |
Hasil evaluasi Confussion Matrix diatas menunjukan Tingkat akurasi hasil klasifikasi model ini 100% apabila menggunakan data data train sedangkan tingkat akurasi pada data test sebesar 92.17%. Dapat dilihat juga, hasil klasifikasi data test pada harga kelas Low Cost meleset sebanyak 6 ponsel, hasil prediksi harga kelas Medium Cost meleset sebanyak 10 ponsel, hasil prediksi harga kelas High Cost meleset 7 ponsel dan hasil prediksi Harga kelas Very Hight Cost meleset 8 ponsel. Jika hanya melihat tingkat akurasi saja, maka model ini merupakan model yang memiliki akurasi yang jauh lebih tinggi dari model Naive Bayes, Decision Tree dan Random Forest tanpa K-Fold, namun perlu dipertimbangkan dan butuh evaluasi lebih lanjut lagi karena model ini termasuk Underfit model dengan selisih yang cukup besar yaitu 7.83%.
6.4 Multinomial Regression
Multinomial Logistic Regression (MLR)
Multinomial Logistic Regression (MLR) merupakan regresi logistik yang digunakan saat variabel target bersifat multi-level atau lebih dari 2 kelas level. Sama seperti regresi linear dan regresi logistik, feature selection atau pemilihan variabel prediktor untuk pemodelan MLR bisa berdasarkan business wise atau dapat menggunakan pendekatan step-wise. Pada pemodelan ini, saya menggunakan model berdasarkan nilai AIC terkecil yang dihasilkan pendekatan step-wise. Berikut prosesnya:
# Model Fitting
mlnom_all <- nnet::multinom(price_range~.,data=phone_train)
# Step wise
mlnom_step_model <- step(
object = mlnom_all,
direction = c("both", "backward", "forward"),
trace = FALSE
)
wd <- as.character(getwd())
saveRDS(object=mlnom_step_model, file=paste(paste(wd,"/model/",sep = ""),"mlnom_step_model.rds",sep=""))Proses Step-wise diatas pada chunk diatas tidak saya jalankan karena hasilnya cukup panjang untuk ditampilkan. Namun berikut summary hasil pemodelannya:
## Call:
## nnet::multinom(formula = price_range ~ battery_power + clock_speed +
## dual_sim + fc + int_memory + mobile_wt + n_cores + pc + px_height +
## px_width + ram + sc_h + wifi, data = phone_train)
##
## Coefficients:
## (Intercept) battery_power clock_speed dual_sim1 fc
## medium cost -460.5756 0.1162919 -2.2767661 0.9957794 -0.4212571
## high cost -935.3460 0.2011965 -1.4660007 -1.5998200 -0.4700379
## very high cost -1784.7342 0.3189757 0.9165559 2.1055809 -1.3086756
## int_memory mobile_wt n_cores pc px_height px_width
## medium cost 0.09153642 -0.2664434 0.8512235 0.2191126 0.06787229 0.06815705
## high cost 0.20110007 -0.3704253 1.5454728 0.6885721 0.11452067 0.12064323
## very high cost 0.40548402 -0.7166483 1.7653956 1.3059461 0.19350520 0.18827259
## ram sc_h wifi1
## medium cost 0.1932683 -0.2590690 -3.389057
## high cost 0.3265007 -0.4937253 -6.683419
## very high cost 0.5213720 0.5646788 -15.747828
##
## Std. Errors:
## (Intercept) battery_power clock_speed dual_sim1 fc
## medium cost 0.002871156 0.002849983 0.3461121 0.3120213 0.2872219
## high cost 0.004111680 0.002997379 0.3777900 0.4738462 0.3188415
## very high cost 0.002423582 0.003232767 0.2995717 0.2411743 0.4092306
## int_memory mobile_wt n_cores pc px_height
## medium cost 0.04307162 0.03210234 0.2337184 0.1897263 0.002556629
## high cost 0.05137663 0.03685170 0.1900613 0.2117067 0.003146576
## very high cost 0.06129258 0.04089119 0.2403122 0.2490643 0.003618307
## px_width ram sc_h wifi1
## medium cost 0.002734334 0.002914374 0.2466561 0.3075387
## high cost 0.003041653 0.003203742 0.2694630 0.4007274
## very high cost 0.003451729 0.003297244 0.3036045 0.1826032
##
## Residual Deviance: 73.37633
## AIC: 157.3763Pada hasil summary model MLR diatas, nilai AIC terkecil dihasilkan yaitu 157.3763 dengan menggunakan 13 variabel. Dari nilai koefisien ini bisa diketahui pengaruh dari variabel prediktor tersebut bersifat postif atau negatif terhadap masing-masing kelas harga. Mari kita coba lakukan prediksi.
# Predict to data Train
mlnom_prediction_train <- predict(mlnom_step_model, phone_train)
mlnom_probability_train <- predict(mlnom_step_model, phone_train, type = "prob")
mlnom_result_train <- cbind(phone_train, price_range_prediction=mlnom_prediction_train,
round(mlnom_probability_train,3))
# Data Predict
mlnom_result_train <- mlnom_result_train[,c(21,22,23,24,25,26)] %>%
setnames("price_range", "price_range_actual") %>%
arrange(price_range_actual) %>%
mutate(
no=seq(1:nrow(phone_train))
) %>%
select(7,1,2,3,4,5,6)
# Predict to Data Test
mlnom_prediction <- predict(mlnom_step_model, phone_test)
mlnom_probability <- predict(mlnom_step_model, phone_test, type="prob")
# Data Predict
mlnom_result <- cbind(phone_test, price_range_prediction=mlnom_prediction,
round(mlnom_probability,3))
mlnom_result <- mlnom_result[,c(21,22,23,24,25,26)] %>%
setnames("price_range", "price_range_actual") %>%
arrange(price_range_actual) %>%
mutate(
no=seq(1:nrow(phone_test))
) %>%
select(7,1,2,3,4,5,6)
data.table(mlnom_result)## no price_range_actual price_range_prediction low cost medium cost
## 1: 1 low cost low cost 1 0
## 2: 2 low cost low cost 1 0
## 3: 3 low cost low cost 1 0
## 4: 4 low cost low cost 1 0
## 5: 5 low cost low cost 1 0
## ---
## 392: 392 very high cost very high cost 0 0
## 393: 393 very high cost very high cost 0 0
## 394: 394 very high cost very high cost 0 0
## 395: 395 very high cost very high cost 0 0
## 396: 396 very high cost very high cost 0 0
## high cost very high cost
## 1: 0 0
## 2: 0 0
## 3: 0 0
## 4: 0 0
## 5: 0 0
## ---
## 392: 0 1
## 393: 0 1
## 394: 0 1
## 395: 0 1
## 396: 0 1Data diatas merupakan hasil klasifikasi menggunakan metode Multinomial Logistic Regression terhadap data tes. price_range_actual merupakan data sebenarnya dan price_range_prediction merupakan data hasil prediksi, kemudian Data low cost, medium cost, high cost dan very high cost merupakan nilai probability terhadap setiap kelas dari target variabel. Sehingga, hasil prediksi pada price_range_prediction diambil berdasarkan nilai probability yang paling tinggi. Mari kita cek hasil evaluasinya menggunakan Confussion Matrix:
# Model Evaluation MLR
cfm_mlnom_train <- confusionMatrix(
data = mlnom_result_train$price_range_prediction,
reference =mlnom_result_train$price_range_actual
)
ggplotConfusionMatrix(my_title = "Multinomial Regression: Model Evaluation on Data Train vs Data Test using Confussion Matrix",
dat_type="Train",
cfm=cfm_mlnom_train,
low_color=mycolor_hex("smooth_blue"),
high_color =mycolor_hex("light_blue")) -> mlnom_p1
cfm_mlnom <- confusionMatrix(
data = mlnom_result$price_range_prediction,
reference = mlnom_result$price_range_actual
)
ggplotConfusionMatrix(my_title = "",
dat_type="Test",
cfm=cfm_mlnom,
low_color=mycolor_hex("dark_pink"),
high_color =mycolor_hex("light_red")) -> mlnom_p2
grid.arrange(mlnom_p1, mlnom_p2, ncol = 2)
| data | accuracy | sensitivity | specificity | precision |
|---|---|---|---|---|
| data train | 98.88 % | 98.88 % | 99.63 % | 98.88 % |
| data test | 97.73 % | 97.73 % | 99.24 % | 97.76 % |
Hasil evaluasi menggunakan Confussion Matrix diatas menunjukan Tingkat akurasi hasil klasifikasi model ini 98.88% apabila model ini diuji kembali terhadap data data train, sedangkan tingkat akurasi pada data test sebesar 97.73%. Dapat dilihat juga, hasil klasifikasi data test pada harga kelas Low Cost meleset sebanyak 3 ponsel, hasil prediksi harga kelas Medium Cost meleset sebanyak 2 ponsel, hasil prediksi harga kelas High Cost meleset 2 ponsel dan hasil prediksi Harga kelas Very Hight Cost meleset 2 ponsel. Berdasar hasil tersebut, maka model ini dapat dikatakan Fit karena selisih akurasi klasifikasi pada data train dan data test cukup kecil yaitu 1.15%. Selain itu, dapat kita simpulkan bahwa metode Multinomial Logistic Regression ini lebih baik daripada metode Naive Bayes, Decision Tree dan Random Forest yang sudah dicoba sebelumnya khusus untuk case ini karena merupakan Fitted Model yang menghasilkan akurasi paling tinggi.
7 Implementasi Model
Seperti yang dijelaskan sebelumnya, Perushaan ingin mengetahui klasifikasi harga dari setiap produk telepon seluler yang diproduksi oleh perusahaannya, sehinnga Perushaan memberikan 1000 data telepon seluler yang diproduksi oleh perusahaannya. Mengacu pada hasil evaluasi model sebelumnya, diketahui bahwa model yang memiliki performa paling baik adalah model Multinomial Logistic Regression, sehinga kita akan menggunakan model tersebut untuk mengklasifikasikan telepon seluler miliki perusahaan Perushaan.
# import data yang sudah divalidasi
phone_Perushaan <- read.csv("data_input/phone_validation.csv")
data.frame("total.data" = dim(phone_Perushaan)[1],
"total.variabel" = dim(phone_Perushaan)[2])## total.data total.variabel
## 1 1000 21# remove id
id <- phone_Perushaan$id
phone_Perushaan <- phone_Perushaan %>%
mutate(
blue = as.factor(blue),
dual_sim = as.factor(dual_sim),
four_g = as.factor(four_g),
three_g = as.factor(three_g),
touch_screen = as.factor(touch_screen),
wifi = as.factor(wifi)
) %>%
select(-id)
# Predict to Data Test
mlnom_prediction_Perushaan <- predict(mlnom_step_model, phone_Perushaan)
mlnom_probability_Perushaan <- predict(mlnom_step_model, phone_Perushaan, type="prob")
# Data Predict
phone_classification <- cbind(id, price_range_prediction=mlnom_prediction_Perushaan,
round(mlnom_probability_Perushaan,3),phone_Perushaan)
phone_classification %>%
arrange(id)%>%
head()## id price_range_prediction low cost medium cost high cost very high cost
## 1 1 very high cost 0 0 0 1
## 2 2 very high cost 0 0 0 1
## 3 3 high cost 0 0 1 0
## 4 4 very high cost 0 0 0 1
## 5 5 medium cost 0 1 0 0
## 6 6 very high cost 0 0 0 1
## battery_power blue clock_speed dual_sim fc four_g int_memory m_dep mobile_wt
## 1 1043 1 1.8 1 14 0 5 0.1 193
## 2 841 1 0.5 1 4 1 61 0.8 191
## 3 1807 1 2.8 0 1 0 27 0.9 186
## 4 1546 0 0.5 1 18 1 25 0.5 96
## 5 1434 0 1.4 0 11 1 49 0.5 108
## 6 1464 1 2.9 1 5 1 50 0.8 198
## n_cores pc px_height px_width ram sc_h sc_w talk_time three_g touch_screen
## 1 3 16 226 1412 3476 12 7 2 0 1
## 2 5 12 746 857 3895 6 0 7 1 0
## 3 3 4 1270 1366 2396 17 10 10 0 1
## 4 8 20 295 1752 3893 10 0 7 1 1
## 5 6 18 749 810 1773 15 8 7 1 0
## 6 8 9 569 939 3506 10 7 3 1 1
## wifi
## 1 0
## 2 0
## 3 1
## 4 0
## 5 1
## 6 1Data diatas merupakan hasil klasifikasi telepon seluler yang diproduksi oleh preusahaan Perushaan. price_range_prediction merupakan data hasil klasifikasi, kemudian Data low cost, medium cost, high cost dan very high cost merupakan nilai probability terhadap setiap kelas dari target variabel. Hasil prediksi pada price_range_prediction diambil berdasarkan nilai probability yang paling tinggi. Jika dilihat dari nilai probability yang dihasilkan, model ini sangat yakin dalam melakukan klasifikasi pada setiap datanya. Berikut proporsi hasil klasifikasinya:
# Proportion of Result
phone_classification %>% group_by(price_range_prediction) %>% summarise(freq=n()) %>%
ggplot( aes(x="", y=freq, fill=price_range_prediction)) +
geom_bar(stat="identity", width=1)+
coord_polar("y", start=0) +
geom_text(aes(label = paste0(round((freq/sum(freq))*100), "%")),
position = position_stack(vjust = 0.5),color="white")+
scale_fill_manual(values=c(mycolor_hex("dark_cream"),
mycolor_hex("smooth_blue"),
mycolor_hex("light_purple"),
mycolor_hex("light_red"))) +
labs(x = NULL, y = NULL, fill = "Price Range", title = "Proportion of Phone Price Classification Result on Perushaan's Company")+
theme_classic() +
theme(axis.line = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
plot.title = element_text(hjust = 0.5),
axis.title=element_text(size=9,face="bold"),
legend.position = "right"
)
Pie chart diatas merupakan proporsi hasil klasifikasi harga telepon seluler yang diproduksi oleh perusahaan Perushaan. Proporsi paling tinggi yaitu telepon seluler kelas Very High Cost dan proporsi paling rendah adalah kelas Medium Cost. Namun secara keseluruhan proporsi ini cukup seimbang.
8 Kesimpulan
Berdasarkan dataset dan pemodelan yang dilakukan, model Multinomial Logistic Regression (MLR) lebih baik daripada metode Naive Bayes, Decision Tree dan Random Forest khusus untuk case ini karena merupakan Fitted Model yang menghasilkan akurasi paling tinggi. Hasil evaluasi menggunakan Confussion Matrix pada model MLR menunjukan tingkat akurasi hasil klasifikasi model ini 98.88% apabila model ini diuji kembali terhadap data data train, sedangkan tingkat akurasi pada data test sebesar 97.73%. Sehinnga model ini yang paling layak diimplementasikan untuk masalah kalsifikasi harga telepon seluler di perusahaan Perushaan. Kemudian, berdasarkan proses implementasi model, diketahui telepon seluler kelas Very High Cost paling banyak diproduksi dan telepon seluler kelas Medium Cost paling sedikit diproduksi. Namun secara keseluruhan proporsi ini cukup seimbang, berikut detail jumlahnya:
