Regresi Binary, Multinomial, Ordinal, dan Poisson
Asrial Qodri Siregar
2026-06-01
#Bagian I Regresi Binary ##Ringkasan masalah
Akses terhadap air minum yang aman merupakan hak dasar manusia dan isu kesehatan global yang kritis. Kemampuan untuk memprediksi apakah suatu sampel air layak untuk dikonsumsi (potable) berdasarkan parameter fisikokimia memiliki nilai praktis yang tinggi, terutama dalam mendukung sistem pemantauan kualitas air secara otomatis. Tujuan analisis ini adalah membangun model regresi logistik biner untuk memprediksi apakah suatu sampel air bersifat dapat diminum (potable), berdasarkan sejumlah prediktor fisikokimia. Kasus ini sesuai dianalisis dengan regresi logistik biner karena variabel respons bersifat biner:
Yi=1Y_i = 1 Yi​=1 : Air dinyatakan layak minum (potable) Yi=0Y_i = 0 Yi​=0 : Air dinyatakan tidak layak minum (not potable) 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 sampel air ke-\(i\) dinyatakan layak minum.
Sumber Data
Dataset yang digunakan adalah Water Potability yang tersedia di Kaggle:
Sumber: https://www.kaggle.com/datasets/adityakadiwal/water-potability
Dataset ini memuat hasil pengukuran kualitas air dari berbagai sumber, dengan total 3.276 observasi dan 10 variabel (9 prediktor fisikokimia dan 1 variabel respons).
# Sesuaikan path ke lokasi file CSV Anda
raw_water <- utils::read.csv(
"C:/Users/LENOVO/Documents/Analisis Data Kategori/water_potability.csv",
stringsAsFactors = FALSE
)
ringkasan_data <- data.frame(
Keterangan = c("Jumlah observasi", "Jumlah variabel"),
Nilai = c(nrow(raw_water), ncol(raw_water))
)
knitr::kable(ringkasan_data, caption = "Ukuran dataset Water Potability")| Keterangan | Nilai |
|---|---|
| Jumlah observasi | 3276 |
| Jumlah variabel | 10 |
Interpretasi output: Dataset berisi 3276 observasi sampel air dengan 10 variabel. Variabel respons adalah kolom Potability yang menunjukkan apakah air layak untuk dikonsumsi.
Persiapan Data
Kamus Variabel
kamus <- data.frame(
`Nama variabel`= c(
"ph", "Hardness", "Solids", "Chloramines", "Sulfate",
"Conductivity", "Organic_carbon", "Trihalomethanes", "Turbidity", "Potability"
),
`Keterangan` = c(
"Tingkat keasaman air; WHO merekomendasikan pH 6,5–8,5",
"Kekerasan air yang disebabkan kalsium & magnesium (mg/L)",
"Total padatan terlarut (ppm); air minum maks. 500 ppm",
"Kadar kloramin sebagai disinfektan (ppm); maks. 4 ppm",
"Kadar sulfat alami yang terlarut dalam air (mg/L)",
"Kemampuan air menghantarkan listrik (μS/cm)",
"Kadar karbon organik dari sumber alami & sintetis (ppm)",
"Senyawa halogenasi sampingan disinfektan (μg/L); maks. 80 ppm",
"Kekeruhan/kejernihan air berdasarkan partikel tersuspensi (NTU)",
"Kelayakan air untuk dikonsumsi (1 = layak, 0 = tidak layak)"
),
`Tipe` = c(
"Numerik", "Numerik", "Numerik", "Numerik", "Numerik",
"Numerik", "Numerik", "Numerik", "Numerik", "Respons biner"
),
check.names = FALSE
)
knitr::kable(kamus, caption = "Kamus variabel dataset Water Potability")| Nama variabel | Keterangan | Tipe |
|---|---|---|
| ph | Tingkat keasaman air; WHO merekomendasikan pH 6,5–8,5 | Numerik |
| Hardness | Kekerasan air yang disebabkan kalsium & magnesium (mg/L) | Numerik |
| Solids | Total padatan terlarut (ppm); air minum maks. 500 ppm | Numerik |
| Chloramines | Kadar kloramin sebagai disinfektan (ppm); maks. 4 ppm | Numerik |
| Sulfate | Kadar sulfat alami yang terlarut dalam air (mg/L) | Numerik |
| Conductivity | Kemampuan air menghantarkan listrik (μS/cm) | Numerik |
| Organic_carbon | Kadar karbon organik dari sumber alami & sintetis (ppm) | Numerik |
| Trihalomethanes | Senyawa halogenasi sampingan disinfektan (μg/L); maks. 80 ppm | Numerik |
| Turbidity | Kekeruhan/kejernihan air berdasarkan partikel tersuspensi (NTU) | Numerik |
| Potability | Kelayakan air untuk dikonsumsi (1 = layak, 0 = tidak layak) | Respons biner |
Transformasi dan Pembersihan Data
Variabel respons Potability telah bersifat biner (0/1)
sehingga tidak memerlukan transformasi lebih lanjut. Penanganan
missing values dilakukan karena tiga variabel —
ph, Sulfate, dan Trihalomethanes
— memiliki nilai yang hilang.
water <- raw_water %>%
transmute(
# Variabel respons
potability = as.integer(Potability),
pot_label = factor(
ifelse(Potability == 1, "Layak Minum", "Tidak Layak"),
levels = c("Tidak Layak", "Layak Minum")
),
# Prediktor numerik
ph = ph,
Hardness = Hardness,
Solids = Solids,
Chloramines = Chloramines,
Sulfate = Sulfate,
Conductivity = Conductivity,
Organic_carbon = Organic_carbon,
Trihalomethanes = Trihalomethanes,
Turbidity = Turbidity
)
# Ringkasan missing values
missing_summary <- data.frame(
Variabel = names(water),
`Jumlah NA` = sapply(water, function(x) sum(is.na(x))),
`Persen NA` = sapply(water, function(x) scales::percent(mean(is.na(x)), accuracy = 0.1)),
check.names = FALSE
) %>% filter(`Jumlah NA` > 0)
if (nrow(missing_summary) > 0) {
knitr::kable(missing_summary, caption = "Variabel dengan nilai hilang (missing values)")
} else {
cat("Tidak ada missing values pada variabel yang digunakan.\n")
}| Variabel | Jumlah NA | Persen NA | |
|---|---|---|---|
| ph | ph | 491 | 15.0% |
| Sulfate | Sulfate | 781 | 23.8% |
| Trihalomethanes | Trihalomethanes | 162 | 4.9% |
water_clean <- water %>%
dplyr::select(
potability,
pot_label,
ph,
Hardness,
Solids,
Chloramines,
Sulfate,
Conductivity,
Organic_carbon,
Trihalomethanes,
Turbidity
) %>%
na.omit()
cat(
sprintf(
"Observasi sebelum na.omit: %d | Setelah na.omit: %d | Dihapus: %d\n",
nrow(water),
nrow(water_clean),
nrow(water) - nrow(water_clean)
)
)## Observasi sebelum na.omit: 3276 | Setelah na.omit: 2011 | Dihapus: 1265Interpretasi output: Tiga variabel memiliki nilai
hilang: ph (491 nilai), Sulfate (781 nilai),
dan Trihalomethanes (162 nilai). Setelah penghapusan baris
dengan nilai hilang, dataset final siap digunakan dalam pemodelan.
Eksplorasi Singkat
Distribusi Kelas Respons
class_summary <- water_clean %>%
count(pot_label, name = "Jumlah") %>%
mutate(Proporsi = scales::percent(Jumlah / sum(Jumlah), accuracy = 0.1)) %>%
rename(Status = pot_label)
knitr::kable(class_summary, caption = "Distribusi kelas respons")| Status | Jumlah | Proporsi |
|---|---|---|
| Tidak Layak | 1200 | 59.7% |
| Layak Minum | 811 | 40.3% |
ggplot(water_clean, aes(x = pot_label, fill = pot_label)) +
geom_bar(width = 0.6, color = "white", linewidth = 0.8) +
geom_text(
stat = "count",
aes(label = after_stat(count)),
vjust = -0.4, fontface = "bold"
) +
scale_fill_manual(values = c("Tidak Layak" = "#e76f51", "Layak Minum" = "#2a9d8f")) +
labs(
title = "Distribusi Kelayakan Air Minum",
x = NULL,
y = "Jumlah sampel"
) +
theme_minimal(base_size = 12) +
theme(legend.position = "none")
Interpretasi output: Grafik batang memperlihatkan distribusi sampel berdasarkan kelayakan air. Terdapat ketidakseimbangan kelas (class imbalance) di mana sampel air tidak layak minum lebih banyak dibanding yang layak. Kondisi ini perlu diperhatikan dalam pemodelan dan evaluasi.
Scatter Plot: pH vs Conductivity
ggplot(water_clean, aes(x = ph, y = Conductivity, color = pot_label)) +
geom_point(alpha = 0.45, size = 1.5) +
scale_color_manual(values = c("Tidak Layak" = "#e76f51", "Layak Minum" = "#2a9d8f")) +
labs(
title = "pH vs Konduktivitas Air",
subtitle = "Titik hijau menunjukkan sampel air yang layak minum",
x = "pH",
y = "Conductivity (μS/cm)",
color = "Status"
) +
theme_minimal(base_size = 12)
Interpretasi output: Scatter plot memperlihatkan hubungan antara tingkat keasaman (pH) dan konduktivitas listrik air. Apabila kedua kelas tampak tumpang tindih, hal ini mengindikasikan bahwa pemisahan kelas tidak trivial dan model perlu mempertimbangkan kombinasi dari beberapa prediktor sekaligus.
Pembagian Data Training dan Testing
Data dibagi secara stratified dengan proporsi 80% training dan 20% testing agar komposisi kelas respons tetap seimbang di kedua subset.
y = "Conductivity (μS/cm)"
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(water_clean$potability, prop = 0.8)
train_data <- water_clean[train_id, ]
test_data <- water_clean[-train_id, ]
split_summary <- bind_rows(
train_data %>% count(pot_label) %>% mutate(Data = "Training"),
test_data %>% count(pot_label) %>% mutate(Data = "Testing")
) %>%
group_by(Data) %>%
mutate(Proporsi = scales::percent(n / sum(n), accuracy = 0.1)) %>%
ungroup() %>%
rename(Status = pot_label, Jumlah = n) %>%
dplyr::select(Data, Status, Jumlah, Proporsi)
knitr::kable(split_summary, caption = "Distribusi kelas pada training dan testing")| Data | Status | Jumlah | Proporsi |
|---|---|---|---|
| Training | Tidak Layak | 960 | 59.7% |
| Training | Layak Minum | 648 | 40.3% |
| Testing | Tidak Layak | 240 | 59.6% |
| Testing | Layak Minum | 163 | 40.4% |
Interpretasi output: Data training berisi 1608 observasi dan data testing berisi 403 observasi. Karena split dilakukan secara stratified, proporsi kelas pada training dan testing mendekati proporsi data keseluruhan, sehingga evaluasi tidak bias akibat perbedaan komposisi kelas.
Model Regresi Logistik Biner
Rumus Model Logistik
Misalkan \(Y_i\) adalah kelayakan sampel air ke-\(i\), dengan:
\[ Y_i = \begin{cases} 1, & \text{jika air dinyatakan layak minum},\\ 0, & \text{jika air dinyatakan tidak layak minum}. \end{cases} \]
Peluang air dinyatakan layak minum dinotasikan sebagai:
\[p_i = P(Y_i = 1 \mid X_i).\]
Pada regresi logistik biner, peluang dimodelkan melalui fungsi logit:
\[ \text{logit}(p_i) = \ln\left(\frac{p_i}{1-p_i}\right) = \eta_i = \beta_0 + \beta_1X_{1i} + \beta_2X_{2i} + \cdots + \beta_kX_{ki}. \]
Bentuk peluang prediksi diperoleh dengan transformasi balik:
\[ \hat{p}_i = \frac{\exp(\hat{\eta}_i)}{1 + \exp(\hat{\eta}_i)} = \frac{1}{1 + \exp(-\hat{\eta}_i)}. \]
Interpretasi odds ratio: Untuk prediktor numerik \(X_j\), odds ratio dihitung dengan:
\[OR_j = \exp(\beta_j).\]
- Jika \(OR_j > 1\) : kenaikan \(X_j\) meningkatkan odds air dinyatakan layak minum.
- Jika \(OR_j < 1\) : kenaikan \(X_j\) menurunkan odds air dinyatakan layak minum.
Estimasi Model pada Data Training
water_fit <- glm(
potability ~ ph + Hardness + Solids + Chloramines + Sulfate +
Conductivity + Organic_carbon + Trihalomethanes + Turbidity,
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(water_fit),
round(water_fit$null.deviance, 3),
round(water_fit$deviance, 3),
water_fit$df.residual,
round(AIC(water_fit), 3)
)
)
knitr::kable(ringkasan_model, caption = "Ringkasan kecocokan model regresi logistik")| Keterangan | Nilai |
|---|---|
| Jumlah observasi training | 1608.000 |
| Null deviance | 2168.238 |
| Residual deviance | 2163.852 |
| Derajat bebas residual | 1598.000 |
| AIC | 2183.852 |
Interpretasi output: Nilai residual deviance yang lebih kecil dari null deviance menunjukkan bahwa prediktor yang dimasukkan memberikan perbaikan nyata dibandingkan model kosong. Nilai AIC digunakan sebagai tolok ukur perbandingan antar model; semakin kecil AIC, semakin baik keseimbangan antara kecocokan model dan jumlah parameter.
Tabel Odds Ratio
coef_table <- broom::tidy(water_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)
) %>%
arrange(p.value) %>%
transmute(
`Variabel` = term,
`Odds ratio` = round(odds_ratio, 3),
`Interval kepercayaan 95 persen` = paste0(round(ci_low, 3), " – ", round(ci_high, 3)),
`p-value` = signif(p.value, 3)
)
knitr::kable(coef_table, caption = "Odds ratio prediktor model regresi logistik")| Variabel | Odds ratio | Interval kepercayaan 95 persen | p-value |
|---|---|---|---|
| Turbidity | 1.092 | 0.962 – 1.241 | 0.174 |
| Solids | 1.000 | 1 – 1 | 0.266 |
| Conductivity | 1.000 | 0.998 – 1.001 | 0.443 |
| ph | 1.019 | 0.955 – 1.086 | 0.571 |
| Organic_carbon | 0.995 | 0.966 – 1.025 | 0.746 |
| Sulfate | 1.000 | 0.997 – 1.002 | 0.786 |
| Hardness | 1.000 | 0.997 – 1.004 | 0.792 |
| Trihalomethanes | 1.001 | 0.995 – 1.007 | 0.829 |
| Chloramines | 1.007 | 0.945 – 1.072 | 0.839 |
Interpretasi output: Tabel odds ratio diurutkan dari p-value terkecil. Prediktor dengan odds ratio jauh di atas 1 atau jauh di bawah 1 dan interval kepercayaan yang tidak melewati angka 1 menunjukkan pengaruh yang signifikan secara statistik terhadap probabilitas air dinyatakan layak minum.
Prediksi dan Evaluasi Klasifikasi
Rumus Prediksi Kelas
Setelah model menghasilkan peluang prediksi \(\hat{p}_i\), kelayakan air ditentukan menggunakan threshold \(c\):
\[ \hat{Y}_i = \begin{cases} 1, & \text{jika } \hat{p}_i \ge c,\\ 0, & \text{jika } \hat{p}_i < c. \end{cases} \]
Jika \(c = 0{,}50\), sampel air diklasifikasikan layak minum ketika peluang prediksinya minimal 50%.
p_train <- predict(water_fit, newdata = train_data, type = "response")
p_test <- predict(water_fit, newdata = test_data, type = "response")
prediction_preview <- head(
data.frame(
`Status aktual` = test_data$pot_label,
`Peluang prediksi (layak)` = round(p_test, 4),
check.names = FALSE
),
6
)
knitr::kable(prediction_preview, caption = "Contoh peluang prediksi kelayakan air pada data testing")| Status aktual | Peluang prediksi (layak) | |
|---|---|---|
| 7 | Tidak Layak | 0.4215 |
| 8 | Tidak Layak | 0.4010 |
| 10 | Tidak Layak | 0.4163 |
| 11 | Tidak Layak | 0.4132 |
| 16 | Tidak Layak | 0.4337 |
| 27 | Tidak Layak | 0.4021 |
Interpretasi output: Semakin besar nilai peluang prediksi, semakin tinggi kemungkinan sampel air diklasifikasikan sebagai layak minum. Nilai ini menjadi kelas akhir setelah dibandingkan dengan threshold.
Rumus Confusion Matrix dan Metrik Evaluasi
Untuk klasifikasi biner kelayakan air, notasi confusion matrix yang digunakan:
- TP (true positive): aktual layak minum, diprediksi layak minum.
- TN (true negative): aktual tidak layak, diprediksi tidak layak.
- FP (false positive): aktual tidak layak, diprediksi layak minum.
- FN (false negative): aktual layak minum, diprediksi tidak layak.
\[\text{Akurasi} = \frac{TP + TN}{TP + TN + FP + FN}\]
\[\text{Sensitivity} = \text{Recall} = \frac{TP}{TP + FN}\]
\[\text{Specificity} = \frac{TN}{TN + FP}\]
\[\text{Presisi} = \frac{TP}{TP + FP}\]
\[\text{F1-score} = 2 \times \frac{\text{Presisi} \times \text{Sensitivity}}{\text{Presisi} + \text{Sensitivity}}\]
\[\text{Balanced accuracy} = \frac{\text{Sensitivity} + \text{Specificity}}{2}\]
Dalam konteks kualitas air, specificity sangat penting karena menunjukkan kemampuan model mendeteksi air yang tidak layak minum agar tidak lolos sebagai air yang aman dikonsumsi (false positive).
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)
sensitivity <- safe_div(tp, tp + fn)
specificity <- safe_div(tn, tn + fp)
precision <- safe_div(tp, tp + fp)
negative_predictive_value <- safe_div(tn, tn + fn)
accuracy <- safe_div(tp + tn, tp + tn + fp + fn)
data.frame(
threshold = threshold,
accuracy = accuracy,
error_rate = 1 - accuracy,
sensitivity = sensitivity,
specificity = specificity,
precision = precision,
negative_predictive_value = negative_predictive_value,
f1_score = safe_div(2 * precision * sensitivity,
precision + sensitivity),
balanced_accuracy = (sensitivity + specificity) / 2,
false_positive_rate = 1 - specificity,
false_negative_rate = 1 - sensitivity
)
}
format_metrics_indonesia <- function(x) {
x %>%
transmute(
Threshold = threshold,
Akurasi = accuracy,
`Error rate` = error_rate,
Sensitivity = sensitivity,
Specificity = specificity,
Presisi = precision,
NPV = negative_predictive_value,
`F1-score` = f1_score,
`Balanced accuracy` = balanced_accuracy,
FPR = false_positive_rate,
FNR = false_negative_rate
)
}
confusion_matrix_tbl <- function(actual, prob, threshold = 0.5) {
pred_label <- factor(
ifelse(prob >= threshold, "Prediksi Layak", "Prediksi Tidak Layak"),
levels = c("Prediksi Layak", "Prediksi Tidak Layak")
)
actual_label <- factor(
ifelse(actual == 1, "Aktual Layak", "Aktual Tidak Layak"),
levels = c("Aktual Layak", "Aktual Tidak Layak")
)
addmargins(table(actual_label, pred_label))
}Evaluasi pada Threshold 0,50
confusion_default <- confusion_matrix_tbl(test_data$potability, p_test, threshold = 0.5)
metrics_default <- classification_metrics(test_data$potability, p_test, threshold = 0.5) %>%
format_metrics_indonesia() %>%
mutate(across(where(is.numeric), round, 3))
knitr::kable(confusion_default, caption = "Confusion matrix testing pada threshold 0,50")| Prediksi Layak | Prediksi Tidak Layak | Sum | |
|---|---|---|---|
| Aktual Layak | 0 | 163 | 163 |
| Aktual Tidak Layak | 0 | 240 | 240 |
| Sum | 0 | 403 | 403 |
knitr::kable(metrics_default, caption = "Metrik evaluasi testing pada threshold 0,50")| Threshold | Akurasi | Error rate | Sensitivity | Specificity | Presisi | NPV | F1-score | Balanced accuracy | FPR | FNR |
|---|---|---|---|---|---|---|---|---|---|---|
| 0.5 | 0.596 | 0.404 | 0 | 1 | NA | 0.596 | NA | 0.5 | 0 | 1 |
Interpretasi output: Pada threshold 0,50, confusion matrix menunjukkan berapa sampel air layak minum yang berhasil dideteksi dan berapa sampel tidak layak yang teridentifikasi dengan benar. Specificity mengukur kemampuan model mendeteksi air yang tidak layak; jika nilai ini rendah, banyak air berbahaya yang akan lolos sebagai aman.
Kurva ROC dan Threshold Optimal
Kurva ROC mengevaluasi trade-off antara:
- Sensitivity / True Positive Rate: proporsi air layak minum yang berhasil dideteksi.
- False Positive Rate = \(1 - \text{Specificity}\): proporsi air tidak layak yang keliru diklasifikasikan layak minum.
Setiap titik pada kurva ROC berasal dari satu nilai threshold \(c\). Untuk setiap threshold dihitung:
\[TPR(c) = \frac{TP(c)}{TP(c) + FN(c)}, \quad FPR(c) = \frac{FP(c)}{FP(c) + TN(c)}.\]
Nilai AUC (area under the curve):
\[AUC = \int_0^1 TPR(FPR)\, d(FPR).\]
Semakin dekat AUC ke 1, semakin baik kemampuan model membedakan sampel layak dan tidak layak minum.
Threshold optimal dipilih menggunakan indeks Youden:
\[J = \text{Sensitivity} + \text{Specificity} - 1.\]
\[c_{\text{optimal}} = \arg\max_c \left\{ \text{Sensitivity}(c) + \text{Specificity}(c) - 1 \right\}.\]
# Tambah fungsi safe_div
safe_div <- function(a, b) ifelse(b == 0, 0, a / b)
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)
sensitivity <- safe_div(tp, tp + fn)
specificity <- safe_div(tn, tn + fp)
data.frame(
threshold = th,
sensitivity = sensitivity,
specificity = specificity,
fpr = 1 - specificity,
youden = sensitivity + specificity - 1
)
})
bind_rows(out)
}
auc_value <- function(roc_df) {
roc_sorted <- roc_df %>% arrange(fpr, sensitivity)
sum(
diff(roc_sorted$fpr) *
(head(roc_sorted$sensitivity, -1) + tail(roc_sorted$sensitivity, -1)) / 2
)
}
# Tambah p_test
p_train <- predict(water_fit, newdata = train_data, type = "response")
p_test <- predict(water_fit, newdata = test_data, type = "response")
roc_train <- roc_points(train_data$potability, p_train) %>% mutate(Data = "Training")
roc_test <- roc_points(test_data$potability, 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$potability, p_test) %>%
filter(is.finite(threshold)) %>%
slice_min(abs(threshold - threshold_opt), n = 1, with_ties = FALSE) %>%
mutate(Data = "Testing — threshold optimal")
auc_table <- data.frame(
Data = c("Training", "Testing"),
AUC = round(c(auc_train, auc_test), 3)
)
threshold_table <- optimal_train %>%
transmute(
`Threshold optimal` = round(threshold, 3),
Sensitivity = round(sensitivity, 3),
Specificity = round(specificity, 3),
`Indeks Youden` = round(youden, 3)
)
knitr::kable(auc_table, caption = "Nilai AUC model regresi logistik")| Data | AUC |
|---|---|
| Training | 0.527 |
| Testing | 0.525 |
knitr::kable(threshold_table, caption = "Threshold optimal berdasarkan ROC training (Indeks Youden)")| Threshold optimal | Sensitivity | Specificity | Indeks Youden |
|---|---|---|---|
| 0.433 | 0.16 | 0.907 | 0.068 |
roc_plot <- bind_rows(roc_train, roc_test)
ggplot(roc_plot, 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, stroke = 1.2
) +
geom_point(
data = test_at_opt,
aes(x = fpr, y = sensitivity),
inherit.aes = FALSE,
color = "#8338ec", fill = "#3a86ff",
shape = 24, size = 4, stroke = 1.2
) +
coord_equal() +
scale_color_manual(values = c("Training" = "#0077b6", "Testing" = "#e76f51")) +
labs(
title = "Kurva ROC Model Regresi Logistik — Water Potability",
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 output: AUC testing mengukur kemampuan model membedakan air layak dan tidak layak minum pada data baru. Nilai AUC yang mendekati 1 menunjukkan performa yang baik. Jika kurva testing mendekati kurva training, model relatif stabil dan tidak mengalami overfitting yang parah. Titik yang ditandai pada kurva menunjukkan posisi threshold optimal berdasarkan indeks Youden.
Evaluasi dengan Threshold Optimal
Threshold optimal dari ROC training diterapkan pada data testing. Pendekatan ini lebih tepat karena threshold dipilih tanpa melihat data testing, sehingga evaluasi tetap bersifat out-of-sample.
metrics_compare <- bind_rows(
classification_metrics(test_data$potability, p_test, threshold = 0.5) %>%
mutate(aturan = "Threshold 0,50"),
classification_metrics(test_data$potability, p_test, threshold = threshold_opt) %>%
mutate(aturan = "Threshold optimal ROC")
) %>%
format_metrics_indonesia() %>%
bind_cols(`Aturan klasifikasi` = c("Threshold 0,50", "Threshold optimal ROC"), .) %>%
dplyr::select(`Aturan klasifikasi`, everything()) %>%
mutate(across(where(is.numeric), round, 3))
confusion_opt <- confusion_matrix_tbl(test_data$potability, p_test, threshold = threshold_opt)
knitr::kable(metrics_compare, caption = "Perbandingan metrik testing: threshold 0,50 vs threshold optimal")| Aturan klasifikasi | Threshold | Akurasi | Error rate | Sensitivity | Specificity | Presisi | NPV | F1-score | Balanced accuracy | FPR | FNR |
|---|---|---|---|---|---|---|---|---|---|---|---|
| Threshold 0,50 | 0.500 | 0.596 | 0.404 | 0.00 | 1.000 | 0.0 | 0.596 | 0.000 | 0.500 | 0.000 | 1.00 |
| Threshold optimal ROC | 0.433 | 0.596 | 0.404 | 0.16 | 0.892 | 0.5 | 0.610 | 0.242 | 0.526 | 0.108 | 0.84 |
knitr::kable(confusion_opt, caption = "Confusion matrix testing pada threshold optimal")| Prediksi Layak | Prediksi Tidak Layak | Sum | |
|---|---|---|---|
| Aktual Layak | 26 | 137 | 163 |
| Aktual Tidak Layak | 26 | 214 | 240 |
| Sum | 52 | 351 | 403 |
Interpretasi output: Tabel perbandingan memperlihatkan dampak perubahan threshold terhadap sensitivity dan specificity. Dalam konteks kualitas air, pilihan threshold perlu mempertimbangkan biaya membiarkan air berbahaya lolos (false positive) versus biaya menolak air yang sebenarnya aman (false negative).
Distribusi Peluang Prediksi
test_prob_plot <- test_data %>% mutate(peluang_layak = p_test)
ggplot(test_prob_plot, aes(x = peluang_layak, fill = pot_label)) +
geom_density(alpha = 0.55, color = "white", linewidth = 0.7) +
geom_vline(
xintercept = threshold_opt,
color = "#fb8500", linewidth = 1.2, linetype = "dashed"
) +
annotate(
"label",
x = threshold_opt, y = Inf,
label = paste0("threshold = ", round(threshold_opt, 3)),
vjust = 1.4, fill = "#fff3b0", color = "#5f370e", label.size = 0
) +
scale_fill_manual(values = c("Tidak Layak" = "#e76f51", "Layak Minum" = "#2a9d8f")) +
labs(
title = "Distribusi Peluang Prediksi Kelayakan Air — Data Testing",
x = "Peluang prediksi air layak minum",
y = "Kepadatan",
fill = "Status aktual"
) +
theme_minimal(base_size = 12)
Interpretasi output: Grafik kepadatan memperlihatkan sebaran peluang prediksi untuk dua kelas. Semakin terpisah dua kurva, semakin baik model membedakan sampel layak dan tidak layak minum. Garis vertikal menunjukkan threshold optimal; observasi di sebelah kanannya diklasifikasikan sebagai layak minum. Area tumpang tindih kedua kurva menunjukkan bagian data yang sulit dibedakan oleh model.
Interpretasi Hasil
Ringkasan hasil utama model regresi logistik biner untuk prediksi kelayakan air minum:
ringkasan_akhir <- data.frame(
Metrik = c(
"AUC Testing",
"Threshold optimal (Youden)",
"Sensitivity pada threshold optimal",
"Specificity pada threshold optimal",
"Akurasi pada threshold optimal",
"Balanced accuracy pada threshold optimal"
),
Nilai = c(
round(auc_test, 3),
round(threshold_opt, 3),
round(classification_metrics(test_data$potability, p_test, threshold_opt)$sensitivity, 3),
round(classification_metrics(test_data$potability, p_test, threshold_opt)$specificity, 3),
round(classification_metrics(test_data$potability, p_test, threshold_opt)$accuracy, 3),
round(classification_metrics(test_data$potability, p_test, threshold_opt)$balanced_accuracy, 3)
)
)
knitr::kable(ringkasan_akhir, caption = "Ringkasan performa model pada data testing")| Metrik | Nilai |
|---|---|
| AUC Testing | 0.525 |
| Threshold optimal (Youden) | 0.433 |
| Sensitivity pada threshold optimal | 0.160 |
| Specificity pada threshold optimal | 0.892 |
| Akurasi pada threshold optimal | 0.596 |
| Balanced accuracy pada threshold optimal | 0.526 |
Secara substantif, model memprediksi peluang suatu sampel air dinyatakan layak minum berdasarkan parameter fisikokimia. Jika peluang prediksi berada di atas threshold optimal, sampel air diklasifikasikan sebagai layak minum dan aman untuk dikonsumsi.
Dalam konteks pengelolaan kualitas air, threshold tidak harus selalu 0,50. Otoritas kesehatan atau sistem pengawasan yang lebih konservatif dapat memilih threshold lebih rendah agar lebih banyak sampel berpotensi berbahaya dapat terdeteksi, meskipun konsekuensinya beberapa sampel air aman mungkin akan keliru diklasifikasikan sebagai tidak layak.
Kesimpulan
Regresi logistik biner dapat digunakan untuk membangun model prediksi kelayakan air minum berbasis parameter fisikokimia. Evaluasi dengan pembagian training-testing memberikan gambaran kinerja model pada data baru yang belum pernah dilihat model sebelumnya. Kurva ROC dan indeks Youden membantu menentukan threshold klasifikasi yang lebih informatif dibandingkan menggunakan angka default 0,50 secara otomatis.
Perlu dicatat bahwa adanya missing values pada beberapa
variabel penting (ph, Sulfate,
Trihalomethanes) dan ketidakseimbangan kelas merupakan
tantangan utama dalam dataset ini. Pendekatan imputasi atau teknik
penanganan class imbalance seperti SMOTE dapat dipertimbangkan
untuk meningkatkan performa model lebih lanjut.