## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.0 ✔ readr 2.2.0
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.2 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
## Warning: package 'caret' was built under R version 4.5.3
## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## lift
## Warning: package 'doParallel' was built under R version 4.5.3
## Loading required package: foreach
##
## Attaching package: 'foreach'
##
## The following objects are masked from 'package:purrr':
##
## accumulate, when
##
## Loading required package: iterators
## Loading required package: parallel
## Warning: package 'ranger' was built under R version 4.5.3
PERSIAPAN DATA DASAR
df <- read.csv("dataset_A.csv", stringsAsFactors = TRUE)
df_clean <- df %>%
distinct() %>%
mutate(across(where(is.factor), ~na_if(as.character(.), "unknown"))) %>%
drop_na() %>%
mutate(education = ifelse(grepl("basic", education), "basic", education)) %>%
mutate(
previous_contact = ifelse(pdays != 999, 1, 0),
previous_contact = as.factor(previous_contact)
) %>%
select(-pdays, -duration) %>%
mutate(y = as.factor(y)) %>%
mutate(year = case_when(
emp.var.rate > 0 ~ 2008,
emp.var.rate <= 0 & emp.var.rate > -2 ~ 2009,
emp.var.rate <= -2 ~ 2010
)) %>%
mutate(year = as.factor(year)) %>%
mutate(across(where(is.character), as.factor))
DUMMY ENCODING & HAPUS NZV
dummies <- dummyVars(~ ., data = df_clean %>% select(-y))
df_base <- as.data.frame(predict(dummies, newdata = df_clean))
df_base$y <- df_clean$y
nzv_cols <- nearZeroVar(df_base)
if(length(nzv_cols) > 0) {
df_base <- df_base[, -nzv_cols]
}
MEMBUAT DUA VERSI DATASET
# Versi 1: Multikolinearitas tak Dihapus
data_keep_all <- df_base
# DATA DIHAPUS KORELASINYA (Multikolinearitas Dihapus > 0.90)
corr_matrix <- cor(df_base %>% select(where(is.numeric)))
highlyCorDescr <- findCorrelation(corr_matrix, cutoff = 0.90)
data_dropped <- df_base[, -highlyCorDescr]
cat("\nJumlah Fitur (Tidak Dihapus):", ncol(data_keep_all) - 1)
##
## Jumlah Fitur (Tidak Dihapus): 42
cat("\nJumlah Fitur (Dihapus):", ncol(data_dropped) - 1, "\n")
##
## Jumlah Fitur (Dihapus): 34
SPLIT DATA
set.seed(16)
train_idx <- createDataPartition(df_base$y, p = 0.8, list = FALSE)
train_keep <- data_keep_all[train_idx, ]
valid_keep <- data_keep_all[-train_idx, ]
train_drop <- data_dropped[train_idx, ]
valid_drop <- data_dropped[-train_idx, ]
TRAINING KEDUA MODEL
# Parallel Processing untuk mempercepat
cl <- makePSOCKcluster(detectCores() - 1)
registerDoParallel(cl)
train_control <- trainControl(method = 'cv', number = 3, classProbs = TRUE,
summaryFunction = twoClassSummary, sampling = "down")
cat("\n--- Melatih Model 1: Multikolinearitas TIDAK Dihapus ---\n")
##
## --- Melatih Model 1: Multikolinearitas TIDAK Dihapus ---
set.seed(16)
time_keep <- system.time({
rf_keep <- train(y ~ ., data = train_keep, method = 'ranger',
metric = 'ROC', trControl = train_control,
importance = 'impurity', num.threads = 1)
})
cat("--- Melatih Model 2: Multikolinearitas DIHAPUS ---\n")
## --- Melatih Model 2: Multikolinearitas DIHAPUS ---
set.seed(16)
time_drop <- system.time({
rf_drop <- train(y ~ ., data = train_drop, method = 'ranger',
metric = 'ROC', trControl = train_control,
importance = 'impurity', num.threads = 1)
})
stopCluster(cl)
registerDoSEQ()
EVALUASI DAN PERBANDINGAN
# Membuat fungsi Evaluasi
evaluate_model_tuned <- function(model, valid_data, model_name) {
# Ekstrak probabilitas tebakan "yes"
probs <- predict(model, newdata = valid_data, type = "prob")[, "yes"]
actual_yes <- valid_data$y == "yes"
best_f1 <- 0
best_th <- 0.5
best_metrics <- data.frame()
# Looping threshold optimal dari 0.30 s/d 0.85
for(th in seq(0.30, 0.85, by = 0.02)) {
pred_yes <- probs >= th
tp <- sum(pred_yes & actual_yes, na.rm = TRUE)
fp <- sum(pred_yes & !actual_yes, na.rm = TRUE)
fn <- sum(!pred_yes & actual_yes, na.rm = TRUE)
tn <- sum(!pred_yes & !actual_yes, na.rm = TRUE)
prec <- ifelse((tp + fp) == 0, 0, tp / (tp + fp))
rec <- ifelse((tp + fn) == 0, 0, tp / (tp + fn))
f1_val <- ifelse((prec + rec) == 0, 0, 2 * (prec * rec) / (prec + rec))
# Simpan jika F1-Score ini adalah yang tertinggi sementara
if(!is.na(f1_val) && f1_val > best_f1) {
best_f1 <- f1_val
best_th <- th
acc <- (tp + tn) / length(actual_yes)
best_metrics <- data.frame(
Skenario = model_name,
Optimal_Threshold = best_th,
Accuracy = round(acc, 4),
Sensitivity = round(rec, 4),
Precision = round(prec, 4),
F1_Score = round(f1_val, 8)
)
}
}
return(best_metrics)
}
# Evaluasi kedua model
res_keep <- evaluate_model_tuned(rf_keep, valid_keep, "1. TIDAK Dihapus (Semua Fitur)")
res_drop <- evaluate_model_tuned(rf_drop, valid_drop, "2. DIHAPUS (Bebas Korelasi > 0.9)")
perbandingan <- bind_rows(res_keep, res_drop)
# Menampilkan Hasil
print(perbandingan)
## Skenario Optimal_Threshold Accuracy Sensitivity
## 1 1. TIDAK Dihapus (Semua Fitur) 0.68 0.8506 0.5812
## 2 2. DIHAPUS (Bebas Korelasi > 0.9) 0.60 0.8363 0.6209
## Precision F1_Score
## 1 0.4598 0.5134189
## 2 0.4284 0.5070119
cat("\n--- Waktu Komputasi (Detik) ---\n")
##
## --- Waktu Komputasi (Detik) ---
cat("Tidak Dihapus :", round(time_keep["elapsed"], 2), "detik\n")
## Tidak Dihapus : 24.5 detik
cat("Dihapus :", round(time_drop["elapsed"], 2), "detik\n")
## Dihapus : 16.84 detik