Pendahuluan
Apa yang akan kita lakukan?
Kita akan mencoba melakukan prediksi terhadap data wholesale dengan model klasifikasi. Saya sebagai seorang distributor ingin melakukan penghabisan stok bahan yang memiliki kadarluarsa dalam jangka waktu dekat, dengan memberikan promo/diskon terhadap jenis perusahaan yang konsumsi barang tersbut dengan cepat , seperti horeca
Data
Package & Import Data
library(tidyverse) # feature engineering
library(rsample) # split data
library(caret) # untuk confusion matrix
library(car) # untuk uji VIF
options(scipen = 99999)ws <- read.csv("wholesale.csv")
summary(ws)## Channel Region Fresh Milk
## Min. :1.000 Min. :1.000 Min. : 3 Min. : 55
## 1st Qu.:1.000 1st Qu.:2.000 1st Qu.: 3128 1st Qu.: 1533
## Median :1.000 Median :3.000 Median : 8504 Median : 3627
## Mean :1.323 Mean :2.543 Mean : 12000 Mean : 5796
## 3rd Qu.:2.000 3rd Qu.:3.000 3rd Qu.: 16934 3rd Qu.: 7190
## Max. :2.000 Max. :3.000 Max. :112151 Max. :73498
## Grocery Frozen Detergents_Paper Delicassen
## Min. : 3 Min. : 25.0 Min. : 3.0 Min. : 3.0
## 1st Qu.: 2153 1st Qu.: 742.2 1st Qu.: 256.8 1st Qu.: 408.2
## Median : 4756 Median : 1526.0 Median : 816.5 Median : 965.5
## Mean : 7951 Mean : 3071.9 Mean : 2881.5 Mean : 1524.9
## 3rd Qu.:10656 3rd Qu.: 3554.2 3rd Qu.: 3922.0 3rd Qu.: 1820.2
## Max. :92780 Max. :60869.0 Max. :40827.0 Max. :47943.0kita bisa simpulkan dari sumarry terdapat : 1. terdapat outlier pada hampir keseluruhan data( kecuali channel region ), dilihat dari nilai max dan perbedaan nilai antara mean dan median, outlier ini dapat mempengaruhi model yang akan kita buat
Data Check
glimpse(ws)## Rows: 440
## Columns: 8
## $ Channel <int> 2, 2, 2, 1, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 1, 2, 1,~
## $ Region <int> 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3,~
## $ Fresh <int> 12669, 7057, 6353, 13265, 22615, 9413, 12126, 7579, 5~
## $ Milk <int> 9656, 9810, 8808, 1196, 5410, 8259, 3199, 4956, 3648,~
## $ Grocery <int> 7561, 9568, 7684, 4221, 7198, 5126, 6975, 9426, 6192,~
## $ Frozen <int> 214, 1762, 2405, 6404, 3915, 666, 480, 1669, 425, 115~
## $ Detergents_Paper <int> 2674, 3293, 3516, 507, 1777, 1795, 3140, 3321, 1716, ~
## $ Delicassen <int> 1338, 1776, 7844, 1788, 5185, 1451, 545, 2566, 750, 2~
) . FRESH: pengeluaran tahunan (m.u.) untuk produk segar (Berkelanjutan) . MILK: pengeluaran tahunan (m.u.) untuk produk susu (Berkelanjutan) . GROCERY: pengeluaran tahunan (m.u.) untuk produk grosir (Berkelanjutan) . FROZEN: pengeluaran tahunan (m.u.) untuk produk beku (Berkelanjutan) . DETERGENTS_PAPER: pengeluaran tahunan (m.u.) untuk deterjen dan produk kertas (Berkelanjutan) . DELICATESSEN: pengeluaran tahunan (m.u.) dan produk makanan jadi (Berkelanjutan) . CHANNEL: saluran pelanggan - Horeca (Hotel / Restoran / Kafe) (1) atau saluran Ritel (Nominal) (2) . REGION: Wilayah pelanggan - Lisnon (1), Oporto(2) atau Lainnya (3)
Check Unique
unique(ws$Channel)## [1] 2 1unique(ws$Region)## [1] 3 1 2Variabel Channel dengan Region dapat kita ubah menjadi tipe data faktor
Check Missing Value
anyNA(ws)## [1] FALSETidak ada NA pada data
Change Type Data Set
tws <- ws %>%
mutate(Region = as.factor(Region))
tws$Channel <- factor(tws$Channel, levels = c(1,2), labels = c("1","0"))
datas_new <- twskita mengubah data channel kategori 2 menjadi 0 , untuk menjadikannya lebih umum dan tipe data sudah berhasil diganti menjadi kategori/faktor
Check Persebaran data
tws %>% ggplot(aes(x=Fresh,y=Milk,col= Channel))+
geom_point()
dari grafik yang didapat dapat disimpulkan bahwa sebenarnya data yang digunakan tidak baik untuk dilakukan model klasifikasi, dikarenakan data cenderung berada di sisi sebelah kiri, sehingga ketika dilakukan siqmoid model tidak akn mendapatkan klasifikasi yang baik
Regresi Logistik
Pre-Processing Data
prop.table(table(datas_new$Channel))##
## 1 0
## 0.6772727 0.3227273terlihat proporsi data antara horeca dan ritel cukup seimbang
table(datas_new$Channel)##
## 1 0
## 298 142terdapat 298 data horeca dan 142 data ritel
Splitting Train-Test
set.seed(26)
init <- initial_split(data = datas_new,prop = 0.8, strata = Channel)
train <- training(init)
test <- testing(init)Dilakukan penetapan set.seed agar hasil random ketika digunakan oleh orang lain tidak berubah ubah , pemilihan angka 26 merupakan berdasarkan angka kelahiran saya, untuk penentuan angka ini bebas.
Data di Split menjadi dua bagian dengan proporsi data yaitu 80% (train) dan 20%(test)
prop.table(table(train$Channel))##
## 1 0
## 0.6770538 0.3229462prop.table(table(test$Channel))##
## 1 0
## 0.6781609 0.3218391Nice!. Setelah dilakukan split data dan dilakukan pengecekan hasil split data terhadap proporsi target kita didapatkan hasil yang sama dengan proprosi sebelumnya.
Model Fitting
Pertama, Mari kita membuat model dengan menggunakan seluruh varibel yang ada dengan target yaitu Channel
model_1 <- glm(formula = Channel~., data = train, family = "binomial")## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurredsummary(model_1)##
## Call:
## glm(formula = Channel ~ ., family = "binomial", data = train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.57291 -0.33610 -0.22455 0.02574 2.95986
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -5.201388782 0.823090856 -6.319 0.000000000263 ***
## Region2 2.221140908 0.898295934 2.473 0.0134 *
## Region3 1.631890428 0.682836580 2.390 0.0169 *
## Fresh -0.000003681 0.000020226 -0.182 0.8556
## Milk 0.000068299 0.000062680 1.090 0.2759
## Grocery 0.000120770 0.000066113 1.827 0.0677 .
## Frozen -0.000099478 0.000092176 -1.079 0.2805
## Detergents_Paper 0.001006858 0.000172580 5.834 0.000000005407 ***
## Delicassen -0.000146850 0.000117632 -1.248 0.2119
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 444.12 on 352 degrees of freedom
## Residual deviance: 159.22 on 344 degrees of freedom
## AIC: 177.22
##
## Number of Fisher Scoring iterations: 7glm.fit: fitted probabilities numerically 0 or 1 occurredList of 30 Terdapat warning yang menyatakan bahwa model yang digunakan terdapat Perfect Separator. Berdasarkan hasil Sumaary sebelumnya dapat dilihat bahwa terdapat banyak data outlier pada beberapa Variabel contohnya Grocery Dan Region. Mari kita liat visualisasinya
plot(train$Channel, train$Grocery)
#dont use grocery
# GGally::ggcorr(train %>%
# select_if(is.numeric),label = TRUE)dari hasil visualisasi dapat disimpulkan bahwa outlier pada data 1 atau Horeca masih dalam range data 0 atau retail sehingga kita putuskan untuk tidak menggunakan variabel grocery.
model_2 <- glm(formula = Channel~Frozen+Milk+Fresh+Region+Delicassen, data = train, family = "binomial")
summary(model_2)##
## Call:
## glm(formula = Channel ~ Frozen + Milk + Fresh + Region + Delicassen,
## family = "binomial", data = train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.0375 -0.6407 -0.3098 0.4187 3.1345
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.62141434 0.48490721 -5.406 0.00000006444338666 ***
## Frozen -0.00032007 0.00008168 -3.918 0.00008916896821818 ***
## Milk 0.00036731 0.00004640 7.916 0.00000000000000245 ***
## Fresh -0.00002734 0.00001488 -1.838 0.06606 .
## Region2 1.76834867 0.60529418 2.921 0.00348 **
## Region3 0.99462677 0.45005581 2.210 0.02710 *
## Delicassen -0.00006697 0.00007483 -0.895 0.37080
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 444.12 on 352 degrees of freedom
## Residual deviance: 277.26 on 346 degrees of freedom
## AIC: 291.26
##
## Number of Fisher Scoring iterations: 6Nice! Perfect Separator berhasil kita keluarkan, sekarang mari kita coba membuat model dengan stepwise
summary(step(model_2, direction = "both", trace = 0))##
## Call:
## glm(formula = Channel ~ Frozen + Milk + Fresh + Region, family = "binomial",
## data = train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.0102 -0.6435 -0.2944 0.4226 3.2176
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.55817787 0.47575830 -5.377 0.000000075714664444 ***
## Frozen -0.00036765 0.00006623 -5.551 0.000000028462078989 ***
## Milk 0.00035340 0.00004326 8.169 0.000000000000000312 ***
## Fresh -0.00002527 0.00001449 -1.745 0.08106 .
## Region2 1.73424777 0.60113357 2.885 0.00391 **
## Region3 0.95970991 0.44418240 2.161 0.03072 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 444.12 on 352 degrees of freedom
## Residual deviance: 278.08 on 347 degrees of freedom
## AIC: 290.08
##
## Number of Fisher Scoring iterations: 6Dari Sumarry yang didapatkan bisa disimpulkan bahwa: 1. hampir semua variabel yang digunakan signifikan kecuali variabel Fresh 2. Nilai Estimate Intercept(log off odds) Sebesar -2.5581 3. Nilai Estimate Milk sebesar 0.00035340 dan bernilai positif maka disimpulkan setiap peningkatan 1 pada Variabel milk akan meningkatkan nilai prediksi channel sebesar 0.00035340 3. Nilai Estimate Frozen sebesar -0.00036765 dan bernilai negatif maka disimpulkan setiap peningkatan 1 pada Variabel Frozen akan menurunkan nilai prediksi channel sebesar 0.00035340 4. Nilai Estimate Pada Region2 sebesar 1.73424777 dan bernilai positif maka disimpulkan setiap peningkatan 1 pada variabel Region 2 maka akan meningkatkan nilai prediksi sebesar 1.73424777 4. Nilai Estimate Pada Region3 sebesar 0.95970991 dan bernilai positif maka disimpulkan setiap peningkatan 1 pada variabel Region 3 maka akan meningkatkan nilai prediksi sebesar 0.95970991
Uji Multicolinearitas
vif(step(model_2, direction = "both", trace = 0))## GVIF Df GVIF^(1/(2*Df))
## Frozen 2.054515 1 1.433358
## Milk 1.933221 1 1.390403
## Fresh 1.278249 1 1.130597
## Region 1.086509 2 1.020959Berdasarkan Uji asumsi terlihat tidak adanya nilai VIF yang lebih dari 10 artinya tidak adanya hubungan yang kuat antar variabel prediktornya
Prediction
kita lakukan pengujian model dengan data test
test$pred.channel <- predict(object = model_2, newdata = test, type = "response")test$pred.label <- ifelse(test$pred.channel<0.5,0,1)
test$pred.label <- as.factor(test$pred.label)
test[1:10, c("Channel", "pred.label")]## Channel pred.label
## 1 0 1
## 10 0 1
## 11 0 0
## 13 0 1
## 14 0 0
## 15 0 1
## 16 1 0
## 22 1 0
## 30 1 0
## 40 1 0Dalam syntax diatas, ketika probabilitas data test lebih dari 0.5, artinya dia Horeca atau Retail. setelah model dilakukan pengujian terhadap data test maka kita melihat bagaimana hasil prediksi dengan aktual
Model Evaluation
Confusion Matrix
library(caret)
confusionMatrix(data = test$pred.label, reference = test$Channel, positive = "1")## Warning in confusionMatrix.default(data = test$pred.label, reference =
## test$Channel, : Levels are not in the same order for reference and data.
## Refactoring data to match.## Confusion Matrix and Statistics
##
## Reference
## Prediction 1 0
## 1 6 20
## 0 53 8
##
## Accuracy : 0.1609
## 95% CI : (0.0909, 0.2552)
## No Information Rate : 0.6782
## P-Value [Acc > NIR] : 1.0000000
##
## Kappa : -0.4678
##
## Mcnemar's Test P-Value : 0.0001802
##
## Sensitivity : 0.10169
## Specificity : 0.28571
## Pos Pred Value : 0.23077
## Neg Pred Value : 0.13115
## Prevalence : 0.67816
## Detection Rate : 0.06897
## Detection Prevalence : 0.29885
## Balanced Accuracy : 0.19370
##
## 'Positive' Class : 1
## Re-call/Sensitivity = dari semua data aktual yang positif, seberapa mampu proporsi model saya menebak benar. Specificity = dari semua data aktual yang negatif, seberapa mampu proporsi model saya menebak yang benar. Accuracy = seberapa mampu model saya menebak dengan benar target Y. Precision = dari semua hasil prediksi, seberapa mampu model saya dapat menebak benar kelas positif
Berdasarkan hasil confusionMatrix diatas, dapat kita ambil informasi bahwa kemampuan model dalam menebak target Y (1horeca atau 0retail) sebesar 16%. Sedangkan dari keluruhan data aktual channel tipe Horeca, model dapat mampu menebak benar sebesar 10,2%. Dari keseluruhan data aktual channel tipe retail, model mampu menebak dengan benar sebesar 23%. Dari keseluruhan hasil prediksi yang mampu ditebak oleh model, model mampu menebak benar kelas positif sebesar 6%.
Hasil model yang kurang baik sebenarnya bukan dikarenakan pemilihan prediktor yang kurang baik melaikan persebaran daata yang ada pada prediktor cukup tidak bagus, terdapat banayak outlier sehingga tidak menampilkan kurva sigmoid
K-NN
Pre-Processing & Splitting Train-Test
#predictor
ws_train_x <- train %>%
select(-Channel)
ws_test_x <- test %>%
select(-c("Channel","pred.channel","pred.label"))
#target
ws_train_y <- train %>%
select(Channel)
ws_test_y <- test %>%
select(Channel)Scale & K Value
#scale
ws_train_xs <- scale(ws_train_x %>% select(-Region))
ws_test_xs <- scale(ws_test_x %>% select(-Region))
dim(ws_train_xs)## [1] 353 6dim(ws_test_xs)## [1] 87 6#K Value
sqrt(nrow(ws_train_xs))## [1] 18.78829Model Fitting
library(class)
ws_pred <- knn(ws_train_xs,ws_test_xs,cl = ws_train_y$Channel,k=19)
head(ws_pred)## [1] 0 0 0 0 0 0
## Levels: 1 0Model Evaluation
Confusion matrix
confusionMatrix(data = ws_pred,reference = as.factor(ws_test_y$Channel),positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 1 0
## 1 55 2
## 0 4 26
##
## Accuracy : 0.931
## 95% CI : (0.8559, 0.9743)
## No Information Rate : 0.6782
## P-Value [Acc > NIR] : 0.00000001437
##
## Kappa : 0.8449
##
## Mcnemar's Test P-Value : 0.6831
##
## Sensitivity : 0.9322
## Specificity : 0.9286
## Pos Pred Value : 0.9649
## Neg Pred Value : 0.8667
## Prevalence : 0.6782
## Detection Rate : 0.6322
## Detection Prevalence : 0.6552
## Balanced Accuracy : 0.9304
##
## 'Positive' Class : 1
## Hasil penelitian menunjukkan bahwa K-NN kami dengan K = 19 memiliki akurasi 93,1% pada dataset uji, artinya 93,1% data kami diklasifikasikan dengan benar. Nilai sensitivitas dan spesifisitas 93.22% dan 92.86%. Ini menunjukkan bahwa sebagian besar hasil positif diklasifikasikan dengan benar tetapi hanya sejumlah kecil hasil negatif yang diklasifikasikan dengan benar. Nilai prediksi presisi / positif adalah 96.49%, artinya 96.49% prediksi positif kami benar.
Conclusion
Berdasarkan Evaluasi kedua model, dapat disimpulkan bahwa model klasifikasi memperlihatkan nilai akurasi , recall , maupun prediksi yang sangat kecil , sementara untuk model Knn memperlihatkan hasil yang sangat bagus. Berdasarkan hasil EDA dari awal sebenarnya dapat disimpulkan bahwa data yang digunakan tidak cocok untuk dilakukan model klasifikasi(logistik).