Studi kasus ini bertujuan untuk menganalisis bagaimana karakteristik individu memengaruhi pengelompokan kategori tertentu yang diamati dalam variabel respon. Data yang digunakan mencakup variabel pendapatan (X₁), usia (X₂), dan frekuensi aktivitas (X₃) sebagai faktor yang diduga berpengaruh terhadap variabel kategori (Y) yang memiliki lebih dari dua kelas. Pendapatan mencerminkan kondisi ekonomi individu, usia menggambarkan tahap kehidupan dan pengalaman, sedangkan frekuensi menunjukkan intensitas aktivitas yang dilakukan. Perbedaan pada ketiga variabel tersebut diduga menyebabkan variasi peluang seseorang berada pada masing-masing kategori. Oleh karena itu, digunakan metode regresi logistik multinomial untuk mengidentifikasi pengaruh setiap variabel independen terhadap probabilitas kategori yang terbentuk, sehingga dapat memberikan gambaran yang lebih jelas mengenai faktor-faktor yang menentukan perbedaan kategori dalam data tersebut.
library(nnet)
library(caret)## Loading required package: ggplot2## Loading required package: latticelibrary(DescTools)##
## Attaching package: 'DescTools'## The following objects are masked from 'package:caret':
##
## MAE, RMSElibrary(pscl)## Classes and Methods for R originally developed in the
## Political Science Computational Laboratory
## Department of Political Science
## Stanford University (2002-2015),
## by and under the direction of Simon Jackman.
## hurdle and zeroinfl functions by Achim Zeileis.data <- read.csv("D:/Youtube/Regresi/Logistic Regression/multinom.csv")
head(data)## X pendapatan usia frekuensi kategori
## 1 1 10.75155 50.95216 6.270135 Medium
## 2 2 20.76610 18.39606 14.356826 High
## 3 3 13.17954 50.72077 6.064732 Medium
## 4 4 22.66035 48.63441 7.732903 High
## 5 5 23.80935 44.46554 5.131709 High
## 6 6 5.91113 38.19825 16.425733 LowX1 <- data$pendapatan
X2 <- data$usia
X3 <- data$frekuensi
Y <- data$kategori# Model multinomial
model <- multinom(Y ~ X1 + X2 + X3)## # weights: 15 (8 variable)
## initial value 329.583687
## iter 10 value 132.901609
## iter 20 value 109.235975
## iter 30 value 109.077641
## final value 109.077603
## converged# Ringkasan model
summary(model)## Call:
## multinom(formula = Y ~ X1 + X2 + X3)
##
## Coefficients:
## (Intercept) X1 X2 X3
## Low 35.93355 -1.977584 0.0001178881 -0.4161372
## Medium 24.08436 -1.124225 -0.0138091773 -0.2188161
##
## Std. Errors:
## (Intercept) X1 X2 X3
## Low 4.632873 0.2276829 0.02947365 0.08008979
## Medium 4.201393 0.1909009 0.02301985 0.05824382
##
## Residual Deviance: 218.1552
## AIC: 234.1552Persamaan Model
Model multinomial membentuk logit (log odds) terhadap kategori referensi (High), sehingga diperoleh:
Kategori Low Terhadap High
\[ \ln \left( \frac{P(Y = \text{High})}{P(Y = \text{Low})} \right) = 35.93355 - 1.977584X_1 + 0.0001179X_2 - 0.4161372X_3\ \]Kategori Medium Terhadap High
\[ \ln \left( \frac{P(Y = \text{High})}{P(Y = \text{Medium})} \right) = 24.08436 - 1.124225X_1 - 0.0138092X_2 - 0.2188161X_3 \]
# Ambil koefisien dan standard error
z <- summary(model)$coefficients / summary(model)$standard.errors
# Hitung p-value
p_value <- (1 - pnorm(abs(z), 0, 1)) * 2
p_value## (Intercept) X1 X2 X3
## Low 8.659740e-15 0.000000e+00 0.9968086 2.03751e-07
## Medium 9.897877e-09 3.884211e-09 0.5485853 1.72032e-04# Odds Ratio
exp(coef(model))## (Intercept) X1 X2 X3
## Low 4.034045e+15 0.1384033 1.0001179 0.6595898
## Medium 2.882060e+10 0.3249042 0.9862857 0.8034694Kategori Low terhadap High
X₁ (Pendapatan) (p-value = 0.000000e+00; OR =
0.1384033)
Nilai p-value lebih kecil dari 0,05 sehingga signifikan. Setiap kenaikan
pendapatan menurunkan peluang individu masuk kategori Low sebesar
sekitar 86,16% dibandingkan kategori High.
X₂ (Usia) (p-value = 0.9968086; OR =
1.0001179)
Nilai p-value lebih besar dari 0,05 sehingga tidak signifikan. Nilai
odds ratio mendekati 1 menunjukkan bahwa usia tidak memberikan pengaruh
berarti terhadap peluang masuk kategori Low.
X₃ (Frekuensi) (p-value = 2.03751e-07; OR =
0.6595898)
Nilai p-value lebih kecil dari 0,05 sehingga signifikan. Setiap kenaikan
frekuensi aktivitas menurunkan peluang masuk kategori Low sebesar
sekitar 34,04% dibandingkan kategori High.
Kategori Medium terhadap High
X₁ (Pendapatan) (p-value = 3.884211e-09; OR =
0.3249042)
Nilai p-value lebih kecil dari 0,05 sehingga signifikan. Setiap kenaikan
pendapatan menurunkan peluang masuk kategori Medium sebesar sekitar
67,51% dibandingkan kategori High.
X₂ (Usia) (p-value = 0.5485853; OR =
0.9862857)
Nilai p-value lebih besar dari 0,05 sehingga tidak signifikan. Nilai
odds ratio mendekati 1 menunjukkan bahwa usia tidak berpengaruh terhadap
kategori Medium.
X₃ (Frekuensi) (p-value = 1.72032e-04; OR =
0.8034694)
Nilai p-value lebih kecil dari 0,05 sehingga signifikan. Setiap kenaikan
frekuensi aktivitas menurunkan peluang masuk kategori Medium sebesar
sekitar 19,65% dibandingkan kategori High.
# Set level dari awal
data$Y <- factor(data$kategori, levels = c("Low", "Medium", "High"))
# Prediksi
pred <- predict(model, data)
# Paksa level sama
pred <- factor(pred, levels = levels(data$Y))
# Evaluasi
confusionMatrix(pred, data$Y)## Confusion Matrix and Statistics
##
## Reference
## Prediction Low Medium High
## Low 91 19 0
## Medium 16 79 10
## High 0 7 78
##
## Overall Statistics
##
## Accuracy : 0.8267
## 95% CI : (0.779, 0.8678)
## No Information Rate : 0.3567
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.7388
##
## Mcnemar's Test P-Value : NA
##
## Statistics by Class:
##
## Class: Low Class: Medium Class: High
## Sensitivity 0.8505 0.7524 0.8864
## Specificity 0.9016 0.8667 0.9670
## Pos Pred Value 0.8273 0.7524 0.9176
## Neg Pred Value 0.9158 0.8667 0.9535
## Prevalence 0.3567 0.3500 0.2933
## Detection Rate 0.3033 0.2633 0.2600
## Detection Prevalence 0.3667 0.3500 0.2833
## Balanced Accuracy 0.8760 0.8095 0.9267Berdasarkan Output diatas diperoleh akurasi model sebesar 0.8267
pR2(model)## fitting null model for pseudo-r2
## # weights: 6 (2 variable)
## initial value 329.583687
## final value 328.470581
## converged## llh llhNull G2 McFadden r2ML r2CU
## -109.0776028 -328.4705807 438.7859556 0.6679228 0.7683714 0.8652233