MPML GBOOST
Restika (H051241055)
2026-11-10
ANALISIS GRADIENT BOOSTING REGRESSION DENGAN PENENTUAN JUMLAH POHON OPTIMAL
library(gbm)
library(ggplot2)
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: 51879cat("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))
}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: 12print(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"MENGGABUNGKAN DATA TRAINING DAN TESTING
X_gabungan <- rbind(
X_train_raw,
X_test_raw
)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)
)
)
# 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]])
)
}STATISTIK DESKRIPTIF
# Menyiapkan variabel numerik
data_deskriptif <- X_train_raw
data_deskriptif$host_response_rate <- as.numeric(
gsub("%", "", as.character(data_deskriptif$host_response_rate))
)
data_deskriptif$cleaning_fee <- as.numeric(
gsub("[$,]", "", as.character(data_deskriptif$cleaning_fee))
)
for (v in variabel_numerik) {
data_deskriptif[[v]] <- as.numeric(as.character(data_deskriptif[[v]]))
}
# Statistik deskriptif numerik
data_numerik <- data.frame(
price = train$price,
data_deskriptif[, variabel_numerik, drop = FALSE]
)
statistik_deskriptif <- do.call(
rbind,
lapply(names(data_numerik), function(v) {
x <- data_numerik[[v]]
x <- x[is.finite(x)]
data.frame(
Variabel = v,
N = length(x),
Mean = if (length(x) > 0) mean(x) else NA,
Median = if (length(x) > 0) median(x) else NA,
SD = if (length(x) > 1) sd(x) else NA,
Minimum = if (length(x) > 0) min(x) else NA,
Maksimum = if (length(x) > 0) max(x) else NA
)
})
)
cat("STATISTIK DESKRIPTIF VARIABEL NUMERIK\\n")## STATISTIK DESKRIPTIF VARIABEL NUMERIK\nprint(statistik_deskriptif)## Variabel N Mean Median SD Minimum Maksimum
## 1 price 51879 160.369051 111 168.9281332 1 1999
## 2 accommodates 51879 3.150176 2 2.1553052 1 16
## 3 bedrooms 51813 1.261093 1 0.8497248 0 10
## 4 bathrooms 51735 1.233507 1 0.5815484 0 8
## 5 beds 51795 1.707443 1 1.2497201 0 18
## 6 number_of_reviews 51879 20.821488 6 37.4908359 0 605
## 7 review_scores_rating 40258 94.077177 96 7.8193346 20 100
## 8 host_response_rate 39125 94.316141 100 16.4116517 0 100
## 9 cleaning_fee 0 NA NA NA NA NA# Frekuensi dan persentase variabel kategorik
for (v in variabel_kategorik) {
kategori <- trimws(as.character(X_train_raw[[v]]))
kategori[is.na(kategori) | kategori == ""] <- "Tidak diketahui"
tabel_frekuensi <- as.data.frame(table(kategori))
names(tabel_frekuensi) <- c("Kategori", "Frekuensi")
tabel_frekuensi$Persentase <- round(
100 * tabel_frekuensi$Frekuensi / sum(tabel_frekuensi$Frekuensi), 2
)
cat("\\nFREKUENSI VARIABEL:", v, "\\n")
print(tabel_frekuensi)
}## \nFREKUENSI VARIABEL: property_type \n Kategori Frekuensi Persentase
## 1 Apartment 34370 66.25
## 2 Bed & Breakfast 307 0.59
## 3 Boat 43 0.08
## 4 Boutique hotel 53 0.10
## 5 Bungalow 254 0.49
## 6 Cabin 51 0.10
## 7 Camper/RV 63 0.12
## 8 Casa particular 1 0.00
## 9 Castle 9 0.02
## 10 Cave 1 0.00
## 11 Chalet 4 0.01
## 12 Condominium 1872 3.61
## 13 Dorm 97 0.19
## 14 Earth House 3 0.01
## 15 Guest suite 93 0.18
## 16 Guesthouse 355 0.68
## 17 Hostel 47 0.09
## 18 House 11502 22.17
## 19 Hut 7 0.01
## 20 In-law 45 0.09
## 21 Island 1 0.00
## 22 Lighthouse 1 0.00
## 23 Loft 871 1.68
## 24 Other 437 0.84
## 25 Parking Space 1 0.00
## 26 Serviced apartment 16 0.03
## 27 Tent 12 0.02
## 28 Timeshare 55 0.11
## 29 Tipi 3 0.01
## 30 Townhouse 1155 2.23
## 31 Train 1 0.00
## 32 Treehouse 5 0.01
## 33 Vacation home 8 0.02
## 34 Villa 127 0.24
## 35 Yurt 9 0.02
## \nFREKUENSI VARIABEL: room_type \n Kategori Frekuensi Persentase
## 1 Entire home/apt 28966 55.83
## 2 Private room 21423 41.29
## 3 Shared room 1490 2.87
## \nFREKUENSI VARIABEL: cancellation_policy \n Kategori Frekuensi Persentase
## 1 flexible 15741 30.34
## 2 moderate 13333 25.70
## 3 strict 22720 43.79
## 4 super_strict_30 74 0.14
## 5 super_strict_60 11 0.02
## \nFREKUENSI VARIABEL: instant_bookable \n Kategori Frekuensi Persentase
## 1 f 38325 73.87
## 2 t 13554 26.13VISUALISASI EKSPLORASI DATA
# 1. Histogram price
p_hist_price <- ggplot(train, aes(x = price)) +
geom_histogram(bins = 30, fill = "#2C7FB8", color = "white") +
labs(
title = "Distribusi Harga Properti",
x = "Harga (price)", y = "Frekuensi"
) +
theme_minimal()
print(p_hist_price)
# 2. Boxplot price
p_box_price <- ggplot(train, aes(x = "", y = price)) +
geom_boxplot(
fill = "#75AADB", color = "#263238",
outlier.color = "#C0392B"
) +
labs(title = "Boxplot Harga Properti", x = NULL, y = "Harga (price)") +
theme_minimal()
print(p_box_price)
# 3. Identifikasi calon pencilan menggunakan IQR
Q1 <- quantile(train$price, 0.25, na.rm = TRUE)
Q3 <- quantile(train$price, 0.75, na.rm = TRUE)
IQR_price <- IQR(train$price, na.rm = TRUE)
batas_bawah <- Q1 - 1.5 * IQR_price
batas_atas <- Q3 + 1.5 * IQR_price
jumlah_pencilan <- sum(
train$price < batas_bawah | train$price > batas_atas,
na.rm = TRUE
)
cat("\\nIDENTIFIKASI PENCILAN PRICE\\n")## \nIDENTIFIKASI PENCILAN PRICE\ncat("Batas bawah:", batas_bawah, "\\n")## Batas bawah: -90 \ncat("Batas atas:", batas_atas, "\\n")## Batas atas: 350 \ncat("Jumlah calon pencilan:", jumlah_pencilan, "\\n")## Jumlah calon pencilan: 3556 \ncat("Pencilan valid dipertahankan dan tidak dihapus.\\n")## Pencilan valid dipertahankan dan tidak dihapus.\n# 4. Heatmap korelasi
mat_korelasi <- cor(data_numerik, use = "pairwise.complete.obs")
data_korelasi <- as.data.frame(as.table(mat_korelasi))
names(data_korelasi) <- c("Variabel1", "Variabel2", "Korelasi")
p_heatmap <- ggplot(
data_korelasi,
aes(x = Variabel1, y = Variabel2, fill = Korelasi)
) +
geom_tile(color = "white") +
geom_text(aes(label = round(Korelasi, 2)), size = 3) +
scale_fill_gradient2(
low = "#B2182B", mid = "white", high = "#2166AC",
midpoint = 0, limits = c(-1, 1)
) +
labs(
title = "Heatmap Korelasi Variabel Numerik",
x = NULL, y = NULL, fill = "Korelasi"
) +
theme_minimal() +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
panel.grid = element_blank()
)
print(p_heatmap)
# 5. Scatter plot price dengan seluruh prediktor numerik
for (v in variabel_numerik) {
data_scatter <- data.frame(
price = train$price,
x = data_deskriptif[[v]]
)
data_scatter <- data_scatter[
is.finite(data_scatter$price) & is.finite(data_scatter$x),
, drop = FALSE
]
p_scatter <- ggplot(data_scatter, aes(x = x, y = price)) +
geom_point(color = "#21618C", alpha = 0.45, size = 1.5) +
labs(
title = paste("Harga Properti dan", v),
x = v, y = "Harga (price)"
) +
theme_minimal()
print(p_scatter)
}
# 6. Diagram batang variabel kategorik
for (v in variabel_kategorik) {
kategori <- trimws(as.character(X_train_raw[[v]]))
kategori[is.na(kategori) | kategori == ""] <- "Tidak diketahui"
data_bar <- as.data.frame(table(kategori))
names(data_bar) <- c("Kategori", "Frekuensi")
p_bar <- ggplot(
data_bar,
aes(x = reorder(Kategori, Frekuensi), y = Frekuensi)
) +
geom_col(fill = "#2C7FB8", width = 0.7) +
coord_flip() +
labs(title = paste("Distribusi", v), x = NULL, y = "Frekuensi") +
theme_minimal()
print(p_bar)
}
# 7. Histogram price setelah transformasi log
p_hist_log <- ggplot(
data.frame(Log_Price = log1p(train$price)),
aes(x = Log_Price)
) +
geom_histogram(bins = 30, fill = "#3A8D7A", color = "white") +
labs(
title = "Distribusi Harga Setelah Transformasi",
x = "log(1 + price)", y = "Frekuensi"
) +
theme_minimal()
print(p_hist_log)
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: 50cat("\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"TRANSFORMASI VARIABEL RESPONS
# Transformasi logaritma
y_all <- log1p(train$price)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: 41503cat("Jumlah data validasi:", nrow(data_valid_gb), "\n")## Jumlah data validasi: 10376PEMODELAN 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## CV: 2## CV: 3## CV: 4## CV: 5MENENTUKAN 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 OPTIMALcat("====================================\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."
)
}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)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 MODELprint(hasil_evaluasi)## Model Jumlah_Pohon_Optimal RMSE MAE R2
## 1 Gradient Boosting 992 125.6057 60.14508 0.4426829VISUALISASI AKTUAL DAN PREDIKSI
data_plot <- data.frame(
Aktual = actual,
Prediksi = pred_valid
)
p_aktual_prediksi <- ggplot(
data_plot,
aes(x = Aktual, y = Prediksi)
) +
geom_point(alpha = 0.4, color = "#21618C") +
geom_abline(
intercept = 0,
slope = 1,
linetype = "dashed",
color = "#C0392B"
) +
labs(
title = "Aktual vs Prediksi Gradient Boosting",
x = "Harga Aktual",
y = "Harga Prediksi"
) +
theme_minimal()
print(p_aktual_prediksi)
VISUALISASI RESIDUAL
data_residual <- data.frame(
Prediksi = pred_valid,
Residual = actual - pred_valid
)
p_residual <- ggplot(
data_residual,
aes(x = Prediksi, y = Residual)
) +
geom_point(color = "#21618C", alpha = 0.5) +
geom_hline(
yintercept = 0,
color = "#C0392B",
linetype = "dashed"
) +
labs(
title = "Residual Plot Gradient Boosting",
x = "Harga Prediksi",
y = "Residual"
) +
theme_minimal()
print(p_residual)
VARIABLE RELATIVE INFLUENCE
importance_gb <- summary(
model_gb,
n.trees = jumlah_pohon_optimal,
plotit = FALSE
)
importance_gb <- importance_gb[
order(importance_gb$rel.inf, decreasing = TRUE),
]
cat("\nRELATIVE INFLUENCE\n")##
## RELATIVE INFLUENCEprint(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.000000000importance_top <- head(importance_gb, 15)
p_importance <- ggplot(
importance_top,
aes(x = rel.inf, y = reorder(var, rel.inf), fill = rel.inf)
) +
geom_col(width = 0.7, color = NA) +
geom_text(
aes(label = sprintf("%.2f", rel.inf)),
hjust = -0.15, size = 3.2, color = "#263238"
) +
scale_fill_gradient(low = "#A6CEE3", high = "#084B75") +
scale_x_continuous(expand = expansion(mult = c(0, 0.15))) +
labs(
title = "Variable Relative Influence",
subtitle = "15 Variabel dengan Pengaruh Terbesar",
x = "Relative Influence (%)",
y = "Variabel Prediktor"
) +
theme_minimal() +
theme(
panel.grid.major.y = element_blank(),
panel.grid.minor = element_blank(),
legend.position = "none"
)
print(p_importance)
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 PERTAMAprint(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-05MEMBENTUK 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
)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 AKHIRprint(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.11865MENYIMPAN 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
)RINGKASAN AKHIR
cat("\n")cat("============================================")## ============================================cat("\nANALISIS GRADIENT BOOSTING SELESAI\n")##
## ANALISIS GRADIENT BOOSTING SELESAIcat("============================================\n")## ============================================cat("Jumlah data training:", nrow(train), "\n")## Jumlah data training: 51879cat("Jumlah data testing:", nrow(test), "\n")## Jumlah data testing: 22232cat("Jumlah variabel X:", length(variabel_X), "\n")## Jumlah variabel X: 12cat("Jumlah prediktor setelah dummy:", ncol(X_train_all), "\n")## Jumlah prediktor setelah dummy: 50cat("Jumlah pohon optimal:", jumlah_pohon_optimal, "\n")## Jumlah pohon optimal: 992cat("\nHASIL EVALUASI MODEL\n")##
## HASIL EVALUASI MODELcat("RMSE:", RMSE, "\n")## RMSE: 125.6057cat("MAE:", MAE, "\n")## MAE: 60.14508cat("R-Squared:", R2, "\n")## R-Squared: 0.4426829cat("\nFile hasil berhasil disimpan.\n")##
## File hasil berhasil disimpan.cat("============================================\n")## ============================================