Analisis Multinominal Logistic Regression & Ordinal Logistic Regression
- Shafira Nabila Noer Poerwanto (23031554011)
- Ratu Arum Rahma Gati (23031554142)
- Alamsyah Ramadhan Vaganza (23031554192)
- Multinominal Logistic Regression
# Load package
library(readr)## Warning: package 'readr' was built under R version 4.4.3# Load data CSV lokal
data <- read.csv("C:\\Users\\dell\\Downloads\\data_anmul\\wine_data.csv")
# Cek 5 baris pertama
head(data)## Alcohol Malicacid Ash Alcalinity_of_ash Magnesium Total_phenols Flavanoids
## 1 14.23 1.71 2.43 15.6 127 2.80 3.06
## 2 13.20 1.78 2.14 11.2 100 2.65 2.76
## 3 13.16 2.36 2.67 18.6 101 2.80 3.24
## 4 14.37 1.95 2.50 16.8 113 3.85 3.49
## 5 13.24 2.59 2.87 21.0 118 2.80 2.69
## 6 14.20 1.76 2.45 15.2 112 3.27 3.39
## Nonflavanoid_phenols Proanthocyanins Color_intensity Hue
## 1 0.28 2.29 5.64 1.04
## 2 0.26 1.28 4.38 1.05
## 3 0.30 2.81 5.68 1.03
## 4 0.24 2.18 7.80 0.86
## 5 0.39 1.82 4.32 1.04
## 6 0.34 1.97 6.75 1.05
## X0D280_0D315_of_diluted_wines Proline class
## 1 3.92 1065 1
## 2 3.40 1050 1
## 3 3.17 1185 1
## 4 3.45 1480 1
## 5 2.93 735 1
## 6 2.85 1450 1# Struktur data
str(data)## 'data.frame': 178 obs. of 14 variables:
## $ Alcohol : num 14.2 13.2 13.2 14.4 13.2 ...
## $ Malicacid : num 1.71 1.78 2.36 1.95 2.59 1.76 1.87 2.15 1.64 1.35 ...
## $ Ash : num 2.43 2.14 2.67 2.5 2.87 2.45 2.45 2.61 2.17 2.27 ...
## $ Alcalinity_of_ash : num 15.6 11.2 18.6 16.8 21 15.2 14.6 17.6 14 16 ...
## $ Magnesium : int 127 100 101 113 118 112 96 121 97 98 ...
## $ Total_phenols : num 2.8 2.65 2.8 3.85 2.8 3.27 2.5 2.6 2.8 2.98 ...
## $ Flavanoids : num 3.06 2.76 3.24 3.49 2.69 3.39 2.52 2.51 2.98 3.15 ...
## $ Nonflavanoid_phenols : num 0.28 0.26 0.3 0.24 0.39 0.34 0.3 0.31 0.29 0.22 ...
## $ Proanthocyanins : num 2.29 1.28 2.81 2.18 1.82 1.97 1.98 1.25 1.98 1.85 ...
## $ Color_intensity : num 5.64 4.38 5.68 7.8 4.32 6.75 5.25 5.05 5.2 7.22 ...
## $ Hue : num 1.04 1.05 1.03 0.86 1.04 1.05 1.02 1.06 1.08 1.01 ...
## $ X0D280_0D315_of_diluted_wines: num 3.92 3.4 3.17 3.45 2.93 2.85 3.58 3.58 2.85 3.55 ...
## $ Proline : int 1065 1050 1185 1480 735 1450 1290 1295 1045 1045 ...
## $ class : int 1 1 1 1 1 1 1 1 1 1 ...# Jumlah baris (observasi)
nrow(data)## [1] 178# Nama kolom
names(data)## [1] "Alcohol" "Malicacid"
## [3] "Ash" "Alcalinity_of_ash"
## [5] "Magnesium" "Total_phenols"
## [7] "Flavanoids" "Nonflavanoid_phenols"
## [9] "Proanthocyanins" "Color_intensity"
## [11] "Hue" "X0D280_0D315_of_diluted_wines"
## [13] "Proline" "class"# Ubah kolom target ke faktor
data$class <- as.factor(data$class)
# Distribusi target (kelas wine)
table(data$class)##
## 1 2 3
## 59 71 48Baris kode tersebut digunakan untuk memastikan apkah data siap untuk digunakan. kolom class diubah menjadi faktor karena berfungsi sebagai target kategori. Jumlah kelas dapat dilihat melalui fungsi table()
# Load library
library(nnet)
# Fit model multinomial logistic regression
model <- multinom(class ~ ., data = data, model = TRUE)## # weights: 45 (28 variable)
## initial value 195.552987
## iter 10 value 25.707822
## iter 20 value 4.439185
## iter 30 value 0.068485
## iter 40 value 0.000861
## final value 0.000002
## converged# Ringkasan model
summary(model)## Call:
## multinom(formula = class ~ ., data = data, model = TRUE)
##
## Coefficients:
## (Intercept) Alcohol Malicacid Ash Alcalinity_of_ash Magnesium
## 2 848.4648 -50.4198 -16.82837 -376.29272 30.77966 -0.3187808
## 3 -149.9645 61.7616 -14.00633 -93.30316 28.10216 -4.2882308
## Total_phenols Flavanoids Nonflavanoid_phenols Proanthocyanins Color_intensity
## 2 115.4110 -93.03559 358.9488 100.5827 -24.09276
## 3 267.9405 -256.98401 -389.8206 151.4916 37.77146
## Hue X0D280_0D315_of_diluted_wines Proline
## 2 442.3062 -26.29891 -0.5581035
## 3 -220.3293 -166.22775 -0.4108165
##
## Std. Errors:
## (Intercept) Alcohol Malicacid Ash Alcalinity_of_ash Magnesium
## 2 0.01821017 0.1939145 0.02173148 0.0671974 0.6027867 2.334497
## 3 0.01299639 0.1670037 0.04249821 0.0335307 0.2859207 1.377618
## Total_phenols Flavanoids Nonflavanoid_phenols Proanthocyanins
## 2 0.07765428 0.150396975 0.006888908 0.04579758
## 3 0.02144405 0.007797837 0.007797837 0.01247654
## Color_intensity Hue X0D280_0D315_of_diluted_wines Proline
## 2 0.11467089 0.01770827 0.08758263 7.118306
## 3 0.07251988 0.01130686 0.02742239 7.407945
##
## Residual Deviance: 4.22418e-06
## AIC: 56Baris kode tersebut menganalisis sejaug mana pengaruh masing masing fitur terhadap kemungkinan masuk ke dalam kelas wine tertentu. Output dari summary() akan memberikan informasi mengenai koefisien dan tingkat signifikansi masing masing variabel
# Prediksi kelas dari model
predicted <- predict(model)
# Buat confusion matrix sederhana
table(data$class, predicted)## predicted
## 1 2 3
## 1 59 0 0
## 2 0 71 0
## 3 0 0 48Baris kode tersebut mengevaluasi seberapa akurat model dalam memprediksi tiap kelas dibandingkan dnegan data asli
# Install dan load caret
library(caret)## Warning: package 'caret' was built under R version 4.4.3## Loading required package: ggplot2## Warning: package 'ggplot2' was built under R version 4.4.3## Loading required package: lattice# Confusion matrix lengkap
confusionMatrix(table(data$class, predicted))## Confusion Matrix and Statistics
##
## predicted
## 1 2 3
## 1 59 0 0
## 2 0 71 0
## 3 0 0 48
##
## Overall Statistics
##
## Accuracy : 1
## 95% CI : (0.9795, 1)
## No Information Rate : 0.3989
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 1
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: 1 Class: 2 Class: 3
## Sensitivity 1.0000 1.0000 1.0000
## Specificity 1.0000 1.0000 1.0000
## Pos Pred Value 1.0000 1.0000 1.0000
## Neg Pred Value 1.0000 1.0000 1.0000
## Prevalence 0.3315 0.3989 0.2697
## Detection Rate 0.3315 0.3989 0.2697
## Detection Prevalence 0.3315 0.3989 0.2697
## Balanced Accuracy 1.0000 1.0000 1.0000Kesimpulan
Model Multinomial Logistic Regression berhasil memprediksi jenis wine berdasarkan fitur kimianya, dengan fitur seperti Alcohol, Malic acid, Color intensity, Proline, dan OD280/OD315 terbukti berpengaruh signifikan. Meskipun performa prediksi model cukup akurat, masih ada misclass pada beberapa kelas, yang kemungkinan disebabkan oleh ketidakseimbangan data atau fitur yang kurang informatif. Secara keseluruhan, model ini cocok sebagai baseline karena mudah diinterpretasi, dan dapat dikembangkan lebih lanjut dengan model lain seperti Random Forest atau XGBoost untuk meningkatkan performa.
- Ordinal Logistic Regression
# Load data dari file txt
data <- read.table("C:\\Users\\dell\\Downloads\\data_anmul\\data.txt")
# Cek data teratas
head(data)## rpurchase coupon peers quality
## 1 high probability 0 0 3.25
## 2 medium probability 1 0 3.20
## 3 low probability 1 1 3.93
## 4 medium probability 0 0 2.80
## 5 medium probability 0 0 2.52
## 6 low probability 0 1 2.58data$rpurchase = factor(data$rpurchase, levels = c("low probability", "medium probability", "high probability"), ordered = TRUE)
data$peers = factor(data$peers, levels = c("0", "1"), ordered = TRUE)
data$coupon = factor(data$coupon, levels = c("0", "1"), ordered = TRUE)Baris kode tersebut digunakan untuk memastikan bahwa variabel rpurchase, peers, dan coupon diperlakukan sebagai faktor ordinal dalam analisis. rpurchase diatur sebagai variabel target dengan urutan level dari “low” ke “high probability”, menunjukkan tingkatan kemungkinan pembelian. Sedangkan peers dan coupon, meskipun hanya memiliki dua level (0 dan 1), juga didefinisikan sebagai faktor ordinal agar model polr memahami bahwa nilai 1 menunjukkan tingkat yang lebih tinggi daripada 0. Pendefinisian ini penting agar model dapat menginterpretasikan arah hubungan antara variabel prediktor dan probabilitas kategori target dengan benar
# Melihat summary data
summary(data)## rpurchase coupon peers quality
## low probability :220 0:337 0:343 Min. :1.890
## medium probability:140 1: 63 1: 57 1st Qu.:2.710
## high probability : 40 Median :2.980
## Mean :2.989
## 3rd Qu.:3.260
## Max. :3.990# Membuat tabel frekuensi
table(data$rpurchase, data$coupon)##
## 0 1
## low probability 200 20
## medium probability 110 30
## high probability 27 13# Membuat random sampling
samplesize = 0.60*nrow(data)
set.seed(100)
index = sample(seq_len(nrow(data)), size = samplesize)# Membuat training dan test set
datatrain = data[index,]
datatest = data[-index,]#Build ordinal logistic regression model
library(MASS)
model= polr(rpurchase ~ coupon + peers + quality , data = datatrain, Hess = TRUE)
summary(model)## Call:
## polr(formula = rpurchase ~ coupon + peers + quality, data = datatrain,
## Hess = TRUE)
##
## Coefficients:
## Value Std. Error t value
## coupon.L 0.8722 0.2630 3.316
## peers.L 0.0874 0.2783 0.314
## quality 0.7375 0.3439 2.145
##
## Intercepts:
## Value Std. Error t value
## low probability|medium probability 1.9021 1.1028 1.7248
## medium probability|high probability 4.0327 1.1279 3.5754
##
## Residual Deviance: 425.8634
## AIC: 435.8634Coupon dan quality secara statistik signifikan meningkatkan kemungkinan seseorang untuk membeli. Peers tidak terlalu berpengaruh dalam model ini.
# Membuat Confusion Matrix
predictrpurchase = predict(model,datatest)
table(datatest$rpurchase, predictrpurchase)## predictrpurchase
## low probability medium probability high probability
## low probability 79 9 0
## medium probability 37 19 0
## high probability 12 4 0mean(as.character(datatest$rpurchase) != as.character(predictrpurchase))## [1] 0.3875Model terlihat hanya memprediksi low dan medium, sedangkan underfitting terhadap kelas high. Kinerja model cukup rendah karena 38,75%
library(effects)## Warning: package 'effects' was built under R version 4.4.3## Loading required package: carData## Warning: package 'carData' was built under R version 4.4.3## Use the command
## lattice::trellis.par.set(effectsTheme())
## to customize lattice options for effects plots.
## See ?effectsTheme for details.Effect(focal.predictors = "quality",model)##
## quality effect (probability) for low probability
## quality
## 1.9 2.4 2.9 3.4 3.9
## 0.7285097 0.6498347 0.5620659 0.4702325 0.3803712
##
## quality effect (probability) for medium probability
## quality
## 1.9 2.4 2.9 3.4 3.9
## 0.2291065 0.2900175 0.3532355 0.4117557 0.4575215
##
## quality effect (probability) for high probability
## quality
## 1.9 2.4 2.9 3.4 3.9
## 0.04238389 0.06014785 0.08469854 0.11801188 0.16210731plot(Effect(focal.predictors = "coupon",model))
plot(Effect(focal.predictors = c("quality", "coupon"),model))
variabel coupon berpengaruh secara signifikan terhadap keputusan pembelian. Efeknya menaikkan peluang dari “low” ke “medium” atau “high”
Kesimpulan
- Faktor kupon dan kualitas produk penting dalam memengaruhi keputusan pembelian pelanggan.
- Memberikan kupon adalah strategi efektif untuk meningkatkan minat beli pelanggan, khususnya dalam menaikkan probabilitas mereka dari “low” ke “medium” atau “high”.
- Model ini masih memiliki akurasi yang rendah sehingga perlu ditingkatkan lagi `