Regresi merupakan salah satu metode statistika yang digunakan untuk mengetahui hubungan antara variabel respon dengan satu atau lebih variabel prediktor. Pada tugas ini digunakan empat jenis model regresi, yaitu Regresi Logistik Biner, Regresi Logistik Multinomial, Regresi Logistik Ordinal, dan Regresi Poisson.
Dataset Medical Appointment No Shows diperoleh dari Kaggle dan berisi 110.527 observasi mengenai kehadiran pasien pada jadwal pemeriksaan medis.
library(readr)
appointment <- read_csv("KaggleV2-May-2016.csv/KaggleV2-May-2016.csv")
## Rows: 110527 Columns: 14
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): Gender, Neighbourhood, No-show
## dbl (9): PatientId, AppointmentID, Age, Scholarship, Hipertension, Diabetes...
## dttm (2): ScheduledDay, AppointmentDay
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
View(appointment)
str(appointment)
## spc_tbl_ [110,527 × 14] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ PatientId : num [1:110527] 2.99e+13 5.59e+14 4.26e+12 8.68e+11 8.84e+12 ...
## $ AppointmentID : num [1:110527] 5642903 5642503 5642549 5642828 5642494 ...
## $ Gender : chr [1:110527] "F" "M" "F" "F" ...
## $ ScheduledDay : POSIXct[1:110527], format: "2016-04-29 18:38:08" "2016-04-29 16:08:27" ...
## $ AppointmentDay: POSIXct[1:110527], format: "2016-04-29" "2016-04-29" ...
## $ Age : num [1:110527] 62 56 62 8 56 76 23 39 21 19 ...
## $ Neighbourhood : chr [1:110527] "JARDIM DA PENHA" "JARDIM DA PENHA" "MATA DA PRAIA" "PONTAL DE CAMBURI" ...
## $ Scholarship : num [1:110527] 0 0 0 0 0 0 0 0 0 0 ...
## $ Hipertension : num [1:110527] 1 0 0 0 1 1 0 0 0 0 ...
## $ Diabetes : num [1:110527] 0 0 0 0 1 0 0 0 0 0 ...
## $ Alcoholism : num [1:110527] 0 0 0 0 0 0 0 0 0 0 ...
## $ Handcap : num [1:110527] 0 0 0 0 0 0 0 0 0 0 ...
## $ SMS_received : num [1:110527] 0 0 0 0 0 0 0 0 0 0 ...
## $ No-show : chr [1:110527] "No" "No" "No" "No" ...
## - attr(*, "spec")=
## .. cols(
## .. PatientId = col_double(),
## .. AppointmentID = col_double(),
## .. Gender = col_character(),
## .. ScheduledDay = col_datetime(format = ""),
## .. AppointmentDay = col_datetime(format = ""),
## .. Age = col_double(),
## .. Neighbourhood = col_character(),
## .. Scholarship = col_double(),
## .. Hipertension = col_double(),
## .. Diabetes = col_double(),
## .. Alcoholism = col_double(),
## .. Handcap = col_double(),
## .. SMS_received = col_double(),
## .. `No-show` = col_character()
## .. )
## - attr(*, "problems")=<externalptr>
summary(appointment)
## PatientId AppointmentID Gender
## Min. :3.922e+04 Min. :5030230 Length:110527
## 1st Qu.:4.173e+12 1st Qu.:5640286 Class :character
## Median :3.173e+13 Median :5680573 Mode :character
## Mean :1.475e+14 Mean :5675305
## 3rd Qu.:9.439e+13 3rd Qu.:5725524
## Max. :1.000e+15 Max. :5790484
## ScheduledDay AppointmentDay
## Min. :2015-11-10 07:13:56.00 Min. :2016-04-29 00:00:00.00
## 1st Qu.:2016-04-29 10:27:01.00 1st Qu.:2016-05-09 00:00:00.00
## Median :2016-05-10 12:13:17.00 Median :2016-05-18 00:00:00.00
## Mean :2016-05-09 07:49:15.84 Mean :2016-05-19 00:57:50.00
## 3rd Qu.:2016-05-20 11:18:37.00 3rd Qu.:2016-05-31 00:00:00.00
## Max. :2016-06-08 20:07:23.00 Max. :2016-06-08 00:00:00.00
## Age Neighbourhood Scholarship Hipertension
## Min. : -1.00 Length:110527 Min. :0.00000 Min. :0.0000
## 1st Qu.: 18.00 Class :character 1st Qu.:0.00000 1st Qu.:0.0000
## Median : 37.00 Mode :character Median :0.00000 Median :0.0000
## Mean : 37.09 Mean :0.09827 Mean :0.1972
## 3rd Qu.: 55.00 3rd Qu.:0.00000 3rd Qu.:0.0000
## Max. :115.00 Max. :1.00000 Max. :1.0000
## Diabetes Alcoholism Handcap SMS_received
## Min. :0.00000 Min. :0.0000 Min. :0.00000 Min. :0.000
## 1st Qu.:0.00000 1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.000
## Median :0.00000 Median :0.0000 Median :0.00000 Median :0.000
## Mean :0.07186 Mean :0.0304 Mean :0.02225 Mean :0.321
## 3rd Qu.:0.00000 3rd Qu.:0.0000 3rd Qu.:0.00000 3rd Qu.:1.000
## Max. :1.00000 Max. :1.0000 Max. :4.00000 Max. :1.000
## No-show
## Length:110527
## Class :character
## Mode :character
##
##
##
install.packages(“car”)
library(car) ## Persiapan Data
appointment$No_show <- factor(
appointment$`No-show`,
levels = c(
"No",
"Yes"
)
)
appointment$Age_Group <- cut(
appointment$Age,
breaks = c(
-Inf,
17,
59,
Inf
),
labels = c(
"Anak",
"Dewasa",
"Lansia"
)
)
table(
appointment$No_show
)
##
## No Yes
## 88208 22319
table(
appointment$Age_Group
)
##
## Anak Dewasa Lansia
## 27380 61974 21173
library(car)
## Loading required package: carData
fit_vif <- lm(
Age ~
Scholarship +
Hipertension +
Diabetes +
Alcoholism +
SMS_received,
data = appointment
)
vif(fit_vif)
## Scholarship Hipertension Diabetes Alcoholism SMS_received
## 1.002059 1.240855 1.232054 1.010313 1.000891
Seluruh nilai VIF kurang dari 10 sehingga tidak terjadi multikolinearitas antar variabel prediktor. # REGRESI LOGISTIK BINER
fit_bin <- glm(
No_show ~
Age +
Scholarship +
Hipertension +
Diabetes +
Alcoholism +
SMS_received,
data = appointment,
family = binomial(link = "logit")
)
summary(fit_bin)
##
## Call:
## glm(formula = No_show ~ Age + Scholarship + Hipertension + Diabetes +
## Alcoholism + SMS_received, family = binomial(link = "logit"),
## data = appointment)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.3927511 0.0157672 -88.332 < 2e-16 ***
## Age -0.0065083 0.0003892 -16.723 < 2e-16 ***
## Scholarship 0.1880790 0.0242824 7.745 9.52e-15 ***
## Hipertension -0.0674139 0.0245664 -2.744 0.00607 **
## Diabetes 0.0855111 0.0341131 2.507 0.01219 *
## Alcoholism 0.1339876 0.0444688 3.013 0.00259 **
## SMS_received 0.6504282 0.0154511 42.096 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 111206 on 110526 degrees of freedom
## Residual deviance: 108989 on 110520 degrees of freedom
## AIC: 109003
##
## Number of Fisher Scoring iterations: 4
Berdasarkan hasil regresi logistik biner diperoleh bahwa variabel Age, Scholarship, Hipertension, Diabetes, Alcoholism, dan SMS_received berpengaruh signifikan terhadap peluang pasien tidak hadir pada jadwal pemeriksaan.
exp(coef(fit_bin))
## (Intercept) Age Scholarship Hipertension Diabetes Alcoholism
## 0.2483910 0.9935128 1.2069289 0.9348082 1.0892737 1.1433786
## SMS_received
## 1.9163613
Variabel Age memiliki OR kurang dari 1 sehingga semakin bertambah usia pasien maka peluang tidak hadir cenderung menurun.
Variabel Scholarship memiliki OR lebih dari 1 sehingga pasien penerima bantuan sosial memiliki peluang tidak hadir lebih besar dibandingkan pasien yang tidak menerima bantuan sosial.
Variabel Hipertension memiliki OR kurang dari 1 sehingga pasien hipertensi cenderung memiliki peluang tidak hadir yang lebih rendah.
Variabel Diabetes dan Alcoholism memiliki OR lebih dari 1 sehingga meningkatkan peluang pasien tidak hadir.
Variabel SMS_received memiliki OR paling besar sehingga menjadi salah satu faktor yang paling berpengaruh terhadap status ketidakhadiran pasien.
library(knitr)
ringkasan_model <- data.frame(
Keterangan = c(
"Jumlah Observasi",
"Null Deviance",
"Residual Deviance",
"AIC"
),
Nilai = c(
nobs(fit_bin),
round(fit_bin$null.deviance,3),
round(fit_bin$deviance,3),
round(AIC(fit_bin),3)
)
)
kable(
ringkasan_model
)
| Keterangan | Nilai |
|---|---|
| Jumlah Observasi | 110527.0 |
| Null Deviance | 111205.6 |
| Residual Deviance | 108988.7 |
| AIC | 109002.7 |
p_pred <- predict(
fit_bin,
type = "response"
)
head(p_pred)
## 1 2 3 4 5 6
## 0.1342747 0.1471393 0.1423062 0.1908004 0.1494249 0.1240313
pred_class <- ifelse(
p_pred >= 0.5,
"Yes",
"No"
)
pred_class <- factor(
pred_class,
levels = c(
"No",
"Yes"
)
)
table(
Aktual = appointment$No_show,
Prediksi = pred_class
)
## Prediksi
## Aktual No Yes
## No 88208 0
## Yes 22319 0
accuracy <- mean(
pred_class ==
appointment$No_show
)
accuracy
## [1] 0.7980674
paste0(
round(
accuracy*100,
2
),
"%"
)
## [1] "79.81%"
AIC(fit_bin)
## [1] 109002.7
Model logistik biner menunjukkan bahwa karakteristik pasien dan kondisi kesehatan berpengaruh terhadap peluang pasien tidak hadir pada jadwal pemeriksaan medis. # REGRESI LOGISTIK MULTINOMIAL
library(nnet)
appointment$Age_Group <- relevel(
factor(appointment$Age_Group),
ref = "Anak"
)
fit_multi <- multinom(
Age_Group ~
Scholarship +
Hipertension +
Diabetes +
Alcoholism +
SMS_received,
data = appointment
)
## # weights: 21 (12 variable)
## initial value 121426.320430
## iter 10 value 105111.047843
## iter 20 value 94243.578173
## iter 30 value 94222.570124
## iter 40 value 94222.341427
## iter 40 value 94222.341425
## iter 40 value 94222.341425
## final value 94222.341425
## converged
summary(fit_multi)
## Call:
## multinom(formula = Age_Group ~ Scholarship + Hipertension + Diabetes +
## Alcoholism + SMS_received, data = appointment)
##
## Coefficients:
## (Intercept) Scholarship Hipertension Diabetes Alcoholism SMS_received
## Dewasa 0.5198657 -0.04267616 4.695627 2.393244 3.716275 0.2274883
## Lansia -1.0610843 -1.68277258 6.384191 3.083825 3.353603 0.1485935
##
## Std. Errors:
## (Intercept) Scholarship Hipertension Diabetes Alcoholism SMS_received
## Dewasa 0.009424216 0.02395200 0.1628245 0.1430365 0.2055883 0.01614489
## Lansia 0.014129814 0.04974937 0.1631334 0.1443252 0.2095986 0.02250866
##
## Residual Deviance: 188444.7
## AIC: 188468.7
z_multi <-
summary(fit_multi)$coefficients /
summary(fit_multi)$standard.errors
p_multi <-
2*(1-pnorm(abs(z_multi)))
p_multi
## (Intercept) Scholarship Hipertension Diabetes Alcoholism SMS_received
## Dewasa 0 0.07479212 0 0 0 0.000000e+00
## Lansia 0 0.00000000 0 0 0 4.067013e-11
exp(
coef(fit_multi)
)
## (Intercept) Scholarship Hipertension Diabetes Alcoholism SMS_received
## Dewasa 1.6818017 0.9582217 109.4674 10.94895 41.11098 1.255443
## Lansia 0.3460804 0.1858580 592.4055 21.84179 28.60560 1.160201
AIC(fit_multi)
## [1] 188468.7
Hasil regresi logistik multinomial menunjukkan bahwa sebagian besar variabel prediktor berpengaruh signifikan terhadap kategori kelompok umur pasien. Variabel kesehatan seperti Hipertension, Diabetes, dan Alcoholism memberikan pengaruh yang kuat terhadap kategori umur pasien. # DATASET 2: ABALONE
library(readr)
abalone <- read_csv("abalone.data")
## Rows: 4176 Columns: 9
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): M
## dbl (8): 0.455, 0.365, 0.095, 0.514, 0.2245, 0.101, 0.15, 15
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
View(abalone)
colnames(abalone) <- c(
"Sex",
"Length",
"Diameter",
"Height",
"Whole_weight",
"Shucked_weight",
"Viscera_weight",
"Shell_weight",
"Rings"
)
head(abalone)
## # A tibble: 6 × 9
## Sex Length Diameter Height Whole_weight Shucked_weight Viscera_weight
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 M 0.35 0.265 0.09 0.226 0.0995 0.0485
## 2 F 0.53 0.42 0.135 0.677 0.256 0.142
## 3 M 0.44 0.365 0.125 0.516 0.216 0.114
## 4 I 0.33 0.255 0.08 0.205 0.0895 0.0395
## 5 I 0.425 0.3 0.095 0.352 0.141 0.0775
## 6 F 0.53 0.415 0.15 0.778 0.237 0.142
## # ℹ 2 more variables: Shell_weight <dbl>, Rings <dbl>
q <- quantile(
abalone$Rings,
probs = c(
0.33,
0.67
)
)
abalone$umur_kategori <- cut(
abalone$Rings,
breaks = c(
-Inf,
q[1],
q[2],
Inf
),
labels = c(
"Muda",
"Dewasa",
"Tua"
)
)
abalone$umur_ord <- ordered(
abalone$umur_kategori,
levels = c(
"Muda",
"Dewasa",
"Tua"
)
)
fit_vif2 <- lm(
Rings ~
Height +
Shell_weight,
data = abalone
)
vif(fit_vif2)
## Height Shell_weight
## 3.012247 3.012247
Nilai VIF kurang dari 10 sehingga tidak terdapat multikolinearitas. # REGRESI LOGISTIK ORDINAL
library(ordinal)
fit_ord <- clm(
umur_ord ~
Height +
Shell_weight +
Sex,
data = abalone,
link = "logit"
)
summary(fit_ord)
## formula: umur_ord ~ Height + Shell_weight + Sex
## data: abalone
##
## link threshold nobs logLik AIC niter max.grad cond.H
## logit flexible 4176 -3379.75 6771.50 6(0) 2.03e-13 3.5e+03
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## Height 9.24359 1.98203 4.664 3.11e-06 ***
## Shell_weight 7.25149 0.56152 12.914 < 2e-16 ***
## SexI -1.08478 0.09584 -11.319 < 2e-16 ***
## SexM -0.13267 0.07571 -1.752 0.0797 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Threshold coefficients:
## Estimate Std. Error z value
## Muda|Dewasa 1.6476 0.2019 8.162
## Dewasa|Tua 4.4641 0.2132 20.937
nominal_test(fit_ord)
## Tests of nominal effects
##
## formula: umur_ord ~ Height + Shell_weight + Sex
## Df logLik AIC LRT Pr(>Chi)
## <none> -3379.7 6771.5
## Height
## Shell_weight 1 -3272.8 6559.5 213.995 < 2.2e-16 ***
## Sex 2 -3361.5 6739.0 36.506 1.183e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
AIC(fit_ord)
## [1] 6771.496
Model ordinal digunakan karena variabel respon memiliki urutan kategori yaitu Muda, Dewasa, dan Tua. Variabel karakteristik fisik abalone berpengaruh terhadap kategori umur abalone. # REGRESI POISSON
fit_pois <- glm(
Rings ~
Height +
Shell_weight +
Sex,
data = abalone,
family = poisson(link = "log")
)
summary(fit_pois)
##
## Call:
## glm(formula = Rings ~ Height + Shell_weight + Sex, family = poisson(link = "log"),
## data = abalone)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.95180 0.02170 89.927 < 2e-16 ***
## Height 0.95008 0.16101 5.901 3.62e-09 ***
## Shell_weight 0.98107 0.05170 18.977 < 2e-16 ***
## SexI -0.12084 0.01485 -8.139 3.97e-16 ***
## SexM -0.01444 0.01143 -1.263 0.207
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 4137.1 on 4175 degrees of freedom
## Residual deviance: 2363.8 on 4171 degrees of freedom
## AIC: 19504
##
## Number of Fisher Scoring iterations: 4
exp(
coef(fit_pois)
)
## (Intercept) Height Shell_weight SexI SexM
## 7.0413664 2.5859152 2.6672984 0.8861792 0.9856673
dispersion <- sum(
residuals(
fit_pois,
type = "pearson"
)^2
) /
fit_pois$df.residual
dispersion
## [1] 0.6090126
AIC(fit_pois)
## [1] 19503.94
Model Poisson digunakan untuk memodelkan jumlah cincin (Rings) pada abalone. Nilai IRR menunjukkan besarnya perubahan rata-rata jumlah cincin akibat perubahan variabel prediktor.
Nilai dispersion digunakan untuk mengevaluasi apakah asumsi Poisson terpenuhi atau tidak. # Kesimpulan
Regresi Logistik Biner menunjukkan bahwa umur, status bantuan sosial, hipertensi, diabetes, alkoholisme, dan penerimaan SMS pengingat berpengaruh terhadap peluang pasien tidak hadir.
Regresi Logistik Multinomial menunjukkan bahwa kondisi kesehatan pasien berhubungan dengan kategori kelompok umur pasien.
Regresi Logistik Ordinal menunjukkan bahwa karakteristik fisik abalone berpengaruh terhadap kategori umur abalone yang bersifat berurutan.
Regresi Poisson menunjukkan bahwa jumlah cincin pada abalone dapat dimodelkan menggunakan karakteristik fisik abalone.
Keempat model berhasil diestimasi dan menghasilkan ukuran evaluasi berupa AIC, Odds Ratio, IRR, serta pengujian asumsi yang relevan.