# =========================================================
# 1.1 MEMBACA DATA
# =========================================================
data <- read.csv(
"C:/Users/USER/Downloads/bank+marketing (1)/bank-additional/bank-additional/bank-additional-full.csv",
sep = ";",
stringsAsFactors = FALSE
)
# Ukuran data
dim(data)## [1] 41188 21# Struktur data
str(data)## 'data.frame': 41188 obs. of 21 variables:
## $ age : int 56 57 37 40 56 45 59 41 24 25 ...
## $ job : chr "housemaid" "services" "services" "admin." ...
## $ marital : chr "married" "married" "married" "married" ...
## $ education : chr "basic.4y" "high.school" "high.school" "basic.6y" ...
## $ default : chr "no" "unknown" "no" "no" ...
## $ housing : chr "no" "no" "yes" "no" ...
## $ loan : chr "no" "no" "no" "no" ...
## $ contact : chr "telephone" "telephone" "telephone" "telephone" ...
## $ month : chr "may" "may" "may" "may" ...
## $ day_of_week : chr "mon" "mon" "mon" "mon" ...
## $ duration : int 261 149 226 151 307 198 139 217 380 50 ...
## $ campaign : int 1 1 1 1 1 1 1 1 1 1 ...
## $ pdays : int 999 999 999 999 999 999 999 999 999 999 ...
## $ previous : int 0 0 0 0 0 0 0 0 0 0 ...
## $ poutcome : chr "nonexistent" "nonexistent" "nonexistent" "nonexistent" ...
## $ emp.var.rate : num 1.1 1.1 1.1 1.1 1.1 1.1 1.1 1.1 1.1 1.1 ...
## $ cons.price.idx: num 94 94 94 94 94 ...
## $ cons.conf.idx : num -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 ...
## $ euribor3m : num 4.86 4.86 4.86 4.86 4.86 ...
## $ nr.employed : num 5191 5191 5191 5191 5191 ...
## $ y : chr "no" "no" "no" "no" ...# Nama variabel
names(data)## [1] "age" "job" "marital" "education"
## [5] "default" "housing" "loan" "contact"
## [9] "month" "day_of_week" "duration" "campaign"
## [13] "pdays" "previous" "poutcome" "emp.var.rate"
## [17] "cons.price.idx" "cons.conf.idx" "euribor3m" "nr.employed"
## [21] "y"# Enam observasi pertama
head(data)## age job marital education default housing loan contact month
## 1 56 housemaid married basic.4y no no no telephone may
## 2 57 services married high.school unknown no no telephone may
## 3 37 services married high.school no yes no telephone may
## 4 40 admin. married basic.6y no no no telephone may
## 5 56 services married high.school no no yes telephone may
## 6 45 services married basic.9y unknown no no telephone may
## day_of_week duration campaign pdays previous poutcome emp.var.rate
## 1 mon 261 1 999 0 nonexistent 1.1
## 2 mon 149 1 999 0 nonexistent 1.1
## 3 mon 226 1 999 0 nonexistent 1.1
## 4 mon 151 1 999 0 nonexistent 1.1
## 5 mon 307 1 999 0 nonexistent 1.1
## 6 mon 198 1 999 0 nonexistent 1.1
## cons.price.idx cons.conf.idx euribor3m nr.employed y
## 1 93.994 -36.4 4.857 5191 no
## 2 93.994 -36.4 4.857 5191 no
## 3 93.994 -36.4 4.857 5191 no
## 4 93.994 -36.4 4.857 5191 no
## 5 93.994 -36.4 4.857 5191 no
## 6 93.994 -36.4 4.857 5191 no# =========================================================
# 1.2 PEMERIKSAAN AWAL
# =========================================================
# Jumlah baris dan kolom
cat("Jumlah observasi :", nrow(data), "\n")## Jumlah observasi : 41188cat("Jumlah variabel :", ncol(data), "\n")## Jumlah variabel : 21# Struktur
str(data)## 'data.frame': 41188 obs. of 21 variables:
## $ age : int 56 57 37 40 56 45 59 41 24 25 ...
## $ job : chr "housemaid" "services" "services" "admin." ...
## $ marital : chr "married" "married" "married" "married" ...
## $ education : chr "basic.4y" "high.school" "high.school" "basic.6y" ...
## $ default : chr "no" "unknown" "no" "no" ...
## $ housing : chr "no" "no" "yes" "no" ...
## $ loan : chr "no" "no" "no" "no" ...
## $ contact : chr "telephone" "telephone" "telephone" "telephone" ...
## $ month : chr "may" "may" "may" "may" ...
## $ day_of_week : chr "mon" "mon" "mon" "mon" ...
## $ duration : int 261 149 226 151 307 198 139 217 380 50 ...
## $ campaign : int 1 1 1 1 1 1 1 1 1 1 ...
## $ pdays : int 999 999 999 999 999 999 999 999 999 999 ...
## $ previous : int 0 0 0 0 0 0 0 0 0 0 ...
## $ poutcome : chr "nonexistent" "nonexistent" "nonexistent" "nonexistent" ...
## $ emp.var.rate : num 1.1 1.1 1.1 1.1 1.1 1.1 1.1 1.1 1.1 1.1 ...
## $ cons.price.idx: num 94 94 94 94 94 ...
## $ cons.conf.idx : num -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 ...
## $ euribor3m : num 4.86 4.86 4.86 4.86 4.86 ...
## $ nr.employed : num 5191 5191 5191 5191 5191 ...
## $ y : chr "no" "no" "no" "no" ...# Nama variabel
names(data)## [1] "age" "job" "marital" "education"
## [5] "default" "housing" "loan" "contact"
## [9] "month" "day_of_week" "duration" "campaign"
## [13] "pdays" "previous" "poutcome" "emp.var.rate"
## [17] "cons.price.idx" "cons.conf.idx" "euribor3m" "nr.employed"
## [21] "y"# =========================================================
# 1.3 IDENTIFIKASI VARIABEL
# =========================================================
categorical_vars <- c(
"job",
"marital",
"education",
"default",
"housing",
"loan",
"contact",
"month",
"day_of_week",
"poutcome"
)
numeric_vars <- c(
"age",
"duration",
"campaign",
"pdays",
"previous",
"emp.var.rate",
"cons.price.idx",
"cons.conf.idx",
"euribor3m",
"nr.employed"
)
target_var <- "y"
cat("Variabel kategorik:\n")## Variabel kategorik:print(categorical_vars)## [1] "job" "marital" "education" "default" "housing"
## [6] "loan" "contact" "month" "day_of_week" "poutcome"cat("\nVariabel numerik:\n")##
## Variabel numerik:print(numeric_vars)## [1] "age" "duration" "campaign" "pdays"
## [5] "previous" "emp.var.rate" "cons.price.idx" "cons.conf.idx"
## [9] "euribor3m" "nr.employed"cat("\nVariabel target:\n")##
## Variabel target:print(target_var)## [1] "y"colSums(is.na(data))## age job marital education default
## 0 0 0 0 0
## housing loan contact month day_of_week
## 0 0 0 0 0
## duration campaign pdays previous poutcome
## 0 0 0 0 0
## emp.var.rate cons.price.idx cons.conf.idx euribor3m nr.employed
## 0 0 0 0 0
## y
## 0sum(is.na(data))## [1] 0Jadi tidak perlu melakukan imputasi.
# =========================================================
# 2.2 CEK KATEGORI UNKNOWN
# =========================================================
for (var in categorical_vars) {
jumlah_unknown <- sum(
data[[var]] == "unknown",
na.rm = TRUE
)
if (jumlah_unknown > 0) {
cat(
var, ":", jumlah_unknown,
"unknown\n"
)
}
}## job : 330 unknown
## marital : 80 unknown
## education : 1731 unknown
## default : 8597 unknown
## housing : 990 unknown
## loan : 990 unknownNA → tidak ada unknown → dipertahankan sebagai kategori
# =========================================================
# METODE 1: PENGHAPUSAN
# =========================================================
data_delete <- na.omit(data)
cat("Data sebelum :", nrow(data), "\n")## Data sebelum : 41188cat("Data sesudah :", nrow(data_delete), "\n")## Data sesudah : 41188# =========================================================
# METODE 2: IMPUTASI SEDERHANA
# =========================================================
data_impute <- data
for (var in numeric_vars) {
median_value <- median(
data_impute[[var]],
na.rm = TRUE
)
data_impute[[var]][
is.na(data_impute[[var]])
] <- median_value
}
cat(
"Total NA setelah imputasi:",
sum(is.na(data_impute)),
"\n"
)## Total NA setelah imputasi: 0Karena tidak ada NA, tidak ada nilai yang benar-benar diimputasi.
# =========================================================
# METODE 3: IMPUTASI BERBASIS MODEL
# KNN IMPUTATION - CONTOH
# =========================================================
# Tidak perlu diterapkan pada dataset akhir
# karena data tidak memiliki NA.
# knn_model <- preProcess(
# data[, numeric_vars],
# method = "knnImpute"
# )
# data_knn <- predict(
# knn_model,
# data[, numeric_vars]
# )Berdasarkan pemeriksaan data, tidak ditemukan missing value
(NA). Oleh karena itu, penghapusan maupun imputasi tidak
diterapkan pada dataset akhir. Kategori unknown
dipertahankan karena merupakan kategori yang terdapat dalam data. Selain
itu, ditemukan 12 baris duplikat yang perlu dihapus.
# =========================================================
# 2.4 CEK DUPLIKAT
# =========================================================
duplicate_count <- sum(
duplicated(data)
)
cat(
"Jumlah data duplikat:",
duplicate_count,
"\n"
)## Jumlah data duplikat: 12# =========================================================
# 2.5 HAPUS DUPLIKAT
# =========================================================
data <- data[
!duplicated(data),
]
cat(
"Jumlah data setelah menghapus duplikat:",
nrow(data),
"\n"
)## Jumlah data setelah menghapus duplikat: 41176#Ini harus dilakukan sebelum preprocessing yang belajar parameter dari data.
# =========================================================
# 3. TRAIN-TEST SPLIT
# =========================================================
set.seed(123)
train_index <- createDataPartition(
data$y,
p = 0.80,
list = FALSE
)
train_data <- data[train_index, ]
test_data <- data[-train_index, ]
dim(train_data)## [1] 32942 21dim(test_data)## [1] 8234 21prop.table(table(train_data$y))##
## no yes
## 0.8873171 0.1126829prop.table(table(test_data$y))##
## no yes
## 0.887418 0.112582# Membuat salinan data training
# agar data asli tidak langsung berubah
label_example <- train_data
# Mengubah kategori marital menjadi kode angka
# Setiap kategori mendapatkan angka yang berbeda
label_example$marital_label <- as.numeric(
factor(label_example$marital)
)
# Melihat hasil encoding
head(
label_example[, c(
"marital",
"marital_label"
)]
)## marital marital_label
## 1 married 2
## 2 married 2
## 3 married 2
## 4 married 2
## 5 married 2
## 6 married 2# Mengambil seluruh kategori marital
marital_levels <- levels(
factor(train_data$marital)
)
# Membuat tabel pemetaan kategori ke angka
marital_mapping <- data.frame(
marital = marital_levels,
marital_label = seq_along(marital_levels)
)
# Menampilkan mapping
print(marital_mapping)## marital marital_label
## 1 divorced 1
## 2 married 2
## 3 single 3
## 4 unknown 4#Ordinal Encoding
Kita gunakan education karena memiliki tingkatan pendidikan.
# ============================================================
# ORDINAL ENCODING
# Variabel yang digunakan: education
# Tujuan: mengubah kategori education menjadi angka
# berdasarkan urutan tingkat pendidikan
# ============================================================
# 1. Menentukan urutan tingkat pendidikan
# Urutan dibuat dari tingkat pendidikan terendah ke tertinggi
education_order <- c(
"illiterate",
"basic.4y",
"basic.6y",
"basic.9y",
"high.school",
"professional.course",
"university.degree"
)
# 2. Membuat tabel mapping
# Setiap kategori diberikan angka sesuai posisinya
# dalam urutan education_order
education_mapping <- data.frame(
education = education_order,
education_ordinal = 1:length(education_order)
)
# 3. Menampilkan tabel mapping
# Tabel ini menunjukkan kategori dan nilai ordinalnya
education_mapping## education education_ordinal
## 1 illiterate 1
## 2 basic.4y 2
## 3 basic.6y 3
## 4 basic.9y 4
## 5 high.school 5
## 6 professional.course 6
## 7 university.degree 7# 4. Membuat variabel education_ordinal pada data TRAIN
# match() mencocokkan kategori education dengan urutan
# yang telah ditentukan
train_data$education_ordinal <- match(
train_data$education,
education_order
)
# 5. Membuat variabel education_ordinal pada data TEST
# Urutan yang digunakan harus sama dengan data train
test_data$education_ordinal <- match(
test_data$education,
education_order
)
# 6. Melihat beberapa contoh hasil encoding
# head() hanya menampilkan 6 baris pertama
head(
train_data[, c("education", "education_ordinal")]
)## education education_ordinal
## 1 basic.4y 2
## 2 high.school 5
## 3 high.school 5
## 4 basic.6y 3
## 5 high.school 5
## 6 basic.9y 4# 7. Melihat seluruh kategori dan hasil encoding
# unique() digunakan agar setiap kombinasi kategori
# ditampilkan satu kali saja
education_result <- unique(
train_data[, c("education", "education_ordinal")]
)
# 8. Mengurutkan hasil berdasarkan nilai ordinal
education_result <- education_result[
order(education_result$education_ordinal),
]
# 9. Menampilkan hasil akhir
education_result## education education_ordinal
## 5394 illiterate 1
## 1 basic.4y 2
## 4 basic.6y 3
## 6 basic.9y 4
## 2 high.school 5
## 7 professional.course 6
## 26 university.degree 7
## 8 unknown NA# ============================================================
# ONE-HOT ENCODING
# Dataset: UCI Bank Marketing
# ============================================================
# 1. Memanggil package caret
# Package caret digunakan untuk melakukan one-hot encoding
library(caret)
# 2. Menentukan variabel kategorikal
# Variabel berikut akan diubah menjadi variabel dummy
categorical_vars <- c(
"job",
"marital",
"education",
"default",
"housing",
"loan",
"contact",
"month",
"day_of_week",
"poutcome"
)
# 3. Memastikan semua variabel kategorikal
# memiliki tipe data character/factor yang sesuai
train_data[categorical_vars] <- lapply(
train_data[categorical_vars],
as.factor
)
test_data[categorical_vars] <- lapply(
test_data[categorical_vars],
as.factor
)
# 4. Menyamakan level kategori data TEST dengan data TRAIN
# Encoder harus mengikuti kategori yang dipelajari dari data training
for (var in categorical_vars) {
test_data[[var]] <- factor(
test_data[[var]],
levels = levels(train_data[[var]])
)
}
# 5. Membuat formula untuk seluruh variabel kategorikal
encoding_formula <- as.formula(
paste(
"~",
paste(
categorical_vars,
collapse = " + "
)
)
)
# 6. Membuat encoder berdasarkan DATA TRAINING
# fullRank = FALSE berarti setiap kategori dibuat menjadi
# satu kolom dummy
dummy_model <- dummyVars(
encoding_formula,
data = train_data,
fullRank = FALSE
)
# 7. Melakukan One-Hot Encoding pada DATA TRAINING
train_encoded <- as.data.frame(
predict(
dummy_model,
newdata = train_data
)
)
# 8. Melakukan One-Hot Encoding pada DATA TESTING
# Menggunakan encoder yang sama dengan data training
test_encoded <- as.data.frame(
predict(
dummy_model,
newdata = test_data
)
)
# 9. Memastikan kolom TRAIN dan TEST sama
# Jika ada kategori yang tidak muncul pada data test,
# kolom tersebut akan ditambahkan dengan nilai 0
missing_test_cols <- setdiff(
names(train_encoded),
names(test_encoded)
)
# 10. Menambahkan kolom yang tidak ada pada data TEST
if (length(missing_test_cols) > 0) {
for (col in missing_test_cols) {
test_encoded[[col]] <- 0
}
}
# 11. Menghapus kolom tambahan pada TEST jika ada
extra_test_cols <- setdiff(
names(test_encoded),
names(train_encoded)
)
if (length(extra_test_cols) > 0) {
test_encoded <- test_encoded[
,
!names(test_encoded) %in% extra_test_cols,
drop = FALSE
]
}
# 12. Menyamakan urutan kolom TRAIN dan TEST
test_encoded <- test_encoded[
,
names(train_encoded),
drop = FALSE
]
# 13. Mengecek jumlah baris dan kolom
# Hasil menunjukkan ukuran data setelah One-Hot Encoding
dim(train_encoded)## [1] 32942 53dim(test_encoded)## [1] 8234 53# 14. Melihat nama seluruh kolom hasil One-Hot Encoding
names(train_encoded)## [1] "job.admin." "job.blue-collar"
## [3] "job.entrepreneur" "job.housemaid"
## [5] "job.management" "job.retired"
## [7] "job.self-employed" "job.services"
## [9] "job.student" "job.technician"
## [11] "job.unemployed" "job.unknown"
## [13] "marital.divorced" "marital.married"
## [15] "marital.single" "marital.unknown"
## [17] "education.basic.4y" "education.basic.6y"
## [19] "education.basic.9y" "education.high.school"
## [21] "education.illiterate" "education.professional.course"
## [23] "education.university.degree" "education.unknown"
## [25] "default.no" "default.unknown"
## [27] "default.yes" "housing.no"
## [29] "housing.unknown" "housing.yes"
## [31] "loan.no" "loan.unknown"
## [33] "loan.yes" "contact.cellular"
## [35] "contact.telephone" "month.apr"
## [37] "month.aug" "month.dec"
## [39] "month.jul" "month.jun"
## [41] "month.mar" "month.may"
## [43] "month.nov" "month.oct"
## [45] "month.sep" "day_of_week.fri"
## [47] "day_of_week.mon" "day_of_week.thu"
## [49] "day_of_week.tue" "day_of_week.wed"
## [51] "poutcome.failure" "poutcome.nonexistent"
## [53] "poutcome.success"# 15. Memastikan struktur kolom TRAIN dan TEST sudah sama
# TRUE berarti nama dan urutan kolom sudah sama
identical(
names(train_encoded),
names(test_encoded)
)## [1] TRUE# 16. Melihat beberapa baris pertama hasil One-Hot Encoding
head(train_encoded)## job.admin. job.blue-collar job.entrepreneur job.housemaid job.management
## 1 0 0 0 1 0
## 2 0 0 0 0 0
## 3 0 0 0 0 0
## 4 1 0 0 0 0
## 5 0 0 0 0 0
## 6 0 0 0 0 0
## job.retired job.self-employed job.services job.student job.technician
## 1 0 0 0 0 0
## 2 0 0 1 0 0
## 3 0 0 1 0 0
## 4 0 0 0 0 0
## 5 0 0 1 0 0
## 6 0 0 1 0 0
## job.unemployed job.unknown marital.divorced marital.married marital.single
## 1 0 0 0 1 0
## 2 0 0 0 1 0
## 3 0 0 0 1 0
## 4 0 0 0 1 0
## 5 0 0 0 1 0
## 6 0 0 0 1 0
## marital.unknown education.basic.4y education.basic.6y education.basic.9y
## 1 0 1 0 0
## 2 0 0 0 0
## 3 0 0 0 0
## 4 0 0 1 0
## 5 0 0 0 0
## 6 0 0 0 1
## education.high.school education.illiterate education.professional.course
## 1 0 0 0
## 2 1 0 0
## 3 1 0 0
## 4 0 0 0
## 5 1 0 0
## 6 0 0 0
## education.university.degree education.unknown default.no default.unknown
## 1 0 0 1 0
## 2 0 0 0 1
## 3 0 0 1 0
## 4 0 0 1 0
## 5 0 0 1 0
## 6 0 0 0 1
## default.yes housing.no housing.unknown housing.yes loan.no loan.unknown
## 1 0 1 0 0 1 0
## 2 0 1 0 0 1 0
## 3 0 0 0 1 1 0
## 4 0 1 0 0 1 0
## 5 0 1 0 0 0 0
## 6 0 1 0 0 1 0
## loan.yes contact.cellular contact.telephone month.apr month.aug month.dec
## 1 0 0 1 0 0 0
## 2 0 0 1 0 0 0
## 3 0 0 1 0 0 0
## 4 0 0 1 0 0 0
## 5 1 0 1 0 0 0
## 6 0 0 1 0 0 0
## month.jul month.jun month.mar month.may month.nov month.oct month.sep
## 1 0 0 0 1 0 0 0
## 2 0 0 0 1 0 0 0
## 3 0 0 0 1 0 0 0
## 4 0 0 0 1 0 0 0
## 5 0 0 0 1 0 0 0
## 6 0 0 0 1 0 0 0
## day_of_week.fri day_of_week.mon day_of_week.thu day_of_week.tue
## 1 0 1 0 0
## 2 0 1 0 0
## 3 0 1 0 0
## 4 0 1 0 0
## 5 0 1 0 0
## 6 0 1 0 0
## day_of_week.wed poutcome.failure poutcome.nonexistent poutcome.success
## 1 0 0 1 0
## 2 0 0 1 0
## 3 0 0 1 0
## 4 0 0 1 0
## 5 0 0 1 0
## 6 0 0 1 0# 17. Melihat jumlah kolom hasil One-Hot Encoding
ncol(train_encoded)## [1] 53# ============================================================
# FREQUENCY ENCODING
# Variabel yang digunakan: job
# ============================================================
# 1. Menghitung jumlah kemunculan setiap kategori job
# HANYA berdasarkan data training
job_count <- table(train_data$job)
# 2. Mengubah jumlah kemunculan menjadi proporsi/frekuensi
# Nilai berada antara 0 dan 1
job_frequency <- prop.table(job_count)
# 3. Melihat hasil frekuensi setiap kategori job
job_frequency##
## admin. blue-collar entrepreneur housemaid management
## 0.254598992 0.223665837 0.035274118 0.025802926 0.070396454
## retired self-employed services student technician
## 0.041952523 0.035243762 0.096320806 0.021401251 0.163560197
## unemployed unknown
## 0.024254751 0.007528383# 4. Membuat tabel mapping frequency encoding
# Tabel ini menunjukkan kategori dan nilai frekuensinya
job_frequency_mapping <- data.frame(
job = names(job_frequency),
frequency = as.numeric(job_frequency)
)
# 5. Menampilkan tabel mapping
job_frequency_mapping## job frequency
## 1 admin. 0.254598992
## 2 blue-collar 0.223665837
## 3 entrepreneur 0.035274118
## 4 housemaid 0.025802926
## 5 management 0.070396454
## 6 retired 0.041952523
## 7 self-employed 0.035243762
## 8 services 0.096320806
## 9 student 0.021401251
## 10 technician 0.163560197
## 11 unemployed 0.024254751
## 12 unknown 0.007528383# 6. Menerapkan frequency encoding pada data TRAIN
# Setiap kategori job diganti dengan frekuensinya
train_data$job_frequency <- unname(
job_frequency[
as.character(train_data$job)
]
)
# 7. Menerapkan frequency encoding pada data TEST
# Menggunakan frekuensi yang diperoleh dari DATA TRAIN
test_data$job_frequency <- unname(
job_frequency[
as.character(test_data$job)
]
)
# 8. Melihat contoh hasil frequency encoding
head(
train_data[, c(
"job",
"job_frequency"
)]
)## job job_frequency
## 1 housemaid 0.02580293
## 2 services 0.09632081
## 3 services 0.09632081
## 4 admin. 0.25459899
## 5 services 0.09632081
## 6 services 0.09632081# 9. Melihat setiap kategori job beserta frekuensinya
unique(
train_data[, c(
"job",
"job_frequency"
)]
)## job job_frequency
## 1 housemaid 0.025802926
## 2 services 0.096320806
## 4 admin. 0.254598992
## 8 blue-collar 0.223665837
## 9 technician 0.163560197
## 16 retired 0.041952523
## 20 management 0.070396454
## 21 unemployed 0.024254751
## 28 self-employed 0.035243762
## 30 unknown 0.007528383
## 42 entrepreneur 0.035274118
## 206 student 0.021401251# ============================================================
# TARGET ENCODING
# Variabel kategorikal : job
# Target : y
# ============================================================
# 1. Menghitung rata-rata target untuk setiap kategori job
# y = "yes" diberi nilai 1
# y = "no" diberi nilai 0
#
# Perhitungan HANYA menggunakan data training
target_encoding <- aggregate(
y ~ job,
data = train_data,
FUN = function(x) mean(x == "yes")
)
# 2. Mengubah nama kolom hasil menjadi lebih jelas
names(target_encoding)[2] <- "job_target"
# 3. Menampilkan tabel mapping target encoding
target_encoding## job job_target
## 1 admin. 0.12984381
## 2 blue-collar 0.06704669
## 3 entrepreneur 0.08433735
## 4 housemaid 0.10470588
## 5 management 0.11211729
## 6 retired 0.25759768
## 7 self-employed 0.11024978
## 8 services 0.07973527
## 9 student 0.31914894
## 10 technician 0.10708983
## 11 unemployed 0.14768461
## 12 unknown 0.10080645# ============================================================
# MENERAPKAN TARGET ENCODING KE DATA TRAIN
# ============================================================
# 4. Menggabungkan nilai target encoding ke data training
# berdasarkan kategori job
train_data <- merge(
train_data,
target_encoding,
by = "job",
all.x = TRUE,
sort = FALSE
)
# ============================================================
# MENERAPKAN TARGET ENCODING KE DATA TEST
# ============================================================
# 5. Menggabungkan mapping yang berasal dari TRAIN
# ke data testing
#
# Data TEST tidak digunakan untuk menghitung nilai encoding
test_data <- merge(
test_data,
target_encoding,
by = "job",
all.x = TRUE,
sort = FALSE
)
# ============================================================
# MELIHAT HASIL
# ============================================================
# 6. Melihat beberapa hasil target encoding pada TRAIN
head(
train_data[, c(
"job",
"y",
"job_target"
)]
)## job y job_target
## 1 housemaid no 0.1047059
## 2 housemaid no 0.1047059
## 3 housemaid yes 0.1047059
## 4 housemaid no 0.1047059
## 5 housemaid no 0.1047059
## 6 housemaid no 0.1047059# 7. Melihat mapping setiap kategori job
unique(
train_data[, c(
"job",
"job_target"
)]
)## job job_target
## 1 housemaid 0.10470588
## 851 services 0.07973527
## 4024 admin. 0.12984381
## 12411 blue-collar 0.06704669
## 19779 technician 0.10708983
## 25167 retired 0.25759768
## 26549 management 0.11211729
## 28868 unemployed 0.14768461
## 29667 self-employed 0.11024978
## 30828 unknown 0.10080645
## 31076 entrepreneur 0.08433735
## 32238 student 0.31914894# 8. Mengecek apakah terdapat nilai NA pada encoding
sum(is.na(train_data$job_target))## [1] 0sum(is.na(test_data$job_target))## [1] 0# ============================================================
# 4. SCALING DAN TRANSFORMASI VARIABEL NUMERIK
# Dataset: UCI Bank Marketing
# ============================================================
# 1. Menentukan variabel numerik
numeric_vars <- c(
"age",
"duration",
"campaign",
"pdays",
"previous",
"emp.var.rate",
"cons.price.idx",
"cons.conf.idx",
"euribor3m",
"nr.employed"
)
# ============================================================
# A. MEMERIKSA KARAKTERISTIK DATA NUMERIK
# ============================================================
# 2. Melihat ringkasan statistik variabel numerik
summary(train_data[numeric_vars])## age duration campaign pdays
## Min. :17.00 Min. : 0.0 Min. : 1.000 Min. : 0.0
## 1st Qu.:32.00 1st Qu.: 102.0 1st Qu.: 1.000 1st Qu.:999.0
## Median :38.00 Median : 180.0 Median : 2.000 Median :999.0
## Mean :40.01 Mean : 257.8 Mean : 2.556 Mean :962.5
## 3rd Qu.:47.00 3rd Qu.: 319.0 3rd Qu.: 3.000 3rd Qu.:999.0
## Max. :98.00 Max. :4918.0 Max. :56.000 Max. :999.0
## previous emp.var.rate cons.price.idx cons.conf.idx
## Min. :0.0000 Min. :-3.40000 Min. :92.20 Min. :-50.80
## 1st Qu.:0.0000 1st Qu.:-1.80000 1st Qu.:93.08 1st Qu.:-42.70
## Median :0.0000 Median : 1.10000 Median :93.75 Median :-41.80
## Mean :0.1726 Mean : 0.08023 Mean :93.58 Mean :-40.52
## 3rd Qu.:0.0000 3rd Qu.: 1.40000 3rd Qu.:93.99 3rd Qu.:-36.40
## Max. :7.0000 Max. : 1.40000 Max. :94.77 Max. :-26.90
## euribor3m nr.employed
## Min. :0.634 Min. :4964
## 1st Qu.:1.344 1st Qu.:5099
## Median :4.857 Median :5191
## Mean :3.619 Mean :5167
## 3rd Qu.:4.961 3rd Qu.:5228
## Max. :5.045 Max. :5228# 3. Mengecek nilai minimum setiap variabel
# Penting sebelum melakukan transformasi Box-Cox
sapply(
train_data[numeric_vars],
min,
na.rm = TRUE
)## age duration campaign pdays previous
## 17.000 0.000 1.000 0.000 0.000
## emp.var.rate cons.price.idx cons.conf.idx euribor3m nr.employed
## -3.400 92.201 -50.800 0.634 4963.600# ============================================================
# B. STANDARDIZATION (Z-SCORE)
# ============================================================
# Standardization mengubah data sehingga:
# mean mendekati 0 dan standar deviasi mendekati 1
#
# Rumus:
# z = (x - mean) / sd
#
# Parameter mean dan sd dihitung dari DATA TRAIN saja.
standard_model <- preProcess(
train_data[numeric_vars],
method = c("center", "scale")
)
# Menerapkan standardization pada TRAIN
train_standard <- predict(
standard_model,
train_data[numeric_vars]
)
# Menerapkan standardization yang sama pada TEST
test_standard <- predict(
standard_model,
test_data[numeric_vars]
)
# Melihat hasil standardization
head(train_standard)## age duration campaign pdays previous emp.var.rate
## 1 1.53445530 0.01220878 -0.5648583 0.1953531 -0.350898 0.6494366
## 2 -0.86446467 -0.76041497 -0.2017343 0.1953531 -0.350898 0.8404896
## 3 -0.09681028 2.58118275 -0.5648583 0.1953531 -0.350898 0.8404896
## 4 1.43849851 -0.94198156 -0.5648583 0.1953531 -0.350898 0.6494366
## 5 -0.09681028 -0.11913726 0.1613897 0.1953531 -0.350898 0.6494366
## 6 0.57488731 0.50282486 -0.2017343 0.1953531 1.682039 -1.1974096
## cons.price.idx cons.conf.idx euribor3m nr.employed
## 1 0.7243911 0.8909511 0.7138082 0.3321312
## 2 0.5929845 -0.4729827 0.7749066 0.8454427
## 3 0.5929845 -0.4729827 0.7720246 0.8454427
## 4 0.7243911 0.8909511 0.7126554 0.3321312
## 5 0.7243911 0.8909511 0.7138082 0.3321312
## 6 -1.1792748 -1.2307237 -1.3473968 -0.9393869# Mengecek rata-rata hasil standardization
sapply(
train_standard,
mean,
na.rm = TRUE
)## age duration campaign pdays previous
## -4.322870e-17 -3.056625e-17 4.193716e-17 -2.640523e-16 2.333878e-18
## emp.var.rate cons.price.idx cons.conf.idx euribor3m nr.employed
## 2.405916e-17 2.835673e-15 2.778730e-16 1.553541e-16 2.977028e-15# Mengecek standar deviasi hasil standardization
sapply(
train_standard,
sd,
na.rm = TRUE
)## age duration campaign pdays previous
## 1 1 1 1 1
## emp.var.rate cons.price.idx cons.conf.idx euribor3m nr.employed
## 1 1 1 1 1# ============================================================
# C. MIN-MAX NORMALIZATION
# ============================================================
# Min-Max mengubah nilai menjadi rentang 0 sampai 1
#
# Rumus:
# x' = (x - min) / (max - min)
#
# Nilai min dan max dihitung dari DATA TRAIN saja.
minmax_model <- preProcess(
train_data[numeric_vars],
method = "range"
)
# Menerapkan Min-Max pada TRAIN
train_minmax <- predict(
minmax_model,
train_data[numeric_vars]
)
# Menerapkan Min-Max yang sama pada TEST
test_minmax <- predict(
minmax_model,
test_data[numeric_vars]
)
# Melihat hasil Min-Max
head(train_minmax)## age duration campaign pdays previous emp.var.rate cons.price.idx
## 1 0.4814815 0.053070354 0.00000000 1 0.0000000 0.9375000 0.6987529
## 2 0.1728395 0.012403416 0.01818182 1 0.0000000 1.0000000 0.6691348
## 3 0.2716049 0.188287922 0.00000000 1 0.0000000 1.0000000 0.6691348
## 4 0.4691358 0.002846686 0.00000000 1 0.0000000 0.9375000 0.6987529
## 5 0.2716049 0.046156974 0.03636364 1 0.0000000 0.9375000 0.6987529
## 6 0.3580247 0.078893859 0.01818182 1 0.1428571 0.3333333 0.2696804
## cons.conf.idx euribor3m nr.employed
## 1 0.6025105 0.9573793 0.8597353
## 2 0.3389121 0.9814101 1.0000000
## 3 0.3389121 0.9802766 1.0000000
## 4 0.6025105 0.9569259 0.8597353
## 5 0.6025105 0.9573793 0.8597353
## 6 0.1924686 0.1466788 0.5122873# Mengecek nilai minimum dan maksimum hasil transformasi
sapply(
train_minmax,
min,
na.rm = TRUE
)## age duration campaign pdays previous
## 0 0 0 0 0
## emp.var.rate cons.price.idx cons.conf.idx euribor3m nr.employed
## 0 0 0 0 0sapply(
train_minmax,
max,
na.rm = TRUE
)## age duration campaign pdays previous
## 1 1 1 1 1
## emp.var.rate cons.price.idx cons.conf.idx euribor3m nr.employed
## 1 1 1 1 1# ============================================================
# D. ROBUST SCALING
# ============================================================
# Robust Scaling menggunakan:
# median dan IQR
#
# Rumus:
# x' = (x - median) / IQR
#
# Metode ini lebih tahan terhadap outlier.
train_robust <- train_data[numeric_vars]
test_robust <- test_data[numeric_vars]
# Menghitung median dan IQR dari DATA TRAIN saja
for (var in numeric_vars) {
median_train <- median(
train_data[[var]],
na.rm = TRUE
)
iqr_train <- IQR(
train_data[[var]],
na.rm = TRUE
)
# Robust Scaling pada TRAIN
train_robust[[var]] <- (
train_data[[var]] - median_train
) / iqr_train
# Menggunakan parameter TRAIN untuk TEST
test_robust[[var]] <- (
test_data[[var]] - median_train
) / iqr_train
}
# Melihat hasil Robust Scaling
head(train_robust)## age duration campaign pdays previous emp.var.rate cons.price.idx
## 1 1.20000000 0.3732719 -0.5 NaN NaN 0.00000 0.2665941
## 2 -0.46666667 -0.5483871 0.0 NaN NaN 0.09375 0.1838955
## 3 0.06666667 3.4377880 -0.5 NaN NaN 0.09375 0.1838955
## 4 1.13333333 -0.7649770 -0.5 NaN NaN 0.00000 0.2665941
## 5 0.06666667 0.2165899 0.5 NaN NaN 0.00000 0.2665941
## 6 0.53333333 0.9585253 0.0 NaN Inf -0.90625 -0.9314472
## cons.conf.idx euribor3m nr.employed
## 1 0.8571429 0.0000000000 0.0000000
## 2 -0.1428571 0.0293060547 0.2875969
## 3 -0.1428571 0.0279236937 0.2875969
## 4 0.8571429 -0.0005529444 0.0000000
## 5 0.8571429 0.0000000000 0.0000000
## 6 -0.6984127 -0.9886646392 -0.7124031# ============================================================
# E. TRANSFORMASI LOG
# ============================================================
# Transformasi log digunakan untuk mengurangi skewness
# terutama pada variabel yang memiliki distribusi menceng ke kanan.
#
# log1p(x) = log(1 + x)
#
# log1p digunakan agar aman untuk nilai 0.
#
# Kita contohkan pada:
# duration, campaign, dan previous
train_log <- train_data[
,
c("duration", "campaign", "previous")
]
test_log <- test_data[
,
c("duration", "campaign", "previous")
]
# Melakukan transformasi log pada TRAIN
for (var in c(
"duration",
"campaign",
"previous"
)) {
train_log[[var]] <- log1p(
train_data[[var]]
)
test_log[[var]] <- log1p(
test_data[[var]]
)
}
# Melihat hasil transformasi log
head(train_log)## duration campaign previous
## 1 5.568345 0.6931472 0.0000000
## 2 4.127134 1.0986123 0.0000000
## 3 6.831954 0.6931472 0.0000000
## 4 2.708050 0.6931472 0.0000000
## 5 5.429346 1.3862944 0.0000000
## 6 5.963579 1.0986123 0.6931472# ============================================================
# F. MENGECEK SKEWNESS SEBELUM DAN SESUDAH LOG
# ============================================================
# Fungsi untuk menghitung skewness
skewness_function <- function(x) {
x <- x[!is.na(x)]
n <- length(x)
mean_x <- mean(x)
sd_x <- sd(x)
sum(
(x - mean_x)^3
) / n / sd_x^3
}
# Skewness SEBELUM log
for (var in c(
"duration",
"campaign",
"previous"
)) {
skew_before <- skewness_function(
train_data[[var]]
)
cat(
var,
"- Skewness sebelum log:",
round(skew_before, 3),
"\n"
)
}## duration - Skewness sebelum log: 3.256
## campaign - Skewness sebelum log: 4.778
## previous - Skewness sebelum log: 3.807# Skewness SESUDAH log
for (var in c(
"duration",
"campaign",
"previous"
)) {
skew_after <- skewness_function(
train_log[[var]]
)
cat(
var,
"- Skewness setelah log:",
round(skew_after, 3),
"\n"
)
}## duration - Skewness setelah log: -0.415
## campaign - Skewness setelah log: 1.358
## previous - Skewness setelah log: 2.573# ============================================================
# G. BOX-COX TRANSFORMATION
# ============================================================
# Box-Cox membutuhkan data yang bernilai POSITIF.
#
# Oleh karena itu, sebelum digunakan kita cek minimum data.
#
# Variabel yang memiliki nilai negatif tidak digunakan
# dalam contoh Box-Cox ini.
boxcox_vars <- c(
"age",
"duration",
"campaign",
"pdays",
"previous",
"cons.price.idx",
"euribor3m",
"nr.employed"
)
# Mengecek nilai minimum
sapply(
train_data[boxcox_vars],
min,
na.rm = TRUE
)## age duration campaign pdays previous
## 17.000 0.000 1.000 0.000 0.000
## cons.price.idx euribor3m nr.employed
## 92.201 0.634 4963.600# Membuat model Box-Cox berdasarkan DATA TRAIN
boxcox_model <- preProcess(
train_data[boxcox_vars],
method = c("BoxCox")
)
# Menerapkan Box-Cox pada TRAIN
train_boxcox <- predict(
boxcox_model,
train_data[boxcox_vars]
)
# Menerapkan parameter Box-Cox yang sama pada TEST
test_boxcox <- predict(
boxcox_model,
test_data[boxcox_vars]
)
# Melihat hasil Box-Cox
head(train_boxcox)## age duration campaign pdays previous cons.price.idx euribor3m
## 1 4.025352 261 0.0000000 999 0 4416.936 5.8138220
## 2 3.433987 61 0.5491826 999 0 4409.795 6.0141476
## 3 3.663562 926 0.0000000 999 0 4409.795 6.0046594
## 4 4.007333 14 0.0000000 999 0 4416.936 5.8100589
## 5 3.663562 227 0.7664813 999 0 4416.936 5.8138220
## 6 3.828641 388 0.5491826 999 1 4314.055 0.2959919
## nr.employed
## 1 13473240
## 2 13666514
## 3 13666514
## 4 13473240
## 5 13473240
## 6 13000410# ============================================================
# H. YEO-JOHNSON TRANSFORMATION
# ============================================================
# Yeo-Johnson dapat digunakan pada data yang:
# - bernilai positif
# - bernilai nol
# - bernilai negatif
#
# Karena itu metode ini lebih fleksibel dibanding Box-Cox.
yj_model <- preProcess(
train_data[numeric_vars],
method = "YeoJohnson"
)
# Menerapkan Yeo-Johnson pada TRAIN
train_yj <- predict(
yj_model,
train_data[numeric_vars]
)
# Menerapkan parameter yang sama pada TEST
test_yj <- predict(
yj_model,
test_data[numeric_vars]
)
# Melihat hasil Yeo-Johnson
head(train_yj)## age duration campaign pdays previous emp.var.rate cons.price.idx
## 1 2.625357 8.028861 0.4688634 999 0 1.540322 93.994
## 2 2.383123 5.392555 0.6070935 999 0 2.103449 93.918
## 3 2.480608 10.762568 0.4688634 999 0 2.103449 93.918
## 4 2.618402 3.219565 0.4688634 999 0 1.540322 93.994
## 5 2.480608 7.753532 0.6712016 999 0 1.540322 93.994
## 6 2.547991 8.838243 0.6070935 999 1 -1.157598 92.893
## cons.conf.idx euribor3m nr.employed
## 1 -669.8007 17.35962 5191.0
## 2 -912.7081 18.02207 5228.1
## 3 -912.7081 17.99055 5228.1
## 4 -669.8007 17.34724 5191.0
## 5 -669.8007 17.35962 5191.0
## 6 -1063.7305 2.13623 5099.1# ============================================================
# I. MEMBANDINGKAN HASIL TRANSFORMASI
# ============================================================
# Melihat sebagian hasil dari beberapa metode
head(
train_data[
,
c(
"age",
"duration",
"campaign"
)
]
)## age duration campaign
## 1 56 261 1
## 2 31 61 2
## 3 39 926 1
## 4 55 14 1
## 5 39 227 3
## 6 46 388 2head(
train_standard[
,
c(
"age",
"duration",
"campaign"
)
]
)## age duration campaign
## 1 1.53445530 0.01220878 -0.5648583
## 2 -0.86446467 -0.76041497 -0.2017343
## 3 -0.09681028 2.58118275 -0.5648583
## 4 1.43849851 -0.94198156 -0.5648583
## 5 -0.09681028 -0.11913726 0.1613897
## 6 0.57488731 0.50282486 -0.2017343head(
train_minmax[
,
c(
"age",
"duration",
"campaign"
)
]
)## age duration campaign
## 1 0.4814815 0.053070354 0.00000000
## 2 0.1728395 0.012403416 0.01818182
## 3 0.2716049 0.188287922 0.00000000
## 4 0.4691358 0.002846686 0.00000000
## 5 0.2716049 0.046156974 0.03636364
## 6 0.3580247 0.078893859 0.01818182head(
train_robust[
,
c(
"age",
"duration",
"campaign"
)
]
)## age duration campaign
## 1 1.20000000 0.3732719 -0.5
## 2 -0.46666667 -0.5483871 0.0
## 3 0.06666667 3.4377880 -0.5
## 4 1.13333333 -0.7649770 -0.5
## 5 0.06666667 0.2165899 0.5
## 6 0.53333333 0.9585253 0.0# ============================================================
# 5. DETEKSI DAN PENANGANAN OUTLIER
# Dataset: UCI Bank Marketing
# ------------------------------------------------------------
# 1. MENENTUKAN VARIABEL NUMERIK
# ------------------------------------------------------------
numeric_vars <- c(
"age",
"duration",
"campaign",
"pdays",
"previous",
"emp.var.rate",
"cons.price.idx",
"cons.conf.idx",
"euribor3m",
"nr.employed"
)
# ============================================================
# A. DETEKSI OUTLIER DENGAN IQR
# ============================================================
# IQR (Interquartile Range) menggunakan Q1 dan Q3.
#
# Batas bawah:
# Q1 - 1.5 x IQR
#
# Batas atas:
# Q3 + 1.5 x IQR
#
# Nilai di luar batas tersebut disebut
# kandidat outlier.
iqr_results <- data.frame(
variable = character(),
Q1 = numeric(),
Q3 = numeric(),
IQR = numeric(),
lower_bound = numeric(),
upper_bound = numeric(),
outlier_count = integer(),
outlier_percent = numeric()
)
for (var in numeric_vars) {
Q1 <- quantile(
train_data[[var]],
0.25,
na.rm = TRUE
)
Q3 <- quantile(
train_data[[var]],
0.75,
na.rm = TRUE
)
IQR_value <- Q3 - Q1
lower_bound <- Q1 - 1.5 * IQR_value
upper_bound <- Q3 + 1.5 * IQR_value
outlier_count <- sum(
train_data[[var]] < lower_bound |
train_data[[var]] > upper_bound,
na.rm = TRUE
)
outlier_percent <- (
outlier_count /
sum(!is.na(train_data[[var]]))
) * 100
iqr_results <- rbind(
iqr_results,
data.frame(
variable = var,
Q1 = Q1,
Q3 = Q3,
IQR = IQR_value,
lower_bound = lower_bound,
upper_bound = upper_bound,
outlier_count = outlier_count,
outlier_percent = outlier_percent
)
)
}
# Menampilkan hasil IQR
iqr_results## variable Q1 Q3 IQR lower_bound upper_bound
## 25% age 32.000 47.000 15.000 9.5000 69.5000
## 25%1 duration 102.000 319.000 217.000 -223.5000 644.5000
## 25%2 campaign 1.000 3.000 2.000 -2.0000 6.0000
## 25%3 pdays 999.000 999.000 0.000 999.0000 999.0000
## 25%4 previous 0.000 0.000 0.000 0.0000 0.0000
## 25%5 emp.var.rate -1.800 1.400 3.200 -6.6000 6.2000
## 25%6 cons.price.idx 93.075 93.994 0.919 91.6965 95.3725
## 25%7 cons.conf.idx -42.700 -36.400 6.300 -52.1500 -26.9500
## 25%8 euribor3m 1.344 4.961 3.617 -4.0815 10.3865
## 25%9 nr.employed 5099.100 5228.100 129.000 4905.6000 5421.6000
## outlier_count outlier_percent
## 25% 378 1.147471
## 25%1 2318 7.036610
## 25%2 1888 5.731285
## 25%3 1211 3.676158
## 25%4 4513 13.699836
## 25%5 0 0.000000
## 25%6 0 0.000000
## 25%7 346 1.050331
## 25%8 0 0.000000
## 25%9 0 0.000000# ============================================================
# B. DETEKSI OUTLIER DENGAN Z-SCORE
# ============================================================
# Z-score menunjukkan jarak suatu observasi
# dari rata-rata dalam satuan standar deviasi.
#
# Rumus:
#
# z = (x - mean) / sd
#
# Kandidat outlier biasanya menggunakan:
# |z| > 3
z_results <- data.frame(
variable = character(),
mean = numeric(),
sd = numeric(),
outlier_count = integer(),
outlier_percent = numeric()
)
for (var in numeric_vars) {
mean_train <- mean(
train_data[[var]],
na.rm = TRUE
)
sd_train <- sd(
train_data[[var]],
na.rm = TRUE
)
z_score <- (
train_data[[var]] - mean_train
) / sd_train
outlier_count <- sum(
abs(z_score) > 3,
na.rm = TRUE
)
outlier_percent <- (
outlier_count /
sum(!is.na(train_data[[var]]))
) * 100
z_results <- rbind(
z_results,
data.frame(
variable = var,
mean = mean_train,
sd = sd_train,
outlier_count = outlier_count,
outlier_percent = outlier_percent
)
)
}
# Menampilkan hasil Z-score
z_results## variable mean sd outlier_count outlier_percent
## 1 age 40.00889442 10.4213564 297 0.9015846
## 2 duration 257.83965758 258.8582083 693 2.1036974
## 3 campaign 2.55555218 2.7538804 688 2.0885192
## 4 pdays 962.49641795 186.8594853 1211 3.6761581
## 5 previous 0.17260640 0.4918991 839 2.5469006
## 6 emp.var.rate 0.08022585 1.5702445 0 0.0000000
## 7 cons.price.idx 93.57504277 0.5783578 0 0.0000000
## 8 cons.conf.idx -40.51529658 4.6189925 0 0.0000000
## 9 euribor3m 3.61860880 1.7349075 0 0.0000000
## 10 nr.employed 5166.99494870 72.2758083 0 0.0000000# ============================================================
# C. ROBUST STATISTICS: MAD
# ============================================================
# MAD = Median Absolute Deviation
#
# MAD lebih tahan terhadap pengaruh nilai ekstrem
# dibandingkan mean dan standar deviasi.
#
# Robust modified z-score:
#
# 0.6745 * (x - median) / MAD
#
# Kandidat outlier:
# |modified z-score| > 3.5
mad_results <- data.frame(
variable = character(),
median = numeric(),
MAD = numeric(),
outlier_count = integer(),
outlier_percent = numeric()
)
for (var in numeric_vars) {
median_train <- median(
train_data[[var]],
na.rm = TRUE
)
mad_train <- mad(
train_data[[var]],
na.rm = TRUE
)
modified_z <- (
0.6745 *
(train_data[[var]] - median_train) /
mad_train
)
outlier_count <- sum(
abs(modified_z) > 3.5,
na.rm = TRUE
)
outlier_percent <- (
outlier_count /
sum(!is.na(train_data[[var]]))
) * 100
mad_results <- rbind(
mad_results,
data.frame(
variable = var,
median = median_train,
MAD = mad_train,
outlier_count = outlier_count,
outlier_percent = outlier_percent
)
)
}
# Menampilkan hasil MAD
mad_results## variable median MAD outlier_count outlier_percent
## 1 age 38.000 10.3782000 6 0.01821383
## 2 duration 180.000 139.3644000 1019 3.09331552
## 3 campaign 2.000 1.4826000 866 2.62886285
## 4 pdays 999.000 0.0000000 1211 3.67615810
## 5 previous 0.000 0.0000000 4513 13.69983608
## 6 emp.var.rate 1.100 0.4447800 10313 31.30653877
## 7 cons.price.idx 93.749 0.5633880 0 0.00000000
## 8 cons.conf.idx -41.800 6.5234400 0 0.00000000
## 9 euribor3m 4.857 0.1601208 11384 34.55770749
## 10 nr.employed 5191.000 55.0044600 0 0.00000000# ============================================================
# D. ISOLATION FOREST
# ============================================================
# Isolation Forest merupakan metode machine learning
# untuk mendeteksi observasi yang berbeda atau terisolasi.
#
# Metode ini dapat mendeteksi outlier berdasarkan
# kombinasi beberapa variabel numerik.
# Memanggil package isotree
library(isotree)
# Membuat model Isolation Forest
# Model dibuat hanya dari DATA TRAINING
set.seed(123)
iso_model <- isolation.forest(
train_data[numeric_vars],
ntrees = 100,
sample_size = 256,
seed = 123
)
# Menghasilkan anomaly score
iso_score <- predict(
iso_model,
train_data[numeric_vars],
type = "score"
)
# Menampilkan beberapa anomaly score
head(iso_score)## 1 2 3 4 5 6
## 0.4222965 0.3900639 0.4522005 0.4434200 0.3993078 0.4549213# Menambahkan anomaly score ke data training
train_data$iso_score <- iso_score
# Melihat ringkasan anomaly score
summary(train_data$iso_score)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.3783 0.4075 0.4309 0.4520 0.4682 0.7208# ============================================================
# E. MENENTUKAN KANDIDAT OUTLIER ISOLATION FOREST
# ============================================================
# Salah satu pendekatan adalah menggunakan threshold
# berdasarkan distribusi anomaly score.
#
# Untuk eksplorasi, observasi dengan skor tinggi
# dapat diperiksa lebih lanjut.
iso_threshold <- quantile(
train_data$iso_score,
0.95,
na.rm = TRUE
)
train_data$iso_outlier <- ifelse(
train_data$iso_score >= iso_threshold,
1,
0
)
# Menghitung jumlah kandidat outlier
sum(
train_data$iso_outlier == 1,
na.rm = TRUE
)## [1] 1648# Persentase kandidat outlier
mean(
train_data$iso_outlier == 1,
na.rm = TRUE
) * 100## [1] 5.002732# ============================================================
# F. MEMBANDINGKAN HASIL METODE
# ============================================================
# Menggabungkan jumlah outlier dari:
# IQR, Z-score, dan MAD
outlier_comparison <- data.frame(
variable = iqr_results$variable,
IQR = iqr_results$outlier_count,
Z_score = z_results$outlier_count,
MAD = mad_results$outlier_count
)
# Menampilkan perbandingan
outlier_comparison## variable IQR Z_score MAD
## 1 age 378 297 6
## 2 duration 2318 693 1019
## 3 campaign 1888 688 866
## 4 pdays 1211 1211 1211
## 5 previous 4513 839 4513
## 6 emp.var.rate 0 0 10313
## 7 cons.price.idx 0 0 0
## 8 cons.conf.idx 346 0 0
## 9 euribor3m 0 0 11384
## 10 nr.employed 0 0 0# ============================================================
# G. PENANGANAN OUTLIER: MEMPERTAHANKAN
# ============================================================
# Tidak semua outlier harus dihapus.
#
# Jika nilai ekstrem merupakan kondisi nyata dan
# tidak disebabkan oleh kesalahan pencatatan,
# nilai tersebut dapat dipertahankan.
train_keep_outlier <- train_data
# Tidak ada observasi yang dihapus.
# ============================================================
# H. PENANGANAN OUTLIER: MENGHAPUS
# ============================================================
# Contoh:
# Menghapus observasi yang merupakan kandidat outlier
# berdasarkan IQR pada variabel duration.
#
# HANYA contoh eksplorasi.
# Jangan langsung digunakan sebagai keputusan final.
var <- "duration"
Q1 <- quantile(
train_data[[var]],
0.25,
na.rm = TRUE
)
Q3 <- quantile(
train_data[[var]],
0.75,
na.rm = TRUE
)
IQR_value <- Q3 - Q1
lower_bound <- Q1 - 1.5 * IQR_value
upper_bound <- Q3 + 1.5 * IQR_value
train_remove <- train_data[
train_data[[var]] >= lower_bound &
train_data[[var]] <= upper_bound,
]
# Membandingkan jumlah data sebelum dan sesudah
nrow(train_data)## [1] 32942nrow(train_remove)## [1] 30624# ============================================================
# I. PENANGANAN OUTLIER: CAPPING / WINSORIZATION
# ============================================================
# Capping membatasi nilai ekstrem pada batas tertentu.
#
# Nilai di bawah lower bound diganti menjadi lower bound
# dan nilai di atas upper bound diganti menjadi upper bound.
#
# Batas dihitung berdasarkan DATA TRAIN saja.
train_capped <- train_data[numeric_vars]
test_capped <- test_data[numeric_vars]
for (var in numeric_vars) {
Q1 <- quantile(
train_data[[var]],
0.25,
na.rm = TRUE
)
Q3 <- quantile(
train_data[[var]],
0.75,
na.rm = TRUE
)
IQR_value <- Q3 - Q1
lower_bound <- Q1 - 1.5 * IQR_value
upper_bound <- Q3 + 1.5 * IQR_value
# Capping pada TRAIN
train_capped[[var]] <- pmax(
pmin(
train_data[[var]],
upper_bound
),
lower_bound
)
# Parameter TRAIN digunakan untuk TEST
test_capped[[var]] <- pmax(
pmin(
test_data[[var]],
upper_bound
),
lower_bound
)
}
# Melihat hasil capping
head(train_capped)## age duration campaign pdays previous emp.var.rate cons.price.idx
## 1 56 261.0 1 999 0 1.1 93.994
## 2 31 61.0 2 999 0 1.4 93.918
## 3 39 644.5 1 999 0 1.4 93.918
## 4 55 14.0 1 999 0 1.1 93.994
## 5 39 227.0 3 999 0 1.1 93.994
## 6 46 388.0 2 999 0 -1.8 92.893
## cons.conf.idx euribor3m nr.employed
## 1 -36.4 4.857 5191.0
## 2 -42.7 4.963 5228.1
## 3 -42.7 4.958 5228.1
## 4 -36.4 4.855 5191.0
## 5 -36.4 4.857 5191.0
## 6 -46.2 1.281 5099.1# ============================================================
# J. PENANGANAN OUTLIER: TRANSFORMASI
# ============================================================
# Transformasi dapat digunakan ketika outlier
# sebenarnya merupakan bagian dari distribusi data
# yang sangat menceng.
#
# Contoh menggunakan log1p pada:
# duration, campaign, dan previous.
train_transformed <- train_data
test_transformed <- test_data
transform_vars <- c(
"duration",
"campaign",
"previous"
)
for (var in transform_vars) {
train_transformed[[var]] <- log1p(
train_data[[var]]
)
test_transformed[[var]] <- log1p(
test_data[[var]]
)
}
# Melihat hasil transformasi
head(
train_transformed[
,
c(
"duration",
"campaign",
"previous"
)
]
)## duration campaign previous
## 1 5.568345 0.6931472 0.0000000
## 2 4.127134 1.0986123 0.0000000
## 3 6.831954 0.6931472 0.0000000
## 4 2.708050 0.6931472 0.0000000
## 5 5.429346 1.3862944 0.0000000
## 6 5.963579 1.0986123 0.6931472# ============================================================
# 6. PENANGANAN KETIDAKSEIMBANGAN KELAS
# Dataset: UCI Bank Marketing
# Target: y
# ============================================================
# ------------------------------------------------------------
# A. MEMERIKSA DISTRIBUSI KELAS
# ------------------------------------------------------------
# Melihat jumlah masing-masing kelas
table(train_data$y)##
## no yes
## 29230 3712# Menghitung proporsi masing-masing kelas
prop.table(table(train_data$y))##
## no yes
## 0.8873171 0.1126829# Mengubah proporsi menjadi persentase
prop.table(table(train_data$y)) * 100##
## no yes
## 88.73171 11.26829# ============================================================
# UNDERSAMPLING
# ============================================================
# Mengubah target y menjadi factor
# downSample() membutuhkan response berupa factor
train_data$y <- as.factor(train_data$y)
# Mengecek tipe data target
class(train_data$y)## [1] "factor"# Mengecek distribusi kelas sebelum undersampling
table(train_data$y)##
## no yes
## 29230 3712# Melakukan undersampling pada DATA TRAINING
set.seed(123)
train_down <- downSample(
x = train_data[, setdiff(names(train_data), "y")],
y = train_data$y
)
# Melihat distribusi kelas setelah undersampling
table(train_down$Class)##
## no yes
## 3712 3712# Melihat persentase kelas setelah undersampling
prop.table(
table(train_down$Class)
) * 100##
## no yes
## 50 50# ============================================================
# OVERSAMPLING
# ============================================================
# Oversampling memperbanyak kelas minoritas (yes)
# agar jumlahnya sama dengan kelas mayoritas (no).
#
# Proses hanya dilakukan pada DATA TRAINING.
set.seed(123)
train_up <- upSample(
x = train_data[, setdiff(names(train_data), "y")],
y = train_data$y
)
# Melihat jumlah kelas setelah oversampling
table(train_up$Class)##
## no yes
## 29230 29230# Melihat persentase kelas setelah oversampling
prop.table(
table(train_up$Class)
) * 100##
## no yes
## 50 50# ============================================================
# SMOTE
# ============================================================
# Memanggil package
library(smotefamily)## Warning: package 'smotefamily' was built under R version 4.4.3# ------------------------------------------------------------
# 1. Menyiapkan variabel numerik untuk SMOTE
# ------------------------------------------------------------
smote_x <- train_data[, numeric_vars]
# ------------------------------------------------------------
# 2. Menyiapkan target
# no = 0
# yes = 1
# ------------------------------------------------------------
smote_y <- ifelse(
train_data$y == "yes",
1,
0
)
# ------------------------------------------------------------
# 3. Melakukan SMOTE
# ------------------------------------------------------------
set.seed(123)
smote_result <- SMOTE(
X = smote_x,
target = smote_y,
K = 5,
dup_size = 1
)
# ------------------------------------------------------------
# 4. Melihat hasil SMOTE
# ------------------------------------------------------------
head(smote_result$data)## age duration campaign pdays previous emp.var.rate cons.price.idx
## 1 25 103 2 999 0 -2.9 92.963
## 2 70 530 2 999 0 -2.9 92.201
## 3 38 993 4 3 1 -2.9 92.963
## 4 54 1689 4 999 0 1.1 93.994
## 5 28 649 2 999 0 -1.8 92.893
## 6 36 328 1 999 0 -2.9 92.201
## cons.conf.idx euribor3m nr.employed class
## 1 -40.8 1.268 5076.2 1
## 2 -31.4 0.881 5076.2 1
## 3 -40.8 1.286 5076.2 1
## 4 -36.4 4.856 5191.0 1
## 5 -46.2 1.281 5099.1 1
## 6 -31.4 0.884 5076.2 1# ------------------------------------------------------------
# 5. Melihat distribusi kelas
# ------------------------------------------------------------
table(smote_result$data$class)##
## 0 1
## 29230 7424# ------------------------------------------------------------
# 6. Melihat persentase kelas
# ------------------------------------------------------------
prop.table(
table(smote_result$data$class)
) * 100##
## 0 1
## 79.74573 20.25427# ============================================================
# CEK HASIL SMOTE
# ============================================================
# Melihat jumlah observasi sebelum dan sesudah SMOTE
nrow(train_data)## [1] 32942nrow(smote_result$data)## [1] 36654# Melihat distribusi kelas
table(smote_result$data$class)##
## 0 1
## 29230 7424# Melihat persentase kelas
prop.table(
table(smote_result$data$class)
) * 100##
## 0 1
## 79.74573 20.25427# ============================================================
# CLASS WEIGHTING
# ============================================================
# Class weighting memberikan bobot lebih besar
# kepada kelas minoritas saat model dilatih.
#
# Class weighting TIDAK mengubah jumlah observasi.
# 1. Menghitung jumlah masing-masing kelas
class_count <- table(train_data$y)
class_count##
## no yes
## 29230 3712# 2. Menghitung bobot kelas berdasarkan inverse frequency
#
# Rumus:
# bobot = jumlah seluruh data /
# (jumlah kelas x jumlah observasi kelas)
class_weight <- sum(class_count) /
(length(class_count) * class_count)
# 3. Menampilkan bobot masing-masing kelas
class_weight##
## no yes
## 0.5634964 4.4372306# Membandingkan bobot kelas
class_weight["no"]## no
## 0.5634964class_weight["yes"]## yes
## 4.437231# Rasio bobot kelas minoritas terhadap mayoritas
class_weight["yes"] /
class_weight["no"]## yes
## 7.874461Ukuran evaluasi pada data yang tidak seimbang tidak cukup hanya menggunakan accuracy karena nilai tersebut dapat terlihat tinggi meskipun model kurang mampu mengenali kelas minoritas. Oleh karena itu, precision digunakan untuk melihat ketepatan prediksi kelas positif, recall untuk mengukur kemampuan model menemukan seluruh kasus positif, dan F1-score untuk menyeimbangkan precision dan recall. Selain itu, specificity digunakan untuk menilai kemampuan mengenali kelas negatif, balanced accuracy untuk memberikan penilaian yang lebih seimbang terhadap kedua kelas, sedangkan ROC-AUC dan PR-AUC digunakan untuk melihat kemampuan model membedakan kelas pada berbagai nilai threshold, dengan PR-AUC yang lebih berfokus pada performa kelas positif atau minoritas.
# ============================================================
# A. FEATURE ENGINEERING
# ============================================================
# Membuat fitur baru:
# previously_contacted = 0 jika pdays = 999
# previously_contacted = 1 jika pernah dihubungi sebelumnya
train_data$previously_contacted <- ifelse(
train_data$pdays == 999,
0,
1
)
test_data$previously_contacted <- ifelse(
test_data$pdays == 999,
0,
1
)
# Melihat hasil fitur baru
head(
train_data[
,
c("pdays", "previously_contacted")
]
)## pdays previously_contacted
## 1 999 0
## 2 999 0
## 3 999 0
## 4 999 0
## 5 999 0
## 6 999 0# Melihat jumlah masing-masing kategori
table(
train_data$previously_contacted
)##
## 0 1
## 31731 1211# ============================================================
# B. FILTER METHOD
# Seleksi fitur berdasarkan uji statistik
# ============================================================
# 1. Menentukan variabel numerik
numeric_vars <- c(
"age",
"duration",
"campaign",
"pdays",
"previous",
"emp.var.rate",
"cons.price.idx",
"cons.conf.idx",
"euribor3m",
"nr.employed"
)
# 2. Membuat data untuk menyimpan hasil uji
filter_results <- data.frame(
variable = character(),
p_value = numeric(),
mean_no = numeric(),
mean_yes = numeric()
)
# 3. Melakukan uji Welch t-test
# Untuk setiap variabel numerik,
# dibandingkan nilai antara kelas no dan yes
for (var in numeric_vars) {
formula_test <- as.formula(
paste(var, "~ y")
)
test_result <- t.test(
formula_test,
data = train_data
)
# Menghitung rata-rata masing-masing kelas
mean_no <- mean(
train_data[
train_data$y == "no",
var
],
na.rm = TRUE
)
mean_yes <- mean(
train_data[
train_data$y == "yes",
var
],
na.rm = TRUE
)
# Menyimpan hasil
filter_results <- rbind(
filter_results,
data.frame(
variable = var,
p_value = test_result$p.value,
mean_no = mean_no,
mean_yes = mean_yes
)
)
}
# 4. Menambahkan keputusan signifikansi
# p-value < 0.05 → terdapat perbedaan yang signifikan
filter_results$significant <- ifelse(
filter_results$p_value < 0.05,
"Ya",
"Tidak"
)
# 5. Mengurutkan berdasarkan p-value terkecil
filter_results <- filter_results[
order(filter_results$p_value),
]
# 6. Menampilkan hasil
filter_results## variable p_value mean_no mean_yes significant
## 2 duration 0.000000e+00 220.8697913 548.9574353 Ya
## 6 emp.var.rate 0.000000e+00 0.2495929 -1.2534483 Ya
## 9 euribor3m 0.000000e+00 3.8115460 2.0993322 Ya
## 10 nr.employed 0.000000e+00 5176.2124324 5094.4122306 Ya
## 4 pdays 3.820915e-164 983.9879918 793.2618534 Ya
## 5 previous 8.222431e-127 0.1331167 0.4835668 Ya
## 7 cons.price.idx 1.773273e-103 93.6037619 93.3488949 Ya
## 3 campaign 5.276688e-72 2.6201163 2.0471444 Ya
## 8 cons.conf.idx 2.614059e-11 -40.5935169 -39.8993534 Ya
## 1 age 3.653075e-05 39.8993500 40.8714978 Ya# ============================================================
# C. WRAPPER METHOD - RECURSIVE FEATURE ELIMINATION (RFE)
# ============================================================
# Wrapper method melakukan seleksi fitur dengan mencoba
# beberapa kombinasi fitur menggunakan suatu model.
#
# Pada penelitian ini digunakan:
# - RFE (Recursive Feature Elimination)
# - Regresi logistik sebagai model
# - Cross-validation 5-fold
#
# Seleksi dilakukan hanya menggunakan DATA TRAINING.
# ------------------------------------------------------------
# 1. Memanggil package
# ------------------------------------------------------------
library(caret)
# ------------------------------------------------------------
# 2. Menyiapkan data
# ------------------------------------------------------------
# Mengambil variabel numerik dan target
rfe_data <- train_data[
,
c(
numeric_vars,
"y"
)
]
# Memastikan target bertipe factor
rfe_data$y <- factor(
rfe_data$y,
levels = c("no", "yes")
)
# ------------------------------------------------------------
# 3. Menentukan kontrol RFE
# ------------------------------------------------------------
set.seed(123)
rfe_control <- rfeControl(
functions = lrFuncs,
method = "cv",
number = 5,
verbose = FALSE
)
# ------------------------------------------------------------
# 4. Menjalankan RFE
# ------------------------------------------------------------
# RFE akan mencoba beberapa jumlah fitur:
# 2, 4, 6, 8, dan 10 fitur
set.seed(123)
rfe_result <- rfe(
x = rfe_data[, numeric_vars],
y = rfe_data$y,
sizes = c(2, 4, 6, 8, 10),
rfeControl = rfe_control
)
# ------------------------------------------------------------
# 5. Menampilkan hasil RFE
# ------------------------------------------------------------
print(rfe_result)##
## Recursive feature selection
##
## Outer resampling method: Cross-Validated (5 fold)
##
## Resampling performance over subset size:
##
## Variables Accuracy Kappa AccuracySD KappaSD Selected
## 2 0.9055 0.3943 0.002399 0.01654
## 4 0.9037 0.3972 0.002268 0.02383
## 6 0.9076 0.4306 0.002164 0.02576
## 8 0.9079 0.4354 0.002173 0.02394
## 10 0.9081 0.4372 0.002612 0.02503 *
##
## The top 5 variables (out of 10):
## duration, pdays, emp.var.rate, previous, nr.employed# ------------------------------------------------------------
# 6. Melihat jumlah fitur terbaik
# ------------------------------------------------------------
rfe_result$optsize## [1] 10# ------------------------------------------------------------
# 7. Melihat fitur yang dipilih
# ------------------------------------------------------------
predictors(rfe_result)## [1] "duration" "pdays" "emp.var.rate" "previous"
## [5] "nr.employed" "cons.price.idx" "cons.conf.idx" "campaign"
## [9] "euribor3m" "age"# ------------------------------------------------------------
# 8. Melihat hasil performa setiap jumlah fitur
# ------------------------------------------------------------
rfe_result$results## Variables Accuracy Kappa AccuracySD KappaSD
## 1 2 0.9055310 0.3942769 0.002398523 0.01654158
## 2 4 0.9037096 0.3972425 0.002268293 0.02383001
## 3 6 0.9075649 0.4305661 0.002164428 0.02576101
## 4 8 0.9079291 0.4353683 0.002173428 0.02394494
## 5 10 0.9080809 0.4372294 0.002611700 0.02502904# ============================================================
# D. EMBEDDED METHOD - LASSO
# ============================================================
# Embedded method melakukan seleksi fitur
# ketika model sedang dilatih.
#
# LASSO menggunakan penalti L1 sehingga beberapa
# koefisien dapat menjadi 0.
#
# Koefisien = 0 -> fitur tidak dipilih
# Koefisien != 0 -> fitur dipilih
#
# Seleksi dilakukan hanya pada DATA TRAINING.
# ------------------------------------------------------------
# 1. Memanggil package
# ------------------------------------------------------------
library(glmnet)## Warning: package 'glmnet' was built under R version 4.4.3## Loading required package: Matrix## Warning: package 'Matrix' was built under R version 4.4.3## Loaded glmnet 4.1-10# ------------------------------------------------------------
# 2. Menyiapkan data prediktor
# ------------------------------------------------------------
# Menggunakan 10 variabel numerik
x_train <- as.matrix(
train_data[, numeric_vars]
)
# ------------------------------------------------------------
# 3. Menyiapkan target
# ------------------------------------------------------------
# Mengubah target:
# no = 0
# yes = 1
y_train <- ifelse(
train_data$y == "yes",
1,
0
)
# ------------------------------------------------------------
# 4. Menangani data yang belum diskalakan
# ------------------------------------------------------------
# LASSO sensitif terhadap skala.
# Karena itu standardization dilakukan oleh glmnet
# dengan standardize = TRUE.
# ------------------------------------------------------------
# 5. Menjalankan LASSO dengan Cross-Validation
# ------------------------------------------------------------
set.seed(123)
lasso_model <- cv.glmnet(
x = x_train,
y = y_train,
family = "binomial",
alpha = 1,
standardize = TRUE,
nfolds = 5,
type.measure = "class"
)
# ------------------------------------------------------------
# 6. Menampilkan nilai lambda terbaik
# ------------------------------------------------------------
lasso_model$lambda.min## [1] 0.001327619# ------------------------------------------------------------
# 7. Menampilkan lambda yang lebih sederhana
# ------------------------------------------------------------
lasso_model$lambda.1se## [1] 0.007775891# ------------------------------------------------------------
# 8. Mengambil koefisien pada lambda terbaik
# ------------------------------------------------------------
lasso_coef <- coef(
lasso_model,
s = "lambda.min"
)
# Menampilkan koefisien
lasso_coef## 11 x 1 sparse Matrix of class "dgCMatrix"
## lambda.min
## (Intercept) 30.426181258
## age 0.001156289
## duration 0.004341353
## campaign -0.022038136
## pdays -0.001796115
## previous -0.233534998
## emp.var.rate -0.313347043
## cons.price.idx 0.187245270
## cons.conf.idx 0.024784434
## euribor3m .
## nr.employed -0.009527211# ------------------------------------------------------------
# 9. Mengubah koefisien menjadi data frame
# ------------------------------------------------------------
lasso_coef_df <- data.frame(
feature = rownames(lasso_coef),
coefficient = as.numeric(lasso_coef)
)
# Menampilkan tabel koefisien
lasso_coef_df## feature coefficient
## 1 (Intercept) 30.426181258
## 2 age 0.001156289
## 3 duration 0.004341353
## 4 campaign -0.022038136
## 5 pdays -0.001796115
## 6 previous -0.233534998
## 7 emp.var.rate -0.313347043
## 8 cons.price.idx 0.187245270
## 9 cons.conf.idx 0.024784434
## 10 euribor3m 0.000000000
## 11 nr.employed -0.009527211# ------------------------------------------------------------
# 10. Menentukan fitur yang dipilih
# ------------------------------------------------------------
selected_features <- lasso_coef_df[
lasso_coef_df$coefficient != 0,
]
# Menampilkan fitur terpilih
selected_features## feature coefficient
## 1 (Intercept) 30.426181258
## 2 age 0.001156289
## 3 duration 0.004341353
## 4 campaign -0.022038136
## 5 pdays -0.001796115
## 6 previous -0.233534998
## 7 emp.var.rate -0.313347043
## 8 cons.price.idx 0.187245270
## 9 cons.conf.idx 0.024784434
## 11 nr.employed -0.009527211# ------------------------------------------------------------
# 11. Menghitung jumlah fitur terpilih
# ------------------------------------------------------------
nrow(selected_features)## [1] 10# ------------------------------------------------------------
# 12. Mengambil hanya nama fitur
# ------------------------------------------------------------
selected_feature_names <- selected_features$feature
selected_feature_names## [1] "(Intercept)" "age" "duration" "campaign"
## [5] "pdays" "previous" "emp.var.rate" "cons.price.idx"
## [9] "cons.conf.idx" "nr.employed"# ============================================================
# E. PCA (PRINCIPAL COMPONENT ANALYSIS)
# ============================================================
# PCA digunakan untuk mengurangi jumlah dimensi
# dengan membentuk variabel baru yang disebut
# principal components.
#
# PCA dilakukan pada variabel numerik.
#
# Sebelum PCA, data di-center dan di-scale karena
# variabel memiliki satuan dan skala yang berbeda.
#
# Parameter PCA dipelajari dari DATA TRAINING saja.
# ------------------------------------------------------------
# 1. Menentukan variabel numerik
# ------------------------------------------------------------
numeric_vars <- c(
"age",
"duration",
"campaign",
"pdays",
"previous",
"emp.var.rate",
"cons.price.idx",
"cons.conf.idx",
"euribor3m",
"nr.employed"
)
# ------------------------------------------------------------
# 2. Membuat model PCA dari DATA TRAINING
# ------------------------------------------------------------
pca_model <- preProcess(
train_data[numeric_vars],
method = c(
"center",
"scale",
"pca"
),
thresh = 0.90
)
# ------------------------------------------------------------
# 3. Menerapkan PCA pada DATA TRAINING
# ------------------------------------------------------------
train_pca <- predict(
pca_model,
train_data[numeric_vars]
)
# ------------------------------------------------------------
# 4. Menerapkan PCA yang sama pada DATA TESTING
# ------------------------------------------------------------
test_pca <- predict(
pca_model,
test_data[numeric_vars]
)
# ------------------------------------------------------------
# 5. Melihat hasil PCA
# ------------------------------------------------------------
head(train_pca)## PC1 PC2 PC3 PC4 PC5 PC6
## 1 -1.278040 -0.8673360 1.4856433 0.20317745 0.08895881 -0.6425637
## 2 -1.506714 0.3514395 -0.8795994 -0.17864925 -0.89360611 -0.2970248
## 3 -1.374573 -0.1103473 -0.4553528 2.45628219 1.22034287 -0.1230187
## 4 -1.304518 -0.7657750 1.4718112 -0.50614505 -0.52592224 -0.7989060
## 5 -1.353420 -0.4568913 0.2269941 -0.06764714 -0.24145002 0.4804820
## 6 2.752731 0.3641192 -0.1514603 0.16138006 0.75598902 -0.8827756# ------------------------------------------------------------
# 6. Melihat jumlah variabel awal
# ------------------------------------------------------------
length(numeric_vars)## [1] 10# ------------------------------------------------------------
# 7. Melihat jumlah komponen PCA
# ------------------------------------------------------------
ncol(train_pca)## [1] 6# ------------------------------------------------------------
# 8. Melihat informasi model PCA
# ------------------------------------------------------------
pca_model## Created from 32942 samples and 10 variables
##
## Pre-processing:
## - centered (10)
## - ignored (0)
## - principal component signal extraction (10)
## - scaled (10)
##
## PCA needed 6 components to capture 90 percent of the variance# ------------------------------------------------------------
# 9. Melihat proporsi variasi yang dijelaskan
# ------------------------------------------------------------
pca_model$std## age duration campaign pdays previous
## 10.4213564 258.8582083 2.7538804 186.8594853 0.4918991
## emp.var.rate cons.price.idx cons.conf.idx euribor3m nr.employed
## 1.5702445 0.5783578 4.6189925 1.7349075 72.2758083# ------------------------------------------------------------
# 10. Melihat loading PCA
# ------------------------------------------------------------
pca_model$rotation## PC1 PC2 PC3 PC4 PC5
## age -0.0004974816 -0.241421262 0.669346016 -0.170970608 0.43104960
## duration 0.0283928146 -0.081982351 -0.052805695 0.760525060 0.60112739
## campaign -0.0997763178 0.008061245 -0.239179983 -0.619390537 0.62196836
## pdays -0.2261114322 0.634174603 0.240507579 0.026999571 0.04931405
## previous 0.3057035754 -0.479095142 -0.268260563 -0.059706569 -0.03728294
## emp.var.rate -0.4881233958 -0.164089473 -0.095410199 0.033623064 -0.02917719
## cons.price.idx -0.3650727396 -0.284652841 -0.280086422 0.036234384 0.04168248
## cons.conf.idx -0.1062047336 -0.416833121 0.522725323 -0.002872354 -0.23442362
## euribor3m -0.4907993877 -0.145923183 -0.008192651 0.036986408 -0.06161690
## nr.employed -0.4700544564 0.014969348 -0.036226878 0.024748933 -0.02890959
## PC6
## age -0.526756863
## duration 0.216815001
## campaign 0.402401392
## pdays 0.017018796
## previous -0.139307905
## emp.var.rate -0.074177609
## cons.price.idx -0.247955441
## cons.conf.idx 0.651215573
## euribor3m 0.004697172
## nr.employed -0.052983446# ============================================================
# B. FIT DAN TRANSFORM
# ============================================================
# Menentukan variabel numerik
numeric_vars <- c(
"age",
"duration",
"campaign",
"pdays",
"previous",
"emp.var.rate",
"cons.price.idx",
"cons.conf.idx",
"euribor3m",
"nr.employed"
)
# ------------------------------------------------------------
# FIT
# ------------------------------------------------------------
# Parameter mean dan standard deviation
# dipelajari dari DATA TRAINING saja
standard_model <- preProcess(
train_data[numeric_vars],
method = c(
"center",
"scale"
)
)
# ------------------------------------------------------------
# TRANSFORM TRAIN
# ------------------------------------------------------------
train_scaled <- predict(
standard_model,
train_data[numeric_vars]
)
# ------------------------------------------------------------
# TRANSFORM TEST
# ------------------------------------------------------------
# Menggunakan parameter yang telah dipelajari
# dari TRAINING
test_scaled <- predict(
standard_model,
test_data[numeric_vars]
)
# Melihat hasil
head(train_scaled)## age duration campaign pdays previous emp.var.rate
## 1 1.53445530 0.01220878 -0.5648583 0.1953531 -0.350898 0.6494366
## 2 -0.86446467 -0.76041497 -0.2017343 0.1953531 -0.350898 0.8404896
## 3 -0.09681028 2.58118275 -0.5648583 0.1953531 -0.350898 0.8404896
## 4 1.43849851 -0.94198156 -0.5648583 0.1953531 -0.350898 0.6494366
## 5 -0.09681028 -0.11913726 0.1613897 0.1953531 -0.350898 0.6494366
## 6 0.57488731 0.50282486 -0.2017343 0.1953531 1.682039 -1.1974096
## cons.price.idx cons.conf.idx euribor3m nr.employed
## 1 0.7243911 0.8909511 0.7138082 0.3321312
## 2 0.5929845 -0.4729827 0.7749066 0.8454427
## 3 0.5929845 -0.4729827 0.7720246 0.8454427
## 4 0.7243911 0.8909511 0.7126554 0.3321312
## 5 0.7243911 0.8909511 0.7138082 0.3321312
## 6 -1.1792748 -1.2307237 -1.3473968 -0.9393869head(test_scaled)## age duration campaign pdays previous emp.var.rate
## 1 1.6304121 0.13582858 -0.5648583 0.1953531 -0.350898 0.6494366
## 2 -0.2887239 -0.44750235 -0.2017343 0.1953531 -0.350898 -1.1974096
## 3 4.3172025 -0.29684072 -0.2017343 0.1953531 -0.350898 -2.2163593
## 4 1.7263689 0.10106051 -0.5648583 -5.1188005 1.682039 -1.1974096
## 5 4.0293321 0.08174492 0.1613897 -5.1348553 3.714977 -0.7516192
## 6 -0.8644647 -0.12686350 -0.2017343 0.1953531 -0.350898 0.8404896
## cons.price.idx cons.conf.idx euribor3m nr.employed
## 1 0.7243911 0.8909511 0.7138082 0.3321312
## 2 -1.1792748 -1.2307237 -1.3560428 -0.9393869
## 3 -1.9780882 2.9476767 -1.6598054 -2.0683954
## 4 0.3007779 1.2806465 -1.7157161 -2.1901512
## 5 1.0788429 0.6528040 -1.5802622 -2.8141498
## 6 0.5929845 -0.4729827 0.7743302 0.8454427# ============================================================
# D. CROSS-VALIDATION
# ============================================================
library(caret)
# Membuat kontrol 5-fold cross-validation
set.seed(123)
cv_control <- trainControl(
method = "cv",
number = 5
)
# Melihat pengaturan cross-validation
cv_control## $method
## [1] "cv"
##
## $number
## [1] 5
##
## $repeats
## [1] NA
##
## $search
## [1] "grid"
##
## $p
## [1] 0.75
##
## $initialWindow
## NULL
##
## $horizon
## [1] 1
##
## $fixedWindow
## [1] TRUE
##
## $skip
## [1] 0
##
## $verboseIter
## [1] FALSE
##
## $returnData
## [1] TRUE
##
## $returnResamp
## [1] "final"
##
## $savePredictions
## [1] FALSE
##
## $classProbs
## [1] FALSE
##
## $summaryFunction
## function (data, lev = NULL, model = NULL)
## {
## if (is.character(data$obs))
## data$obs <- factor(data$obs, levels = lev)
## postResample(data[, "pred"], data[, "obs"])
## }
## <bytecode: 0x000001205b5b6a88>
## <environment: namespace:caret>
##
## $selectionFunction
## [1] "best"
##
## $preProcOptions
## $preProcOptions$thresh
## [1] 0.95
##
## $preProcOptions$ICAcomp
## [1] 3
##
## $preProcOptions$k
## [1] 5
##
## $preProcOptions$freqCut
## [1] 19
##
## $preProcOptions$uniqueCut
## [1] 10
##
## $preProcOptions$cutoff
## [1] 0.9
##
##
## $sampling
## NULL
##
## $index
## NULL
##
## $indexOut
## NULL
##
## $indexFinal
## NULL
##
## $timingSamps
## [1] 0
##
## $predictionBounds
## [1] FALSE FALSE
##
## $seeds
## [1] NA
##
## $adaptive
## $adaptive$min
## [1] 5
##
## $adaptive$alpha
## [1] 0.05
##
## $adaptive$method
## [1] "gls"
##
## $adaptive$complete
## [1] TRUE
##
##
## $trim
## [1] FALSE
##
## $allowParallel
## [1] TRUE