Pendahuluan

Latar Belakang

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.

Tujuan

  1. Menerapkan Regresi Logistik Biner.
  2. Menerapkan Regresi Logistik Multinomial.
  3. Menerapkan Regresi Logistik Ordinal.
  4. Menerapkan Regresi Poisson.
  5. Menginterpretasikan hasil pemodelan. # DATASET 1: MEDICAL APPOINTMENT NO SHOWS

Deskripsi Data

Dataset Medical Appointment No Shows diperoleh dari Kaggle dan berisi 110.527 observasi mengenai kehadiran pasien pada jadwal pemeriksaan medis.

Import Data

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

Uji Multikolinearitas

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

Interpretasi

Seluruh nilai VIF kurang dari 10 sehingga tidak terjadi multikolinearitas antar variabel prediktor. # REGRESI LOGISTIK BINER

Model

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

Interpretasi

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.

Odds Ratio

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

Interpretasi Odds Ratio

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.

Ringkasan Model

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

Prediksi Probabilitas

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

Confusion Matrix

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

Akurasi

accuracy <- mean(
  pred_class ==
    appointment$No_show
)

accuracy
## [1] 0.7980674
paste0(
  round(
    accuracy*100,
    2
  ),
  "%"
)
## [1] "79.81%"

AIC

AIC(fit_bin)
## [1] 109002.7

Kesimpulan

Model logistik biner menunjukkan bahwa karakteristik pasien dan kondisi kesehatan berpengaruh terhadap peluang pasien tidak hadir pada jadwal pemeriksaan medis. # REGRESI LOGISTIK MULTINOMIAL

Model

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

P-Value

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

Odds Ratio

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

AIC(fit_multi)
## [1] 188468.7

Interpretasi

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

Import Data

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>

Membentuk Variabel Ordinal

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"
  )
)

Uji Multikolinearitas

fit_vif2 <- lm(
  Rings ~
    Height +
    Shell_weight,
  data = abalone
)

vif(fit_vif2)
##       Height Shell_weight 
##     3.012247     3.012247

Interpretasi

Nilai VIF kurang dari 10 sehingga tidak terdapat multikolinearitas. # REGRESI LOGISTIK ORDINAL

Model

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

Uji Proportional Odds

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

AIC(fit_ord)
## [1] 6771.496

Interpretasi

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

Model

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

IRR

exp(
  coef(fit_pois)
)
##  (Intercept)       Height Shell_weight         SexI         SexM 
##    7.0413664    2.5859152    2.6672984    0.8861792    0.9856673

Overdispersion

dispersion <- sum(
  residuals(
    fit_pois,
    type = "pearson"
  )^2
) /
fit_pois$df.residual

dispersion
## [1] 0.6090126

AIC

AIC(fit_pois)
## [1] 19503.94

Interpretasi

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

  1. Regresi Logistik Biner menunjukkan bahwa umur, status bantuan sosial, hipertensi, diabetes, alkoholisme, dan penerimaan SMS pengingat berpengaruh terhadap peluang pasien tidak hadir.

  2. Regresi Logistik Multinomial menunjukkan bahwa kondisi kesehatan pasien berhubungan dengan kategori kelompok umur pasien.

  3. Regresi Logistik Ordinal menunjukkan bahwa karakteristik fisik abalone berpengaruh terhadap kategori umur abalone yang bersifat berurutan.

  4. Regresi Poisson menunjukkan bahwa jumlah cincin pada abalone dapat dimodelkan menggunakan karakteristik fisik abalone.

  5. Keempat model berhasil diestimasi dan menghasilkan ukuran evaluasi berupa AIC, Odds Ratio, IRR, serta pengujian asumsi yang relevan.