Logistic Regression & KNN
Mulatua Hasiholan
2022-08-28
1 . Pendahuluan
Project ini dilakukan untuk tugas Learning By Building sebagai
pendalaman dan pembelajaran mandiri atas materi Logistic Regression dan
KNN. Objektif dari project ini adalah melakukan eksplorasi target
variabel channel untuk dapat dianalisis variabel-variabel
apa yang mempengaruhi untuk sebuah data dikelompokan sebagai channel
klien tertentu. Dataset yang digunakan mengacu kepada klien dari
wholesale distributor.
2 . Import Data
Wholesale <-
read.csv("wholesale.csv")Mengubah sistem label nominal pada variabel target yang sebelumnya 1-2 menjadi 0-1 agar pembuatan model dan analisisnya dapat dilakukan dengan lebih mudah
Wholesale$Channel <-
ifelse(Wholesale$Channel=="1", yes = 0, no = 1)
3 . Pengecekan Atribut Data
glimpse(Wholesale)## Rows: 440
## Columns: 8
## $ Channel <dbl> 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 0,…
## $ 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…Deskripsi dari variabel yang ada pada dataset adalah sebagai berikut:
CHANNEL : customers Channel - 1 Hotel (Hotel/Restaurant/Cafe) or 0 Retail channel (Nominal)
REGION : customers Region Lisnon, Oporto or Other (Nominal)
FRESH : annual spending (m.u.) on fresh products (Continuous)
MILK : annual spending (m.u.) on milk products (Continuous)
GROCERY : annual spending (m.u.)on grocery products (Continuous)
FROZEN : annual spending (m.u.)on frozen products (Continuous)
DETERGENTS_PAPER : annual spending (m.u.) on detergents and paper products (Continuous)
DELICATESSEN : annual spending (m.u.)on and delicatessen products (Continuous)
4 . Penyesuaian Tipe Data
Pada data di atas terdapat 2 variabel yang harus diubah jenis datanya, yakni: Channel menjadi bentuk category. Selain itu juga ada data yang tidak dibutuhkan, yakni Region sehingga akan di-drop.
Wholesale <-
Wholesale %>%
select(!c(Region)) %>%
mutate(Channel = as.factor(Channel))
str(Wholesale)## 'data.frame': 440 obs. of 7 variables:
## $ Channel : Factor w/ 2 levels "0","1": 2 2 2 1 2 2 2 2 1 2 ...
## $ Fresh : int 12669 7057 6353 13265 22615 9413 12126 7579 5963 6006 ...
## $ Milk : int 9656 9810 8808 1196 5410 8259 3199 4956 3648 11093 ...
## $ Grocery : int 7561 9568 7684 4221 7198 5126 6975 9426 6192 18881 ...
## $ Frozen : int 214 1762 2405 6404 3915 666 480 1669 425 1159 ...
## $ Detergents_Paper: int 2674 3293 3516 507 1777 1795 3140 3321 1716 7425 ...
## $ Delicassen : int 1338 1776 7844 1788 5185 1451 545 2566 750 2098 ...
5 . Eksplorasi Data
5.1 Pengecekan Kelengkapan Data
colSums(is.na(Wholesale))## Channel Fresh Milk Grocery
## 0 0 0 0
## Frozen Detergents_Paper Delicassen
## 0 0 0Kolom yang akan digunakan semuanya memiliki data yang lengkap sehingga tidak ada baris yang perlu dihilangkan.
5.2 Pengecekan Skala Data
summary(Wholesale)## Channel Fresh Milk Grocery Frozen
## 0:298 Min. : 3 Min. : 55 Min. : 3 Min. : 25.0
## 1:142 1st Qu.: 3128 1st Qu.: 1533 1st Qu.: 2153 1st Qu.: 742.2
## Median : 8504 Median : 3627 Median : 4756 Median : 1526.0
## Mean : 12000 Mean : 5796 Mean : 7951 Mean : 3071.9
## 3rd Qu.: 16934 3rd Qu.: 7190 3rd Qu.:10656 3rd Qu.: 3554.2
## Max. :112151 Max. :73498 Max. :92780 Max. :60869.0
## Detergents_Paper Delicassen
## Min. : 3.0 Min. : 3.0
## 1st Qu.: 256.8 1st Qu.: 408.2
## Median : 816.5 Median : 965.5
## Mean : 2881.5 Mean : 1524.9
## 3rd Qu.: 3922.0 3rd Qu.: 1820.2
## Max. :40827.0 Max. :47943.0Kolom yang akan digunakan memiliki skala yang tidak jauh berbeda antara satu kolom dengan kolom lainnya sehingga tidak perlu dilakukan skala data.
6 . Cross Validation
6.1 Melakukan pemisahan antara data Train dan data Test
library(rsample)
RNGkind(sample.kind = "Rounding")## Warning in RNGkind(sample.kind = "Rounding"): non-uniform 'Rounding' sampler
## usedset.seed(100)
intrain <- initial_split(data = Wholesale, prop = 0.8,
strata = "Channel")
wholesale_train <- training(intrain)
wholesale_test <- testing(intrain)
6.2 Pengecekan class-imbalance data train
prop.table(table(wholesale_train$Channel))##
## 0 1
## 0.6780627 0.3219373Karena datanya tidak seimbang maka untuk kali ini akan dilakukan Downsample yakni mengurangi observasi mayoritas (kelas 0) hingga seimbang dengan yang minoritas (kelas 1). Proporsi yang seimbang penting agar model klasifikasi mempelajari karakteristik setiap kelas secara seimbang, tidak dominan hanya satu kelas saja. Hal ini mencegah model bias terhadap model dengan nilai yang lebih besar proporsinya sehingga hanya baik untuk memprediksi 1 kelas saja.
RNGkind(sample.kind = "Rounding")## Warning in RNGkind(sample.kind = "Rounding"): non-uniform 'Rounding' sampler
## usedset.seed(100)
wholesale_train_down <- downSample(x = wholesale_train %>% select(-c(Channel)),
y = wholesale_train$Channel,
yname = "Channel")
prop.table(table(wholesale_train_down$Channel))##
## 0 1
## 0.5 0.5Kolom target pada data train sudah memiliki data yang balance
7 . Pembuatan Model
model_wholesale <- glm(formula = Channel~.,
data = wholesale_train_down,
family = "binomial")## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurredsummary(model_wholesale)##
## Call:
## glm(formula = Channel ~ ., family = "binomial", data = wholesale_train_down)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.47918 -0.28178 -0.04021 0.09392 2.81240
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -4.115e+00 7.279e-01 -5.652 1.58e-08 ***
## Fresh 1.791e-05 2.452e-05 0.730 0.465
## Milk 7.045e-05 1.013e-04 0.696 0.487
## Grocery 1.017e-04 9.087e-05 1.120 0.263
## Frozen -6.306e-05 7.648e-05 -0.825 0.410
## Detergents_Paper 1.308e-03 2.315e-04 5.648 1.62e-08 ***
## Delicassen -4.929e-05 1.204e-04 -0.409 0.682
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 313.303 on 225 degrees of freedom
## Residual deviance: 90.404 on 219 degrees of freedom
## AIC: 104.4
##
## Number of Fisher Scoring iterations: 87.1 Deteksi Perfect Separation
#table(wholesale_train_down$Channel, wholesale_train_down$Grocery)
#table(wholesale_train_down$Channel, wholesale_train_down$Detergents_Paper)
#table(wholesale_train_down$Channel, wholesale_train_down$Delicassen)Variabel yang diduga mengalami Perfect Separation adalah Grocery, Detergent Papers, Delicassen. Hal ini terlihat dari datanya yang mengalami permisahaan skala 0-1 yang jelas sehingga predictor ini tidak akan digunakan pada persamaan yang baru.
7.2 Pembuatan Model Baru
7.2.1 Metode Klasifikasi (Glm)
Selanjutnya dibuat model baru hanya dengan prediktor yang bebas perfect separation.
model_wholesale_new <- glm(formula = Channel~Fresh+Milk+Frozen,
data = wholesale_train_down,
family = "binomial")
summary(model_wholesale_new)##
## Call:
## glm(formula = Channel ~ Fresh + Milk + Frozen, family = "binomial",
## data = wholesale_train_down)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.3139 -0.6737 -0.0001 0.6747 3.3519
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -9.852e-01 3.208e-01 -3.071 0.00214 **
## Fresh -3.481e-05 2.186e-05 -1.592 0.11129
## Milk 3.763e-04 5.543e-05 6.789 1.13e-11 ***
## Frozen -3.800e-04 7.729e-05 -4.917 8.81e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 313.30 on 225 degrees of freedom
## Residual deviance: 190.51 on 222 degrees of freedom
## AIC: 198.51
##
## Number of Fisher Scoring iterations: 67.2.2 Metode Step-Wise
Selain dengan model glm, juga dilakukan percobaan untuk mencari predictor dengan metode Step-Wise (Backward) untuk mendapatkan nilai AIC yang optimum.
model_wholesale_step <- step(object = model_wholesale_new,
direction = "backward",
trace = 0)
summary(model_wholesale_step)##
## Call:
## glm(formula = Channel ~ Fresh + Milk + Frozen, family = "binomial",
## data = wholesale_train_down)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.3139 -0.6737 -0.0001 0.6747 3.3519
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -9.852e-01 3.208e-01 -3.071 0.00214 **
## Fresh -3.481e-05 2.186e-05 -1.592 0.11129
## Milk 3.763e-04 5.543e-05 6.789 1.13e-11 ***
## Frozen -3.800e-04 7.729e-05 -4.917 8.81e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 313.30 on 225 degrees of freedom
## Residual deviance: 190.51 on 222 degrees of freedom
## AIC: 198.51
##
## Number of Fisher Scoring iterations: 6Ternyata pilihan predictor tidak berbeda dibandingkan dengan model
yang dibuat sebelumnya.
7.2.3 Interpretasi Model
exp(model_wholesale_new$coefficients)## (Intercept) Fresh Milk Frozen
## 0.3733737 0.9999652 1.0003764 0.9996201Setiap kenaikan 1 satuan pada nilai Milk/Fresh/Frozen maka
kemungkinan dia adalah Wholesale akan 1 kali lebih mungkin dibandingkan
nilai di bawahnya dengan catatan variabel lainnya konstan (nilainya
sama).
8 . Prediksi
wholesale_test$pred_channel <- predict(object = model_wholesale_new,
newdata = wholesale_test,
type = "link")
head(wholesale_test,3)## Channel Fresh Milk Grocery Frozen Detergents_Paper Delicassen pred_channel
## 3 1 6353 8808 7684 2405 3516 7844 1.194235
## 4 0 13265 1196 4221 6404 507 1788 -3.430331
## 5 1 22615 5410 7198 3915 1777 5185 -1.224345Klasifikasi data wholesale_test berdasarkan pred_wholesale_new dan disimpan pada kolom baru bernama pred_label menggunakan threshold 0.5
wholesale_test$pred_channel_label <- ifelse(test = wholesale_test$pred_channel > 0.5,
yes = 1,
no = 0)
head(wholesale_test,3)## Channel Fresh Milk Grocery Frozen Detergents_Paper Delicassen pred_channel
## 3 1 6353 8808 7684 2405 3516 7844 1.194235
## 4 0 13265 1196 4221 6404 507 1788 -3.430331
## 5 1 22615 5410 7198 3915 1777 5185 -1.224345
## pred_channel_label
## 3 1
## 4 0
## 5 0Melihat hasil prediksi dibandingkan dengan data aktual
head(wholesale_test %>%
select(pred_channel, pred_channel_label, Channel))## pred_channel pred_channel_label Channel
## 3 1.1942348 1 1
## 4 -3.4303313 0 0
## 5 -1.2243446 0 1
## 6 1.5419042 1 1
## 9 0.0184746 0 0
## 10 2.5396148 1 1
9 . Evaluasi Model
9.1 Confusion Matrix Model Klasifikasi
confusionMatrix(data = as.factor(wholesale_test$pred_channel_label),
reference = wholesale_test$Channel,
positive = "1") ## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 54 10
## 1 6 19
##
## Accuracy : 0.8202
## 95% CI : (0.7245, 0.8936)
## No Information Rate : 0.6742
## P-Value [Acc > NIR] : 0.001565
##
## Kappa : 0.5757
##
## Mcnemar's Test P-Value : 0.453255
##
## Sensitivity : 0.6552
## Specificity : 0.9000
## Pos Pred Value : 0.7600
## Neg Pred Value : 0.8438
## Prevalence : 0.3258
## Detection Rate : 0.2135
## Detection Prevalence : 0.2809
## Balanced Accuracy : 0.7776
##
## 'Positive' Class : 1
##
9.2 Confusion Matrix K-NN
9.2.1 Nilai optimum K & Data Train-Test
sqrt(nrow(wholesale_train_down))## [1] 15.0333# variabel prediktor (x)
wholesale_train_x_KNN <- select(wholesale_train_down, -Channel)
wholesale_test_x_KNN <- select(wholesale_test, -Channel, -pred_channel, -pred_channel_label)
#variabel target (y: kategorikal)
wholesale_train_y_KNN <- select(wholesale_train_down, Channel)
wholesale_test_y_KNN <- select(wholesale_test, Channel)9.2.2 Perhitungan menggunakan KNN
wholesale_KNN <- knn(train = wholesale_train_x_KNN,
test = wholesale_test_x_KNN,
cl = wholesale_train_y_KNN$Channel,
k = 15)
head(wholesale_KNN)## [1] 1 0 0 1 0 1
## Levels: 0 19.2.3 Pembuatan Confusion Matrix K-NN
confusionMatrix(data = as.factor(wholesale_KNN),
reference = wholesale_test_y_KNN$Channel,
positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 53 3
## 1 7 26
##
## Accuracy : 0.8876
## 95% CI : (0.8031, 0.9448)
## No Information Rate : 0.6742
## P-Value [Acc > NIR] : 2.711e-06
##
## Kappa : 0.7531
##
## Mcnemar's Test P-Value : 0.3428
##
## Sensitivity : 0.8966
## Specificity : 0.8833
## Pos Pred Value : 0.7879
## Neg Pred Value : 0.9464
## Prevalence : 0.3258
## Detection Rate : 0.2921
## Detection Prevalence : 0.3708
## Balanced Accuracy : 0.8899
##
## 'Positive' Class : 1
##
10 . Kesimpulan
Kesimpulan untuk menentukan metode terbaik dilakukan dengan
membandingkan nilai accuracy metode Logistic Regression vs KNN.
Alasan evaluasi akan didasarkan pada nilai Accuracy adalah:
Dengan tujuan ingin memprediksi kelompok customer tertentu untuk membuat strategi marketing untuk tiap kelompok membuat kedua kelas yang ada pada analisis menjadi sama pentingnya.
Data yang digunakan pada saat training sudah balance, dan data keseluruhan perbedaan antar kelas Channel tidak ekstrim.
Dari Confusion Matrix di kedua metode terlihat bahwa nilai accuracy dengan menggunakan metode KNN memiliki nilai yang lebih baik yakni 89% dibandingkan dengan model logistik regresi dengan nilai accuracy 82%. Hal ini menunjukkan bahwa pada kasus ini, KNN lebih mampu melakukan prediksi yang tepat pada setiap kelas dibandingkan jika menggunakan Logistik Regresi.