# ============================================================
# ANALISIS GRADIENT BOOSTING REGRESSION
# DENGAN PENENTUAN JUMLAH POHON OPTIMAL
# ============================================================
# ============================================================
# 1. MEMANGGIL PACKAGE
# ============================================================
library(gbm)
## Loaded gbm 2.3.1
## This version of gbm is no longer under development. Consider transitioning to gbm3, https://github.com/gbm-developers/gbm3
library(ggplot2)
# ============================================================
# 2. MEMBACA DATA
# ============================================================
train <- read.csv(
"D:/STATISTIKA/SEM 5/Modern Prediksi dan Machine Learning/PEkan 9-18/Studi Kasus pekan 11/train.csv",
stringsAsFactors = FALSE
)
test <- read.csv(
"D:/STATISTIKA/SEM 5/Modern Prediksi dan Machine Learning/PEkan 9-18/Studi Kasus pekan 11/test.csv",
stringsAsFactors = FALSE
)
cat("Jumlah data training:", nrow(train), "\n")
## Jumlah data training: 51879
cat("Jumlah data testing:", nrow(test), "\n")
## Jumlah data testing: 22232
# Memastikan variabel respons tersedia
if (!"price" %in% names(train)) {
stop("Variabel price tidak ditemukan pada data training.")
}
# Mengubah price menjadi numerik
train$price <- as.numeric(
gsub("[^0-9.]", "", as.character(train$price))
)
# Menghapus harga yang tidak valid
train <- train[
is.finite(train$price) & train$price >= 0,
,
drop = FALSE
]
# Menyimpan ID data testing
if ("id" %in% names(test)) {
id_test <- test$id
} else {
id_test <- seq_len(nrow(test))
}
# ============================================================
# 3. MEMILIH VARIABEL PENELITIAN
# ============================================================
# Variabel respons
variabel_Y <- "price"
# 12 variabel prediktor sesuai tabel penelitian
variabel_X <- c(
"property_type",
"room_type",
"accommodates",
"bedrooms",
"bathrooms",
"beds",
"number_of_reviews",
"review_scores_rating",
"host_response_rate",
"cancellation_policy",
"instant_bookable",
"cleaning_fee"
)
# Memeriksa variabel pada data training
variabel_tidak_ada <- setdiff(
c(variabel_Y, variabel_X),
names(train)
)
if (length(variabel_tidak_ada) > 0) {
stop(
paste(
"Variabel tidak tersedia pada training:",
paste(variabel_tidak_ada, collapse = ", ")
)
)
}
# Memeriksa variabel pada data testing
variabel_test_tidak_ada <- setdiff(
variabel_X,
names(test)
)
if (length(variabel_test_tidak_ada) > 0) {
stop(
paste(
"Variabel tidak tersedia pada testing:",
paste(variabel_test_tidak_ada, collapse = ", ")
)
)
}
# Mengambil hanya variabel penelitian
X_train_raw <- train[, variabel_X, drop = FALSE]
X_test_raw <- test[, variabel_X, drop = FALSE]
n_train <- nrow(X_train_raw)
cat("\nJUMLAH VARIABEL PREDIKTOR:", length(variabel_X), "\n")
##
## JUMLAH VARIABEL PREDIKTOR: 12
print(variabel_X)
## [1] "property_type" "room_type" "accommodates"
## [4] "bedrooms" "bathrooms" "beds"
## [7] "number_of_reviews" "review_scores_rating" "host_response_rate"
## [10] "cancellation_policy" "instant_bookable" "cleaning_fee"
# ============================================================
# 4. MENGGABUNGKAN DATA TRAINING DAN TESTING
# ============================================================
X_gabungan <- rbind(
X_train_raw,
X_test_raw
)
# ============================================================
# 5. PREPROCESSING VARIABEL
# ============================================================
# Mengubah host_response_rate menjadi numerik
X_gabungan$host_response_rate <- as.numeric(
gsub(
"%",
"",
as.character(X_gabungan$host_response_rate)
)
)
# Mengubah cleaning_fee menjadi numerik
X_gabungan$cleaning_fee <- as.numeric(
gsub(
"[$,]",
"",
as.character(X_gabungan$cleaning_fee)
)
)
## Warning: NAs introduced by coercion
# Variabel numerik
variabel_numerik <- c(
"accommodates",
"bedrooms",
"bathrooms",
"beds",
"number_of_reviews",
"review_scores_rating",
"host_response_rate",
"cleaning_fee"
)
# Variabel kategorik
variabel_kategorik <- c(
"property_type",
"room_type",
"cancellation_policy",
"instant_bookable"
)
# Memastikan tipe data numerik
for (v in variabel_numerik) {
X_gabungan[[v]] <- as.numeric(
as.character(X_gabungan[[v]])
)
}
# Memastikan tipe data kategorik
for (v in variabel_kategorik) {
X_gabungan[[v]] <- as.factor(
as.character(X_gabungan[[v]])
)
}
# ============================================================
# 6. MENGATASI MISSING VALUE
# ============================================================
for (j in seq_along(X_gabungan)) {
kolom <- X_gabungan[[j]]
if (is.numeric(kolom)) {
kolom[!is.finite(kolom)] <- NA
# Median dihitung dari data training
median_train <- median(
kolom[seq_len(n_train)],
na.rm = TRUE
)
if (!is.finite(median_train)) {
median_train <- 0
}
kolom[is.na(kolom)] <- median_train
X_gabungan[[j]] <- kolom
} else {
kolom <- as.character(kolom)
kolom[
is.na(kolom) |
trimws(kolom) == ""
] <- "Tidak diketahui"
X_gabungan[[j]] <- as.factor(kolom)
}
}
# ============================================================
# 7. MENGUBAH VARIABEL KATEGORIK MENJADI DUMMY
# ============================================================
X_all <- model.matrix(
~ . - 1,
data = X_gabungan
)
colnames(X_all) <- make.names(
colnames(X_all),
unique = TRUE
)
X_all[!is.finite(X_all)] <- 0
# Memisahkan data training dan testing
X_train_all <- X_all[
seq_len(n_train),
,
drop = FALSE
]
X_test_all <- X_all[
(n_train + 1):nrow(X_all),
,
drop = FALSE
]
cat("\nJUMLAH PREDIKTOR SETELAH DUMMY:",
ncol(X_train_all), "\n")
##
## JUMLAH PREDIKTOR SETELAH DUMMY: 50
cat("\nDAFTAR PREDIKTOR SETELAH DUMMY:\n")
##
## DAFTAR PREDIKTOR SETELAH DUMMY:
print(colnames(X_train_all))
## [1] "property_typeApartment" "property_typeBed...Breakfast"
## [3] "property_typeBoat" "property_typeBoutique.hotel"
## [5] "property_typeBungalow" "property_typeCabin"
## [7] "property_typeCamper.RV" "property_typeCasa.particular"
## [9] "property_typeCastle" "property_typeCave"
## [11] "property_typeChalet" "property_typeCondominium"
## [13] "property_typeDorm" "property_typeEarth.House"
## [15] "property_typeGuest.suite" "property_typeGuesthouse"
## [17] "property_typeHostel" "property_typeHouse"
## [19] "property_typeHut" "property_typeIn.law"
## [21] "property_typeIsland" "property_typeLighthouse"
## [23] "property_typeLoft" "property_typeOther"
## [25] "property_typeParking.Space" "property_typeServiced.apartment"
## [27] "property_typeTent" "property_typeTimeshare"
## [29] "property_typeTipi" "property_typeTownhouse"
## [31] "property_typeTrain" "property_typeTreehouse"
## [33] "property_typeVacation.home" "property_typeVilla"
## [35] "property_typeYurt" "room_typePrivate.room"
## [37] "room_typeShared.room" "accommodates"
## [39] "bedrooms" "bathrooms"
## [41] "beds" "number_of_reviews"
## [43] "review_scores_rating" "host_response_rate"
## [45] "cancellation_policymoderate" "cancellation_policystrict"
## [47] "cancellation_policysuper_strict_30" "cancellation_policysuper_strict_60"
## [49] "instant_bookablet" "cleaning_fee"
# ============================================================
# 8. TRANSFORMASI VARIABEL RESPONS
# ============================================================
# Transformasi logaritma
y_all <- log1p(train$price)
# ============================================================
# 9. MEMBAGI DATA TRAINING DAN VALIDASI
# ============================================================
set.seed(123)
n <- nrow(X_train_all)
indeks_train <- sample(
seq_len(n),
size = floor(0.8 * n)
)
indeks_valid <- setdiff(
seq_len(n),
indeks_train
)
# Data training
X_train <- X_train_all[
indeks_train,
,
drop = FALSE
]
y_train <- y_all[indeks_train]
# Data validasi
X_valid <- X_train_all[
indeks_valid,
,
drop = FALSE
]
y_valid <- y_all[indeks_valid]
# Nilai aktual skala asli
actual <- train$price[indeks_valid]
# Membentuk data frame untuk gbm
data_gb <- data.frame(
y = as.numeric(y_train),
X_train,
check.names = TRUE
)
data_valid_gb <- as.data.frame(
X_valid,
check.names = TRUE
)
cat("\nJumlah data training:", nrow(data_gb), "\n")
##
## Jumlah data training: 41503
cat("Jumlah data validasi:", nrow(data_valid_gb), "\n")
## Jumlah data validasi: 10376
# ============================================================
# 10. PEMODELAN GRADIENT BOOSTING
# DENGAN CROSS VALIDATION 5-FOLD
# ============================================================
set.seed(123)
model_gb <- gbm(
formula = y ~ .,
distribution = "gaussian",
data = data_gb,
# Batas maksimum pencarian
n.trees = 1000,
# Parameter model
interaction.depth = 3,
n.minobsinnode = 2,
shrinkage = 0.05,
bag.fraction = 0.8,
# Cross Validation
cv.folds = 5,
# Menggunakan satu core
n.cores = 1,
verbose = FALSE
)
## CV: 1
## Warning in gbm.fit(x = x, y = y, offset = offset, distribution = distribution,
## : variable 22: property_typeLighthouse has no variation.
## Warning in gbm.fit(x = x, y = y, offset = offset, distribution = distribution,
## : variable 50: cleaning_fee has no variation.
## CV: 2
## Warning in gbm.fit(x = x, y = y, offset = offset, distribution = distribution,
## : variable 22: property_typeLighthouse has no variation.
## Warning in gbm.fit(x = x, y = y, offset = offset, distribution = distribution,
## : variable 50: cleaning_fee has no variation.
## CV: 3
## Warning in gbm.fit(x = x, y = y, offset = offset, distribution = distribution,
## : variable 22: property_typeLighthouse has no variation.
## Warning in gbm.fit(x = x, y = y, offset = offset, distribution = distribution,
## : variable 50: cleaning_fee has no variation.
## CV: 4
## Warning in gbm.fit(x = x, y = y, offset = offset, distribution = distribution,
## : variable 22: property_typeLighthouse has no variation.
## Warning in gbm.fit(x = x, y = y, offset = offset, distribution = distribution,
## : variable 50: cleaning_fee has no variation.
## CV: 5
## Warning in gbm.fit(x = x, y = y, offset = offset, distribution = distribution,
## : variable 22: property_typeLighthouse has no variation.
## Warning in gbm.fit(x = x, y = y, offset = offset, distribution = distribution,
## : variable 50: cleaning_fee has no variation.
## Warning in gbm.fit(x = x, y = y, offset = offset, distribution = distribution,
## : variable 22: property_typeLighthouse has no variation.
## Warning in gbm.fit(x = x, y = y, offset = offset, distribution = distribution,
## : variable 50: cleaning_fee has no variation.
# ============================================================
# 11. MENENTUKAN JUMLAH POHON OPTIMAL
# ============================================================
jumlah_pohon_optimal <- gbm.perf(
model_gb,
method = "cv",
plot.it = TRUE
)
cat("\n====================================\n")
##
## ====================================
cat("HASIL PENCARIAN POHON OPTIMAL\n")
## HASIL PENCARIAN POHON OPTIMAL
cat("====================================\n")
## ====================================
cat(
"Jumlah pohon optimal:",
jumlah_pohon_optimal,
"\n"
)
## Jumlah pohon optimal: 992
# Memeriksa apakah pencarian mencapai batas
if (jumlah_pohon_optimal >= 1000) {
warning(
"Jumlah pohon optimal mencapai batas maksimum 1000. ",
"Pencarian perlu diperluas."
)
}
# ============================================================
# 12. PREDIKSI DATA VALIDASI
# MENGGUNAKAN POHON OPTIMAL
# ============================================================
pred_valid_log <- predict(
model_gb,
newdata = data_valid_gb,
n.trees = jumlah_pohon_optimal,
type = "response"
)
# Mengembalikan ke skala asli
pred_valid <- expm1(pred_valid_log)
# ============================================================
# 13. EVALUASI MODEL
# ============================================================
# RMSE
RMSE <- sqrt(
mean((actual - pred_valid)^2)
)
# MAE
MAE <- mean(
abs(actual - pred_valid)
)
# R-Squared
R2 <- 1 -
sum((actual - pred_valid)^2) /
sum((actual - mean(actual))^2)
# Tabel evaluasi
hasil_evaluasi <- data.frame(
Model = "Gradient Boosting",
Jumlah_Pohon_Optimal = jumlah_pohon_optimal,
RMSE = RMSE,
MAE = MAE,
R2 = R2
)
cat("\nHASIL EVALUASI MODEL\n")
##
## HASIL EVALUASI MODEL
print(hasil_evaluasi)
## Model Jumlah_Pohon_Optimal RMSE MAE R2
## 1 Gradient Boosting 992 125.6057 60.14508 0.4426829
# ============================================================
# 14. VISUALISASI AKTUAL DAN PREDIKSI
# ============================================================
data_plot <- data.frame(
Aktual = actual,
Prediksi = pred_valid
)
ggplot(
data_plot,
aes(x = Aktual, y = Prediksi)
) +
geom_point(alpha = 0.4) +
geom_abline(
intercept = 0,
slope = 1,
linetype = "dashed"
) +
labs(
title = "Aktual vs Prediksi Gradient Boosting",
x = "Harga Aktual",
y = "Harga Prediksi"
) +
theme_minimal()
# ============================================================
# 15. VARIABLE RELATIVE INFLUENCE
# ============================================================
importance_gb <- summary(
model_gb,
n.trees = jumlah_pohon_optimal,
plotit = TRUE
)
cat("\nRELATIVE INFLUENCE\n")
##
## RELATIVE INFLUENCE
print(importance_gb)
## var
## room_typePrivate.room room_typePrivate.room
## bedrooms bedrooms
## accommodates accommodates
## room_typeShared.room room_typeShared.room
## bathrooms bathrooms
## number_of_reviews number_of_reviews
## review_scores_rating review_scores_rating
## beds beds
## property_typeCondominium property_typeCondominium
## host_response_rate host_response_rate
## cancellation_policystrict cancellation_policystrict
## property_typeHouse property_typeHouse
## instant_bookablet instant_bookablet
## property_typeLoft property_typeLoft
## property_typeTimeshare property_typeTimeshare
## property_typeOther property_typeOther
## property_typeApartment property_typeApartment
## cancellation_policymoderate cancellation_policymoderate
## property_typeBed...Breakfast property_typeBed...Breakfast
## cancellation_policysuper_strict_30 cancellation_policysuper_strict_30
## property_typeDorm property_typeDorm
## property_typeGuesthouse property_typeGuesthouse
## property_typeBoutique.hotel property_typeBoutique.hotel
## property_typeHostel property_typeHostel
## property_typeTownhouse property_typeTownhouse
## property_typeVilla property_typeVilla
## cancellation_policysuper_strict_60 cancellation_policysuper_strict_60
## property_typeBungalow property_typeBungalow
## property_typeCamper.RV property_typeCamper.RV
## property_typeHut property_typeHut
## property_typeCastle property_typeCastle
## property_typeBoat property_typeBoat
## property_typeTent property_typeTent
## property_typeServiced.apartment property_typeServiced.apartment
## property_typeYurt property_typeYurt
## property_typeCabin property_typeCabin
## property_typeGuest.suite property_typeGuest.suite
## property_typeTipi property_typeTipi
## property_typeIn.law property_typeIn.law
## property_typeCasa.particular property_typeCasa.particular
## property_typeCave property_typeCave
## property_typeChalet property_typeChalet
## property_typeEarth.House property_typeEarth.House
## property_typeIsland property_typeIsland
## property_typeLighthouse property_typeLighthouse
## property_typeParking.Space property_typeParking.Space
## property_typeTrain property_typeTrain
## property_typeTreehouse property_typeTreehouse
## property_typeVacation.home property_typeVacation.home
## cleaning_fee cleaning_fee
## rel.inf
## room_typePrivate.room 33.063046394
## bedrooms 21.045450690
## accommodates 19.404653453
## room_typeShared.room 11.198534580
## bathrooms 7.109951471
## number_of_reviews 2.862817091
## review_scores_rating 1.581605498
## beds 0.680402790
## property_typeCondominium 0.381969550
## host_response_rate 0.354379034
## cancellation_policystrict 0.348865589
## property_typeHouse 0.312614097
## instant_bookablet 0.220099325
## property_typeLoft 0.203114477
## property_typeTimeshare 0.136472979
## property_typeOther 0.123037649
## property_typeApartment 0.103003123
## cancellation_policymoderate 0.095300930
## property_typeBed...Breakfast 0.087415124
## cancellation_policysuper_strict_30 0.087295517
## property_typeDorm 0.078439072
## property_typeGuesthouse 0.077642440
## property_typeBoutique.hotel 0.063887191
## property_typeHostel 0.054648187
## property_typeTownhouse 0.048018245
## property_typeVilla 0.041238350
## cancellation_policysuper_strict_60 0.036130248
## property_typeBungalow 0.035684433
## property_typeCamper.RV 0.029410654
## property_typeHut 0.028215341
## property_typeCastle 0.026969677
## property_typeBoat 0.020613185
## property_typeTent 0.014325391
## property_typeServiced.apartment 0.013687123
## property_typeYurt 0.010572050
## property_typeCabin 0.008448837
## property_typeGuest.suite 0.006181979
## property_typeTipi 0.003720010
## property_typeIn.law 0.002138227
## property_typeCasa.particular 0.000000000
## property_typeCave 0.000000000
## property_typeChalet 0.000000000
## property_typeEarth.House 0.000000000
## property_typeIsland 0.000000000
## property_typeLighthouse 0.000000000
## property_typeParking.Space 0.000000000
## property_typeTrain 0.000000000
## property_typeTreehouse 0.000000000
## property_typeVacation.home 0.000000000
## cleaning_fee 0.000000000
# ============================================================
# 16. STRUKTUR POHON REGRESI
# ============================================================
# Mengambil struktur pohon pertama
pohon_pertama <- pretty.gbm.tree(
model_gb,
i.tree = 1
)
cat("\nSTRUKTUR POHON ITERASI PERTAMA\n")
##
## STRUKTUR POHON ITERASI PERTAMA
print(pohon_pertama)
## SplitVar SplitCodePred LeftNode RightNode MissingNode ErrorReduction Weight
## 0 35 5.000000e-01 1 8 9 4716.211 33202
## 1 38 1.500000e+00 2 6 7 1910.328 19481
## 2 36 5.000000e-01 3 4 5 1011.151 12100
## 3 -1 7.823734e-03 -1 -1 -1 0.000 11153
## 4 -1 -4.599083e-02 -1 -1 -1 0.000 947
## 5 -1 3.611966e-03 -1 -1 -1 0.000 12100
## 6 -1 3.588794e-02 -1 -1 -1 0.000 7381
## 7 -1 1.584075e-02 -1 -1 -1 0.000 19481
## 8 -1 -2.242852e-02 -1 -1 -1 0.000 13721
## 9 -1 2.565708e-05 -1 -1 -1 0.000 33202
## Prediction
## 0 2.565708e-05
## 1 1.584075e-02
## 2 3.611966e-03
## 3 7.823734e-03
## 4 -4.599083e-02
## 5 3.611966e-03
## 6 3.588794e-02
## 7 1.584075e-02
## 8 -2.242852e-02
## 9 2.565708e-05
# ============================================================
# 17. MEMBENTUK MODEL FINAL
# MENGGUNAKAN SELURUH DATA TRAINING
# ============================================================
# Model final menggunakan jumlah pohon
# yang telah ditemukan melalui Cross Validation.
data_gb_full <- data.frame(
y = as.numeric(y_all),
X_train_all,
check.names = TRUE
)
set.seed(123)
model_gb_final <- gbm(
formula = y ~ .,
distribution = "gaussian",
data = data_gb_full,
n.trees = jumlah_pohon_optimal,
interaction.depth = 3,
n.minobsinnode = 2,
shrinkage = 0.05,
bag.fraction = 0.8,
cv.folds = 0,
n.cores = 1,
verbose = FALSE
)
## Warning in gbm.fit(x = x, y = y, offset = offset, distribution = distribution,
## : variable 50: cleaning_fee has no variation.
# ============================================================
# 18. PREDIKSI AKHIR DATA TESTING
# ============================================================
data_test_gb <- as.data.frame(
X_test_all,
check.names = TRUE
)
pred_test_log <- predict(
model_gb_final,
newdata = data_test_gb,
n.trees = jumlah_pohon_optimal,
type = "response"
)
# Mengembalikan ke skala asli
pred_test_final <- expm1(pred_test_log)
# Hasil prediksi akhir
hasil_prediksi_final <- data.frame(
id = id_test,
Prediksi_Price = pred_test_final
)
cat("\nHASIL PREDIKSI AKHIR\n")
##
## HASIL PREDIKSI AKHIR
print(head(hasil_prediksi_final))
## id Prediksi_Price
## 1 17423675 209.51931
## 2 6226658 87.28115
## 3 3563677 144.70815
## 4 17615783 72.61099
## 5 2479317 183.60472
## 6 14122244 241.11865
# ============================================================
# 19. MENYIMPAN HASIL
# ============================================================
# Evaluasi model
write.csv(
hasil_evaluasi,
"Evaluasi_Gradient_Boosting.csv",
row.names = FALSE
)
# Prediksi validasi
hasil_validasi <- data.frame(
Aktual = actual,
Prediksi = pred_valid
)
write.csv(
hasil_validasi,
"Prediksi_Validasi_Gradient_Boosting.csv",
row.names = FALSE
)
# Prediksi data testing
write.csv(
hasil_prediksi_final,
"Prediksi_Final_Gradient_Boosting.csv",
row.names = FALSE
)
# Struktur pohon pertama
write.csv(
pohon_pertama,
"Struktur_Pohon_Gradient_Boosting.csv",
row.names = FALSE
)
# Relative influence
write.csv(
importance_gb,
"Relative_Influence_Gradient_Boosting.csv",
row.names = FALSE
)
# ============================================================
# 20. RINGKASAN AKHIR
# ============================================================
cat("\n============================================\n")
##
## ============================================
cat("ANALISIS GRADIENT BOOSTING SELESAI\n")
## ANALISIS GRADIENT BOOSTING SELESAI
cat("============================================\n")
## ============================================
cat(
"Jumlah pohon optimal:",
jumlah_pohon_optimal,
"\n"
)
## Jumlah pohon optimal: 992
cat("RMSE:", RMSE, "\n")
## RMSE: 125.6057
cat("MAE:", MAE, "\n")
## MAE: 60.14508
cat("R-Squared:", R2, "\n")
## R-Squared: 0.4426829
cat("\nFile hasil berhasil disimpan.\n")
##
## File hasil berhasil disimpan.
cat("============================================\n")
## ============================================