0. Package, Seed, Dan
Fungsi Umum
# Pengaturan chunk R Markdown.
knitr::opts_chunk$set(
echo = TRUE,
warning = FALSE,
message = FALSE,
fig.width = 10,
fig.height = 6
)
packages <- c(
"readxl", "dplyr", "tidyr", "caret",
"recipes", "themis", "rpart", "rpart.plot",
"ggplot2"
)
installed <- rownames(installed.packages())
for (pkg in packages) {
if (!(pkg %in% installed)) {
install.packages(pkg, dependencies = TRUE)
}
}
invisible(lapply(packages, library, character.only = TRUE))
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
## Warning: package 'caret' was built under R version 4.5.3
## Loading required package: ggplot2
## Loading required package: lattice
##
## Attaching package: 'recipes'
## The following object is masked from 'package:stats':
##
## step
## Warning: package 'themis' was built under R version 4.5.3
## Warning: package 'rpart.plot' was built under R version 4.5.3
set.seed(123)
ringkasan_missing <- function(data) {
data.frame(
variabel = names(data),
jumlah_na = sapply(data, function(x) sum(is.na(x))),
persen_na = round(sapply(data, function(x) mean(is.na(x)) * 100), 2),
jumlah_unik = sapply(data, function(x) length(unique(x)))
)
}
valid_code <- function(x, valid_values) {
ifelse(is.na(x) | x %in% valid_values, x, NA)
}
# Fungsi untuk menyamakan level factor antara data acuan dan data lain.
# Ini penting karena rpart akan error jika data testing memiliki level factor
# yang tidak dikenali oleh model dari data training.
samakan_level_factor <- function(data_ref, data_baru) {
variabel_sama <- intersect(names(data_ref), names(data_baru))
for (var in variabel_sama) {
if (is.factor(data_ref[[var]])) {
data_baru[[var]] <- factor(
as.character(data_baru[[var]]),
levels = levels(data_ref[[var]]),
ordered = is.ordered(data_ref[[var]])
)
}
}
return(data_baru)
}
# Fungsi diagnostik untuk memeriksa apakah ada level factor pada data baru
# yang tidak ada di data acuan.
cek_level_factor_baru <- function(data_ref, data_baru) {
variabel_sama <- intersect(names(data_ref), names(data_baru))
hasil <- data.frame()
for (var in variabel_sama) {
if (is.factor(data_ref[[var]]) && is.factor(data_baru[[var]])) {
level_baru <- setdiff(
unique(as.character(data_baru[[var]])),
levels(data_ref[[var]])
)
level_baru <- level_baru[!is.na(level_baru)]
if (length(level_baru) > 0) {
hasil <- bind_rows(
hasil,
data.frame(
variabel = var,
level_baru = paste(level_baru, collapse = ", ")
)
)
}
}
}
return(hasil)
}
ambil_metrik <- function(model, data_eval, nama_model = "Model") {
pred <- predict(model, newdata = data_eval, type = "class")
pred <- factor(pred, levels = c("Tidak_Diare", "Diare"))
actual <- factor(data_eval$status_diare, levels = c("Tidak_Diare", "Diare"))
cm <- confusionMatrix(
data = pred,
reference = actual,
positive = "Diare",
mode = "everything"
)
hasil <- data.frame(
Model = nama_model,
Accuracy = as.numeric(cm$overall["Accuracy"]),
Kappa = as.numeric(cm$overall["Kappa"]),
Precision_Diare = as.numeric(cm$byClass["Precision"]),
Recall_Diare = as.numeric(cm$byClass["Recall"]),
Specificity = as.numeric(cm$byClass["Specificity"]),
F1_Diare = as.numeric(cm$byClass["F1"]),
Balanced_Accuracy = as.numeric(cm$byClass["Balanced Accuracy"])
)
# Beberapa metrik dapat menjadi NA, misalnya ketika model tidak pernah
# memprediksi kelas positif "Diare". Kondisi ini perlu diberi peringatan
# agar tidak menjadi silent failure.
metrik_cols <- setdiff(names(hasil), "Model")
if (any(is.na(hasil[metrik_cols]))) {
warning(
paste(
"Ada metrik NA di model:", nama_model,
"- metrik NA diisi 0. Periksa apakah model gagal memprediksi kelas Diare."
)
)
hasil[metrik_cols] <- lapply(
hasil[metrik_cols],
function(x) ifelse(is.na(x), 0, x)
)
}
return(hasil)
}
train_dt <- function(data_train_input, cp, maxdepth, minsplit, minbucket) {
model <- rpart(
status_diare ~ .,
data = data_train_input,
method = "class",
model = TRUE,
control = rpart.control(
cp = cp,
maxdepth = maxdepth,
minsplit = minsplit,
minbucket = minbucket,
xval = 0
)
)
return(model)
}
buat_smote <- function(data_input, over_ratio = 1, neighbors = 5, seed_value = 123) {
set.seed(seed_value)
recipe_smote <- recipe(status_diare ~ ., data = data_input) %>%
step_smotenc(
status_diare,
over_ratio = over_ratio,
neighbors = neighbors,
# skip = TRUE memastikan SMOTE tidak diterapkan ketika recipe digunakan
# untuk data baru/testing. Pada fungsi ini, SMOTE tetap diterapkan karena
# bake(new_data = NULL) mengambil data training hasil prep().
skip = TRUE,
seed = seed_value
)
prep_smote <- prep(
recipe_smote,
training = data_input,
retain = TRUE
)
data_smote <- bake(
prep_smote,
new_data = NULL
)
data_smote <- data_smote %>%
mutate(
status_diare = factor(status_diare, levels = c("Tidak_Diare", "Diare"))
)
return(data_smote)
}
cramer_v <- function(x, y) {
# Cramer's V digunakan untuk mengukur asosiasi antar-prediktor kategorik.
# droplevels() dan pembuangan baris/kolom kosong dilakukan agar level factor
# yang tidak muncul pada data training tidak menghasilkan NaN.
x <- droplevels(as.factor(x))
y <- droplevels(as.factor(y))
tab <- table(x, y)
tab <- tab[rowSums(tab) > 0, colSums(tab) > 0, drop = FALSE]
if (nrow(tab) < 2 || ncol(tab) < 2 || sum(tab) == 0) {
return(NA_real_)
}
chi <- suppressWarnings(chisq.test(tab, correct = FALSE))
n <- sum(tab)
r <- nrow(tab)
k <- ncol(tab)
v <- sqrt(as.numeric(chi$statistic) / (n * min(r - 1, k - 1)))
if (!is.finite(v)) {
return(NA_real_)
}
return(v)
}
buat_matriks_cramer <- function(data_prediktor) {
data_prediktor <- data_prediktor %>%
mutate(across(everything(), as.factor))
nama_prediktor <- names(data_prediktor)
matriks <- matrix(
NA_real_,
nrow = length(nama_prediktor),
ncol = length(nama_prediktor),
dimnames = list(nama_prediktor, nama_prediktor)
)
for (i in seq_along(nama_prediktor)) {
for (j in seq_along(nama_prediktor)) {
matriks[i, j] <- cramer_v(
data_prediktor[[i]],
data_prediktor[[j]]
)
}
}
return(matriks)
}
buat_tabel_asosiasi <- function(matriks_cramer) {
hasil <- as.data.frame(as.table(matriks_cramer)) %>%
rename(
variabel_1 = Var1,
variabel_2 = Var2,
cramer_v = Freq
) %>%
filter(
variabel_1 != variabel_2,
!is.na(cramer_v)
) %>%
rowwise() %>%
mutate(
pasangan = paste(sort(c(variabel_1, variabel_2)), collapse = " - ")
) %>%
ungroup() %>%
distinct(pasangan, .keep_all = TRUE) %>%
arrange(desc(cramer_v)) %>%
mutate(
kategori_asosiasi = case_when(
cramer_v >= 0.70 ~ "Tinggi",
cramer_v >= 0.50 ~ "Cukup_kuat",
cramer_v >= 0.30 ~ "Sedang",
TRUE ~ "Lemah"
)
)
return(hasil)
}
pilih_variabel_redundan <- function(data_prediktor, tabel_asosiasi, batas_cramer = 0.70) {
# Fungsi ini memilih variabel redundan secara otomatis.
# Dasar penghapusan:
# 1. Ambil pasangan prediktor dengan Cramer's V >= batas_cramer.
# 2. Jika dua prediktor sangat berasosiasi, hapus prediktor yang memiliki
# rata-rata asosiasi lebih tinggi terhadap prediktor lain.
# 3. Jika rata-rata asosiasi sama, hapus prediktor dengan jumlah kategori
# lebih banyak karena lebih kompleks untuk interpretasi model.
#
# Target status_diare tidak digunakan dalam fungsi ini.
kandidat <- tabel_asosiasi %>%
filter(cramer_v >= batas_cramer) %>%
arrange(desc(cramer_v))
if (nrow(kandidat) == 0) {
return(character(0))
}
mean_assoc <- sapply(names(data_prediktor), function(v) {
nilai <- tabel_asosiasi %>%
filter(variabel_1 == v | variabel_2 == v) %>%
pull(cramer_v)
mean(nilai, na.rm = TRUE)
})
n_level <- sapply(data_prediktor, function(x) length(unique(x)))
variabel_hapus <- character(0)
for (i in seq_len(nrow(kandidat))) {
v1 <- as.character(kandidat$variabel_1[i])
v2 <- as.character(kandidat$variabel_2[i])
# Jika salah satu variabel pada pasangan sudah dihapus,
# pasangan ini tidak perlu diproses lagi.
if (v1 %in% variabel_hapus || v2 %in% variabel_hapus) {
next
}
skor_v1 <- mean_assoc[v1]
skor_v2 <- mean_assoc[v2]
if (is.na(skor_v1)) skor_v1 <- 0
if (is.na(skor_v2)) skor_v2 <- 0
if (skor_v1 > skor_v2) {
hapus <- v1
} else if (skor_v2 > skor_v1) {
hapus <- v2
} else {
# Jika rata-rata asosiasi sama, hapus variabel dengan kategori lebih banyak.
# Variabel dengan kategori lebih banyak biasanya lebih kompleks untuk model.
hapus <- ifelse(n_level[v1] >= n_level[v2], v1, v2)
}
variabel_hapus <- c(variabel_hapus, hapus)
}
unique(variabel_hapus)
}
1. Import Data Awal Dan
Pemilihan Variabel
# Variabel yang digunakan dalam penelitian.
variabel_digunakan <- c(
"ID_ANAK", "H11", "B4", "B19", "BORD", "V012", "V106", "V190",
"V024", "V025", "V113", "V116", "V127", "V128", "V129", "V161",
"V416", "V481"
)
# Nama objek yang mungkin muncul di Environment.
# Catatan: datadiareana dimasukkan karena pada beberapa kasus nama objek hasil
# Import Dataset bisa terpotong/tidak sama dengan nama file.
kandidat_objek_data <- c("datadiareanak", "datadiareana", "data_awal")
objek_ditemukan <- kandidat_objek_data[
sapply(kandidat_objek_data, function(obj) {
if (!exists(obj, envir = .GlobalEnv)) return(FALSE)
data_obj <- get(obj, envir = .GlobalEnv)
is.data.frame(data_obj) && all(variabel_digunakan %in% names(data_obj))
})
]
if (length(objek_ditemukan) > 0) {
nama_objek_data <- objek_ditemukan[1]
data_awal <- get(nama_objek_data, envir = .GlobalEnv)
sumber_data <- paste0("Objek Environment: ", nama_objek_data)
} else {
# Jika nama objek berbeda dari kandidat, cari semua objek data frame/tibble
# yang memiliki seluruh variabel penelitian.
semua_objek <- ls(envir = .GlobalEnv)
kandidat_df <- semua_objek[
sapply(semua_objek, function(obj) {
data_obj <- get(obj, envir = .GlobalEnv)
is.data.frame(data_obj) && all(variabel_digunakan %in% names(data_obj))
})
]
if (length(kandidat_df) > 0) {
nama_objek_data <- kandidat_df[1]
data_awal <- get(nama_objek_data, envir = .GlobalEnv)
sumber_data <- paste0("Objek Environment terdeteksi otomatis: ", nama_objek_data)
} else {
# Cadangan khusus agar proses Knit tetap dapat berjalan.
# Simpan file Excel ini dalam folder yang sama dengan file .Rmd.
file_excel <- "datadiareanak.xlsx"
if (!file.exists(file_excel)) {
stop(
paste0(
"Objek data tidak ditemukan di Environment dan file '", file_excel, "' juga tidak ditemukan.
",
"Solusi 1: jika ingin menjalankan per chunk, pastikan objek data ada di Environment dengan nama datadiareanak atau datadiareana.
",
"Solusi 2: jika ingin Knit, simpan file datadiareanak.xlsx dalam folder yang sama dengan file Rmd.
",
"Solusi 3: jika nama objek berbeda, tambahkan nama objek tersebut ke kandidat_objek_data."
)
)
}
sheet_input <- readxl::excel_sheets(file_excel)
sheet_digunakan <- ifelse(
"Data_Diare_Terpilih" %in% sheet_input,
"Data_Diare_Terpilih",
sheet_input[1]
)
data_awal <- readxl::read_excel(
path = file_excel,
sheet = sheet_digunakan,
na = c("", "NA", "N/A", "#NULL!", "NULL", ".")
)
sumber_data <- paste0("File Excel: ", file_excel, " | Sheet: ", sheet_digunakan)
}
}
# Pastikan format data menjadi tibble.
data_awal <- as_tibble(data_awal)
cat("Sumber data yang digunakan:", sumber_data, "
")
## Sumber data yang digunakan: File Excel: datadiareanak.xlsx | Sheet: Data_Diare_Terpilih
# Cek struktur data awal.
dim(data_awal)
## [1] 17848 18
names(data_awal)
## [1] "ID_ANAK" "H11" "B4" "B19" "BORD" "V012" "V106"
## [8] "V190" "V024" "V025" "V113" "V116" "V127" "V128"
## [15] "V129" "V161" "V416" "V481"
str(data_awal)
## tibble [17,848 × 18] (S3: tbl_df/tbl/data.frame)
## $ ID_ANAK: chr [1:17848] "DHS_1_2_2_B01" "DHS_1_2_2_B02" "DHS_1_3_2_B01" "DHS_110_2_B01" ...
## $ H11 : num [1:17848] 0 0 2 0 0 2 0 2 2 2 ...
## $ B4 : num [1:17848] 1 1 1 1 1 1 2 1 2 1 ...
## $ B19 : num [1:17848] 22 22 27 43 29 23 53 14 17 41 ...
## $ BORD : num [1:17848] 6 5 4 5 1 8 7 3 2 1 ...
## $ V012 : num [1:17848] 39 39 30 42 28 37 37 31 29 29 ...
## $ V106 : num [1:17848] 1 1 1 0 3 1 1 1 3 3 ...
## $ V190 : num [1:17848] 1 1 3 1 5 2 2 1 2 2 ...
## $ V024 : num [1:17848] 11 11 11 11 11 11 11 11 11 11 ...
## $ V025 : num [1:17848] 2 2 2 2 2 2 2 2 2 2 ...
## $ V113 : num [1:17848] 31 31 72 42 31 32 32 31 21 21 ...
## $ V116 : num [1:17848] 31 31 12 31 12 16 16 16 21 21 ...
## $ V127 : num [1:17848] 35 35 35 35 33 35 35 35 21 21 ...
## $ V128 : num [1:17848] 36 36 36 36 35 36 36 36 36 36 ...
## $ V129 : num [1:17848] 31 31 31 31 31 31 31 31 31 31 ...
## $ V161 : num [1:17848] 2 2 2 2 2 2 2 8 2 2 ...
## $ V416 : num [1:17848] 2 2 1 2 2 1 1 1 1 1 ...
## $ V481 : num [1:17848] 1 1 1 1 1 1 1 1 1 1 ...
head(data_awal)
# Cek apakah semua variabel tersedia dalam data awal.
variabel_tidak_ada <- setdiff(variabel_digunakan, names(data_awal))
variabel_tidak_ada
## character(0)
if (length(variabel_tidak_ada) > 0) {
stop(
paste0(
"Ada variabel yang tidak ditemukan dalam data sumber: ",
paste(variabel_tidak_ada, collapse = ", "),
". Periksa kembali nama kolom pada data."
)
)
}
# Dataset baru setelah pemilihan variabel.
datadiareanak <- data_awal %>%
select(all_of(variabel_digunakan))
# Cek dataset hasil pemilihan variabel.
dim(datadiareanak)
## [1] 17848 18
names(datadiareanak)
## [1] "ID_ANAK" "H11" "B4" "B19" "BORD" "V012" "V106"
## [8] "V190" "V024" "V025" "V113" "V116" "V127" "V128"
## [15] "V129" "V161" "V416" "V481"
str(datadiareanak)
## tibble [17,848 × 18] (S3: tbl_df/tbl/data.frame)
## $ ID_ANAK: chr [1:17848] "DHS_1_2_2_B01" "DHS_1_2_2_B02" "DHS_1_3_2_B01" "DHS_110_2_B01" ...
## $ H11 : num [1:17848] 0 0 2 0 0 2 0 2 2 2 ...
## $ B4 : num [1:17848] 1 1 1 1 1 1 2 1 2 1 ...
## $ B19 : num [1:17848] 22 22 27 43 29 23 53 14 17 41 ...
## $ BORD : num [1:17848] 6 5 4 5 1 8 7 3 2 1 ...
## $ V012 : num [1:17848] 39 39 30 42 28 37 37 31 29 29 ...
## $ V106 : num [1:17848] 1 1 1 0 3 1 1 1 3 3 ...
## $ V190 : num [1:17848] 1 1 3 1 5 2 2 1 2 2 ...
## $ V024 : num [1:17848] 11 11 11 11 11 11 11 11 11 11 ...
## $ V025 : num [1:17848] 2 2 2 2 2 2 2 2 2 2 ...
## $ V113 : num [1:17848] 31 31 72 42 31 32 32 31 21 21 ...
## $ V116 : num [1:17848] 31 31 12 31 12 16 16 16 21 21 ...
## $ V127 : num [1:17848] 35 35 35 35 33 35 35 35 21 21 ...
## $ V128 : num [1:17848] 36 36 36 36 35 36 36 36 36 36 ...
## $ V129 : num [1:17848] 31 31 31 31 31 31 31 31 31 31 ...
## $ V161 : num [1:17848] 2 2 2 2 2 2 2 8 2 2 ...
## $ V416 : num [1:17848] 2 2 1 2 2 1 1 1 1 1 ...
## $ V481 : num [1:17848] 1 1 1 1 1 1 1 1 1 1 ...
head(datadiareanak)
2. Validasi Awal Data
Terpilih
missing_awal <- ringkasan_missing(datadiareanak)
missing_awal
validasi_id_awal <- datadiareanak %>%
summarise(
jumlah_observasi = n(),
jumlah_id_unik = n_distinct(ID_ANAK),
jumlah_id_duplikat = n() - n_distinct(ID_ANAK),
jumlah_id_kosong = sum(is.na(ID_ANAK))
)
validasi_id_awal
id_duplikat <- datadiareanak %>%
count(ID_ANAK) %>%
filter(n > 1)
id_duplikat
3. Konversi Tipe Data
Dan Recode Target
# Semua variabel selain ID_ANAK dikonversi menjadi numerik.
data1 <- datadiareanak %>%
mutate(
across(
.cols = -ID_ANAK,
.fns = ~ suppressWarnings(as.numeric(as.character(.)))
)
)
str(data1)
## tibble [17,848 × 18] (S3: tbl_df/tbl/data.frame)
## $ ID_ANAK: chr [1:17848] "DHS_1_2_2_B01" "DHS_1_2_2_B02" "DHS_1_3_2_B01" "DHS_110_2_B01" ...
## $ H11 : num [1:17848] 0 0 2 0 0 2 0 2 2 2 ...
## $ B4 : num [1:17848] 1 1 1 1 1 1 2 1 2 1 ...
## $ B19 : num [1:17848] 22 22 27 43 29 23 53 14 17 41 ...
## $ BORD : num [1:17848] 6 5 4 5 1 8 7 3 2 1 ...
## $ V012 : num [1:17848] 39 39 30 42 28 37 37 31 29 29 ...
## $ V106 : num [1:17848] 1 1 1 0 3 1 1 1 3 3 ...
## $ V190 : num [1:17848] 1 1 3 1 5 2 2 1 2 2 ...
## $ V024 : num [1:17848] 11 11 11 11 11 11 11 11 11 11 ...
## $ V025 : num [1:17848] 2 2 2 2 2 2 2 2 2 2 ...
## $ V113 : num [1:17848] 31 31 72 42 31 32 32 31 21 21 ...
## $ V116 : num [1:17848] 31 31 12 31 12 16 16 16 21 21 ...
## $ V127 : num [1:17848] 35 35 35 35 33 35 35 35 21 21 ...
## $ V128 : num [1:17848] 36 36 36 36 35 36 36 36 36 36 ...
## $ V129 : num [1:17848] 31 31 31 31 31 31 31 31 31 31 ...
## $ V161 : num [1:17848] 2 2 2 2 2 2 2 8 2 2 ...
## $ V416 : num [1:17848] 2 2 1 2 2 1 1 1 1 1 ...
## $ V481 : num [1:17848] 1 1 1 1 1 1 1 1 1 1 ...
# Distribusi target H11 sebelum recode.
distribusi_target_awal <- data1 %>%
count(H11, name = "frekuensi") %>%
mutate(
persen = round(frekuensi / sum(frekuensi) * 100, 2)
)
distribusi_target_awal
# H11 asli DHS:
# 0 = Tidak diare
# 2 = Diare
# 8, 9, NA = tidak valid / tidak diketahui
#
# Target baru:
# 0 = Tidak_Diare
# 1 = Diare
data2 <- data1 %>%
mutate(
status_diare_num = case_when(
H11 == 0 ~ 0,
H11 == 2 ~ 1,
TRUE ~ NA_real_
),
status_diare = factor(
status_diare_num,
levels = c(0, 1),
labels = c("Tidak_Diare", "Diare")
)
)
# Cek target tidak valid.
target_tidak_valid <- data2 %>%
filter(is.na(status_diare)) %>%
count(H11, name = "frekuensi")
target_tidak_valid
# Hapus observasi dengan target tidak valid.
data3 <- data2 %>%
filter(!is.na(status_diare))
dim(data3)
## [1] 17155 20
# Distribusi target setelah target valid.
distribusi_target_valid <- data3 %>%
count(status_diare, name = "frekuensi") %>%
mutate(
persen = round(frekuensi / sum(frekuensi) * 100, 2)
)
distribusi_target_valid
4. Validasi Rentang
Nilai Dan Kode Variabel
# B19 = umur anak dalam bulan, umumnya 0-59 bulan.
# V012 = umur ibu/responden, umumnya 15-49 tahun.
# BORD = urutan kelahiran, minimal 1.
data4 <- data3 %>%
mutate(
B19 = ifelse(B19 < 0 | B19 > 59, NA, B19),
V012 = ifelse(V012 < 15 | V012 > 49, NA, V012),
BORD = ifelse(BORD < 1, NA, BORD)
)
# Daftar kode valid variabel kategorik.
kode_V024 <- c(
11, 12, 13, 14, 15, 16, 17, 18, 19,
21, 31, 32, 33, 34, 35, 36,
51, 52, 53,
61, 62, 63, 64, 65,
71, 72, 73, 74, 75, 76,
81, 82, 91, 94
)
kode_V113 <- c(
10, 11, 12, 13, 14,
20, 21,
30, 31, 32,
40, 41, 42, 43,
51, 61, 62, 71, 72, 96
)
kode_V116 <- c(
10, 11, 12, 13, 14, 15, 16, 17,
20, 21, 22, 23,
30, 31,
41, 42, 43,
96
)
kode_V127 <- c(
10, 11, 12,
20, 21, 22,
30, 31, 32, 33, 34, 35, 36,
96
)
kode_V128 <- c(
10, 12, 13,
20, 21, 22, 23, 24, 25, 26,
30, 31, 32, 34, 35, 36, 37, 38,
96
)
kode_V129 <- c(
10, 12, 13,
20, 21, 22, 23,
30, 31, 32, 33, 34, 35, 36,
96
)
kode_V161 <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 95, 96)
# Kode yang tidak termasuk daftar kode valid akan diubah menjadi NA.
# Kode 97 = Not a de jure resident juga akan menjadi NA.
data5 <- data4 %>%
mutate(
B4 = valid_code(B4, c(1, 2)),
V106 = valid_code(V106, c(0, 1, 2, 3)),
V190 = valid_code(V190, c(1, 2, 3, 4, 5)),
V024 = valid_code(V024, kode_V024),
V025 = valid_code(V025, c(1, 2)),
V113 = valid_code(V113, kode_V113),
V116 = valid_code(V116, kode_V116),
V127 = valid_code(V127, kode_V127),
V128 = valid_code(V128, kode_V128),
V129 = valid_code(V129, kode_V129),
V161 = valid_code(V161, kode_V161),
V416 = valid_code(V416, c(0, 1, 2)),
V481 = valid_code(V481, c(0, 1))
)
5. Recode Variabel
Berdasarkan Label Dhs
data_recode <- data5 %>%
transmute(
ID_ANAK = ID_ANAK,
status_diare_num = status_diare_num,
status_diare = status_diare,
jenis_kelamin_anak = factor(
B4,
levels = c(1, 2),
labels = c("Male", "Female")
),
umur_anak_bulan = as.numeric(B19),
urutan_kelahiran = as.numeric(BORD),
umur_ibu = as.numeric(V012),
pendidikan_ibu = factor(
V106,
levels = c(0, 1, 2, 3),
labels = c("No_education", "Primary", "Secondary", "Higher"),
ordered = TRUE
),
indeks_kekayaan = factor(
V190,
levels = c(1, 2, 3, 4, 5),
labels = c("Poorest", "Poorer", "Middle", "Richer", "Richest"),
ordered = TRUE
),
provinsi = factor(
V024,
levels = kode_V024,
labels = c(
"Aceh", "North_Sumatera", "West_Sumatera", "Riau", "Jambi",
"South_Sumatera", "Bengkulu", "Lampung", "Bangka_Belitung",
"Riau_Islands", "Jakarta", "West_Java", "Central_Java",
"Yogyakarta", "East_Java", "Banten", "Bali", "West_Nusa_Tenggara",
"East_Nusa_Tenggara", "West_Kalimantan", "Central_Kalimantan",
"South_Kalimantan", "East_Kalimantan", "North_Kalimantan",
"North_Sulawesi", "Central_Sulawesi", "South_Sulawesi",
"Southeast_Sulawesi", "Gorontalo", "West_Sulawesi", "Maluku",
"North_Maluku", "West_Papua", "Papua"
)
),
wilayah_tinggal = factor(
V025,
levels = c(1, 2),
labels = c("Urban", "Rural")
),
sumber_air_minum = factor(
V113,
levels = kode_V113,
labels = c(
"Piped_water", "Piped_into_dwelling", "Piped_to_yard_plot",
"Public_tap_standpipe", "Piped_public_tap_standpipe",
"Tube_well_water", "Tube_well_or_borehole",
"Dug_well_open_protected", "Protected_well", "Unprotected_well",
"Surface_water", "Protected_spring", "Unprotected_spring",
"River_dam_lake_pond_stream_canal", "Rainwater", "Tanker_truck",
"Cart_with_small_tank", "Bottled_water", "Refilled_water", "Other"
)
),
jenis_toilet = factor(
V116,
levels = kode_V116,
labels = c(
"Flush_toilet", "Flush_to_piped_sewer_system", "Flush_to_septic_tank",
"Flush_to_pit_latrine", "Flush_to_somewhere_else", "Flush_dont_know_where",
"Flush_toilet_no_septic_tank", "Flush_toilet_shared_public",
"Pit_toilet_latrine", "Ventilated_improved_pit_latrine",
"Pit_latrine_with_slab", "Pit_latrine_without_slab_open_pit",
"No_facility", "No_facility_bush_field_river_beach", "Composting_toilet",
"Bucket_toilet", "Hanging_toilet_latrine", "Other"
)
),
material_lantai = factor(
V127,
levels = kode_V127,
labels = c(
"Natural", "Earth_sand", "Dung", "Rudimentary", "Wood_planks",
"Palm_bamboo", "Finished", "Parquet_or_polished_wood",
"Vinyl_or_asphalt_strips", "Ceramic_marble", "Ceramic_tiles",
"Cement_red_bricks", "Carpet", "Other"
)
),
material_dinding = factor(
V128,
levels = kode_V128,
labels = c(
"Natural", "Cane_palm_trunks", "Dirt", "Rudimentary", "Bamboo_with_mud",
"Stone_with_mud", "Uncovered_adobe", "Plywood", "Cardboard", "Reused_wood",
"Finished", "Woven_bamboo", "Stone_with_lime_cement", "Cement_blocks",
"Covered_adobe", "Wood_planks_shingles", "Plaster_wire", "GRC_gypsum_asbestos",
"Other"
)
),
material_atap = factor(
V129,
levels = kode_V129,
labels = c(
"Natural", "Thatch_palm_leaf", "Sod", "Rudimentary", "Rustic_mat",
"Palm_bamboo", "Wood_planks", "Finished", "Roofing", "Asbestos",
"Tile", "Concrete", "Metal_tile", "Roofing_shingles", "Other"
)
),
bahan_bakar_memasak = factor(
V161,
levels = kode_V161,
labels = c(
"Electricity", "LPG", "Natural_gas", "Biogas", "Kerosene",
"Coal_lignite", "Charcoal", "Wood", "Straw_shrubs_grass",
"Agricultural_crop", "Animal_dung", "No_food_cooked_in_house", "Other"
)
),
tahu_ors = factor(
V416,
levels = c(0, 1, 2),
labels = c("Never_heard_of", "Used_ORS", "Heard_of_ORS")
),
asuransi_kesehatan = factor(
V481,
levels = c(0, 1),
labels = c("No", "Yes")
)
)
5A. Kategorisasi
Variabel Numerik Berdasarkan Acuan
# Catatan metodologis:
# - umur_anak_bulan, urutan_kelahiran, dan umur_ibu dikategorikan.
# - Variabel numerik aslinya nanti dihapus dari data model agar tidak terjadi
# duplikasi informasi.
# - Kategorisasi dibuat sebelum split karena ini merupakan transformasi berbasis
# acuan/substansi, bukan berdasarkan hubungan dengan target.
data_recode <- data_recode %>%
mutate(
kelompok_umur_anak = cut(
umur_anak_bulan,
breaks = c(-Inf, 5, 11, 23, 35, 47, 59),
labels = c(
"0_5_bulan", "6_11_bulan", "12_23_bulan",
"24_35_bulan", "36_47_bulan", "48_59_bulan"
),
right = TRUE,
ordered_result = TRUE
),
kelompok_urutan_kelahiran = cut(
urutan_kelahiran,
breaks = c(0, 1, 3, 5, Inf),
labels = c("1", "2_3", "4_5", "6_plus"),
right = TRUE,
ordered_result = TRUE
),
kelompok_umur_ibu = cut(
umur_ibu,
breaks = c(14, 24, 34, 49),
labels = c("15_24_tahun", "25_34_tahun", "35_49_tahun"),
right = TRUE,
ordered_result = TRUE
)
)
# Cek distribusi hasil kategorisasi.
table(data_recode$kelompok_umur_anak, useNA = "ifany")
##
## 0_5_bulan 6_11_bulan 12_23_bulan 24_35_bulan 36_47_bulan 48_59_bulan
## 1689 1690 3516 3382 3422 3456
table(data_recode$kelompok_urutan_kelahiran, useNA = "ifany")
##
## 1 2_3 4_5 6_plus
## 5650 8672 2192 641
table(data_recode$kelompok_umur_ibu, useNA = "ifany")
##
## 15_24_tahun 25_34_tahun 35_49_tahun
## 3122 8964 5069
str(data_recode)
## tibble [17,155 × 22] (S3: tbl_df/tbl/data.frame)
## $ ID_ANAK : chr [1:17155] "DHS_1_2_2_B01" "DHS_1_2_2_B02" "DHS_1_3_2_B01" "DHS_110_2_B01" ...
## $ status_diare_num : num [1:17155] 0 0 1 0 0 1 0 1 1 1 ...
## $ status_diare : Factor w/ 2 levels "Tidak_Diare",..: 1 1 2 1 1 2 1 2 2 2 ...
## $ jenis_kelamin_anak : Factor w/ 2 levels "Male","Female": 1 1 1 1 1 1 2 1 2 1 ...
## $ umur_anak_bulan : num [1:17155] 22 22 27 43 29 23 53 14 17 41 ...
## $ urutan_kelahiran : num [1:17155] 6 5 4 5 1 8 7 3 2 1 ...
## $ umur_ibu : num [1:17155] 39 39 30 42 28 37 37 31 29 29 ...
## $ pendidikan_ibu : Ord.factor w/ 4 levels "No_education"<..: 2 2 2 1 4 2 2 2 4 4 ...
## $ indeks_kekayaan : Ord.factor w/ 5 levels "Poorest"<"Poorer"<..: 1 1 3 1 5 2 2 1 2 2 ...
## $ provinsi : Factor w/ 34 levels "Aceh","North_Sumatera",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ wilayah_tinggal : Factor w/ 2 levels "Urban","Rural": 2 2 2 2 2 2 2 2 2 2 ...
## $ sumber_air_minum : Factor w/ 20 levels "Piped_water",..: 9 9 19 13 9 10 10 9 7 7 ...
## $ jenis_toilet : Factor w/ 18 levels "Flush_toilet",..: 14 14 3 14 3 7 7 7 10 10 ...
## $ material_lantai : Factor w/ 14 levels "Natural","Earth_sand",..: 12 12 12 12 10 12 12 12 5 5 ...
## $ material_dinding : Factor w/ 19 levels "Natural","Cane_palm_trunks",..: 16 16 16 16 15 16 16 16 16 16 ...
## $ material_atap : Factor w/ 15 levels "Natural","Thatch_palm_leaf",..: 9 9 9 9 9 9 9 9 9 9 ...
## $ bahan_bakar_memasak : Factor w/ 13 levels "Electricity",..: 2 2 2 2 2 2 2 8 2 2 ...
## $ tahu_ors : Factor w/ 3 levels "Never_heard_of",..: 3 3 2 3 3 2 2 2 2 2 ...
## $ asuransi_kesehatan : Factor w/ 2 levels "No","Yes": 2 2 2 2 2 2 2 2 2 2 ...
## $ kelompok_umur_anak : Ord.factor w/ 6 levels "0_5_bulan"<"6_11_bulan"<..: 3 3 4 5 4 3 6 3 3 5 ...
## $ kelompok_urutan_kelahiran: Ord.factor w/ 4 levels "1"<"2_3"<"4_5"<..: 4 3 3 3 1 4 4 2 2 1 ...
## $ kelompok_umur_ibu : Ord.factor w/ 3 levels "15_24_tahun"<..: 3 3 2 3 2 3 3 2 2 2 ...
head(data_recode)
6. Missing Value,
Duplikasi, Dan Data Bersih
missing_setelah_recode <- ringkasan_missing(data_recode)
missing_setelah_recode
distribusi_kategorik <- data_recode %>%
select(where(is.factor)) %>%
lapply(table, useNA = "ifany")
distribusi_kategorik
## $status_diare
##
## Tidak_Diare Diare
## 14715 2440
##
## $jenis_kelamin_anak
##
## Male Female
## 8814 8341
##
## $pendidikan_ibu
##
## No_education Primary Secondary Higher
## 236 4253 9567 3099
##
## $indeks_kekayaan
##
## Poorest Poorer Middle Richer Richest
## 4694 3356 3163 3029 2913
##
## $provinsi
##
## Aceh North_Sumatera West_Sumatera Riau
## 912 951 376 409
## Jambi South_Sumatera Bengkulu Lampung
## 226 412 271 413
## Bangka_Belitung Riau_Islands Jakarta West_Java
## 259 339 530 1656
## Central_Java Yogyakarta East_Java Banten
## 1034 171 1035 541
## Bali West_Nusa_Tenggara East_Nusa_Tenggara West_Kalimantan
## 238 481 996 359
## Central_Kalimantan South_Kalimantan East_Kalimantan North_Kalimantan
## 216 262 467 269
## North_Sulawesi Central_Sulawesi South_Sulawesi Southeast_Sulawesi
## 170 416 590 607
## Gorontalo West_Sulawesi Maluku North_Maluku
## 216 614 802 398
## West_Papua Papua
## 230 289
##
## $wilayah_tinggal
##
## Urban Rural
## 8433 8722
##
## $sumber_air_minum
##
## Piped_water Piped_into_dwelling
## 0 1289
## Piped_to_yard_plot Public_tap_standpipe
## 220 141
## Piped_public_tap_standpipe Tube_well_water
## 72 0
## Tube_well_or_borehole Dug_well_open_protected
## 1997 0
## Protected_well Unprotected_well
## 2556 869
## Surface_water Protected_spring
## 0 1571
## Unprotected_spring River_dam_lake_pond_stream_canal
## 475 431
## Rainwater Tanker_truck
## 518 126
## Cart_with_small_tank Bottled_water
## 105 1386
## Refilled_water Other
## 4800 1
## <NA>
## 598
##
## $jenis_toilet
##
## Flush_toilet Flush_to_piped_sewer_system
## 0 0
## Flush_to_septic_tank Flush_to_pit_latrine
## 11358 0
## Flush_to_somewhere_else Flush_dont_know_where
## 0 0
## Flush_toilet_no_septic_tank Flush_toilet_shared_public
## 1387 1462
## Pit_toilet_latrine Ventilated_improved_pit_latrine
## 0 595
## Pit_latrine_with_slab Pit_latrine_without_slab_open_pit
## 0 0
## No_facility No_facility_bush_field_river_beach
## 0 1746
## Composting_toilet Bucket_toilet
## 0 0
## Hanging_toilet_latrine Other
## 0 8
## <NA>
## 599
##
## $material_lantai
##
## Natural Earth_sand Dung
## 0 665 4
## Rudimentary Wood_planks Palm_bamboo
## 0 2204 151
## Finished Parquet_or_polished_wood Vinyl_or_asphalt_strips
## 0 28 24
## Ceramic_marble Ceramic_tiles Cement_red_bricks
## 6851 693 5847
## Carpet Other <NA>
## 52 10 626
##
## $material_dinding
##
## Natural Cane_palm_trunks Dirt
## 0 282 1
## Rudimentary Bamboo_with_mud Stone_with_mud
## 0 59 2
## Uncovered_adobe Plywood Cardboard
## 544 181 2
## Reused_wood Finished Woven_bamboo
## 32 0 433
## Stone_with_lime_cement Cement_blocks Covered_adobe
## 523 1656 8457
## Wood_planks_shingles Plaster_wire GRC_gypsum_asbestos
## 4096 69 195
## Other <NA>
## 21 602
##
## $material_atap
##
## Natural Thatch_palm_leaf Sod Rudimentary
## 0 383 80 0
## Rustic_mat Palm_bamboo Wood_planks Finished
## 7 5 9 0
## Roofing Asbestos Tile Concrete
## 8916 1485 5063 173
## Metal_tile Roofing_shingles Other <NA>
## 343 80 4 607
##
## $bahan_bakar_memasak
##
## Electricity LPG Natural_gas
## 35 11098 76
## Biogas Kerosene Coal_lignite
## 2 1357 2
## Charcoal Wood Straw_shrubs_grass
## 31 3927 7
## Agricultural_crop Animal_dung No_food_cooked_in_house
## 1 0 18
## Other <NA>
## 0 601
##
## $tahu_ors
##
## Never_heard_of Used_ORS Heard_of_ORS <NA>
## 1289 1214 14625 27
##
## $asuransi_kesehatan
##
## No Yes
## 6473 10682
##
## $kelompok_umur_anak
##
## 0_5_bulan 6_11_bulan 12_23_bulan 24_35_bulan 36_47_bulan 48_59_bulan
## 1689 1690 3516 3382 3422 3456
##
## $kelompok_urutan_kelahiran
##
## 1 2_3 4_5 6_plus
## 5650 8672 2192 641
##
## $kelompok_umur_ibu
##
## 15_24_tahun 25_34_tahun 35_49_tahun
## 3122 8964 5069
data_unique <- data_recode %>%
distinct(ID_ANAK, .keep_all = TRUE)
validasi_id_setelah <- data_unique %>%
summarise(
jumlah_observasi = n(),
jumlah_id_unik = n_distinct(ID_ANAK),
jumlah_id_duplikat = n() - n_distinct(ID_ANAK),
jumlah_id_kosong = sum(is.na(ID_ANAK))
)
validasi_id_setelah
# Complete case analysis: observasi dengan missing value dihapus per baris.
# droplevels() digunakan untuk menghapus level factor yang tidak lagi muncul
# setelah observasi missing dihapus.
data_clean <- data_unique %>%
drop_na() %>%
droplevels()
dim(data_recode)
## [1] 17155 22
dim(data_clean)
## [1] 16490 22
# Hitung jumlah observasi yang terhapus.
# Jika script dijalankan dari awal, data_awal pasti tersedia.
# Baris if ini hanya membuat ringkasan tetap aman jika pengguna menjalankan
# sebagian script dari objek datadiareanak yang sudah ada.
jumlah_observasi_awal <- if (exists("data_awal")) nrow(data_awal) else nrow(datadiareanak)
jumlah_datadiareanak <- nrow(datadiareanak)
jumlah_setelah_target_valid <- nrow(data3)
jumlah_setelah_recode <- nrow(data_recode)
jumlah_setelah_unik <- nrow(data_unique)
jumlah_setelah_clean <- nrow(data_clean)
jumlah_terhapus_target <- jumlah_datadiareanak - jumlah_setelah_target_valid
jumlah_terhapus_duplikat <- jumlah_setelah_recode - jumlah_setelah_unik
jumlah_terhapus_missing <- jumlah_setelah_unik - jumlah_setelah_clean
jumlah_terhapus_total <- jumlah_datadiareanak - jumlah_setelah_clean
jumlah_observasi_awal
## [1] 17848
jumlah_datadiareanak
## [1] 17848
jumlah_setelah_target_valid
## [1] 17155
jumlah_setelah_clean
## [1] 16490
jumlah_terhapus_target
## [1] 693
jumlah_terhapus_duplikat
## [1] 0
jumlah_terhapus_missing
## [1] 665
jumlah_terhapus_total
## [1] 1358
# Distribusi target data bersih.
distribusi_target_bersih <- data_clean %>%
count(status_diare, name = "frekuensi") %>%
mutate(
persen = round(frekuensi / sum(frekuensi) * 100, 2)
)
distribusi_target_bersih
prop.table(table(data_clean$status_diare))
##
## Tidak_Diare Diare
## 0.8571255 0.1428745
7. Pembentukan Data
Model Awal
# Data model awal:
# - ID_ANAK tidak digunakan sebagai prediktor.
# - status_diare_num hanya dokumentasi target numerik, sehingga dihapus.
# - umur_anak_bulan, urutan_kelahiran, dan umur_ibu dihapus karena sudah
# digantikan oleh versi kategorik.
data_model_awal <- data_clean %>%
select(
-ID_ANAK,
-status_diare_num,
-umur_anak_bulan,
-urutan_kelahiran,
-umur_ibu
)
str(data_model_awal)
## tibble [16,490 × 17] (S3: tbl_df/tbl/data.frame)
## $ status_diare : Factor w/ 2 levels "Tidak_Diare",..: 1 1 2 1 1 2 1 2 2 2 ...
## $ jenis_kelamin_anak : Factor w/ 2 levels "Male","Female": 1 1 1 1 1 1 2 1 2 1 ...
## $ pendidikan_ibu : Ord.factor w/ 4 levels "No_education"<..: 2 2 2 1 4 2 2 2 4 4 ...
## $ indeks_kekayaan : Ord.factor w/ 5 levels "Poorest"<"Poorer"<..: 1 1 3 1 5 2 2 1 2 2 ...
## $ provinsi : Factor w/ 34 levels "Aceh","North_Sumatera",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ wilayah_tinggal : Factor w/ 2 levels "Urban","Rural": 2 2 2 2 2 2 2 2 2 2 ...
## $ sumber_air_minum : Factor w/ 16 levels "Piped_into_dwelling",..: 6 6 15 9 6 7 7 6 5 5 ...
## $ jenis_toilet : Factor w/ 6 levels "Flush_to_septic_tank",..: 5 5 1 5 1 2 2 2 4 4 ...
## $ material_lantai : Factor w/ 11 levels "Earth_sand","Dung",..: 9 9 9 9 7 9 9 9 3 3 ...
## $ material_dinding : Factor w/ 16 levels "Cane_palm_trunks",..: 13 13 13 13 12 13 13 13 13 13 ...
## $ material_atap : Factor w/ 12 levels "Thatch_palm_leaf",..: 6 6 6 6 6 6 6 6 6 6 ...
## $ bahan_bakar_memasak : Factor w/ 11 levels "Electricity",..: 2 2 2 2 2 2 2 8 2 2 ...
## $ tahu_ors : Factor w/ 3 levels "Never_heard_of",..: 3 3 2 3 3 2 2 2 2 2 ...
## $ asuransi_kesehatan : Factor w/ 2 levels "No","Yes": 2 2 2 2 2 2 2 2 2 2 ...
## $ kelompok_umur_anak : Ord.factor w/ 6 levels "0_5_bulan"<"6_11_bulan"<..: 3 3 4 5 4 3 6 3 3 5 ...
## $ kelompok_urutan_kelahiran: Ord.factor w/ 4 levels "1"<"2_3"<"4_5"<..: 4 3 3 3 1 4 4 2 2 1 ...
## $ kelompok_umur_ibu : Ord.factor w/ 3 levels "15_24_tahun"<..: 3 3 2 3 2 3 3 2 2 2 ...
summary(data_model_awal)
## status_diare jenis_kelamin_anak pendidikan_ibu indeks_kekayaan
## Tidak_Diare:14134 Male :8462 No_education: 231 Poorest:4465
## Diare : 2356 Female:8028 Primary :4091 Poorer :3236
## Secondary :9221 Middle :3068
## Higher :2947 Richer :2918
## Richest:2803
##
##
## provinsi wilayah_tinggal sumber_air_minum
## West_Java : 1607 Urban:8123 Refilled_water :4782
## East_Java : 1007 Rural:8367 Protected_well :2538
## Central_Java : 1002 Tube_well_or_borehole:1990
## East_Nusa_Tenggara: 936 Protected_spring :1567
## North_Sumatera : 915 Bottled_water :1379
## Aceh : 882 Piped_into_dwelling :1286
## (Other) :10141 (Other) :2948
## jenis_toilet material_lantai
## Flush_to_septic_tank :11316 Ceramic_marble :6836
## Flush_toilet_no_septic_tank : 1380 Cement_red_bricks:5829
## Flush_toilet_shared_public : 1456 Wood_planks :2199
## Ventilated_improved_pit_latrine : 594 Ceramic_tiles : 693
## No_facility_bush_field_river_beach: 1736 Earth_sand : 664
## Other : 8 Palm_bamboo : 151
## (Other) : 118
## material_dinding material_atap bahan_bakar_memasak
## Covered_adobe :8416 Roofing :8891 LPG :11055
## Wood_planks_shingles :4084 Tile :5041 Wood : 3910
## Cement_blocks :1653 Asbestos :1481 Kerosene : 1353
## Uncovered_adobe : 539 Thatch_palm_leaf: 380 Natural_gas: 76
## Stone_with_lime_cement: 523 Metal_tile : 341 Electricity: 35
## Woven_bamboo : 433 Concrete : 171 Charcoal : 31
## (Other) : 842 (Other) : 185 (Other) : 30
## tahu_ors asuransi_kesehatan kelompok_umur_anak
## Never_heard_of: 1217 No : 6238 0_5_bulan :1585
## Used_ORS : 1178 Yes:10252 6_11_bulan :1612
## Heard_of_ORS :14095 12_23_bulan:3378
## 24_35_bulan:3272
## 36_47_bulan:3284
## 48_59_bulan:3359
##
## kelompok_urutan_kelahiran kelompok_umur_ibu
## 1 :5305 15_24_tahun:2903
## 2_3 :8407 25_34_tahun:8619
## 4_5 :2148 35_49_tahun:4968
## 6_plus: 630
##
##
##
class(data_model_awal$status_diare)
## [1] "factor"
levels(data_model_awal$status_diare)
## [1] "Tidak_Diare" "Diare"
# Cek akhir missing value setelah data bersih dan data model awal terbentuk.
missing_final_data_clean <- ringkasan_missing(data_clean)
missing_final_data_model_awal <- ringkasan_missing(data_model_awal)
total_missing_data_clean <- sum(is.na(data_clean))
total_missing_data_model_awal <- sum(is.na(data_model_awal))
missing_final_data_clean
missing_final_data_model_awal
total_missing_data_clean
## [1] 0
total_missing_data_model_awal
## [1] 0
8. Split Data Training
Dan Testing
# Split dilakukan sebelum seleksi asosiasi antar-prediktor.
# Dengan cara ini, data testing tidak ikut memengaruhi keputusan seleksi variabel.
set.seed(123)
index_train <- createDataPartition(
y = data_model_awal$status_diare,
p = 0.80,
list = FALSE
)
data_train_awal <- data_model_awal[index_train, ]
data_test_awal <- data_model_awal[-index_train, ]
dim(data_train_awal)
## [1] 13193 17
dim(data_test_awal)
## [1] 3297 17
distribusi_train_awal <- data_train_awal %>%
count(status_diare, name = "frekuensi") %>%
mutate(
persen = round(frekuensi / sum(frekuensi) * 100, 2)
)
distribusi_test_awal <- data_test_awal %>%
count(status_diare, name = "frekuensi") %>%
mutate(
persen = round(frekuensi / sum(frekuensi) * 100, 2)
)
distribusi_train_awal
distribusi_test_awal
9. Uji Asosiasi
Antar-Prediktor Pada Data Training
# Target status_diare tidak dilibatkan.
# Tujuan tahap ini adalah mengurangi prediktor yang terlalu redundan,
# bukan memilih variabel berdasarkan hubungan dengan target.
data_prediktor_train <- data_train_awal %>%
select(-status_diare) %>%
mutate(across(everything(), ~ droplevels(as.factor(.))))
matriks_cramer <- buat_matriks_cramer(data_prediktor_train)
matriks_cramer_round <- round(matriks_cramer, 3)
matriks_cramer_round
## jenis_kelamin_anak pendidikan_ibu indeks_kekayaan
## jenis_kelamin_anak 1.000 0.018 0.002
## pendidikan_ibu 0.018 1.000 0.286
## indeks_kekayaan 0.002 0.286 1.000
## provinsi 0.048 0.155 0.260
## wilayah_tinggal 0.003 0.235 0.483
## sumber_air_minum 0.033 0.187 0.334
## jenis_toilet 0.004 0.198 0.323
## material_lantai 0.030 0.193 0.361
## material_dinding 0.049 0.160 0.316
## material_atap 0.026 0.157 0.236
## bahan_bakar_memasak 0.020 0.184 0.343
## tahu_ors 0.019 0.159 0.134
## asuransi_kesehatan 0.005 0.166 0.130
## kelompok_umur_anak 0.033 0.036 0.022
## kelompok_urutan_kelahiran 0.022 0.162 0.106
## kelompok_umur_ibu 0.022 0.155 0.083
## provinsi wilayah_tinggal sumber_air_minum
## jenis_kelamin_anak 0.048 0.003 0.033
## pendidikan_ibu 0.155 0.235 0.187
## indeks_kekayaan 0.260 0.483 0.334
## provinsi 1.000 0.407 0.236
## wilayah_tinggal 0.407 1.000 0.485
## sumber_air_minum 0.236 0.485 1.000
## jenis_toilet 0.191 0.285 0.186
## material_lantai 0.249 0.366 0.156
## material_dinding 0.246 0.321 0.119
## material_atap 0.329 0.265 0.139
## bahan_bakar_memasak 0.258 0.414 0.177
## tahu_ors 0.115 0.112 0.098
## asuransi_kesehatan 0.225 0.086 0.113
## kelompok_umur_anak 0.047 0.030 0.034
## kelompok_urutan_kelahiran 0.133 0.079 0.083
## kelompok_umur_ibu 0.079 0.064 0.067
## jenis_toilet material_lantai material_dinding
## jenis_kelamin_anak 0.004 0.030 0.049
## pendidikan_ibu 0.198 0.193 0.160
## indeks_kekayaan 0.323 0.361 0.316
## provinsi 0.191 0.249 0.246
## wilayah_tinggal 0.285 0.366 0.321
## sumber_air_minum 0.186 0.156 0.119
## jenis_toilet 1.000 0.198 0.183
## material_lantai 0.198 1.000 0.261
## material_dinding 0.183 0.261 1.000
## material_atap 0.136 0.217 0.185
## bahan_bakar_memasak 0.175 0.133 0.137
## tahu_ors 0.113 0.087 0.092
## asuransi_kesehatan 0.055 0.071 0.061
## kelompok_umur_anak 0.022 0.026 0.036
## kelompok_urutan_kelahiran 0.064 0.078 0.085
## kelompok_umur_ibu 0.062 0.058 0.054
## material_atap bahan_bakar_memasak tahu_ors
## jenis_kelamin_anak 0.026 0.020 0.019
## pendidikan_ibu 0.157 0.184 0.159
## indeks_kekayaan 0.236 0.343 0.134
## provinsi 0.329 0.258 0.115
## wilayah_tinggal 0.265 0.414 0.112
## sumber_air_minum 0.139 0.177 0.098
## jenis_toilet 0.136 0.175 0.113
## material_lantai 0.217 0.133 0.087
## material_dinding 0.185 0.137 0.092
## material_atap 1.000 0.127 0.091
## bahan_bakar_memasak 0.127 1.000 0.114
## tahu_ors 0.091 0.114 1.000
## asuransi_kesehatan 0.087 0.076 0.041
## kelompok_umur_anak 0.033 0.026 0.074
## kelompok_urutan_kelahiran 0.101 0.106 0.061
## kelompok_umur_ibu 0.043 0.050 0.106
## asuransi_kesehatan kelompok_umur_anak
## jenis_kelamin_anak 0.005 0.033
## pendidikan_ibu 0.166 0.036
## indeks_kekayaan 0.130 0.022
## provinsi 0.225 0.047
## wilayah_tinggal 0.086 0.030
## sumber_air_minum 0.113 0.034
## jenis_toilet 0.055 0.022
## material_lantai 0.071 0.026
## material_dinding 0.061 0.036
## material_atap 0.087 0.033
## bahan_bakar_memasak 0.076 0.026
## tahu_ors 0.041 0.074
## asuransi_kesehatan 1.000 0.049
## kelompok_umur_anak 0.049 1.000
## kelompok_urutan_kelahiran 0.054 0.032
## kelompok_umur_ibu 0.066 0.126
## kelompok_urutan_kelahiran kelompok_umur_ibu
## jenis_kelamin_anak 0.022 0.022
## pendidikan_ibu 0.162 0.155
## indeks_kekayaan 0.106 0.083
## provinsi 0.133 0.079
## wilayah_tinggal 0.079 0.064
## sumber_air_minum 0.083 0.067
## jenis_toilet 0.064 0.062
## material_lantai 0.078 0.058
## material_dinding 0.085 0.054
## material_atap 0.101 0.043
## bahan_bakar_memasak 0.106 0.050
## tahu_ors 0.061 0.106
## asuransi_kesehatan 0.054 0.066
## kelompok_umur_anak 0.032 0.126
## kelompok_urutan_kelahiran 1.000 0.433
## kelompok_umur_ibu 0.433 1.000
hasil_asosiasi_prediktor <- buat_tabel_asosiasi(matriks_cramer)
hasil_asosiasi_prediktor
# Batas asosiasi tinggi dapat disesuaikan.
# Gunakan 0.70 jika ingin cukup ketat, atau 0.80 jika ingin lebih konservatif.
batas_asosiasi_tinggi <- 0.70
asosiasi_tinggi_prediktor <- hasil_asosiasi_prediktor %>%
filter(cramer_v >= batas_asosiasi_tinggi)
asosiasi_tinggi_prediktor
# Seleksi variabel otomatis.
# Variabel yang dipilih untuk dihapus ditentukan hanya berdasarkan asosiasi
# antar-prediktor pada data training. Target status_diare tidak digunakan.
variabel_dihapus_asosiasi <- pilih_variabel_redundan(
data_prediktor = data_prediktor_train,
tabel_asosiasi = hasil_asosiasi_prediktor,
batas_cramer = batas_asosiasi_tinggi
)
variabel_dihapus_asosiasi
## character(0)
variabel_dipertahankan_asosiasi <- setdiff(
names(data_prediktor_train),
variabel_dihapus_asosiasi
)
variabel_dipertahankan_asosiasi
## [1] "jenis_kelamin_anak" "pendidikan_ibu"
## [3] "indeks_kekayaan" "provinsi"
## [5] "wilayah_tinggal" "sumber_air_minum"
## [7] "jenis_toilet" "material_lantai"
## [9] "material_dinding" "material_atap"
## [11] "bahan_bakar_memasak" "tahu_ors"
## [13] "asuransi_kesehatan" "kelompok_umur_anak"
## [15] "kelompok_urutan_kelahiran" "kelompok_umur_ibu"
ringkasan_seleksi_asosiasi <- data.frame(
keterangan = c(
"Jumlah prediktor awal",
"Jumlah prediktor dihapus otomatis",
"Jumlah prediktor dipertahankan"
),
jumlah = c(
length(names(data_prediktor_train)),
length(variabel_dihapus_asosiasi),
length(variabel_dipertahankan_asosiasi)
)
)
ringkasan_seleksi_asosiasi
cat("============================================================\n")
## ============================================================
cat("RINGKASAN SELEKSI VARIABEL OTOMATIS BERDASARKAN CRAMER'S V\n")
## RINGKASAN SELEKSI VARIABEL OTOMATIS BERDASARKAN CRAMER'S V
cat("============================================================\n")
## ============================================================
cat("Batas Cramer's V tinggi :", batas_asosiasi_tinggi, "\n")
## Batas Cramer's V tinggi : 0.7
cat("Jumlah prediktor awal :", length(names(data_prediktor_train)), "\n")
## Jumlah prediktor awal : 16
cat("Jumlah prediktor dihapus :", length(variabel_dihapus_asosiasi), "\n")
## Jumlah prediktor dihapus : 0
cat("Jumlah prediktor dipertahankan :", length(variabel_dipertahankan_asosiasi), "\n")
## Jumlah prediktor dipertahankan : 16
cat("\nVariabel yang dihapus otomatis:\n")
##
## Variabel yang dihapus otomatis:
print(variabel_dihapus_asosiasi)
## character(0)
cat("\nVariabel yang dipertahankan:\n")
##
## Variabel yang dipertahankan:
print(variabel_dipertahankan_asosiasi)
## [1] "jenis_kelamin_anak" "pendidikan_ibu"
## [3] "indeks_kekayaan" "provinsi"
## [5] "wilayah_tinggal" "sumber_air_minum"
## [7] "jenis_toilet" "material_lantai"
## [9] "material_dinding" "material_atap"
## [11] "bahan_bakar_memasak" "tahu_ors"
## [13] "asuransi_kesehatan" "kelompok_umur_anak"
## [15] "kelompok_urutan_kelahiran" "kelompok_umur_ibu"
cat("============================================================\n")
## ============================================================
# Pemeriksaan keamanan: jangan sampai semua prediktor terhapus.
if (length(variabel_dipertahankan_asosiasi) == 0) {
stop("Semua prediktor terhapus oleh seleksi otomatis. Naikkan batas_asosiasi_tinggi, misalnya menjadi 0.80.")
}
# Bentuk data final untuk modeling.
# Variabel yang dihapus dari training juga dihapus dari testing agar struktur sama.
data_train <- data_train_awal %>%
select(-all_of(variabel_dihapus_asosiasi))
data_test <- data_test_awal %>%
select(-all_of(variabel_dihapus_asosiasi))
# Jangan menggunakan droplevels() secara terpisah pada training dan testing.
# Jika level tertentu hanya muncul pada testing, misalnya sumber_air_minum = "Other",
# rpart akan membaca level tersebut sebagai level baru dan predict() akan error.
# Level factor disamakan berdasarkan data_model_awal sebagai skema level dari hasil recode.
data_train <- samakan_level_factor(data_model_awal, data_train)
data_test <- samakan_level_factor(data_model_awal, data_test)
level_baru_test_awal <- cek_level_factor_baru(data_train, data_test)
level_baru_test_awal
# Objek data_model final disimpan sebagai gabungan training dan testing
# setelah seleksi prediktor, hanya untuk dokumentasi/ringkasan.
data_model <- bind_rows(data_train, data_test)
str(data_model)
## tibble [16,490 × 17] (S3: tbl_df/tbl/data.frame)
## $ status_diare : Factor w/ 2 levels "Tidak_Diare",..: 1 1 2 1 2 1 2 2 1 2 ...
## $ jenis_kelamin_anak : Factor w/ 2 levels "Male","Female": 1 1 1 1 1 2 1 1 2 2 ...
## $ pendidikan_ibu : Ord.factor w/ 4 levels "No_education"<..: 2 2 2 4 2 2 2 4 4 3 ...
## $ indeks_kekayaan : Ord.factor w/ 5 levels "Poorest"<"Poorer"<..: 1 1 3 5 2 2 1 2 2 1 ...
## $ provinsi : Factor w/ 34 levels "Aceh","North_Sumatera",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ wilayah_tinggal : Factor w/ 2 levels "Urban","Rural": 2 2 2 2 2 2 2 2 2 2 ...
## $ sumber_air_minum : Factor w/ 16 levels "Piped_into_dwelling",..: 6 6 15 6 7 7 6 5 6 7 ...
## $ jenis_toilet : Factor w/ 6 levels "Flush_to_septic_tank",..: 5 5 1 1 2 2 2 4 2 5 ...
## $ material_lantai : Factor w/ 11 levels "Earth_sand","Dung",..: 9 9 9 7 9 9 9 3 9 9 ...
## $ material_dinding : Factor w/ 16 levels "Cane_palm_trunks",..: 13 13 13 12 13 13 13 13 5 12 ...
## $ material_atap : Factor w/ 12 levels "Thatch_palm_leaf",..: 6 6 6 6 6 6 6 6 6 6 ...
## $ bahan_bakar_memasak : Factor w/ 11 levels "Electricity",..: 2 2 2 2 2 2 8 2 2 2 ...
## $ tahu_ors : Factor w/ 3 levels "Never_heard_of",..: 3 3 2 3 2 2 2 2 3 3 ...
## $ asuransi_kesehatan : Factor w/ 2 levels "No","Yes": 2 2 2 2 2 2 2 2 2 2 ...
## $ kelompok_umur_anak : Ord.factor w/ 6 levels "0_5_bulan"<"6_11_bulan"<..: 3 3 4 4 3 6 3 5 3 1 ...
## $ kelompok_urutan_kelahiran: Ord.factor w/ 4 levels "1"<"2_3"<"4_5"<..: 4 3 3 1 4 4 2 1 2 1 ...
## $ kelompok_umur_ibu : Ord.factor w/ 3 levels "15_24_tahun"<..: 3 3 2 2 3 3 2 2 3 1 ...
summary(data_model)
## status_diare jenis_kelamin_anak pendidikan_ibu indeks_kekayaan
## Tidak_Diare:14134 Male :8462 No_education: 231 Poorest:4465
## Diare : 2356 Female:8028 Primary :4091 Poorer :3236
## Secondary :9221 Middle :3068
## Higher :2947 Richer :2918
## Richest:2803
##
##
## provinsi wilayah_tinggal sumber_air_minum
## West_Java : 1607 Urban:8123 Refilled_water :4782
## East_Java : 1007 Rural:8367 Protected_well :2538
## Central_Java : 1002 Tube_well_or_borehole:1990
## East_Nusa_Tenggara: 936 Protected_spring :1567
## North_Sumatera : 915 Bottled_water :1379
## Aceh : 882 Piped_into_dwelling :1286
## (Other) :10141 (Other) :2948
## jenis_toilet material_lantai
## Flush_to_septic_tank :11316 Ceramic_marble :6836
## Flush_toilet_no_septic_tank : 1380 Cement_red_bricks:5829
## Flush_toilet_shared_public : 1456 Wood_planks :2199
## Ventilated_improved_pit_latrine : 594 Ceramic_tiles : 693
## No_facility_bush_field_river_beach: 1736 Earth_sand : 664
## Other : 8 Palm_bamboo : 151
## (Other) : 118
## material_dinding material_atap bahan_bakar_memasak
## Covered_adobe :8416 Roofing :8891 LPG :11055
## Wood_planks_shingles :4084 Tile :5041 Wood : 3910
## Cement_blocks :1653 Asbestos :1481 Kerosene : 1353
## Uncovered_adobe : 539 Thatch_palm_leaf: 380 Natural_gas: 76
## Stone_with_lime_cement: 523 Metal_tile : 341 Electricity: 35
## Woven_bamboo : 433 Concrete : 171 Charcoal : 31
## (Other) : 842 (Other) : 185 (Other) : 30
## tahu_ors asuransi_kesehatan kelompok_umur_anak
## Never_heard_of: 1217 No : 6238 0_5_bulan :1585
## Used_ORS : 1178 Yes:10252 6_11_bulan :1612
## Heard_of_ORS :14095 12_23_bulan:3378
## 24_35_bulan:3272
## 36_47_bulan:3284
## 48_59_bulan:3359
##
## kelompok_urutan_kelahiran kelompok_umur_ibu
## 1 :5305 15_24_tahun:2903
## 2_3 :8407 25_34_tahun:8619
## 4_5 :2148 35_49_tahun:4968
## 6_plus: 630
##
##
##
class(data_model$status_diare)
## [1] "factor"
levels(data_model$status_diare)
## [1] "Tidak_Diare" "Diare"
dim(data_model_awal)
## [1] 16490 17
dim(data_model)
## [1] 16490 17
dim(data_train)
## [1] 13193 17
dim(data_test)
## [1] 3297 17
missing_final_data_model <- ringkasan_missing(data_model)
total_missing_data_model <- sum(is.na(data_model))
missing_final_data_model
total_missing_data_model
## [1] 0
# Distribusi target setelah seleksi variabel.
distribusi_train <- data_train %>%
count(status_diare, name = "frekuensi") %>%
mutate(
persen = round(frekuensi / sum(frekuensi) * 100, 2)
)
distribusi_test <- data_test %>%
count(status_diare, name = "frekuensi") %>%
mutate(
persen = round(frekuensi / sum(frekuensi) * 100, 2)
)
distribusi_train
distribusi_test
# Visualisasi heatmap asosiasi antar-prediktor pada data training.
hasil_asosiasi_heatmap <- as.data.frame(as.table(matriks_cramer)) %>%
rename(
variabel_1 = Var1,
variabel_2 = Var2,
cramer_v = Freq
) %>%
filter(!is.na(cramer_v), is.finite(cramer_v))
ggplot(
hasil_asosiasi_heatmap,
aes(x = variabel_1, y = variabel_2, fill = cramer_v)
) +
geom_tile() +
geom_text(aes(label = round(cramer_v, 2)), size = 3) +
labs(
title = "Heatmap Asosiasi Antar-Prediktor pada Data Training",
subtitle = "Ukuran asosiasi menggunakan Cramer's V; target tidak dilibatkan",
x = "Variabel Prediktor",
y = "Variabel Prediktor",
fill = "Cramer's V"
) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1)
)
10. Simpan Objek Hasil
Preprocessing
saveRDS(data_clean, "data_diare_anak_clean.rds")
saveRDS(data_model, "data_diare_anak_model.rds")
saveRDS(data_train, "data_train_diare.rds")
saveRDS(data_test, "data_test_diare.rds")
cat("============================================================\n")
## ============================================================
cat("RINGKASAN PREPROCESSING DATA DIARE ANAK\n")
## RINGKASAN PREPROCESSING DATA DIARE ANAK
cat("============================================================\n")
## ============================================================
cat("Jumlah observasi data_awal :", jumlah_observasi_awal, "\n")
## Jumlah observasi data_awal : 17848
cat("Jumlah observasi datadiareanak :", jumlah_datadiareanak, "\n")
## Jumlah observasi datadiareanak : 17848
cat("Jumlah observasi setelah target valid :", jumlah_setelah_target_valid, "\n")
## Jumlah observasi setelah target valid : 17155
cat("Jumlah observasi setelah recode :", jumlah_setelah_recode, "\n")
## Jumlah observasi setelah recode : 17155
cat("Jumlah observasi setelah hapus duplikat :", jumlah_setelah_unik, "\n")
## Jumlah observasi setelah hapus duplikat : 17155
cat("Jumlah observasi data bersih :", jumlah_setelah_clean, "\n")
## Jumlah observasi data bersih : 16490
cat("Jumlah observasi terhapus karena target :", jumlah_terhapus_target, "\n")
## Jumlah observasi terhapus karena target : 693
cat("Jumlah observasi terhapus karena duplikat :", jumlah_terhapus_duplikat, "\n")
## Jumlah observasi terhapus karena duplikat : 0
cat("Jumlah observasi terhapus karena missing :", jumlah_terhapus_missing, "\n")
## Jumlah observasi terhapus karena missing : 665
cat("Jumlah observasi terhapus total :", jumlah_terhapus_total, "\n")
## Jumlah observasi terhapus total : 1358
cat("Jumlah variabel datadiareanak :", ncol(datadiareanak), "\n")
## Jumlah variabel datadiareanak : 18
cat("Jumlah variabel data_model :", ncol(data_model), "\n")
## Jumlah variabel data_model : 17
cat("Jumlah prediktor awal sebelum seleksi :", length(names(data_prediktor_train)), "\n")
## Jumlah prediktor awal sebelum seleksi : 16
cat("Jumlah prediktor dihapus otomatis :", length(variabel_dihapus_asosiasi), "\n")
## Jumlah prediktor dihapus otomatis : 0
cat("Jumlah prediktor dipertahankan :", length(variabel_dipertahankan_asosiasi), "\n")
## Jumlah prediktor dipertahankan : 16
cat("Jumlah data training :", nrow(data_train), "\n")
## Jumlah data training : 13193
cat("Jumlah data testing :", nrow(data_test), "\n")
## Jumlah data testing : 3297
cat("============================================================\n")
## ============================================================
cat("\nDistribusi target data bersih:\n")
##
## Distribusi target data bersih:
print(distribusi_target_bersih)
## # A tibble: 2 × 3
## status_diare frekuensi persen
## <fct> <int> <dbl>
## 1 Tidak_Diare 14134 85.7
## 2 Diare 2356 14.3
cat("\nDistribusi target data training:\n")
##
## Distribusi target data training:
print(distribusi_train)
## # A tibble: 2 × 3
## status_diare frekuensi persen
## <fct> <int> <dbl>
## 1 Tidak_Diare 11308 85.7
## 2 Diare 1885 14.3
cat("\nDistribusi target data testing:\n")
##
## Distribusi target data testing:
print(distribusi_test)
## # A tibble: 2 × 3
## status_diare frekuensi persen
## <fct> <int> <dbl>
## 1 Tidak_Diare 2826 85.7
## 2 Diare 471 14.3
11. Smote / Smotenc
Untuk Penanganan Imbalanced Data
# Pastikan target berbentuk factor dengan urutan level yang benar.
data_train <- data_train %>%
mutate(
status_diare = factor(status_diare, levels = c("Tidak_Diare", "Diare"))
)
data_test <- data_test %>%
mutate(
status_diare = factor(status_diare, levels = c("Tidak_Diare", "Diare"))
)
str(data_train)
## tibble [13,193 × 17] (S3: tbl_df/tbl/data.frame)
## $ status_diare : Factor w/ 2 levels "Tidak_Diare",..: 1 1 2 1 2 1 2 2 1 2 ...
## $ jenis_kelamin_anak : Factor w/ 2 levels "Male","Female": 1 1 1 1 1 2 1 1 2 2 ...
## $ pendidikan_ibu : Ord.factor w/ 4 levels "No_education"<..: 2 2 2 4 2 2 2 4 4 3 ...
## $ indeks_kekayaan : Ord.factor w/ 5 levels "Poorest"<"Poorer"<..: 1 1 3 5 2 2 1 2 2 1 ...
## $ provinsi : Factor w/ 34 levels "Aceh","North_Sumatera",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ wilayah_tinggal : Factor w/ 2 levels "Urban","Rural": 2 2 2 2 2 2 2 2 2 2 ...
## $ sumber_air_minum : Factor w/ 16 levels "Piped_into_dwelling",..: 6 6 15 6 7 7 6 5 6 7 ...
## $ jenis_toilet : Factor w/ 6 levels "Flush_to_septic_tank",..: 5 5 1 1 2 2 2 4 2 5 ...
## $ material_lantai : Factor w/ 11 levels "Earth_sand","Dung",..: 9 9 9 7 9 9 9 3 9 9 ...
## $ material_dinding : Factor w/ 16 levels "Cane_palm_trunks",..: 13 13 13 12 13 13 13 13 5 12 ...
## $ material_atap : Factor w/ 12 levels "Thatch_palm_leaf",..: 6 6 6 6 6 6 6 6 6 6 ...
## $ bahan_bakar_memasak : Factor w/ 11 levels "Electricity",..: 2 2 2 2 2 2 8 2 2 2 ...
## $ tahu_ors : Factor w/ 3 levels "Never_heard_of",..: 3 3 2 3 2 2 2 2 3 3 ...
## $ asuransi_kesehatan : Factor w/ 2 levels "No","Yes": 2 2 2 2 2 2 2 2 2 2 ...
## $ kelompok_umur_anak : Ord.factor w/ 6 levels "0_5_bulan"<"6_11_bulan"<..: 3 3 4 4 3 6 3 5 3 1 ...
## $ kelompok_urutan_kelahiran: Ord.factor w/ 4 levels "1"<"2_3"<"4_5"<..: 4 3 3 1 4 4 2 1 2 1 ...
## $ kelompok_umur_ibu : Ord.factor w/ 3 levels "15_24_tahun"<..: 3 3 2 2 3 3 2 2 3 1 ...
str(data_test)
## tibble [3,297 × 17] (S3: tbl_df/tbl/data.frame)
## $ status_diare : Factor w/ 2 levels "Tidak_Diare",..: 1 2 1 2 1 1 1 1 1 1 ...
## $ jenis_kelamin_anak : Factor w/ 2 levels "Male","Female": 1 2 1 2 1 1 2 1 1 1 ...
## $ pendidikan_ibu : Ord.factor w/ 4 levels "No_education"<..: 1 4 2 2 2 3 2 4 3 3 ...
## $ indeks_kekayaan : Ord.factor w/ 5 levels "Poorest"<"Poorer"<..: 1 2 4 1 1 1 3 3 4 2 ...
## $ provinsi : Factor w/ 34 levels "Aceh","North_Sumatera",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ wilayah_tinggal : Factor w/ 2 levels "Urban","Rural": 2 2 2 2 2 1 1 1 1 1 ...
## $ sumber_air_minum : Factor w/ 16 levels "Piped_into_dwelling",..: 9 5 6 15 6 7 15 15 6 7 ...
## $ jenis_toilet : Factor w/ 6 levels "Flush_to_septic_tank",..: 5 4 1 5 1 5 1 1 1 2 ...
## $ material_lantai : Factor w/ 11 levels "Earth_sand","Dung",..: 9 3 7 9 9 9 9 9 7 9 ...
## $ material_dinding : Factor w/ 16 levels "Cane_palm_trunks",..: 13 13 12 13 12 12 12 13 12 12 ...
## $ material_atap : Factor w/ 12 levels "Thatch_palm_leaf",..: 6 6 6 6 6 6 6 6 6 6 ...
## $ bahan_bakar_memasak : Factor w/ 11 levels "Electricity",..: 2 2 2 8 8 8 2 2 2 2 ...
## $ tahu_ors : Factor w/ 3 levels "Never_heard_of",..: 3 2 3 3 3 3 3 3 3 3 ...
## $ asuransi_kesehatan : Factor w/ 2 levels "No","Yes": 2 2 2 2 2 2 2 2 2 2 ...
## $ kelompok_umur_anak : Ord.factor w/ 6 levels "0_5_bulan"<"6_11_bulan"<..: 5 3 4 1 6 6 1 3 2 4 ...
## $ kelompok_urutan_kelahiran: Ord.factor w/ 4 levels "1"<"2_3"<"4_5"<..: 3 2 3 2 4 2 3 2 2 2 ...
## $ kelompok_umur_ibu : Ord.factor w/ 3 levels "15_24_tahun"<..: 3 2 2 3 3 2 3 2 3 2 ...
# Distribusi kelas sebelum SMOTE.
distribusi_train_sebelum_smote <- data_train %>%
count(status_diare, name = "frekuensi") %>%
mutate(
persen = round(frekuensi / sum(frekuensi) * 100, 2)
)
distribusi_test_asli <- data_test %>%
count(status_diare, name = "frekuensi") %>%
mutate(
persen = round(frekuensi / sum(frekuensi) * 100, 2)
)
distribusi_train_sebelum_smote
distribusi_test_asli
# SMOTENC digunakan karena prediktor data model berbentuk kategorik/factor.
# Fungsi buat_smote() digunakan agar proses SMOTE konsisten pada modeling final
# dan tuning internal. Data testing tidak disentuh oleh SMOTE.
data_train_smote <- buat_smote(
data_input = data_train,
over_ratio = 1,
neighbors = 5,
seed_value = 123
)
# Samakan kembali level factor setelah SMOTENC.
# Tujuannya agar model yang dilatih pada data_train_smote mengenali
# seluruh level factor yang valid dari data training hasil recode.
data_train_smote <- samakan_level_factor(data_train, data_train_smote)
# Data testing tidak di-SMOTE dan tidak perlu di-bake karena tidak ada
# transformasi preprocessing lain dalam recipe selain SMOTE.
data_test_final <- samakan_level_factor(data_train_smote, data_test)
level_baru_test_final <- cek_level_factor_baru(data_train_smote, data_test_final)
level_baru_test_final
# Distribusi kelas setelah SMOTE.
distribusi_train_setelah_smote <- data_train_smote %>%
count(status_diare, name = "frekuensi") %>%
mutate(
persen = round(frekuensi / sum(frekuensi) * 100, 2)
)
distribusi_test_final <- data_test_final %>%
count(status_diare, name = "frekuensi") %>%
mutate(
persen = round(frekuensi / sum(frekuensi) * 100, 2)
)
distribusi_train_sebelum_smote
distribusi_train_setelah_smote
distribusi_test_final
# Dimensi data setelah SMOTE.
dim(data_train)
## [1] 13193 17
dim(data_train_smote)
## [1] 22616 17
dim(data_test)
## [1] 3297 17
dim(data_test_final)
## [1] 3297 17
jumlah_data_sintetis <- nrow(data_train_smote) - nrow(data_train)
jumlah_data_sintetis
## [1] 9423
# Cek missing value setelah SMOTE.
total_missing_train_smote <- sum(is.na(data_train_smote))
total_missing_test_final <- sum(is.na(data_test_final))
total_missing_train_smote
## [1] 0
total_missing_test_final
## [1] 0
missing_train_smote <- data.frame(
variabel = names(data_train_smote),
jumlah_na = sapply(data_train_smote, function(x) sum(is.na(x))),
persen_na = round(sapply(data_train_smote, function(x) mean(is.na(x)) * 100), 2)
)
missing_test_final <- data.frame(
variabel = names(data_test_final),
jumlah_na = sapply(data_test_final, function(x) sum(is.na(x))),
persen_na = round(sapply(data_test_final, function(x) mean(is.na(x)) * 100), 2)
)
missing_train_smote
missing_test_final
# Simpan objek RDS hasil SMOTE.
saveRDS(data_train_smote, "data_train_diare_smote.rds")
saveRDS(data_test_final, "data_test_diare_final.rds")
cat("============================================================\n")
## ============================================================
cat("RINGKASAN SMOTE / SMOTENC DATA DIARE ANAK\n")
## RINGKASAN SMOTE / SMOTENC DATA DIARE ANAK
cat("============================================================\n")
## ============================================================
cat("Jumlah data training sebelum SMOTE :", nrow(data_train), "\n")
## Jumlah data training sebelum SMOTE : 13193
cat("Jumlah data training setelah SMOTE :", nrow(data_train_smote), "\n")
## Jumlah data training setelah SMOTE : 22616
cat("Jumlah data sintetis yang dibuat :", jumlah_data_sintetis, "\n")
## Jumlah data sintetis yang dibuat : 9423
cat("Jumlah data testing asli :", nrow(data_test_final), "\n")
## Jumlah data testing asli : 3297
cat("============================================================\n")
## ============================================================
cat("\nDistribusi training sebelum SMOTE:\n")
##
## Distribusi training sebelum SMOTE:
print(distribusi_train_sebelum_smote)
## # A tibble: 2 × 3
## status_diare frekuensi persen
## <fct> <int> <dbl>
## 1 Tidak_Diare 11308 85.7
## 2 Diare 1885 14.3
cat("\nDistribusi training setelah SMOTE:\n")
##
## Distribusi training setelah SMOTE:
print(distribusi_train_setelah_smote)
## # A tibble: 2 × 3
## status_diare frekuensi persen
## <fct> <int> <dbl>
## 1 Tidak_Diare 11308 50
## 2 Diare 11308 50
cat("\nDistribusi testing tetap asli:\n")
##
## Distribusi testing tetap asli:
print(distribusi_test_final)
## # A tibble: 2 × 3
## status_diare frekuensi persen
## <fct> <int> <dbl>
## 1 Tidak_Diare 2826 85.7
## 2 Diare 471 14.3
12. Validasi Objek
Untuk Modeling Decision Tree
if (!exists("data_test_final")) {
data_test_final <- data_test
}
stopifnot(exists("data_train"))
stopifnot(exists("data_train_smote"))
stopifnot(exists("data_test_final"))
data_train <- data_train %>%
mutate(
status_diare = factor(status_diare, levels = c("Tidak_Diare", "Diare"))
)
data_train_smote <- data_train_smote %>%
mutate(
status_diare = factor(status_diare, levels = c("Tidak_Diare", "Diare"))
)
data_test_final <- data_test_final %>%
mutate(
status_diare = factor(status_diare, levels = c("Tidak_Diare", "Diare"))
)
table(data_train$status_diare)
##
## Tidak_Diare Diare
## 11308 1885
table(data_train_smote$status_diare)
##
## Tidak_Diare Diare
## 11308 11308
table(data_test_final$status_diare)
##
## Tidak_Diare Diare
## 2826 471
13. Split Internal
Untuk Tuning Parameter
# Data testing akhir tidak digunakan untuk tuning.
# Catatan: tuning memakai satu inner hold-out split, bukan cross-validation.
# Ini dapat ditulis sebagai limitasi pada laporan karena hasil tuning bisa
# sensitif terhadap pembagian train_inner dan valid_inner.
set.seed(123)
index_inner <- createDataPartition(
y = data_train$status_diare,
p = 0.80,
list = FALSE
)
train_inner <- data_train[index_inner, ]
valid_inner <- data_train[-index_inner, ]
# Samakan level factor pada split internal agar valid_inner tidak memiliki
# level factor yang dianggap baru oleh model dari train_inner.
train_inner <- samakan_level_factor(data_train, train_inner)
valid_inner <- samakan_level_factor(data_train, valid_inner)
# SMOTE hanya pada train_inner untuk proses tuning.
train_inner_smote <- buat_smote(
data_input = train_inner,
over_ratio = 1,
neighbors = 5,
seed_value = 123
)
train_inner_smote <- samakan_level_factor(train_inner, train_inner_smote)
valid_inner <- samakan_level_factor(train_inner_smote, valid_inner)
level_baru_valid_inner <- cek_level_factor_baru(train_inner_smote, valid_inner)
level_baru_valid_inner
table(train_inner$status_diare)
##
## Tidak_Diare Diare
## 9047 1508
table(train_inner_smote$status_diare)
##
## Tidak_Diare Diare
## 9047 9047
table(valid_inner$status_diare)
##
## Tidak_Diare Diare
## 2261 377
14. Tuning Parameter
Dengan Grid Search
# Catatan penting:
# Tuning dilakukan hanya menggunakan data training melalui split internal.
# Data testing tidak digunakan untuk memilih metode tuning atau parameter.
grid_param <- expand.grid(
cp = c(0.0001, 0.0005, 0.001, 0.002, 0.005, 0.01),
maxdepth = c(3, 5, 7, 10),
minsplit = c(20, 50, 100),
minbucket = c(7, 15, 30)
)
grid_param <- grid_param %>%
filter(minsplit >= 2 * minbucket)
nrow(grid_param)
## [1] 144
if (nrow(grid_param) == 0) {
stop("Grid parameter kosong setelah filter minsplit >= 2 * minbucket.")
}
grid_results <- data.frame()
set.seed(123)
for (i in 1:nrow(grid_param)) {
param <- grid_param[i, ]
model_temp <- tryCatch(
{
train_dt(
data_train_input = train_inner_smote,
cp = param$cp,
maxdepth = param$maxdepth,
minsplit = param$minsplit,
minbucket = param$minbucket
)
},
error = function(e) NULL
)
if (!is.null(model_temp)) {
metrik_temp <- ambil_metrik(
model = model_temp,
data_eval = valid_inner,
nama_model = "Grid_Search"
)
metrik_temp <- cbind(param, metrik_temp)
grid_results <- bind_rows(grid_results, metrik_temp)
}
}
if (nrow(grid_results) == 0) {
stop("Grid search gagal: tidak ada model yang berhasil dilatih.")
}
grid_results <- grid_results %>%
arrange(
desc(F1_Diare),
desc(Recall_Diare),
desc(Balanced_Accuracy),
desc(Accuracy),
maxdepth,
desc(cp),
desc(minsplit)
)
best_grid <- grid_results[1, ]
best_grid
15. Tuning Parameter
Dengan Random Search
set.seed(123)
n_iter_random <- 80
random_param <- data.frame(
cp = 10 ^ runif(n_iter_random, log10(0.0001), log10(0.05)),
maxdepth = sample(2:15, n_iter_random, replace = TRUE),
minsplit = sample(seq(20, 300, by = 10), n_iter_random, replace = TRUE),
minbucket = sample(seq(5, 80, by = 5), n_iter_random, replace = TRUE)
)
random_param <- random_param %>%
mutate(
minbucket = pmin(minbucket, floor(minsplit / 2)),
minbucket = pmax(minbucket, 1)
) %>%
distinct()
nrow(random_param)
## [1] 80
if (nrow(random_param) == 0) {
stop("Random parameter kosong setelah distinct/filter parameter.")
}
random_results <- data.frame()
for (i in 1:nrow(random_param)) {
param <- random_param[i, ]
model_temp <- tryCatch(
{
train_dt(
data_train_input = train_inner_smote,
cp = param$cp,
maxdepth = param$maxdepth,
minsplit = param$minsplit,
minbucket = param$minbucket
)
},
error = function(e) NULL
)
if (!is.null(model_temp)) {
metrik_temp <- ambil_metrik(
model = model_temp,
data_eval = valid_inner,
nama_model = "Random_Search"
)
metrik_temp <- cbind(param, metrik_temp)
random_results <- bind_rows(random_results, metrik_temp)
}
}
if (nrow(random_results) == 0) {
stop("Random search gagal: tidak ada model yang berhasil dilatih.")
}
random_results <- random_results %>%
arrange(
desc(F1_Diare),
desc(Recall_Diare),
desc(Balanced_Accuracy),
desc(Accuracy),
maxdepth,
desc(cp),
desc(minsplit)
)
best_random <- random_results[1, ]
best_random
16. Pemilihan Model
Akhir Berdasarkan Validasi Internal
# Model akhir dipilih hanya berdasarkan performa validasi internal.
# Data testing belum digunakan pada tahap ini.
# Jika performa sama, digunakan tie-break berbasis kesederhanaan model:
# 1. maxdepth lebih kecil,
# 2. cp lebih besar,
# 3. minsplit lebih besar.
hasil_validasi_tuning <- bind_rows(
best_grid %>%
mutate(Metode_Tuning = "Grid Search"),
best_random %>%
mutate(Metode_Tuning = "Random Search")
) %>%
select(
Metode_Tuning,
cp, maxdepth, minsplit, minbucket,
Accuracy, Kappa, Precision_Diare, Recall_Diare,
F1_Diare, Balanced_Accuracy
) %>%
arrange(
desc(F1_Diare),
desc(Recall_Diare),
desc(Balanced_Accuracy),
desc(Accuracy),
maxdepth,
desc(cp),
desc(minsplit)
)
hasil_validasi_tuning
metode_tuning_terbaik <- hasil_validasi_tuning[1, ]
metode_tuning_terbaik
nama_tuning_terbaik <- metode_tuning_terbaik$Metode_Tuning
nama_tuning_terbaik
## [1] "Random Search"
parameter_terbaik <- metode_tuning_terbaik %>%
select(cp, maxdepth, minsplit, minbucket)
if (nama_tuning_terbaik == "Grid Search") {
nama_model_terbaik <- "Decision_Tree_Grid_Search"
} else if (nama_tuning_terbaik == "Random Search") {
nama_model_terbaik <- "Decision_Tree_Random_Search"
} else {
stop("Metode tuning terbaik tidak dikenali.")
}
parameter_terbaik
nama_model_terbaik
## [1] "Decision_Tree_Random_Search"
cat("============================================================\n")
## ============================================================
cat("RINGKASAN PEMILIHAN MODEL BERDASARKAN VALIDASI INTERNAL\n")
## RINGKASAN PEMILIHAN MODEL BERDASARKAN VALIDASI INTERNAL
cat("============================================================\n")
## ============================================================
cat("Metode tuning terpilih:", nama_model_terbaik, "\n")
## Metode tuning terpilih: Decision_Tree_Random_Search
cat("Parameter terbaik:\n")
## Parameter terbaik:
print(parameter_terbaik)
## cp maxdepth minsplit minbucket
## 1 0.0382353 2 270 45
cat("\nCatatan:\n")
##
## Catatan:
cat("Data testing tidak digunakan untuk memilih metode tuning atau parameter.\n")
## Data testing tidak digunakan untuk memilih metode tuning atau parameter.
cat("Jika performa validasi sama, model yang lebih sederhana dipilih.\n")
## Jika performa validasi sama, model yang lebih sederhana dipilih.
cat("============================================================\n")
## ============================================================
17. Latih Model Akhir
Dan Evaluasi Satu Kali Pada Data Testing
# Model akhir dilatih ulang menggunakan seluruh data training hasil SMOTE,
# lalu dievaluasi satu kali pada data testing asli.
# Tidak ada perbandingan beberapa model pada data testing.
model_terbaik <- train_dt(
data_train_input = data_train_smote,
cp = parameter_terbaik$cp,
maxdepth = parameter_terbaik$maxdepth,
minsplit = parameter_terbaik$minsplit,
minbucket = parameter_terbaik$minbucket
)
hasil_model_akhir_test <- ambil_metrik(
model = model_terbaik,
data_eval = data_test_final,
nama_model = nama_model_terbaik
)
hasil_model_akhir_test
18. Confusion Matrix
Model Akhir
pred_model_akhir <- predict(
model_terbaik,
newdata = data_test_final,
type = "class"
)
pred_model_akhir <- factor(
pred_model_akhir,
levels = c("Tidak_Diare", "Diare")
)
confusion_model_akhir <- confusionMatrix(
data = pred_model_akhir,
reference = data_test_final$status_diare,
positive = "Diare",
mode = "everything"
)
confusion_model_akhir
## Confusion Matrix and Statistics
##
## Reference
## Prediction Tidak_Diare Diare
## Tidak_Diare 2806 251
## Diare 20 220
##
## Accuracy : 0.9178
## 95% CI : (0.9079, 0.927)
## No Information Rate : 0.8571
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.5782
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 0.46709
## Specificity : 0.99292
## Pos Pred Value : 0.91667
## Neg Pred Value : 0.91789
## Precision : 0.91667
## Recall : 0.46709
## F1 : 0.61885
## Prevalence : 0.14286
## Detection Rate : 0.06673
## Detection Prevalence : 0.07279
## Balanced Accuracy : 0.73001
##
## 'Positive' Class : Diare
##
19. Cek Overfitting
Model Akhir
# Overfitting dicek hanya untuk model akhir yang dipilih dari validasi internal.
# Data training yang dipakai untuk pembanding adalah data_train asli
# agar distribusinya sama-sama tidak disintesis seperti data testing.
hasil_model_akhir_train <- ambil_metrik(
model = model_terbaik,
data_eval = data_train,
nama_model = nama_model_terbaik
)
overfit_check_model_akhir <- hasil_model_akhir_train %>%
select(
Model,
Accuracy_Train_Asli = Accuracy,
F1_Train_Asli = F1_Diare,
Recall_Train_Asli = Recall_Diare,
Balanced_Accuracy_Train_Asli = Balanced_Accuracy
) %>%
left_join(
hasil_model_akhir_test %>%
select(
Model,
Accuracy_Test = Accuracy,
F1_Test = F1_Diare,
Recall_Test = Recall_Diare,
Balanced_Accuracy_Test = Balanced_Accuracy
),
by = "Model"
) %>%
mutate(
Gap_Accuracy = Accuracy_Train_Asli - Accuracy_Test,
Gap_F1 = F1_Train_Asli - F1_Test,
Gap_Recall = Recall_Train_Asli - Recall_Test,
Gap_Balanced_Accuracy = Balanced_Accuracy_Train_Asli - Balanced_Accuracy_Test,
Interpretasi_Overfit = case_when(
Gap_F1 > 0.10 | Gap_Accuracy > 0.10 ~ "Indikasi overfitting",
Gap_F1 < -0.10 | Gap_Accuracy < -0.10 ~ "Performa test lebih tinggi / tidak overfit",
TRUE ~ "Tidak ada indikasi overfitting kuat"
)
)
overfit_check_model_akhir
20. Visualisasi Model
Akhir Dan Variable Importance
# Visualisasi pohon model akhir.
rpart.plot(
model_terbaik,
type = 2,
extra = 104,
fallen.leaves = TRUE,
roundint = FALSE,
faclen = 4,
varlen = 0,
cex = 0.6,
main = paste("Decision Tree Akhir -", nama_model_terbaik)
)
# ------------------------------------------------------------
20A. Variable
importance variabel yang digunakan dalam split
# ------------------------------------------------------------
# Objek model_terbaik$variable.importance dari rpart hanya menampilkan
# variabel yang berkontribusi pada split pohon. Variabel lain tidak muncul.
if (!is.null(model_terbaik$variable.importance)) {
importance_model_terbaik <- data.frame(
variabel = names(model_terbaik$variable.importance),
importance = as.numeric(model_terbaik$variable.importance),
row.names = NULL
) %>%
arrange(desc(importance))
} else {
importance_model_terbaik <- data.frame(
variabel = character(),
importance = numeric()
)
cat("Variable importance tidak tersedia karena pohon tidak membentuk split.\n")
}
importance_model_terbaik
# ------------------------------------------------------------
20B. Variable
importance seluruh variabel prediktor
# ------------------------------------------------------------
# Bagian ini menampilkan semua prediktor yang masuk ke model akhir.
# Prediktor yang tidak digunakan dalam split pohon diberi nilai importance = 0.
# Daftar seluruh prediktor yang digunakan dalam model akhir.
daftar_prediktor_model_akhir <- setdiff(names(data_train), "status_diare")
importance_semua_variabel <- data.frame(
variabel = daftar_prediktor_model_akhir
) %>%
left_join(
importance_model_terbaik,
by = "variabel"
) %>%
mutate(
importance = ifelse(is.na(importance), 0, importance),
proporsi_importance = ifelse(
sum(importance) > 0,
importance / sum(importance),
0
),
persen_importance = round(proporsi_importance * 100, 2),
digunakan_dalam_pohon = ifelse(importance > 0, "Ya", "Tidak")
) %>%
arrange(desc(importance), variabel)
importance_semua_variabel
# ------------------------------------------------------------
20C. Pemeriksaan
khusus dominasi tahu_ors
# ------------------------------------------------------------
# tahu_ors tetap digunakan tanpa penalti. Jika variabel ini dominan,
# hasilnya harus dibahas sebagai interpretasi model, bukan hubungan kausal.
importance_tahu_ors <- importance_semua_variabel %>%
filter(variabel == "tahu_ors")
importance_tahu_ors
if (nrow(importance_tahu_ors) > 0) {
cat("Persentase importance tahu_ors:",
importance_tahu_ors$persen_importance, "%\n")
if (importance_tahu_ors$persen_importance >= 80) {
cat("Interpretasi: tahu_ors masih sangat dominan dalam model akhir.\n")
} else if (importance_tahu_ors$persen_importance >= 50) {
cat("Interpretasi: tahu_ors masih dominan, tetapi tidak sepenuhnya tunggal.\n")
} else if (importance_tahu_ors$persen_importance > 0) {
cat("Interpretasi: tahu_ors digunakan, tetapi dominasinya relatif lebih terkendali.\n")
} else {
cat("Interpretasi: tahu_ors tidak digunakan sebagai split dalam pohon akhir.\n")
}
} else {
cat("Variabel tahu_ors tidak ditemukan dalam daftar prediktor model akhir.\n")
}
## Persentase importance tahu_ors: 0 %
## Interpretasi: tahu_ors tidak digunakan sebagai split dalam pohon akhir.
# ------------------------------------------------------------
20D. Grafik variable
importance seluruh prediktor
# ------------------------------------------------------------
ggplot(
importance_semua_variabel,
aes(x = reorder(variabel, importance), y = importance)
) +
geom_col() +
coord_flip() +
labs(
title = paste("Variable Importance Seluruh Prediktor -", nama_model_terbaik),
subtitle = "Variabel dengan importance 0 tidak digunakan dalam split pohon akhir",
x = "Variabel Prediktor",
y = "Importance"
)
# Grafik dalam bentuk persentase agar lebih mudah dibaca pada laporan.
ggplot(
importance_semua_variabel,
aes(x = reorder(variabel, persen_importance), y = persen_importance)
) +
geom_col() +
coord_flip() +
labs(
title = paste("Persentase Variable Importance Seluruh Prediktor -", nama_model_terbaik),
subtitle = "Variabel dengan nilai 0 tidak digunakan dalam split pohon akhir",
x = "Variabel Prediktor",
y = "Persentase Importance (%)"
)
# ------------------------------------------------------------
20E. Ringkasan
variable importance untuk laporan
# ------------------------------------------------------------
cat("============================================================\n")
## ============================================================
cat("RINGKASAN VARIABLE IMPORTANCE MODEL AKHIR\n")
## RINGKASAN VARIABLE IMPORTANCE MODEL AKHIR
cat("============================================================\n")
## ============================================================
cat("Model akhir:", nama_model_terbaik, "\n")
## Model akhir: Decision_Tree_Random_Search
cat("Jumlah prediktor total :", length(daftar_prediktor_model_akhir), "\n")
## Jumlah prediktor total : 16
cat("Jumlah prediktor terpakai :", sum(importance_semua_variabel$importance > 0), "\n")
## Jumlah prediktor terpakai : 1
cat("Jumlah prediktor tidak terpakai:", sum(importance_semua_variabel$importance == 0), "\n")
## Jumlah prediktor tidak terpakai: 15
cat("\nLima variabel dengan importance tertinggi:\n")
##
## Lima variabel dengan importance tertinggi:
print(head(importance_semua_variabel, 5))
## variabel importance proporsi_importance persen_importance
## 1 tahu_ors 3210.753 0 0
## 2 asuransi_kesehatan 0.000 0 0
## 3 bahan_bakar_memasak 0.000 0 0
## 4 indeks_kekayaan 0.000 0 0
## 5 jenis_kelamin_anak 0.000 0 0
## digunakan_dalam_pohon
## 1 Ya
## 2 Tidak
## 3 Tidak
## 4 Tidak
## 5 Tidak
cat("\nImportance tahu_ors:\n")
##
## Importance tahu_ors:
print(importance_tahu_ors)
## variabel importance proporsi_importance persen_importance
## 1 tahu_ors 3210.753 0 0
## digunakan_dalam_pohon
## 1 Ya
cat("============================================================\n")
## ============================================================
# Catatan ini bukan output numerik, tetapi pengingat agar interpretasi laporan
# tidak menyatakan tahu_ors sebagai penyebab langsung diare.
cat("\nCatatan interpretasi tahu_ors:\n")
##
## Catatan interpretasi tahu_ors:
cat("Variabel tahu_ors tetap digunakan tanpa penalti.\n")
## Variabel tahu_ors tetap digunakan tanpa penalti.
cat("Jika tahu_ors menjadi variabel paling dominan, hasil ini tidak ditafsirkan secara kausal.\n")
## Jika tahu_ors menjadi variabel paling dominan, hasil ini tidak ditafsirkan secara kausal.
cat("Penggunaan atau pengetahuan ORS dapat berkaitan dengan pengalaman diare anak sebelumnya.\n")
## Penggunaan atau pengetahuan ORS dapat berkaitan dengan pengalaman diare anak sebelumnya.
cat("Karena itu, dominasi tahu_ors dibahas sebagai keterbatasan interpretasi model.\n")
## Karena itu, dominasi tahu_ors dibahas sebagai keterbatasan interpretasi model.
21. Grafik Hasil
Tuning Dan Evaluasi Model Akhir
# Grafik tuning berasal dari validasi internal pada data training.
# Data testing hanya digunakan pada grafik evaluasi satu model akhir.
# Grafik Grid Search: cp vs F1-score.
ggplot(grid_results, aes(x = cp, y = F1_Diare)) +
geom_point(alpha = 0.4) +
stat_summary(
fun = max,
geom = "line",
linewidth = 0.8,
aes(group = 1)
) +
scale_x_log10() +
labs(
title = "Grid Search: cp vs F1-score pada Validasi Internal",
subtitle = "Garis menunjukkan nilai F1 maksimum pada setiap cp",
x = "cp (log scale)",
y = "F1-score Kelas Diare"
)
# Grafik Random Search: cp vs F1-score.
ggplot(random_results, aes(x = cp, y = F1_Diare)) +
geom_point(alpha = 0.5) +
scale_x_log10() +
labs(
title = "Random Search: cp vs F1-score pada Validasi Internal",
x = "cp (log scale)",
y = "F1-score Kelas Diare"
)
# Grafik Grid Search: cp vs Accuracy.
ggplot(grid_results, aes(x = cp, y = Accuracy)) +
geom_point(alpha = 0.4) +
stat_summary(
fun = max,
geom = "line",
linewidth = 0.8,
aes(group = 1)
) +
scale_x_log10() +
labs(
title = "Grid Search: cp vs Accuracy pada Validasi Internal",
subtitle = "Garis menunjukkan accuracy maksimum pada setiap cp",
x = "cp (log scale)",
y = "Accuracy"
)
# Grafik Random Search: cp vs Accuracy.
ggplot(random_results, aes(x = cp, y = Accuracy)) +
geom_point(alpha = 0.5) +
scale_x_log10() +
labs(
title = "Random Search: cp vs Accuracy pada Validasi Internal",
x = "cp (log scale)",
y = "Accuracy"
)
# Grafik evaluasi model akhir pada data testing.
hasil_model_akhir_long <- hasil_model_akhir_test %>%
select(
Model,
Accuracy,
Precision_Diare,
Recall_Diare,
F1_Diare,
Balanced_Accuracy
) %>%
pivot_longer(
cols = -Model,
names_to = "Metrik",
values_to = "Nilai"
)
ggplot(
hasil_model_akhir_long,
aes(x = Metrik, y = Nilai)
) +
geom_col() +
labs(
title = "Evaluasi Model Akhir Decision Tree pada Data Testing",
subtitle = paste("Model akhir:", nama_model_terbaik),
x = "Metrik Evaluasi",
y = "Nilai"
) +
theme(axis.text.x = element_text(angle = 30, hjust = 1))
22. Simpan Objek Hasil
Modeling
saveRDS(model_terbaik, "model_dt_akhir_terpilih.rds")
saveRDS(hasil_validasi_tuning, "hasil_validasi_tuning.rds")
saveRDS(hasil_model_akhir_test, "hasil_model_akhir_test.rds")
saveRDS(confusion_model_akhir, "confusion_model_akhir.rds")
saveRDS(overfit_check_model_akhir, "overfit_check_model_akhir.rds")
saveRDS(importance_semua_variabel, "importance_semua_variabel_model_akhir.rds")
saveRDS(importance_tahu_ors, "importance_tahu_ors_model_akhir.rds")
write.csv(
importance_semua_variabel,
"importance_semua_variabel_model_akhir.csv",
row.names = FALSE
)
cat("============================================================\n")
## ============================================================
cat("RINGKASAN MODEL DECISION TREE AKHIR\n")
## RINGKASAN MODEL DECISION TREE AKHIR
cat("============================================================\n")
## ============================================================
cat("Model akhir dipilih berdasarkan validasi internal :", nama_model_terbaik, "\n")
## Model akhir dipilih berdasarkan validasi internal : Decision_Tree_Random_Search
cat("\nVariabel prediktor yang dihapus otomatis karena asosiasi tinggi:\n")
##
## Variabel prediktor yang dihapus otomatis karena asosiasi tinggi:
print(variabel_dihapus_asosiasi)
## character(0)
cat("\nVariabel prediktor yang digunakan dalam model akhir:\n")
##
## Variabel prediktor yang digunakan dalam model akhir:
print(setdiff(names(data_train), "status_diare"))
## [1] "jenis_kelamin_anak" "pendidikan_ibu"
## [3] "indeks_kekayaan" "provinsi"
## [5] "wilayah_tinggal" "sumber_air_minum"
## [7] "jenis_toilet" "material_lantai"
## [9] "material_dinding" "material_atap"
## [11] "bahan_bakar_memasak" "tahu_ors"
## [13] "asuransi_kesehatan" "kelompok_umur_anak"
## [15] "kelompok_urutan_kelahiran" "kelompok_umur_ibu"
cat("\nParameter terbaik berdasarkan validasi internal:\n")
##
## Parameter terbaik berdasarkan validasi internal:
print(parameter_terbaik)
## cp maxdepth minsplit minbucket
## 1 0.0382353 2 270 45
cat("\nPerforma model akhir pada data testing:\n")
##
## Performa model akhir pada data testing:
print(hasil_model_akhir_test)
## Model Accuracy Kappa Precision_Diare Recall_Diare
## 1 Decision_Tree_Random_Search 0.9178041 0.5781632 0.9166667 0.4670913
## Specificity F1_Diare Balanced_Accuracy
## 1 0.9929229 0.6188467 0.7300071
cat("\nConfusion matrix model akhir:\n")
##
## Confusion matrix model akhir:
print(confusion_model_akhir)
## Confusion Matrix and Statistics
##
## Reference
## Prediction Tidak_Diare Diare
## Tidak_Diare 2806 251
## Diare 20 220
##
## Accuracy : 0.9178
## 95% CI : (0.9079, 0.927)
## No Information Rate : 0.8571
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.5782
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 0.46709
## Specificity : 0.99292
## Pos Pred Value : 0.91667
## Neg Pred Value : 0.91789
## Precision : 0.91667
## Recall : 0.46709
## F1 : 0.61885
## Prevalence : 0.14286
## Detection Rate : 0.06673
## Detection Prevalence : 0.07279
## Balanced Accuracy : 0.73001
##
## 'Positive' Class : Diare
##
cat("\nCek overfitting model akhir:\n")
##
## Cek overfitting model akhir:
print(overfit_check_model_akhir)
## Model Accuracy_Train_Asli F1_Train_Asli
## 1 Decision_Tree_Random_Search 0.9148791 0.6021962
## Recall_Train_Asli Balanced_Accuracy_Train_Asli Accuracy_Test F1_Test
## 1 0.4509284 0.7215731 0.9178041 0.6188467
## Recall_Test Balanced_Accuracy_Test Gap_Accuracy Gap_F1 Gap_Recall
## 1 0.4670913 0.7300071 -0.002924962 -0.01665045 -0.01616291
## Gap_Balanced_Accuracy Interpretasi_Overfit
## 1 -0.008433937 Tidak ada indikasi overfitting kuat
cat("\nRingkasan variable importance seluruh prediktor:\n")
##
## Ringkasan variable importance seluruh prediktor:
print(importance_semua_variabel)
## variabel importance proporsi_importance persen_importance
## 1 tahu_ors 3210.753 0 0
## 2 asuransi_kesehatan 0.000 0 0
## 3 bahan_bakar_memasak 0.000 0 0
## 4 indeks_kekayaan 0.000 0 0
## 5 jenis_kelamin_anak 0.000 0 0
## 6 jenis_toilet 0.000 0 0
## 7 kelompok_umur_anak 0.000 0 0
## 8 kelompok_umur_ibu 0.000 0 0
## 9 kelompok_urutan_kelahiran 0.000 0 0
## 10 material_atap 0.000 0 0
## 11 material_dinding 0.000 0 0
## 12 material_lantai 0.000 0 0
## 13 pendidikan_ibu 0.000 0 0
## 14 provinsi 0.000 0 0
## 15 sumber_air_minum 0.000 0 0
## 16 wilayah_tinggal 0.000 0 0
## digunakan_dalam_pohon
## 1 Ya
## 2 Tidak
## 3 Tidak
## 4 Tidak
## 5 Tidak
## 6 Tidak
## 7 Tidak
## 8 Tidak
## 9 Tidak
## 10 Tidak
## 11 Tidak
## 12 Tidak
## 13 Tidak
## 14 Tidak
## 15 Tidak
## 16 Tidak
cat("\nRingkasan importance tahu_ors:\n")
##
## Ringkasan importance tahu_ors:
print(importance_tahu_ors)
## variabel importance proporsi_importance persen_importance
## 1 tahu_ors 3210.753 0 0
## digunakan_dalam_pohon
## 1 Ya
cat("============================================================\n")
## ============================================================
cat("Catatan metodologis:\n")
## Catatan metodologis:
cat("Data testing hanya digunakan untuk evaluasi satu model akhir.\n")
## Data testing hanya digunakan untuk evaluasi satu model akhir.
cat("Data testing tidak digunakan untuk memilih model, parameter, atau variabel.\n")
## Data testing tidak digunakan untuk memilih model, parameter, atau variabel.
cat("============================================================\n")
## ============================================================