required_packages <- c("dplyr", "ggplot2", "broom", "knitr", "scales", "tidyr", "car")
missing_packages <- required_packages[
  !vapply(required_packages, requireNamespace, logical(1), quietly = TRUE)
]
if (length(missing_packages) > 0) {
  stop(
    "Paket berikut belum tersedia: ",
    paste(missing_packages, collapse = ", "),
    ". Silakan install terlebih dahulu."
  )
}
invisible(lapply(required_packages, library, character.only = TRUE))

1 Ringkasan Masalah

Putus studi (dropout) mahasiswa merupakan persoalan serius bagi institusi pendidikan tinggi karena berdampak pada efisiensi akademik, reputasi institusi, dan masa depan mahasiswa yang bersangkutan. Kemampuan memprediksi secara dini mahasiswa yang berisiko tidak menyelesaikan studi memberikan peluang bagi institusi untuk melakukan intervensi tepat waktu.

Tujuan analisis ini adalah membangun model regresi logistik biner untuk memprediksi apakah seorang mahasiswa akan putus studi (dropout) atau lulus (graduate) berdasarkan karakteristik demografis, akademik, dan ekonomi.

Kasus ini sesuai dianalisis dengan regresi logistik biner karena variabel respons bersifat biner, setelah menyaring hanya dua kelas dari dataset:

\(Y_i = 1\) : Mahasiswa putus studi (Dropout)
\(Y_i = 0\) : Mahasiswa lulus (Graduate)

Model yang digunakan adalah:

\[ \log\left(\frac{p_i}{1 - p_i}\right) = \beta_0 + \beta_1 X_{1i} + \beta_2 X_{2i} + \cdots + \beta_k X_{ki} \]

di mana \(p_i = P(Y_i = 1 \mid X_i)\) adalah peluang mahasiswa ke-\(i\) mengalami putus studi.

2 Sumber Data

Dataset yang digunakan adalah Predict Students’ Dropout and Academic Success yang tersedia di Kaggle:

Sumber: https://www.kaggle.com/datasets/hamnawaseem112222222/predict-students-dropout-and-academic-success

Dataset ini berasal dari sebuah perguruan tinggi di Portugal dan mencakup informasi mahasiswa dari berbagai program studi. Dataset asli terdiri dari tiga kelas target: Graduate, Dropout, dan Enrolled. Pada analisis ini, observasi dengan status Enrolled dikeluarkan karena status akhir studi mereka belum diketahui, sehingga pemodelan hanya mencakup mahasiswa yang sudah memiliki status akhir yang jelas.

# Sesuaikan path ke lokasi file CSV Anda
raw_data <- read.csv(
  "student_dropout_academic_success.csv.csv",
  sep              = ";",
  stringsAsFactors = FALSE,
  check.names      = FALSE
)

cat(sprintf(
  "Ukuran dataset asli  : %d observasi, %d variabel\n",
  nrow(raw_data), ncol(raw_data)
))

## Ukuran dataset asli  : 4424 observasi, 37 variabel

cat(sprintf(
  "Distribusi Target awal:\n  Graduate : %d\n  Dropout  : %d\n  Enrolled : %d\n",
  sum(raw_data$Target == "Graduate"),
  sum(raw_data$Target == "Dropout"),
  sum(raw_data$Target == "Enrolled")
))

## Distribusi Target awal:
##   Graduate : 2209
##   Dropout  : 1421
##   Enrolled : 794

fix_grade <- function(x){

  x <- trimws(x)

  x <- ifelse(
    grepl("^\\d+\\.\\d+\\.\\d+", x),
    sub(
      "^(\\d+)\\.(.*)$",
      "\\1.\\2",
      gsub("\\.", "", x)
    ),
    x
  )

  as.numeric(x)
}

raw_data$`Curricular units 1st sem (grade)` <-
  fix_grade(raw_data$`Curricular units 1st sem (grade)`)

raw_data$`Curricular units 2nd sem (grade)` <-
  fix_grade(raw_data$`Curricular units 2nd sem (grade)`)

3 Persiapan Data

3.1 Kamus Variabel

Berikut variabel yang digunakan dalam analisis. Variabel dengan informasi redundan atau bersifat pengenal (ID) dikeluarkan dari model.

kamus <- data.frame(
  `Nama variabel` = c(
    "Marital status", "Application mode", "Application order", "Course",
    "Daytime/evening attendance", "Previous qualification",
    "Previous qualification (grade)", "Nacionality",
    "Mother's qualification", "Father's qualification",
    "Mother's occupation", "Father's occupation",
    "Admission grade", "Displaced", "Educational special needs",
    "Debtor", "Tuition fees up to date", "Gender",
    "Scholarship holder", "Age at enrollment", "International",
    "Curricular units 1st sem (credited)", "Curricular units 1st sem (enrolled)",
    "Curricular units 1st sem (evaluations)", "Curricular units 1st sem (approved)",
    "Curricular units 1st sem (grade)", "Curricular units 1st sem (without evaluations)",
    "Curricular units 2nd sem (credited)", "Curricular units 2nd sem (enrolled)",
    "Curricular units 2nd sem (evaluations)", "Curricular units 2nd sem (approved)",
    "Curricular units 2nd sem (grade)", "Curricular units 2nd sem (without evaluations)",
    "Unemployment rate", "Inflation rate", "GDP", "Target"
  ),
  Keterangan = c(
    "Status pernikahan mahasiswa",
    "Jalur pendaftaran masuk perguruan tinggi",
    "Urutan pilihan program studi saat mendaftar",
    "Program studi yang diambil",
    "Kelas siang (1) atau malam (0)",
    "Kualifikasi pendidikan sebelumnya",
    "Nilai kualifikasi pendidikan sebelumnya (0–200)",
    "Kebangsaan mahasiswa",
    "Kualifikasi pendidikan ibu",
    "Kualifikasi pendidikan ayah",
    "Pekerjaan ibu",
    "Pekerjaan ayah",
    "Nilai masuk perguruan tinggi (0–200)",
    "Mahasiswa pengungsi atau terlantar (1 = ya)",
    "Mahasiswa dengan kebutuhan pendidikan khusus (1 = ya)",
    "Mahasiswa memiliki tunggakan biaya (1 = ya)",
    "Biaya kuliah sudah terbayar tepat waktu (1 = ya)",
    "Jenis kelamin (1 = pria, 0 = wanita)",
    "Penerima beasiswa (1 = ya)",
    "Usia saat mendaftar (tahun)",
    "Mahasiswa internasional (1 = ya)",
    "SKS dikreditkan semester 1",
    "SKS yang diambil semester 1",
    "Jumlah evaluasi semester 1",
    "SKS lulus semester 1",
    "Nilai rata-rata SKS lulus semester 1 (0–20)",
    "SKS tanpa evaluasi semester 1",
    "SKS dikreditkan semester 2",
    "SKS yang diambil semester 2",
    "Jumlah evaluasi semester 2",
    "SKS lulus semester 2",
    "Nilai rata-rata SKS lulus semester 2 (0–20)",
    "SKS tanpa evaluasi semester 2",
    "Tingkat pengangguran nasional (%)",
    "Tingkat inflasi nasional (%)",
    "Produk Domestik Bruto (PDB)",
    "Status akhir studi: Graduate / Dropout / Enrolled"
  ),
  Tipe = c(
    "Kategorik", "Kategorik", "Numerik", "Kategorik",
    "Biner", "Kategorik",
    "Numerik", "Kategorik",
    "Kategorik", "Kategorik",
    "Kategorik", "Kategorik",
    "Numerik", "Biner", "Biner",
    "Biner", "Biner", "Biner",
    "Biner", "Numerik", "Biner",
    "Numerik", "Numerik",
    "Numerik", "Numerik",
    "Numerik", "Numerik",
    "Numerik", "Numerik",
    "Numerik", "Numerik",
    "Numerik", "Numerik",
    "Numerik", "Numerik", "Numerik",
    "Respons"
  ),
  check.names = FALSE
)
knitr::kable(kamus, caption = "Kamus variabel dataset Students' Dropout and Academic Success")

Kamus variabel dataset Students’ Dropout and Academic Success
Nama variabel	Keterangan	Tipe
Marital status	Status pernikahan mahasiswa	Kategorik
Application mode	Jalur pendaftaran masuk perguruan tinggi	Kategorik
Application order	Urutan pilihan program studi saat mendaftar	Numerik
Course	Program studi yang diambil	Kategorik
Daytime/evening attendance	Kelas siang (1) atau malam (0)	Biner
Previous qualification	Kualifikasi pendidikan sebelumnya	Kategorik
Previous qualification (grade)	Nilai kualifikasi pendidikan sebelumnya (0–200)	Numerik
Nacionality	Kebangsaan mahasiswa	Kategorik
Mother’s qualification	Kualifikasi pendidikan ibu	Kategorik
Father’s qualification	Kualifikasi pendidikan ayah	Kategorik
Mother’s occupation	Pekerjaan ibu	Kategorik
Father’s occupation	Pekerjaan ayah	Kategorik
Admission grade	Nilai masuk perguruan tinggi (0–200)	Numerik
Displaced	Mahasiswa pengungsi atau terlantar (1 = ya)	Biner
Educational special needs	Mahasiswa dengan kebutuhan pendidikan khusus (1 = ya)	Biner
Debtor	Mahasiswa memiliki tunggakan biaya (1 = ya)	Biner
Tuition fees up to date	Biaya kuliah sudah terbayar tepat waktu (1 = ya)	Biner
Gender	Jenis kelamin (1 = pria, 0 = wanita)	Biner
Scholarship holder	Penerima beasiswa (1 = ya)	Biner
Age at enrollment	Usia saat mendaftar (tahun)	Numerik
International	Mahasiswa internasional (1 = ya)	Biner
Curricular units 1st sem (credited)	SKS dikreditkan semester 1	Numerik
Curricular units 1st sem (enrolled)	SKS yang diambil semester 1	Numerik
Curricular units 1st sem (evaluations)	Jumlah evaluasi semester 1	Numerik
Curricular units 1st sem (approved)	SKS lulus semester 1	Numerik
Curricular units 1st sem (grade)	Nilai rata-rata SKS lulus semester 1 (0–20)	Numerik
Curricular units 1st sem (without evaluations)	SKS tanpa evaluasi semester 1	Numerik
Curricular units 2nd sem (credited)	SKS dikreditkan semester 2	Numerik
Curricular units 2nd sem (enrolled)	SKS yang diambil semester 2	Numerik
Curricular units 2nd sem (evaluations)	Jumlah evaluasi semester 2	Numerik
Curricular units 2nd sem (approved)	SKS lulus semester 2	Numerik
Curricular units 2nd sem (grade)	Nilai rata-rata SKS lulus semester 2 (0–20)	Numerik
Curricular units 2nd sem (without evaluations)	SKS tanpa evaluasi semester 2	Numerik
Unemployment rate	Tingkat pengangguran nasional (%)	Numerik
Inflation rate	Tingkat inflasi nasional (%)	Numerik
GDP	Produk Domestik Bruto (PDB)	Numerik
Target	Status akhir studi: Graduate / Dropout / Enrolled	Respons

3.2 Penyaringan dan Transformasi Data

# Filter hanya Graduate dan Dropout
df_bin <- raw_data %>%
  filter(Target %in% c("Graduate", "Dropout")) %>%
  transmute(
    # Variabel respons
    dropout   = as.integer(Target == "Dropout"),
    do_label  = factor(Target, levels = c("Graduate", "Dropout")),

    # Variabel numerik
    age            = `Age at enrollment`,
    prev_grade     = `Previous qualification (grade)`,
    admission_grade= `Admission grade`,
    cu1_approved   = `Curricular units 1st sem (approved)`,
    cu1_grade      = `Curricular units 1st sem (grade)`,
    cu2_approved   = `Curricular units 2nd sem (approved)`,
    cu2_grade      = `Curricular units 2nd sem (grade)`,
    unemp_rate     = `Unemployment rate`,
    inflation_rate = `Inflation rate`,
    gdp            = GDP,

    # Variabel biner (0/1)
    gender          = factor(Gender,                  levels = c(0, 1),
                             labels = c("Wanita", "Pria")),
    scholarship     = factor(`Scholarship holder`,    levels = c(0, 1),
                             labels = c("Tidak", "Ya")),
    debtor          = factor(Debtor,                  levels = c(0, 1),
                             labels = c("Tidak", "Ya")),
    tuition_ok      = factor(`Tuition fees up to date`, levels = c(0, 1),
                             labels = c("Belum lunas", "Lunas")),
    displaced       = factor(Displaced,               levels = c(0, 1),
                             labels = c("Tidak", "Ya")),
    international   = factor(International,           levels = c(0, 1),
                             labels = c("Tidak", "Ya")),
    special_needs   = factor(`Educational special needs`, levels = c(0, 1),
                             labels = c("Tidak", "Ya")),
    day_attendance  = factor(`Daytime/evening attendance\t`, levels = c(0, 1),
                             labels = c("Malam", "Siang"))
  )

cat(sprintf(
  "Jumlah observasi setelah filter: %d\n  Graduate (Y=0): %d\n  Dropout  (Y=1): %d\n",
  nrow(df_bin),
  sum(df_bin$dropout == 0),
  sum(df_bin$dropout == 1)
))

## Jumlah observasi setelah filter: 3630
##   Graduate (Y=0): 2209
##   Dropout  (Y=1): 1421

Interpretasi: Setelah menyaring hanya kelas Graduate dan Dropout, diperoleh 3630 observasi — terdiri dari 2209 mahasiswa yang lulus dan 1421 mahasiswa yang putus studi. Status Enrolled sengaja dikeluarkan karena mahasiswa yang masih aktif belum memiliki status akhir, sehingga memasukkannya akan mengaburkan pola yang dipelajari model.

missing_df <- data.frame(
  Variabel    = names(df_bin),
  `Jumlah NA` = sapply(df_bin, function(x) sum(is.na(x))),
  check.names = FALSE
) %>% filter(`Jumlah NA` > 0)

if (nrow(missing_df) > 0) {
  knitr::kable(missing_df, caption = "Variabel dengan nilai hilang")
} else {
  cat("Tidak ditemukan nilai hilang (missing values) pada seluruh variabel yang digunakan.\n")
}

## Tidak ditemukan nilai hilang (missing values) pada seluruh variabel yang digunakan.

4 Eksplorasi Data

4.1 Distribusi Kelas Respons

kelas_summary <- df_bin %>%
  count(do_label, name = "Jumlah") %>%
  mutate(Proporsi = scales::percent(Jumlah / sum(Jumlah), accuracy = 0.1)) %>%
  rename(Status = do_label)
knitr::kable(kelas_summary, caption = "Distribusi kelas respons (Graduate vs Dropout)")

Distribusi kelas respons (Graduate vs Dropout)
Status	Jumlah	Proporsi
Graduate	2209	60.9%
Dropout	1421	39.1%

ggplot(df_bin, aes(x = do_label, fill = do_label)) +
  geom_bar(width = 0.55, color = "white", linewidth = 0.8) +
  geom_text(
    stat  = "count",
    aes(label = after_stat(count)),
    vjust = -0.4, fontface = "bold", size = 4.5
  ) +
  scale_fill_manual(values = c("Graduate" = "#2a9d8f", "Dropout" = "#e76f51")) +
  labs(
    title = "Distribusi Status Akhir Studi Mahasiswa",
    x     = NULL,
    y     = "Jumlah mahasiswa"
  ) +
  theme_minimal(base_size = 12) +
  theme(legend.position = "none")

Interpretasi: Dari 3630 observasi yang dianalisis, sebanyak 2209 mahasiswa (60.9%) berstatus lulus (Graduate) dan 1421 mahasiswa (39.1%) berstatus putus studi (Dropout). Proporsi yang tidak seimbang ini wajar dalam konteks perguruan tinggi, namun perlu diperhatikan dalam interpretasi metrik evaluasi model — khususnya sensitivity, yang mengukur kemampuan mendeteksi mahasiswa yang benar-benar putus studi.

4.2 Perbandingan Variabel Numerik Kunci

num_summary <- df_bin %>%
  group_by(do_label) %>%
  summarise(
    N                         = n(),
    `Rata-rata usia`          = round(mean(age), 2),
    `Nilai masuk (median)`    = round(median(admission_grade), 2),
    `SKS lulus sem-1 (mean)`  = round(mean(cu1_approved), 2),
    `Nilai SKS sem-1 (mean)`  = round(mean(cu1_grade), 2),
    `SKS lulus sem-2 (mean)`  = round(mean(cu2_approved), 2),
    `Nilai SKS sem-2 (mean)`  = round(mean(cu2_grade), 2),
    .groups = "drop"
  ) %>%
  rename(Status = do_label)
knitr::kable(num_summary, caption = "Perbandingan variabel akademik dan demografis menurut status studi")

Perbandingan variabel akademik dan demografis menurut status studi
Status	N	Rata-rata usia	Nilai masuk (median)	SKS lulus sem-1 (mean)	Nilai SKS sem-1 (mean)	SKS lulus sem-2 (mean)	Nilai SKS sem-2 (mean)
Graduate	2209	21.78	127.4	6.23	6.342907e+15	6.18	5.683058e+15
Dropout	1421	26.07	123.6	2.55	2.080732e+15	1.94	1.583528e+15

Interpretasi: Perbedaan yang sangat mencolok terlihat pada variabel kinerja akademik semester. Mahasiswa yang lulus rata-rata menyelesaikan sekitar 6.2 SKS di semester 2, sementara mahasiswa putus studi hanya sekitar 1.9 SKS. Demikian pula nilai rata-rata SKS: mahasiswa lulus memiliki nilai yang jauh lebih tinggi dibanding mahasiswa dropout. Perbedaan ini mengindikasikan bahwa kinerja akademik pada semester awal merupakan sinyal prediktif yang sangat kuat. Mahasiswa yang putus studi juga rata-rata berusia lebih tua saat mendaftar (26.1 tahun) dibanding yang lulus (21.8 tahun), yang mungkin mencerminkan tekanan dari tanggung jawab di luar kampus.

4.3 Distribusi SKS Lulus Semester 2 Menurut Status

ggplot(df_bin, aes(x = cu2_approved, fill = do_label)) +
  geom_histogram(
    binwidth = 1, position = "identity",
    alpha = 0.65, color = "white", linewidth = 0.3
  ) +
  scale_fill_manual(values = c("Graduate" = "#2a9d8f", "Dropout" = "#e76f51")) +
  labs(
    title    = "Distribusi SKS yang Lulus di Semester 2",
    subtitle = "Berdasarkan status akhir studi mahasiswa",
    x        = "Jumlah SKS yang lulus (semester 2)",
    y        = "Frekuensi",
    fill     = "Status"
  ) +
  theme_minimal(base_size = 12)

Interpretasi: Histogram memperlihatkan pemisahan yang sangat jelas antara kedua kelompok. Mahasiswa dropout terkonsentrasi pada 0 SKS lulus di semester 2, artinya sebagian besar mahasiswa yang putus studi tidak berhasil menyelesaikan satu pun mata kuliah di semester kedua mereka. Sebaliknya, distribusi mahasiswa lulus memusat pada 5–8 SKS dengan sebaran yang relatif normal. Pemisahan visual yang tajam ini mengkonfirmasi bahwa variabel ini akan menjadi prediktor sangat kuat dalam model.

4.4 Distribusi Usia Saat Mendaftar

ggplot(df_bin, aes(x = do_label, y = age, fill = do_label)) +
  geom_boxplot(alpha = 0.75, outlier.shape = 21, outlier.fill = "white",
               outlier.size = 1.5) +
  scale_fill_manual(values = c("Graduate" = "#2a9d8f", "Dropout" = "#e76f51")) +
  labs(
    title = "Distribusi Usia Saat Mendaftar Menurut Status Studi",
    x     = NULL,
    y     = "Usia saat mendaftar (tahun)"
  ) +
  theme_minimal(base_size = 12) +
  theme(legend.position = "none")

Interpretasi: Boxplot memperlihatkan bahwa mahasiswa dropout memiliki median usia yang lebih tinggi dan variabilitas yang lebih besar dibanding mahasiswa lulus. Terdapat sejumlah outlier usia yang sangat tinggi (di atas 40 tahun) pada kelompok dropout, yang menunjukkan bahwa mahasiswa dewasa yang masuk kembali ke perguruan tinggi setelah lama meninggalkan pendidikan menghadapi risiko putus studi lebih besar — kemungkinan karena konflik antara studi, pekerjaan, dan tanggung jawab keluarga.

4.5 Proporsi Dropout Berdasarkan Variabel Kategorik

prop_df <- bind_rows(
  df_bin %>% group_by(Variabel = "Jenis Kelamin",
                      Kategori = as.character(gender)) %>%
    summarise(dropout_rate = mean(dropout), n = n(), .groups="drop"),
  df_bin %>% group_by(Variabel = "Penerima Beasiswa",
                      Kategori = as.character(scholarship)) %>%
    summarise(dropout_rate = mean(dropout), n = n(), .groups="drop"),
  df_bin %>% group_by(Variabel = "Biaya Kuliah Lunas",
                      Kategori = as.character(tuition_ok)) %>%
    summarise(dropout_rate = mean(dropout), n = n(), .groups="drop"),
  df_bin %>% group_by(Variabel = "Memiliki Tunggakan",
                      Kategori = as.character(debtor)) %>%
    summarise(dropout_rate = mean(dropout), n = n(), .groups="drop")
)

ggplot(prop_df, aes(x = Kategori, y = dropout_rate, fill = Kategori)) +
  geom_col(width = 0.55, color = "white", show.legend = FALSE) +
  geom_text(aes(label = scales::percent(dropout_rate, accuracy = 0.1)),
            vjust = -0.4, size = 3.5) +
  scale_y_continuous(labels = scales::percent_format(), limits = c(0, 1)) +
  scale_fill_brewer(palette = "Set2") +
  facet_wrap(~Variabel, scales = "free_x") +
  labs(
    title = "Proporsi Dropout Berdasarkan Variabel Kategorik Kunci",
    x     = NULL,
    y     = "Proporsi dropout"
  ) +
  theme_minimal(base_size = 11)

Interpretasi: Empat variabel kategorik mengungkap pola yang bermakna. Mahasiswa dengan tunggakan biaya (debtor) memiliki proporsi dropout yang jauh lebih tinggi dibanding yang tidak memiliki tunggakan. Mahasiswa yang biaya kuliahnya belum lunas (tuition fees not up to date) juga menunjukkan tingkat dropout yang sangat tinggi — kondisi finansial yang tidak stabil menjadi faktor penghambat penyelesaian studi. Penerima beasiswa memiliki proporsi dropout yang lebih rendah, mengindikasikan bahwa dukungan finansial berperan dalam mempertahankan mahasiswa. Adapun jenis kelamin menunjukkan perbedaan yang lebih moderat, dengan mahasiswa pria sedikit lebih berisiko dibanding wanita.

5 Pemeriksaan Asumsi

Sebelum pembentukan model, dilakukan pemeriksaan terhadap dua asumsi utama regresi logistik biner: (1) linearitas hubungan antara prediktor kontinu dan log-odds respons, serta (2) tidak adanya multikolinearitas yang signifikan antar prediktor. Asumsi independensi diasumsikan terpenuhi karena setiap mahasiswa merupakan unit observasi yang berbeda dan tidak saling berkaitan.

5.1 Uji Linearitas Box–Tidwell

Uji Box–Tidwell digunakan untuk memeriksa apakah hubungan antara setiap prediktor kontinu dan log-odds variabel respons bersifat linear. Pengujian dilakukan dengan menambahkan term interaksi \(X \cdot \ln(X)\) ke dalam model logistik:

\[\text{logit}[\pi(x)] = \beta_0 + \beta_1 X + \beta_2 (X \cdot \ln X)\]

Asumsi linearitas dinyatakan terpenuhi apabila koefisien \(\beta_2\) tidak signifikan secara statistik (\(p > 0{,}05\)), yang mengindikasikan tidak adanya hubungan nonlinear antara prediktor kontinu dengan log-odds. Pengujian dilakukan secara terpisah untuk masing-masing variabel kontinu yang digunakan dalam model.

Hipotesis:

\(H_0\): Hubungan antara variabel kontinu \(X_k\) dengan log-odds \(\pi(x)\) bersifat linear
\(H_1\): Hubungan antara variabel kontinu \(X_k\) dengan log-odds \(\pi(x)\) tidak bersifat linear

Kriteria penolakan \(H_0\): p-value \(< \alpha = 0{,}05\)

# Variabel kontinu yang diuji
num_vars <- c("age", "prev_grade", "admission_grade",
              "cu1_approved", "cu1_grade",
              "cu2_approved", "cu2_grade",
              "unemp_rate", "inflation_rate", "gdp")

# Hitung interaksi X * ln(X) untuk setiap variabel kontinu (hanya untuk nilai > 0)
df_bt <- df_bin
bt_terms <- c()
for (v in num_vars) {
  vals <- df_bt[[v]]
  # Geser nilai agar > 0 jika ada nol atau negatif
  offset <- ifelse(min(vals, na.rm = TRUE) <= 0, abs(min(vals, na.rm = TRUE)) + 1, 0)
  df_bt[[paste0(v, "_ln")]] <- (vals + offset) * log(vals + offset)
  bt_terms <- c(bt_terms, paste0(v, "_ln"))
}

# Formula model Box-Tidwell: semua prediktor asli + semua interaksi X*ln(X)
bt_formula <- as.formula(
  paste("dropout ~",
        paste(num_vars, collapse = " + "), "+",
        paste(c("gender", "scholarship", "debtor", "tuition_ok",
                "displaced", "international", "day_attendance"),
              collapse = " + "), "+",
        paste(bt_terms, collapse = " + "))
)

bt_fit <- glm(bt_formula, data = df_bt, family = binomial(link = "logit"))

bt_summary <- broom::tidy(bt_fit) %>%
  filter(term %in% bt_terms) %>%
  mutate(
    `Variabel asli` = sub("_ln$", "", term),
    `p-value`       = round(p.value, 3),
    Kesimpulan      = ifelse(p.value > 0.05, "Linear (H\u2080 gagal ditolak)", "Tidak linear (H\u2080 ditolak)")
  ) %>%
  select(`Variabel asli`, estimate, std.error, statistic, `p-value`, Kesimpulan) %>%
  rename(
    `Koefisien (β₂)` = estimate,
    `Std. Error`     = std.error,
    `z value`        = statistic
  )

knitr::kable(bt_summary,
  caption = "Hasil uji linearitas Box–Tidwell untuk variabel prediktor kontinu",
  digits  = 4)

Hasil uji linearitas Box–Tidwell untuk variabel prediktor kontinu
Variabel asli	Koefisien (β₂)	Std. Error	z value	p-value	Kesimpulan
age	-0.2766	0.0455	-6.0804	0.000	Tidak linear (H₀ ditolak)
prev_grade	-0.0480	0.0594	-0.8068	0.420	Linear (H₀ gagal ditolak)
admission_grade	-0.1368	0.0561	-2.4394	0.015	Tidak linear (H₀ ditolak)
cu1_approved	-0.1762	0.0833	-2.1150	0.034	Tidak linear (H₀ ditolak)
cu1_grade	0.0000	0.0000	-1.6629	0.096	Linear (H₀ gagal ditolak)
cu2_approved	0.5821	0.1042	5.5877	0.000	Tidak linear (H₀ ditolak)
cu2_grade	0.0000	0.0000	-2.3618	0.018	Tidak linear (H₀ ditolak)
unemp_rate	-0.0273	0.2476	-0.1101	0.912	Linear (H₀ gagal ditolak)
inflation_rate	-0.1272	0.4065	-0.3130	0.754	Linear (H₀ gagal ditolak)
gdp	0.0692	0.1188	0.5823	0.560	Linear (H₀ gagal ditolak)

Interpretasi: Berdasarkan hasil uji Box–Tidwell, variabel kontinu yang memiliki nilai p-value > 0,05 pada term interaksi \(X \cdot \ln(X)\) dinyatakan memenuhi asumsi linearitas pada skala logit dan dapat diikutsertakan dalam model tanpa transformasi tambahan. Variabel yang melanggar asumsi linearitas (p-value < 0,05) menunjukkan hubungan nonlinear dengan log-odds dropout, sehingga perlu diperhatikan dalam interpretasi hasil model.

5.2 Uji Multikolinearitas (GVIF)

Multikolinearitas diperiksa menggunakan Generalized Variance Inflation Factor (GVIF), yang merupakan perluasan dari VIF standar untuk mengakomodasi variabel kategorik politomus. Nilai yang dievaluasi adalah \(\text{GVIF}^{1/(2 \cdot df)}\) dengan kriteria:

\[\text{GVIF}^{1/(2 \cdot df)} < 2\]

Nilai di bawah ambang batas tersebut mengindikasikan bahwa estimasi koefisien model tetap stabil dan dapat diandalkan.

Hipotesis:

\(H_0\): Tidak terdapat multikolinearitas yang bermasalah di antara variabel prediktor
\(H_1\): Terdapat multikolinearitas yang bermasalah di antara variabel prediktor

# Buat model penuh untuk GVIF
full_fit_gvif <- glm(
  dropout ~ age + prev_grade + admission_grade +
    cu1_approved + cu1_grade + cu2_approved + cu2_grade +
    unemp_rate + inflation_rate + gdp +
    gender + scholarship + debtor + tuition_ok +
    displaced + international + day_attendance,
  data   = df_bin,
  family = binomial(link = "logit")
)

# Hitung GVIF menggunakan fungsi car::vif()
# Untuk variabel biner/kategorik: GVIF^(1/(2*df)) yang digunakan
gvif_raw <- car::vif(full_fit_gvif)

# Konversi ke data frame yang rapi
if (is.matrix(gvif_raw)) {
  # Variabel kategorik: car mengembalikan matriks 3-kolom
  gvif_tbl <- data.frame(
    Prediktor       = rownames(gvif_raw),
    GVIF            = round(gvif_raw[, 1], 4),
    df              = gvif_raw[, 2],
    `GVIF^(1/2df)` = round(gvif_raw[, 3], 4),
    check.names     = FALSE
  )
} else {
  # Semua numerik: car mengembalikan vektor
  gvif_tbl <- data.frame(
    Prediktor       = names(gvif_raw),
    GVIF            = round(gvif_raw, 4),
    df              = 1,
    `GVIF^(1/2df)` = round(sqrt(gvif_raw), 4),
    check.names     = FALSE
  )
}

gvif_tbl$Kesimpulan <- ifelse(
  gvif_tbl$`GVIF^(1/2df)` < 2,
  "Tidak bermasalah",
  "Bermasalah (> 2)"
)

knitr::kable(gvif_tbl,
  caption = "Nilai GVIF model penuh — pemeriksaan multikolinearitas",
  row.names = FALSE)

Nilai GVIF model penuh — pemeriksaan multikolinearitas
Prediktor	GVIF	df	GVIF^(1/2df)	Kesimpulan
age	1.5061	1	1.2272	Tidak bermasalah
prev_grade	1.5720	1	1.2538	Tidak bermasalah
admission_grade	1.5400	1	1.2410	Tidak bermasalah
cu1_approved	4.3708	1	2.0906	Bermasalah (> 2)
cu1_grade	1.2339	1	1.1108	Tidak bermasalah
cu2_approved	4.4190	1	2.1022	Bermasalah (> 2)
cu2_grade	1.1962	1	1.0937	Tidak bermasalah
unemp_rate	1.1650	1	1.0794	Tidak bermasalah
inflation_rate	1.0302	1	1.0150	Tidak bermasalah
gdp	1.1395	1	1.0675	Tidak bermasalah
gender	1.0544	1	1.0268	Tidak bermasalah
scholarship	1.0355	1	1.0176	Tidak bermasalah
debtor	1.0915	1	1.0447	Tidak bermasalah
tuition_ok	1.1016	1	1.0496	Tidak bermasalah
displaced	1.2068	1	1.0986	Tidak bermasalah
international	1.0353	1	1.0175	Tidak bermasalah
day_attendance	1.3613	1	1.1668	Tidak bermasalah

Interpretasi: Seluruh nilai \(\text{GVIF}^{1/(2 \cdot df)}\) yang berada di bawah ambang batas 2 mengindikasikan tidak adanya masalah multikolinearitas yang signifikan di antara variabel prediktor. Estimasi koefisien model dapat dianggap stabil dan dapat diandalkan. Apabila terdapat variabel yang melampaui ambang batas, hal tersebut perlu dipertimbangkan dalam interpretasi koefisien karena estimasinya mungkin tidak stabil.

6 Pembagian Data Training dan Testing

Data dibagi secara stratified dengan proporsi 80% training dan 20% testing agar komposisi kelas pada kedua subset mencerminkan proporsi data keseluruhan.

stratified_split <- function(y, prop = 0.8) {
  idx_by_class <- split(seq_along(y), y)
  train_idx <- lapply(
    idx_by_class,
    function(idx) sample(idx, size = floor(length(idx) * prop))
  )
  unlist(train_idx, use.names = FALSE)
}

set.seed(42)
train_id   <- stratified_split(df_bin$dropout, prop = 0.8)
train_data <- df_bin[train_id, ]
test_data  <- df_bin[-train_id, ]

split_summary <- bind_rows(
  train_data %>% count(do_label) %>% mutate(Data = "Training"),
  test_data  %>% count(do_label) %>% mutate(Data = "Testing")
) %>%
  group_by(Data) %>%
  mutate(Proporsi = scales::percent(n / sum(n), accuracy = 0.1)) %>%
  ungroup() %>%
  rename(Status = do_label, Jumlah = n) %>%
  select(Data, Status, Jumlah, Proporsi)

knitr::kable(split_summary, caption = "Distribusi kelas pada data training dan testing")

Distribusi kelas pada data training dan testing
Data	Status	Jumlah	Proporsi
Training	Graduate	1767	60.9%
Training	Dropout	1136	39.1%
Testing	Graduate	442	60.8%
Testing	Dropout	285	39.2%

Interpretasi: Pembagian stratified memastikan proporsi Graduate dan Dropout pada data training dan testing seimbang dan representatif. Data training (2903 observasi) digunakan untuk mengestimasi parameter model, sementara data testing (727 observasi) digunakan untuk mengevaluasi performa model pada data yang tidak pernah dilihat selama proses estimasi.

7 Model Regresi Logistik Biner

7.1 Rumus Model

Misalkan \(Y_i\) menyatakan status akhir mahasiswa ke-\(i\):

\[ Y_i = \begin{cases} 1, & \text{jika mahasiswa putus studi (Dropout),} \\ 0, & \text{jika mahasiswa lulus (Graduate).} \end{cases} \]

Peluang mahasiswa putus studi dinotasikan:

\[p_i = P(Y_i = 1 \mid X_i).\]

Model logistik memodelkan log-odds putus studi sebagai fungsi linear dari prediktor:

\[ \text{logit}(p_i) = \ln\!\left(\frac{p_i}{1 - p_i}\right) = \beta_0 + \sum_{j=1}^{k} \beta_j X_{ji}. \]

Peluang prediksi diperoleh melalui transformasi balik:

\[ \hat{p}_i = \frac{1}{1 + \exp\!\left(-\hat{\eta}_i\right)}. \]

Interpretasi odds ratio: Untuk prediktor numerik \(X_j\), kenaikan satu satuan pada \(X_j\) mengubah odds dropout sebesar faktor \(\exp(\hat\beta_j)\), dengan asumsi prediktor lain tetap:

\(\exp(\hat\beta_j) > 1\) : kenaikan \(X_j\) meningkatkan odds dropout.
\(\exp(\hat\beta_j) < 1\) : kenaikan \(X_j\) menurunkan odds dropout.
Untuk prediktor kategorik, odds ratio dibandingkan terhadap kategori referensi.

7.2 Model Penuh

Model penuh dibangun dengan memasukkan seluruh variabel kandidat ke dalam model regresi logistik biner secara simultan menggunakan data training. Model ini berfungsi sebagai titik awal yang komprehensif sebelum dilakukan proses seleksi variabel.

heart_fit <- glm(
  dropout ~ age + prev_grade + admission_grade +
    cu1_approved + cu1_grade + cu2_approved + cu2_grade +
    unemp_rate + inflation_rate + gdp +
    gender + scholarship + debtor + tuition_ok +
    displaced + international + day_attendance,
  data   = train_data,
  family = binomial(link = "logit")
)

ringkasan_model <- data.frame(
  Keterangan = c(
    "Jumlah observasi training",
    "Null deviance",
    "Residual deviance",
    "Derajat bebas residual",
    "AIC"
  ),
  Nilai = c(
    nobs(heart_fit),
    round(heart_fit$null.deviance, 3),
    round(heart_fit$deviance, 3),
    heart_fit$df.residual,
    round(AIC(heart_fit), 3)
  )
)
knitr::kable(ringkasan_model, caption = "Ringkasan kecocokan model penuh regresi logistik biner")

Ringkasan kecocokan model penuh regresi logistik biner
Keterangan	Nilai
Jumlah observasi training	2903.000
Null deviance	3886.157
Residual deviance	1880.950
Derajat bebas residual	2885.000
AIC	1916.950

Interpretasi: Residual deviance (1880.9) yang jauh lebih kecil dari null deviance (3886.2) menunjukkan bahwa prediktor yang dimasukkan secara bersama-sama memberikan kontribusi nyata dalam menjelaskan variasi status studi mahasiswa. Selisih deviance sebesar 2005.2 poin mengindikasikan perbaikan kecocokan model yang substansial dibandingkan model tanpa prediktor sama sekali.

7.3 Seleksi Model Terbaik (Stepwise Bidirectional–AIC)

Seleksi variabel dilakukan menggunakan metode stepwise bidirectional berbasis Akaike Information Criterion (AIC). Pada setiap iterasi, algoritma mempertimbangkan penambahan variabel (forward step) maupun penghapusan variabel (backward step), dan memilih aksi yang menghasilkan penurunan AIC terbesar. Proses berlanjut hingga tidak ada lagi perubahan yang menurunkan AIC.

\[AIC = -2\ln(L) + 2k\]

di mana \(L\) adalah nilai likelihood maksimum model dan \(k\) adalah jumlah parameter yang diestimasi. Model dengan nilai AIC terkecil dipilih sebagai model terbaik.

# Model null (hanya intercept) sebagai batas bawah
null_fit <- glm(dropout ~ 1, data = train_data, family = binomial(link = "logit"))

# Stepwise bidirectional berbasis AIC
step_fit <- step(
  heart_fit,
  scope     = list(lower = null_fit, upper = heart_fit),
  direction = "both",
  trace     = 0   # set trace = 1 untuk melihat log iterasi
)

# Ringkasan perbandingan AIC model penuh vs model final
aic_compare <- data.frame(
  Model              = c("Model Penuh", "Model Final (Stepwise AIC)"),
  `Jumlah variabel`  = c(length(coef(heart_fit)) - 1,
                          length(coef(step_fit))  - 1),
  AIC                = round(c(AIC(heart_fit), AIC(step_fit)), 3),
  check.names        = FALSE
)
knitr::kable(aic_compare, caption = "Perbandingan AIC model penuh dan model final")

Perbandingan AIC model penuh dan model final
Model	Jumlah variabel	AIC
Model Penuh	17	1916.950
Model Final (Stepwise AIC)	11	1909.549

# Variabel yang terpilih dalam model final
cat("\nVariabel yang dipertahankan dalam model final:\n")

## 
## Variabel yang dipertahankan dalam model final:

cat(paste(names(coef(step_fit))[-1], collapse = "\n"), "\n")

## age
## admission_grade
## cu1_approved
## cu1_grade
## cu2_approved
## unemp_rate
## genderPria
## scholarshipYa
## debtorYa
## tuition_okLunas
## internationalYa

Interpretasi: Proses seleksi stepwise bidirectional menghasilkan model final dengan AIC yang lebih rendah dibanding model penuh, mencerminkan keseimbangan optimal antara kesesuaian model dan kompleksitasnya. Variabel yang dieliminasi selama proses seleksi dinilai tidak memberikan kontribusi informasi yang cukup signifikan untuk mempertahankan keberadaannya dalam model.

7.4 Koefisien Model Terbaik (Stepwise)

Tabel berikut menyajikan bentuk nyata model terbaik hasil seleksi stepwise, lengkap dengan estimasi koefisien logit (\(\hat{\beta}\)), odds ratio (\(\exp(\hat{\beta})\)), interval kepercayaan 95%, dan tingkat signifikansi masing-masing variabel terpilih.

coef_step <- broom::tidy(step_fit) %>%
  mutate(
    odds_ratio = exp(estimate),
    ci_low     = exp(estimate - 1.96 * std.error),
    ci_high    = exp(estimate + 1.96 * std.error),
    signif     = case_when(
      p.value < 0.001 ~ "***",
      p.value < 0.01  ~ "**",
      p.value < 0.05  ~ "*",
      TRUE            ~ ""
    ),
    label_term = dplyr::recode(term,
      "(Intercept)"         = "(Intercept)",
      "age"                 = "Usia saat mendaftar",
      "prev_grade"          = "Nilai kualifikasi sebelumnya",
      "admission_grade"     = "Nilai masuk",
      "cu1_approved"        = "SKS lulus sem-1",
      "cu1_grade"           = "Nilai SKS sem-1",
      "cu2_approved"        = "SKS lulus sem-2",
      "cu2_grade"           = "Nilai SKS sem-2",
      "unemp_rate"          = "Tingkat pengangguran",
      "inflation_rate"      = "Inflasi",
      "gdp"                 = "PDB",
      "genderPria"          = "Jenis kelamin: Pria",
      "scholarshipYa"       = "Beasiswa: Ya",
      "debtorYa"            = "Tunggakan: Ya",
      "tuition_okLunas"     = "Biaya kuliah: Lunas",
      "displacedYa"         = "Displaced: Ya",
      "internationalYa"     = "Internasional: Ya",
      "day_attendanceSiang" = "Kelas siang"
    )
  ) %>%
  transmute(
    `Variabel`         = label_term,
    `β̂ (Koefisien)`   = round(estimate, 4),
    `Std. Error`       = round(std.error, 4),
    `Odds Ratio (eβ̂)` = round(odds_ratio, 4),
    `IK 95% Bawah`    = round(ci_low, 4),
    `IK 95% Atas`     = round(ci_high, 4),
    `p-value`          = signif(p.value, 3),
    `Sig.`             = signif
  )

knitr::kable(
  coef_step,
  caption = "Koefisien model terbaik hasil stepwise AIC (*** p<0,001 | ** p<0,01 | * p<0,05)"
)

Koefisien model terbaik hasil stepwise AIC (*** p<0,001 | ** p<0,01 | * p<0,05)
Variabel	β̂ (Koefisien)	Std. Error	Odds Ratio (eβ̂)	IK 95% Bawah	IK 95% Atas	p-value	Sig.
(Intercept)	5.7499	0.6723	314.1600	84.1095	1173.4279	0.00e+00	***
Usia saat mendaftar	0.0393	0.0076	1.0401	1.0248	1.0556	2.00e-07	***
Nilai masuk	-0.0194	0.0041	0.9808	0.9730	0.9887	2.10e-06	***
SKS lulus sem-1	0.1790	0.0466	1.1960	1.0915	1.3105	1.24e-04	***
Nilai SKS sem-1	0.0000	0.0000	1.0000	1.0000	1.0000	5.77e-02
SKS lulus sem-2	-0.7476	0.0499	0.4735	0.4293	0.5222	0.00e+00	***
Tingkat pengangguran	0.0380	0.0222	1.0387	0.9945	1.0849	8.73e-02
Jenis kelamin: Pria	0.3729	0.1235	1.4520	1.1398	1.8497	2.54e-03	**
Beasiswa: Ya	-1.2682	0.1557	0.2813	0.2073	0.3817	0.00e+00	***
Tunggakan: Ya	0.8438	0.2192	2.3251	1.5129	3.5732	1.19e-04	***
Biaya kuliah: Lunas	-2.8921	0.2903	0.0555	0.0314	0.0980	0.00e+00	***
Internasional: Ya	-1.3128	0.4462	0.2691	0.1122	0.6452	3.26e-03	**

Interpretasi model terbaik: Tabel di atas menampilkan bentuk nyata persamaan logistik model terpilih. Kolom \(\hat{\beta}\) menunjukkan arah pengaruh setiap prediktor terhadap log-odds putus studi, sedangkan odds ratio (\(e^{\hat{\beta}}\)) menunjukkan besaran perubahan odds dropout per satu satuan perubahan prediktor (dengan prediktor lain tetap). Variabel dengan tanda \(\hat{\beta}\) positif meningkatkan risiko dropout, sementara \(\hat{\beta}\) negatif bersifat protektif. Interval kepercayaan 95% yang tidak mencakup nilai 1,0 pada kolom OR mengkonfirmasi signifikansi statistik variabel tersebut.

# Gunakan model final hasil stepwise sebagai model terpilih
ringkasan_final_fit <- data.frame(
  Keterangan = c(
    "Jumlah observasi training",
    "Null deviance",
    "Residual deviance",
    "Derajat bebas residual",
    "AIC (model penuh)",
    "AIC (model final)"
  ),
  Nilai = c(
    nobs(step_fit),
    round(step_fit$null.deviance, 3),
    round(step_fit$deviance, 3),
    step_fit$df.residual,
    round(AIC(heart_fit), 3),
    round(AIC(step_fit), 3)
  )
)
knitr::kable(ringkasan_final_fit, caption = "Ringkasan kecocokan model final regresi logistik biner")

Ringkasan kecocokan model final regresi logistik biner
Keterangan	Nilai
Jumlah observasi training	2903.000
Null deviance	3886.157
Residual deviance	1885.549
Derajat bebas residual	2891.000
AIC (model penuh)	1916.950
AIC (model final)	1909.549

Interpretasi: Model final yang dihasilkan melalui seleksi stepwise memiliki AIC sebesar 1909.549, lebih rendah dibanding model penuh (1916.95). Penurunan AIC ini mengindikasikan peningkatan efisiensi model — model final mampu menjelaskan variasi status studi mahasiswa dengan lebih parsimoni tanpa kehilangan kemampuan prediksi yang berarti.

8 Pengujian Signifikansi

8.1 Uji G² — Uji Simultan (Likelihood Ratio Test)

Uji \(G^2\) digunakan untuk menguji apakah model secara keseluruhan signifikan, dengan membandingkan model final terhadap model kosong (hanya intersep).

\[G^2 = -2\ln\!\left(\frac{L_0}{L_1}\right) = -2[\ln(L_0) - \ln(L_1)]\]

di mana \(L_0\) adalah log-likelihood model nol dan \(L_1\) adalah log-likelihood model final.

Hipotesis:

\[H_0: \beta_1 = \beta_2 = \cdots = \beta_k = 0 \quad \text{vs} \quad H_1: \text{minimal satu } \beta_j \neq 0\]

\(H_0\) ditolak jika \(G^2 > \chi^2_{(p;\, 0{,}05)}\) atau \(p\text{-value} < 0{,}05\).

# Uji Likelihood Ratio (G²)
g2_stat  <- step_fit$null.deviance - step_fit$deviance
df_g2    <- step_fit$df.null - step_fit$df.residual
p_g2     <- pchisq(g2_stat, df = df_g2, lower.tail = FALSE)
chi2_kritis <- qchisq(0.95, df = df_g2)

g2_tbl <- data.frame(
  `G² (statistik uji)`  = round(g2_stat, 3),
  `df`                   = df_g2,
  `χ² tabel (α = 0,05)` = round(chi2_kritis, 3),
  `p-value`              = format.pval(p_g2, digits = 3, eps = 0.001),
  Kesimpulan             = ifelse(p_g2 < 0.05, "Tolak H₀ — model signifikan",
                                  "Gagal tolak H₀ — model tidak signifikan"),
  check.names            = FALSE
)
knitr::kable(g2_tbl, caption = "Hasil uji G² (Likelihood Ratio Test) model final")

Hasil uji G² (Likelihood Ratio Test) model final
G² (statistik uji)	df	χ² tabel (α = 0,05)	p-value	Kesimpulan
2000.608	11	19.675	<0.001	Tolak H₀ — model signifikan

Interpretasi: Nilai \(G^2 =\) 2000.608 dengan derajat bebas \(df =\) 11 dibandingkan terhadap nilai kritis \(\chi^2_{(11;\,0{,}05)} =\) 19.675. Karena \(G^2\) melampaui nilai kritis dan \(p\text{-value}\) < 0,05, maka \(H_0\) ditolak. Model secara keseluruhan signifikan — minimal satu prediktor dalam model final memiliki hubungan yang bermakna dengan status putus studi mahasiswa.

8.2 Uji Wald — Uji Parsial

Uji Wald digunakan untuk menguji signifikansi setiap koefisien secara individual:

\[W^2 = \left(\frac{\hat\beta_j}{SE(\hat\beta_j)}\right)^2\]

Hipotesis: \(H_0: \beta_j = 0\) vs \(H_1: \beta_j \neq 0\). \(H_0\) ditolak jika \(p\text{-value} < 0{,}05\).

coef_table <- broom::tidy(heart_fit) %>%
  filter(term != "(Intercept)") %>%
  mutate(
    odds_ratio = exp(estimate),
    ci_low     = exp(estimate - 1.96 * std.error),
    ci_high    = exp(estimate + 1.96 * std.error),
    signif     = case_when(
      p.value < 0.001 ~ "***",
      p.value < 0.01  ~ "**",
      p.value < 0.05  ~ "*",
      TRUE            ~ ""
    )
  ) %>%
  arrange(p.value) %>%
  transmute(
    `Variabel / level`              = term,
    `Odds ratio`                    = round(odds_ratio, 3),
    `IK 95% bawah`                  = round(ci_low, 3),
    `IK 95% atas`                   = round(ci_high, 3),
    `p-value`                       = signif(p.value, 3),
    `Signifikansi`                  = signif
  )

knitr::kable(
  coef_table,
  caption = "Koefisien model regresi logistik — diurutkan dari p-value terkecil (*** p<0.001, ** p<0.01, * p<0.05)"
)

Koefisien model regresi logistik — diurutkan dari p-value terkecil (*** p<0.001, ** p<0.01, * p<0.05)
Variabel / level	Odds ratio	IK 95% bawah	IK 95% atas	p-value	Signifikansi
cu2_approved	0.478	0.433	0.529	0.00e+00	***
tuition_okLunas	0.055	0.031	0.098	0.00e+00	***
scholarshipYa	0.286	0.210	0.388	0.00e+00	***
age	1.040	1.022	1.059	1.45e-05	***
debtorYa	2.310	1.499	3.558	1.46e-04	***
cu1_approved	1.194	1.089	1.308	1.52e-04	***
admission_grade	0.984	0.974	0.993	8.46e-04	***
genderPria	1.449	1.135	1.850	2.94e-03	**
internationalYa	0.271	0.113	0.650	3.44e-03	**
cu1_grade	1.000	1.000	1.000	7.94e-02
unemp_rate	1.037	0.989	1.086	1.30e-01
inflation_rate	1.058	0.972	1.152	1.89e-01
cu2_grade	1.000	1.000	1.000	3.09e-01
prev_grade	0.995	0.984	1.006	3.53e-01
gdp	0.983	0.930	1.040	5.58e-01
day_attendanceSiang	1.118	0.755	1.657	5.77e-01
displacedYa	0.951	0.736	1.228	6.98e-01

Interpretasi tabel koefisien:

Prediktor dengan pengaruh paling dominan terhadap peluang putus studi berdasarkan tabel adalah sebagai berikut.

Biaya kuliah yang belum lunas (tuition fees not up to date) menunjukkan odds ratio yang jauh di atas 1. Artinya, mahasiswa yang pembayaran biaya kuliahnya tidak tepat waktu memiliki kecenderungan putus studi yang jauh lebih tinggi dibanding mahasiswa yang biayanya sudah lunas, dengan asumsi faktor lain konstan. Kondisi finansial yang tidak stabil secara langsung mengancam kelangsungan studi mahasiswa.

SKS yang lulus di semester 2 (cu2_approved) memiliki odds ratio di bawah 1 dan sangat signifikan. Setiap tambahan satu SKS yang berhasil diselesaikan di semester 2 secara substansial menurunkan odds putus studi. Ini mengkonfirmasi bahwa keberhasilan akademik di awal studi merupakan pelindung utama terhadap dropout.

Nilai rata-rata SKS semester 2 (cu2_grade) juga menunjukkan arah yang sama: nilai yang lebih tinggi berasosiasi dengan odds dropout yang lebih rendah, mencerminkan bahwa performa akademik yang baik secara konsisten mengurangi risiko putus studi.

Memiliki tunggakan (debtor) meningkatkan odds dropout secara signifikan. Mahasiswa dengan tunggakan keuangan kepada institusi menghadapi tekanan finansial yang dapat memaksa mereka meninggalkan studi.

Penerima beasiswa (scholarship holder) memiliki odds ratio di bawah 1, artinya beasiswa menurunkan peluang dropout. Dukungan finansial formal dari institusi terbukti menjadi faktor protektif yang penting.

Usia saat mendaftar memiliki odds ratio di atas 1 — setiap tambahan satu tahun usia saat mendaftar meningkatkan odds dropout. Mahasiswa yang mendaftar pada usia lebih tua kemungkinan memiliki komitmen eksternal (pekerjaan, keluarga) yang bersaing dengan kewajiban akademik.

8.3 Uji Hosmer–Lemeshow (Goodness-of-Fit)

Uji Hosmer–Lemeshow digunakan untuk mengevaluasi kesesuaian model dengan data observasi. Prosedur pengujian membagi data ke dalam \(g = 10\) kelompok berdasarkan nilai probabilitas prediksi, kemudian membandingkan frekuensi yang teramati dengan frekuensi yang diprediksi pada masing-masing kelompok.

Hipotesis:

\(H_0\): Model memiliki kalibrasi yang baik (tidak terdapat perbedaan signifikan antara nilai teramati dan diprediksi)
\(H_1\): Model tidak memiliki kalibrasi yang baik

Model dinyatakan fit apabila \(p\text{-value} > 0{,}05\).

# Uji Hosmer-Lemeshow (implementasi manual tanpa paket tambahan)
hosmer_lemeshow_test <- function(actual, fitted, g = 10) {
  df_hl     <- data.frame(actual = actual, fitted = fitted)
  df_hl$grp <- cut(fitted, breaks = quantile(fitted, probs = seq(0, 1, length.out = g + 1)),
                   include.lowest = TRUE, labels = FALSE)
  hl_grp <- df_hl %>%
    group_by(grp) %>%
    summarise(
      n      = n(),
      obs1   = sum(actual),
      obs0   = n() - sum(actual),
      exp1   = sum(fitted),
      exp0   = n() - sum(fitted),
      .groups = "drop"
    )
  chi2 <- sum((hl_grp$obs1 - hl_grp$exp1)^2 / hl_grp$exp1 +
                (hl_grp$obs0 - hl_grp$exp0)^2 / hl_grp$exp0)
  df_hl_test <- g - 2
  p_val <- pchisq(chi2, df = df_hl_test, lower.tail = FALSE)
  list(chi2 = chi2, df = df_hl_test, p_value = p_val, table = hl_grp)
}

p_train_hl <- predict(heart_fit, type = "response")
hl_result  <- hosmer_lemeshow_test(train_data$dropout, p_train_hl, g = 10)

hl_tbl <- data.frame(
  `χ²`                   = round(hl_result$chi2, 4),
  `df`                    = hl_result$df,
  `χ² tabel (α = 0,05)`  = round(qchisq(0.95, df = hl_result$df), 3),
  `p-value`               = round(hl_result$p_value, 4),
  Kesimpulan              = ifelse(hl_result$p_value > 0.05,
                                   "H₀ gagal ditolak — model fit",
                                   "H₀ ditolak — model tidak fit"),
  check.names             = FALSE
)
knitr::kable(hl_tbl, caption = "Hasil uji Hosmer–Lemeshow model final (g = 10 kelompok)")

Hasil uji Hosmer–Lemeshow model final (g = 10 kelompok)
χ²	df	χ² tabel (α = 0,05)	p-value	Kesimpulan
139.1371	8	15.507	0	H₀ ditolak — model tidak fit

Interpretasi: Nilai \(\chi^2 =\) 139.1371 dengan \(df =\) 8 menghasilkan \(p\text{-value} =\) 0. Karena \(p\text{-value}\) < 0,05, maka \(H_0\) ditolak. Model menunjukkan ketidaksesuaian antara nilai yang diprediksi dan yang teramati pada setidaknya beberapa kelompok.

9 Estimasi Odds Ratio dan Interpretasi Faktor Risiko

Interpretasi pengaruh variabel prediktor dilakukan melalui odds ratio (OR) yang dihitung sebagai:

\[OR = \exp(\hat\beta_j)\]

Nilai OR > 1 menunjukkan bahwa variabel tersebut merupakan faktor risiko yang meningkatkan peluang dropout, sedangkan OR < 1 menunjukkan faktor protektif. Interval kepercayaan 95% dihitung menggunakan metode Wald:

\[95\%\,CI = \exp\!\left(\hat\beta_j \pm 1{,}96 \times SE(\hat\beta_j)\right)\]

Apabila interval kepercayaan tidak mencakup nilai 1,0, asosiasi dinyatakan signifikan secara statistik pada \(\alpha = 0{,}05\).

9.1 Visualisasi Odds Ratio

or_plot_data <- broom::tidy(heart_fit) %>%
  filter(term != "(Intercept)") %>%
  mutate(
    odds_ratio = exp(estimate),
    ci_low     = exp(estimate - 1.96 * std.error),
    ci_high    = exp(estimate + 1.96 * std.error),
    arah       = ifelse(odds_ratio >= 1, "Meningkatkan odds dropout", "Menurunkan odds dropout"),
    label_term = dplyr::recode(term,
      "age"                 = "Usia saat mendaftar",
      "prev_grade"          = "Nilai kualifikasi sebelumnya",
      "admission_grade"     = "Nilai masuk",
      "cu1_approved"        = "SKS lulus sem-1",
      "cu1_grade"           = "Nilai SKS sem-1",
      "cu2_approved"        = "SKS lulus sem-2",
      "cu2_grade"           = "Nilai SKS sem-2",
      "unemp_rate"          = "Tingkat pengangguran",
      "inflation_rate"      = "Inflasi",
      "gdp"                 = "PDB",
      "genderPria"          = "Jenis kelamin: Pria",
      "scholarshipYa"       = "Beasiswa: Ya",
      "debtorYa"            = "Tunggakan: Ya",
      "tuition_okLunas"     = "Biaya kuliah: Lunas",
      "displacedYa"         = "Displaced: Ya",
      "internationalYa"     = "Internasional: Ya",
      "day_attendanceSiang" = "Kelas siang"
    )
  ) %>%
  arrange(odds_ratio)

ggplot(or_plot_data,
       aes(x = odds_ratio,
           y = reorder(label_term, odds_ratio),
           color = arah)) +
  geom_vline(xintercept = 1, linetype = "dashed", color = "#6c757d") +
  geom_errorbarh(aes(xmin = ci_low, xmax = ci_high), height = 0.3, linewidth = 0.7) +
  geom_point(size = 3) +
  scale_color_manual(values = c(
    "Meningkatkan odds dropout" = "#e76f51",
    "Menurunkan odds dropout"   = "#2a9d8f"
  )) +
  scale_x_log10() +
  labs(
    title    = "Odds Ratio Prediktor Regresi Logistik Biner",
    subtitle = "Prediksi putus studi (Dropout vs Graduate) — skala logaritmik",
    x        = "Odds ratio (log scale) + Interval Kepercayaan 95%",
    y        = NULL,
    color    = NULL
  ) +
  theme_minimal(base_size = 11) +
  theme(legend.position = "bottom")

Interpretasi: Grafik forest plot menyajikan odds ratio setiap prediktor beserta interval kepercayaan 95%-nya pada skala logaritmik. Prediktor berwarna oranye (odds ratio > 1) meningkatkan odds putus studi, sedangkan yang berwarna hijau (odds ratio < 1) menurunkannya. Prediktor yang interval kepercayaannya tidak melewati garis putus-putus pada nilai 1 dinyatakan signifikan secara statistik. Visualisasi ini memperlihatkan bahwa faktor akademik semester awal (SKS lulus dan nilai) serta faktor finansial (biaya lunas, tunggakan, beasiswa) mendominasi model sebagai prediktor paling informatif.

10 Prediksi dan Evaluasi Klasifikasi

10.1 Rumus Prediksi Kelas

Kelas prediksi ditentukan berdasarkan threshold \(c\):

\[ \hat{Y}_i = \begin{cases} 1 \;(\text{Dropout}), & \text{jika } \hat{p}_i \ge c, \\ 0 \;(\text{Graduate}), & \text{jika } \hat{p}_i < c. \end{cases} \]

10.2 Rumus Metrik Evaluasi

Dari confusion matrix diperoleh:

\[\text{Akurasi} = \frac{TP + TN}{TP + TN + FP + FN}\]

\[\text{Sensitivity} = \frac{TP}{TP + FN} \quad \text{(kemampuan mendeteksi dropout)}\]

\[\text{Specificity} = \frac{TN}{TN + FP} \quad \text{(kemampuan mengidentifikasi lulusan)}\]

\[\text{Presisi} = \frac{TP}{TP + FP}\]

\[\text{F1-score} = \frac{2 \times \text{Presisi} \times \text{Sensitivity}}{\text{Presisi} + \text{Sensitivity}}\]

\[\text{Balanced accuracy} = \frac{\text{Sensitivity} + \text{Specificity}}{2}\]

Dalam konteks prediksi dropout, sensitivity menjadi metrik prioritas karena merepresentasikan proporsi mahasiswa dropout yang berhasil diidentifikasi oleh model. Mahasiswa dropout yang tidak terdeteksi (false negative) akan kehilangan kesempatan mendapat intervensi dini.

safe_div <- function(num, den) ifelse(den == 0, NA_real_, num / den)

classification_metrics <- function(actual, prob, threshold = 0.5) {
  pred <- as.integer(prob >= threshold)
  tp   <- sum(pred == 1 & actual == 1)
  tn   <- sum(pred == 0 & actual == 0)
  fp   <- sum(pred == 1 & actual == 0)
  fn   <- sum(pred == 0 & actual == 1)
  sens <- safe_div(tp, tp + fn)
  spec <- safe_div(tn, tn + fp)
  prec <- safe_div(tp, tp + fp)
  data.frame(
    threshold         = threshold,
    accuracy          = safe_div(tp + tn, tp + tn + fp + fn),
    error_rate        = 1 - safe_div(tp + tn, tp + tn + fp + fn),
    sensitivity       = sens,
    specificity       = spec,
    precision         = prec,
    npv               = safe_div(tn, tn + fn),
    f1_score          = safe_div(2 * prec * sens, prec + sens),
    balanced_accuracy = (sens + spec) / 2,
    fpr               = 1 - spec,
    fnr               = 1 - sens
  )
}

confusion_matrix_tbl <- function(actual, prob, threshold = 0.5) {
  pred_lbl   <- factor(ifelse(prob >= threshold, "Prediksi Dropout","Prediksi Graduate"),
                       levels = c("Prediksi Dropout","Prediksi Graduate"))
  actual_lbl <- factor(ifelse(actual == 1, "Aktual Dropout","Aktual Graduate"),
                       levels = c("Aktual Dropout","Aktual Graduate"))
  addmargins(table(actual_lbl, pred_lbl))
}

p_train <- predict(heart_fit, newdata = train_data, type = "response")
p_test  <- predict(heart_fit, newdata = test_data,  type = "response")

10.3 Evaluasi pada Threshold 0,50

cm_default <- confusion_matrix_tbl(test_data$dropout, p_test, 0.5)
m_default  <- classification_metrics(test_data$dropout, p_test, 0.5)

knitr::kable(cm_default,
  caption = "Confusion matrix data testing — threshold 0,50")

Confusion matrix data testing — threshold 0,50
	Prediksi Dropout	Prediksi Graduate	Sum
Aktual Dropout	234	51	285
Aktual Graduate	30	412	442
Sum	264	463	727

knitr::kable(
  m_default %>% mutate(across(where(is.numeric), round, 3)) %>%
    rename(Threshold = threshold, Akurasi = accuracy, `Error rate` = error_rate,
           Sensitivity = sensitivity, Specificity = specificity,
           Presisi = precision, NPV = npv, `F1-score` = f1_score,
           `Balanced accuracy` = balanced_accuracy, FPR = fpr, FNR = fnr),
  caption = "Metrik evaluasi data testing pada threshold 0,50")

Metrik evaluasi data testing pada threshold 0,50
Threshold	Akurasi	Error rate	Sensitivity	Specificity	Presisi	NPV	F1-score	Balanced accuracy	FPR	FNR
0.5	0.889	0.111	0.821	0.932	0.886	0.89	0.852	0.877	0.068	0.179

Interpretasi: Pada threshold 0,50, model mengklasifikasikan mahasiswa sebagai dropout jika peluang prediksinya minimal 50%. Nilai akurasi keseluruhan menggambarkan proporsi prediksi yang benar dari seluruh observasi. Namun dalam konteks prediksi dropout, akurasi saja tidak cukup — perlu melihat sensitivity (proporsi mahasiswa dropout yang berhasil dideteksi) dan specificity (proporsi mahasiswa lulus yang diidentifikasi dengan benar). Jika sensitivity pada threshold ini masih rendah, berarti banyak mahasiswa yang benar-benar berisiko dropout tidak terdeteksi oleh model.

11 Kurva ROC dan Threshold Optimal

11.1 Konstruksi Kurva ROC

Kurva ROC (Receiver Operating Characteristic) dibangun dengan menghitung pasangan (FPR, TPR) untuk setiap nilai threshold yang mungkin, di mana:

\[TPR(c) = \text{Sensitivity}(c), \quad FPR(c) = 1 - \text{Specificity}(c).\]

Nilai AUC (Area Under Curve) dihitung sebagai:

\[AUC = \int_0^1 TPR(FPR)\, d(FPR).\]

AUC merepresentasikan probabilitas bahwa model memberikan skor dropout yang lebih tinggi pada mahasiswa yang benar-benar dropout dibandingkan mahasiswa yang lulus, jika diambil satu pasang secara acak.

Threshold optimal dipilih menggunakan Indeks Youden:

\[J = \max_c \{\text{Sensitivity}(c) + \text{Specificity}(c) - 1\}.\]

roc_points <- function(actual, prob) {
  thresholds <- c(Inf, sort(unique(prob), decreasing = TRUE), -Inf)
  out <- lapply(thresholds, function(th) {
    pred <- as.integer(prob >= th)
    tp   <- sum(pred == 1 & actual == 1)
    tn   <- sum(pred == 0 & actual == 0)
    fp   <- sum(pred == 1 & actual == 0)
    fn   <- sum(pred == 0 & actual == 1)
    sens <- safe_div(tp, tp + fn)
    spec <- safe_div(tn, tn + fp)
    data.frame(threshold = th, sensitivity = sens, specificity = spec,
               fpr = 1 - spec, youden = sens + spec - 1)
  })
  bind_rows(out)
}

auc_value <- function(roc_df) {
  r <- roc_df %>% arrange(fpr, sensitivity)
  sum(diff(r$fpr) * (head(r$sensitivity,-1) + tail(r$sensitivity,-1)) / 2)
}

roc_train <- roc_points(train_data$dropout, p_train) %>% mutate(Data = "Training")
roc_test  <- roc_points(test_data$dropout,  p_test)  %>% mutate(Data = "Testing")
auc_train <- auc_value(roc_train)
auc_test  <- auc_value(roc_test)

optimal_train <- roc_train %>%
  filter(is.finite(threshold)) %>%
  arrange(desc(youden), desc(sensitivity)) %>%
  slice(1)

threshold_opt <- optimal_train$threshold[1]

test_at_opt <- roc_points(test_data$dropout, p_test) %>%
  filter(is.finite(threshold)) %>%
  slice_min(abs(threshold - threshold_opt), n = 1, with_ties = FALSE)

auc_tbl <- data.frame(
  Data = c("Training", "Testing"),
  AUC  = round(c(auc_train, auc_test), 3)
)
knitr::kable(auc_tbl, caption = "Nilai AUC pada data training dan testing")

Nilai AUC pada data training dan testing
Data	AUC
Training	0.922
Testing	0.945

youden_tbl <- optimal_train %>%
  transmute(
    `Threshold optimal` = round(threshold, 3),
    Sensitivity         = round(sensitivity, 3),
    Specificity         = round(specificity, 3),
    `Indeks Youden (J)` = round(youden, 3)
  )
knitr::kable(youden_tbl, caption = "Threshold optimal berdasarkan Indeks Youden (dari ROC training)")

Threshold optimal berdasarkan Indeks Youden (dari ROC training)
Threshold optimal	Sensitivity	Specificity	Indeks Youden (J)
0.454	0.831	0.92	0.751

Interpretasi AUC: AUC training sebesar 0.922 dan AUC testing sebesar 0.945 menunjukkan kemampuan diskriminasi model yang sangat baik (excellent). Kedekatan nilai AUC training dan testing mengindikasikan model tidak mengalami overfitting yang signifikan — performa yang diperoleh pada data training mampu digeneralisasi ke data baru dengan baik.

Threshold optimal 0.454 diperoleh dari titik pada kurva ROC yang memaksimalkan Indeks Youden, yaitu titik dengan kombinasi sensitivity dan specificity terbaik secara bersamaan.

roc_all <- bind_rows(roc_train, roc_test)

ggplot(roc_all, aes(x = fpr, y = sensitivity, color = Data)) +
  geom_path(linewidth = 1.1) +
  geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = "#6c757d") +
  geom_point(data = optimal_train,
             aes(x = fpr, y = sensitivity), inherit.aes = FALSE,
             color = "#ffb703", fill = "#fb8500",
             shape = 21, size = 4.5, stroke = 1.4) +
  geom_point(data = test_at_opt,
             aes(x = fpr, y = sensitivity), inherit.aes = FALSE,
             color = "#8338ec", fill = "#3a86ff",
             shape = 24, size = 4.5, stroke = 1.4) +
  annotate("text", x = optimal_train$fpr + 0.07, y = optimal_train$sensitivity - 0.04,
           label = paste0("Opt. Training\n(", round(threshold_opt,3),")"),
           size = 3, color = "#fb8500") +
  coord_equal() +
  scale_color_manual(values = c("Training" = "#0077b6", "Testing" = "#e76f51")) +
  labs(
    title    = "Kurva ROC — Prediksi Putus Studi Mahasiswa",
    subtitle = paste0("AUC training = ", round(auc_train,3),
                      "  |  AUC testing = ", round(auc_test,3),
                      "  |  Threshold optimal = ", round(threshold_opt,3)),
    x     = "False Positive Rate  (1 – Specificity)",
    y     = "Sensitivity  (True Positive Rate)",
    color = "Data"
  ) +
  theme_minimal(base_size = 12) +
  theme(legend.position = "bottom")

Interpretasi kurva ROC: Kurva ROC yang jauh di atas garis diagonal (model acak) menunjukkan bahwa model memiliki kemampuan diskriminasi yang kuat. Kurva training dan testing yang hampir berhimpit mengkonfirmasi stabilitas model. Titik kuning pada kurva training dan segitiga ungu pada kurva testing menandai posisi threshold optimal — titik di mana trade-off antara mendeteksi mahasiswa dropout dan tidak salah mengklasifikasikan mahasiswa lulus mencapai keseimbangan terbaik.

12 Evaluasi dengan Threshold Optimal

Threshold optimal dari ROC training (0.454) diterapkan pada data testing. Dengan threshold ini, mahasiswa diklasifikasikan dropout jika peluang prediksinya \(\geq\) 0.454.

cm_opt <- confusion_matrix_tbl(test_data$dropout, p_test, threshold_opt)
m_opt  <- classification_metrics(test_data$dropout, p_test, threshold_opt)

knitr::kable(cm_opt,
  caption = paste0("Confusion matrix data testing — threshold optimal (",
                   round(threshold_opt,3),")"))

Confusion matrix data testing — threshold optimal (0.454)
	Prediksi Dropout	Prediksi Graduate	Sum
Aktual Dropout	244	41	285
Aktual Graduate	33	409	442
Sum	277	450	727

compare_df <- bind_rows(
  m_default %>% mutate(Aturan = "Threshold 0,50"),
  m_opt     %>% mutate(Aturan = paste0("Threshold optimal (", round(threshold_opt,3),")"))
) %>%
  mutate(across(where(is.numeric), round, 3)) %>%
  select(Aturan, threshold, accuracy, sensitivity, specificity,
         f1_score, balanced_accuracy) %>%
  rename(
    `Aturan klasifikasi` = Aturan, Threshold = threshold,
    Akurasi = accuracy, Sensitivity = sensitivity,
    Specificity = specificity, `F1-score` = f1_score,
    `Balanced accuracy` = balanced_accuracy
  )

knitr::kable(compare_df,
  caption = "Perbandingan metrik evaluasi: threshold 0,50 vs threshold optimal")

Perbandingan metrik evaluasi: threshold 0,50 vs threshold optimal
Aturan klasifikasi	Threshold	Akurasi	Sensitivity	Specificity	F1-score	Balanced accuracy
Threshold 0,50	0.500	0.889	0.821	0.932	0.852	0.877
Threshold optimal (0.454)	0.454	0.898	0.856	0.925	0.868	0.891

Interpretasi perbandingan threshold:

Pergeseran dari threshold 0,50 ke threshold optimal mengubah keseimbangan antara sensitivity dan specificity. Dengan threshold yang lebih rendah, model menjadi lebih “waspada” dalam menandai mahasiswa sebagai berisiko dropout — artinya lebih banyak mahasiswa dropout yang berhasil terdeteksi (sensitivity meningkat), meskipun sebagian mahasiswa yang sebenarnya lulus mungkin ikut terflag (specificity sedikit turun).

Dalam konteks intervensi akademik, peningkatan sensitivity lebih berharga: lebih baik memberikan perhatian ekstra kepada mahasiswa lulus yang tidak memerlukannya (false positive) daripada melewatkan mahasiswa dropout yang benar-benar memerlukan bantuan (false negative). Nilai balanced accuracy dan F1-score memberikan gambaran kinerja model yang lebih seimbang dibandingkan akurasi biasa, terutama pada data yang tidak seimbang.

12.1 Distribusi Peluang Prediksi

test_with_prob <- test_data %>% mutate(prob_dropout = p_test)

ggplot(test_with_prob, aes(x = prob_dropout, fill = do_label)) +
  geom_density(alpha = 0.60, color = "white", linewidth = 0.7) +
  geom_vline(xintercept = 0.5, color = "#6c757d",
             linewidth = 0.9, linetype = "dotted") +
  geom_vline(xintercept = threshold_opt, color = "#fb8500",
             linewidth = 1.2, linetype = "dashed") +
  annotate("label", x = threshold_opt, y = Inf,
           label = paste0("Threshold optimal\n", round(threshold_opt,3)),
           vjust = 1.5, fill = "#fff3b0", color = "#5f370e", label.size = 0, size = 3.2) +
  annotate("label", x = 0.5, y = Inf,
           label = "Threshold\n0,50",
           vjust = 3.5, fill = "#f0f0f0", color = "#444444", label.size = 0, size = 3.2) +
  scale_fill_manual(values = c("Graduate" = "#2a9d8f", "Dropout" = "#e76f51")) +
  labs(
    title    = "Distribusi Peluang Prediksi Dropout — Data Testing",
    subtitle = "Dua garis vertikal menunjukkan threshold default (0,50) dan threshold optimal",
    x        = "Peluang prediksi putus studi",
    y        = "Kepadatan",
    fill     = "Status aktual"
  ) +
  theme_minimal(base_size = 12)

Interpretasi: Grafik kepadatan memperlihatkan bahwa model mampu memisahkan distribusi peluang kedua kelompok dengan cukup baik. Distribusi mahasiswa Graduate (hijau) terkonsentrasi di peluang rendah (mendekati 0), sementara distribusi Dropout (oranye) terkonsentrasi di peluang tinggi (mendekati 1). Tumpang tindih yang relatif kecil di tengah mencerminkan ketidakpastian model pada kasus-kasus yang memiliki karakteristik campuran. Threshold optimal (garis oranye putus-putus) terletak di titik yang memisahkan dua distribusi secara lebih tepat dibandingkan threshold default 0,50 (garis abu-abu).

13 Ringkasan Hasil Model

m_final <- classification_metrics(test_data$dropout, p_test, threshold_opt)

ringkasan_final <- data.frame(
  Metrik = c(
    "AUC (Testing)",
    "Threshold optimal (Indeks Youden)",
    "Akurasi (threshold optimal)",
    "Sensitivity — deteksi dropout (threshold optimal)",
    "Specificity — identifikasi lulus (threshold optimal)",
    "F1-score (threshold optimal)",
    "Balanced accuracy (threshold optimal)"
  ),
  Nilai = c(
    round(auc_test, 3),
    round(threshold_opt, 3),
    round(m_final$accuracy, 3),
    round(m_final$sensitivity, 3),
    round(m_final$specificity, 3),
    round(m_final$f1_score, 3),
    round(m_final$balanced_accuracy, 3)
  )
)
knitr::kable(ringkasan_final, caption = "Ringkasan performa model regresi logistik biner pada data testing")

Ringkasan performa model regresi logistik biner pada data testing
Metrik	Nilai
AUC (Testing)	0.945
Threshold optimal (Indeks Youden)	0.454
Akurasi (threshold optimal)	0.898
Sensitivity — deteksi dropout (threshold optimal)	0.856
Specificity — identifikasi lulus (threshold optimal)	0.925
F1-score (threshold optimal)	0.868
Balanced accuracy (threshold optimal)	0.891

Interpretasi ringkasan: Model regresi logistik biner yang dibangun berhasil memisahkan mahasiswa dropout dan lulus dengan performa yang sangat baik berdasarkan nilai AUC sebesar 0.945. Pada threshold optimal 0.454, model mencapai sensitivity 0.856 dan specificity 0.925, yang berarti model mampu mengidentifikasi 85.6% mahasiswa yang benar-benar dropout dan mengidentifikasi 92.5% mahasiswa yang benar-benar lulus dengan tepat.

Faktor-faktor yang paling menentukan status studi mahasiswa dalam model ini adalah: kinerja akademik semester awal (jumlah SKS yang lulus dan nilai rata-rata di semester 1 dan 2), kondisi finansial (biaya kuliah terbayar tepat waktu, ada tidaknya tunggakan, status penerima beasiswa), dan usia saat mendaftar. Ketiga dimensi ini — akademik, finansial, dan demografis — secara bersama-sama membentuk profil risiko putus studi yang komprehensif dan dapat digunakan sebagai dasar pengambilan keputusan intervensi akademik sejak dini.

Analisis Regresi Logistik Biner untuk Prediksi Putus Studi (Dropout) Mahasiswa Berdasarkan Karakteristik Demografis, Akademik, dan Ekonomi

David Christian (0054) dan Anolius Laia (0057)

17 June 2026

1 Ringkasan Masalah

2 Sumber Data

3 Persiapan Data

3.1 Kamus Variabel

3.2 Penyaringan dan Transformasi Data

4 Eksplorasi Data

4.1 Distribusi Kelas Respons

4.2 Perbandingan Variabel Numerik Kunci

4.3 Distribusi SKS Lulus Semester 2 Menurut Status

4.4 Distribusi Usia Saat Mendaftar

4.5 Proporsi Dropout Berdasarkan Variabel Kategorik

5 Pemeriksaan Asumsi

5.1 Uji Linearitas Box–Tidwell

5.2 Uji Multikolinearitas (GVIF)

6 Pembagian Data Training dan Testing

7 Model Regresi Logistik Biner

7.1 Rumus Model

7.2 Model Penuh

7.3 Seleksi Model Terbaik (Stepwise Bidirectional–AIC)

7.4 Koefisien Model Terbaik (Stepwise)

8 Pengujian Signifikansi

8.1 Uji G² — Uji Simultan (Likelihood Ratio Test)

8.2 Uji Wald — Uji Parsial

8.3 Uji Hosmer–Lemeshow (Goodness-of-Fit)

9 Estimasi Odds Ratio dan Interpretasi Faktor Risiko

9.1 Visualisasi Odds Ratio

10 Prediksi dan Evaluasi Klasifikasi

10.1 Rumus Prediksi Kelas

10.2 Rumus Metrik Evaluasi

10.3 Evaluasi pada Threshold 0,50

11 Kurva ROC dan Threshold Optimal

11.1 Konstruksi Kurva ROC

12 Evaluasi dengan Threshold Optimal

12.1 Distribusi Peluang Prediksi

13 Ringkasan Hasil Model