Nonlinear Regression and Generalized Models
Nur Khamidah G1501221023
Prostate Cancer Data
# library(remotes)
# install_github("cran/ElemStatLearn")
# install.packages("earth")library(ElemStatLearn)
library(knitr)
data(prostate)
kable(head(prostate))| lcavol | lweight | age | lbph | svi | lcp | gleason | pgg45 | lpsa | train |
|---|---|---|---|---|---|---|---|---|---|
| -0.5798185 | 2.769459 | 50 | -1.386294 | 0 | -1.386294 | 6 | 0 | -0.4307829 | TRUE |
| -0.9942523 | 3.319626 | 58 | -1.386294 | 0 | -1.386294 | 6 | 0 | -0.1625189 | TRUE |
| -0.5108256 | 2.691243 | 74 | -1.386294 | 0 | -1.386294 | 7 | 20 | -0.1625189 | TRUE |
| -1.2039728 | 3.282789 | 58 | -1.386294 | 0 | -1.386294 | 6 | 0 | -0.1625189 | TRUE |
| 0.7514161 | 3.432373 | 62 | -1.386294 | 0 | -1.386294 | 6 | 0 | 0.3715636 | TRUE |
| -1.0498221 | 3.228826 | 50 | -1.386294 | 0 | -1.386294 | 6 | 0 | 0.7654678 | TRUE |
Dalam data ini terdiri dari beberapa peubah, antara lain:
- Peubah Respon
Peubah respon dalam data ini berupa lpsa (log prostate
specific antigen).
- Peubah Prediktor
Prediktor dalam data ini ada 8, yang terdiri dari:
lcavol: log cancer volumelweight: log of weightagelbph: log(benign prostatic hyperplasia amount)svi: seminal vesicle invasionlcp: log(capsular penetration)gleason: Gleason scorepgg45: Gleason score and the percentage of gleason scores
Eksplorasi Data
Berikut merupakan statistik deskriptif dari keseluruhan data.
library(sjmisc)
eksp_data <- prostate
kable(as.data.frame(descr(eksp_data)))| var | type | label | n | NA.prc | mean | sd | se | md | trimmed | range | iqr | skew | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 4 | lcavol | numeric | lcavol | 97 | 0 | 1.3500096 | 1.1786249 | 0.1196712 | 1.4469190 | 1.3872633 | 5.17 (-1.35-3.82) | 1.614217 | -0.2503040 |
| 7 | lweight | numeric | lweight | 97 | 0 | 3.6289427 | 0.4284112 | 0.0434986 | 3.6230070 | 3.6235564 | 2.41 (2.37-4.78) | 0.500516 | 0.0635414 |
| 1 | age | integer | age | 97 | 0 | 63.8659794 | 7.4451171 | 0.7559371 | 65.0000000 | 64.4683544 | 38 (41-79) | 8.000000 | -0.8284755 |
| 3 | lbph | numeric | lbph | 97 | 0 | 0.1003556 | 1.4508066 | 0.1473071 | 0.3001046 | 0.0307268 | 3.71 (-1.39-2.33) | 2.944439 | 0.1338133 |
| 9 | svi | integer | svi | 97 | 0 | 0.2164948 | 0.4139949 | 0.0420348 | 0.0000000 | 0.1518987 | 1 (0-1) | 0.000000 | 1.3984409 |
| 5 | lcp | numeric | lcp | 97 | 0 | -0.1793656 | 1.3982496 | 0.1419707 | -0.7985077 | -0.3447901 | 4.29 (-1.39-2.9) | 2.564949 | 0.7286344 |
| 2 | gleason | integer | gleason | 97 | 0 | 6.7525773 | 0.7221341 | 0.0733216 | 7.0000000 | 6.6708861 | 3 (6-9) | 1.000000 | 1.2604803 |
| 8 | pgg45 | integer | pgg45 | 97 | 0 | 24.3814433 | 28.2040346 | 2.8636858 | 15.0000000 | 20.5696203 | 100 (0-100) | 40.000000 | 0.9681051 |
| 6 | lpsa | numeric | lpsa | 97 | 0 | 2.4783869 | 1.1543291 | 0.1172044 | 2.5915164 | 2.4823693 | 6.01 (-0.43-5.58) | 1.324701 | -0.0004335 |
Data berukuran 97 observasi dan terdiri dari 1 respon, 8 prediktor.
Terdapat 1 prediktor kategorik, yaitu svi yang memiliki
nilai 0 dan 1. Kemudian diperiksa apa ada nilai hilang:
sum(is.na(data))## [1] 0Eksplorasi Peubah Prediktor
library(ggplot2)Berikut merupakan sebaran nilai prediktor yang digunakan:
x1 <- ggplot(eksp_data, aes(lcavol)) +
geom_histogram(aes(y = ..density..), color = "#000000", fill = "#3F2B44") +
geom_density(color = "#000000", fill = "#E3ADB5", alpha = 0.6) + ggtitle('lcavol')
x2 <- ggplot(eksp_data, aes(lweight)) +
geom_histogram(aes(y = ..density..), color = "#000000", fill = "#231F20") +
geom_density(color = "#000000", fill = "#95DFE3", alpha = 0.6) + ggtitle('lweight')
x3 <- ggplot(eksp_data, aes(age)) +
geom_histogram(aes(y = ..density..), color = "#000000", fill = "#3F2B44") +
geom_density(color = "#000000", fill = "#E3ADB5", alpha = 0.6) + ggtitle('age')
x4 <- ggplot(eksp_data, aes(lbph)) +
geom_histogram(aes(y = ..density..), color = "#000000", fill = "#3F2B44") +
geom_density(color = "#000000", fill = "#E3ADB5", alpha = 0.6) + ggtitle('lbph')x5 <- ggplot(eksp_data, aes(svi)) +
geom_histogram(aes(y = ..density..), color = "#000000", fill = "#454727") +
geom_density(color = "#000000", fill = "#95B8E3", alpha = 0.6) +ggtitle('svi')
x6 <- ggplot(eksp_data, aes(lcp)) +
geom_histogram(aes(y = ..density..), color = "#000000", fill = "#231F20") +
geom_density(color = "#000000", fill = "#95DFE3", alpha = 0.6) +ggtitle('lcp')
x7 <- ggplot(eksp_data, aes(gleason)) +
geom_histogram(aes(y = ..density..), color = "#000000", fill = "#454727") +
geom_density(color = "#000000", fill = "#95B8E3", alpha = 0.6) + ggtitle("gleason")
x8 <- ggplot(eksp_data, aes(pgg45)) +
geom_histogram(aes(y = ..density..), color = "#000000", fill = "#3E2A1F") +
geom_density(color = "#000000", fill = "#A99887", alpha = 0.6) + ggtitle("pgg45")gridExtra::grid.arrange(x1, x2, x3, x4, ncol=2)## Warning: The dot-dot notation (`..density..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(density)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
gridExtra::grid.arrange(x5, x6, x7, x8, ncol=2)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Kemudian, dilihat matriks dan plot korelasi dari prediktor-prediktor yang dianalisis.
kable(cor(eksp_data[, -c(9, 10)]))| lcavol | lweight | age | lbph | svi | lcp | gleason | pgg45 | |
|---|---|---|---|---|---|---|---|---|
| lcavol | 1.0000000 | 0.2805214 | 0.2249999 | 0.0273497 | 0.5388450 | 0.6753105 | 0.4324171 | 0.4336522 |
| lweight | 0.2805214 | 1.0000000 | 0.3479691 | 0.4422644 | 0.1553849 | 0.1645371 | 0.0568821 | 0.1073538 |
| age | 0.2249999 | 0.3479691 | 1.0000000 | 0.3501859 | 0.1176580 | 0.1276678 | 0.2688916 | 0.2761124 |
| lbph | 0.0273497 | 0.4422644 | 0.3501859 | 1.0000000 | -0.0858432 | -0.0069994 | 0.0778204 | 0.0784600 |
| svi | 0.5388450 | 0.1553849 | 0.1176580 | -0.0858432 | 1.0000000 | 0.6731112 | 0.3204122 | 0.4576476 |
| lcp | 0.6753105 | 0.1645371 | 0.1276678 | -0.0069994 | 0.6731112 | 1.0000000 | 0.5148301 | 0.6315282 |
| gleason | 0.4324171 | 0.0568821 | 0.2688916 | 0.0778204 | 0.3204122 | 0.5148301 | 1.0000000 | 0.7519045 |
| pgg45 | 0.4336522 | 0.1073538 | 0.2761124 | 0.0784600 | 0.4576476 | 0.6315282 | 0.7519045 | 1.0000000 |
corrplot::corrplot(corr = cor(eksp_data[, -c(9, 10)]), method = "square")
Diperoleh bahwa tidak ada peubah yang berkorelasi > 0.8, sehingga tidak perlu ada peubah yang dibuang.
Eksplorasi Peubah Respon
ggplot(eksp_data, aes(lpsa)) +
geom_histogram(aes(y = ..density..), color = "#000000", fill = "#454727") +
geom_density(color = "#000000", fill = "#95B8E3", alpha = 0.6) + ggtitle("lpsa")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Diperoleh bahwa nilai peubah respon, log prostate specific antigen, cenderung berdistribusi normal secara visual dan tidak ditemukan adanya pencilan.
Selanjutnya, data dibagi menjadi data latih (train) dan data uji dengan proporsi 9:1 sebagai berikut:
train <- subset( prostate, train==TRUE )[,1:9]
test <- subset( prostate, train==FALSE )[,1:9]Pemodelan dengan Regresi Polinomial
Regression polinomial adalah teknik pemodelan regresi yang menggabungkan lebih dari satu variabel input dengan membuat model dengan persamaan polinom Pemodelan dilakukan dengan membangun fungsi validasi silang sebagai berikut:
library(boot)
crossval10fold_polynomials <- function(data, max_degree){
set.seed(2023)
max_poly_degree <- max_degree
cv.error <- rep(NA, max_poly_degree)
datapoly <- data
for (i in 1:max_poly_degree){
datapoly$lcavol <- datapoly$lcavol**i
datapoly$lweight <- datapoly$lweight**i
datapoly$age <- datapoly$age**i
datapoly$lbph <- datapoly$lbph**i
datapoly$svi <- datapoly$svi**i
datapoly$lcp <- datapoly$lcp**i
datapoly$gleason <- datapoly$gleason**i
datapoly$pgg45 <- datapoly$pgg45**i
polynom_model <- glm(lpsa ~ ., data = datapoly)
cv.error[i] <- cv.glm(datapoly, polynom_model, K=10)$delta[1]
}
cv.error
plot(x=1:max_poly_degree, y=cv.error, xlab='Degree Polynomial', ylab='CV MSE', type='b', main='CV MSE vs Degree of Polynomial'); points(x=which.min(cv.error[2:length(cv.error)]), y=min(cv.error), col='red', pch=20); axis(1, at = seq(1,max_poly_degree, by=1))
return(list(cv_opt=which.min(cv.error[2:length(cv.error)]), cv_result = cv.error, max_degree=max_poly_degree))
}Karena dalam hal ini derajat terbaik adalan 2, namun melihat kompleksitas model dan error yang dihasilkan, maka dibuat model regresi derajat 1. Dimodelkan sebagai berikut:
poly_result <- crossval10fold_polynomials(train, 4)
Diperoleh derajat terbaik adalah 1, maka regresi polinomial disamakan dengan regresi linier berganda biasa. Dimodelkan sebagai berikut:
model_lm <- lm(lpsa~., data = train)
summary(model_lm)##
## Call:
## lm(formula = lpsa ~ ., data = train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.64870 -0.34147 -0.05424 0.44941 1.48675
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.429170 1.553588 0.276 0.78334
## lcavol 0.576543 0.107438 5.366 1.47e-06 ***
## lweight 0.614020 0.223216 2.751 0.00792 **
## age -0.019001 0.013612 -1.396 0.16806
## lbph 0.144848 0.070457 2.056 0.04431 *
## svi 0.737209 0.298555 2.469 0.01651 *
## lcp -0.206324 0.110516 -1.867 0.06697 .
## gleason -0.029503 0.201136 -0.147 0.88389
## pgg45 0.009465 0.005447 1.738 0.08755 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7123 on 58 degrees of freedom
## Multiple R-squared: 0.6944, Adjusted R-squared: 0.6522
## F-statistic: 16.47 on 8 and 58 DF, p-value: 2.042e-12model_lm2 <- lm(lpsa ~ lcavol + lweight + lbph + svi + lcp + pgg45, data = train)
summary(model_lm2)##
## Call:
## lm(formula = lpsa ~ lcavol + lweight + lbph + svi + lcp + pgg45,
## data = train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.69209 -0.33444 -0.05102 0.53576 1.37947
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.728972 0.788328 -0.925 0.3588
## lcavol 0.549778 0.104846 5.244 2.15e-06 ***
## lweight 0.563106 0.217436 2.590 0.0120 *
## lbph 0.125979 0.069389 1.816 0.0744 .
## svi 0.756355 0.297239 2.545 0.0135 *
## lcp -0.190825 0.110076 -1.734 0.0881 .
## pgg45 0.007541 0.004029 1.872 0.0661 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7134 on 60 degrees of freedom
## Multiple R-squared: 0.6828, Adjusted R-squared: 0.6511
## F-statistic: 21.53 on 6 and 60 DF, p-value: 2.611e-13Karena terjadi kenaikan SSE dan penurunan R squared, maka disarankan untuk tidak membuang peubah yang tidak signifikan.
Selanjutnya dilakukan uji asumsi klasik sebagaimana regresi berganda pada umumnya.
par(mfrow = c(2, 2))
plot(model_lm2)
Berdasarkan plot residual, diperoleh bahwa ragam sisaan konstan di nilai yang mendekati nol, serta nilai-nilai sisaan mengikuti garis lurus pada QQ-plot yang mengindikasikan bahwa sisaan menyebar normal. Ragam sisaan juga dianggap homogen.
Kemudian dilakukan prediksi sebagai berikut:
library(caret)## Loading required package: lattice##
## Attaching package: 'lattice'## The following object is masked from 'package:boot':
##
## melanomapred_lm <- predict(model_lm2, test)
rmse_pred_lm <- RMSE(pred_lm, test$lpsa)
rmse_pred_lm## [1] 0.7406709Diperoleh nilai RMSE sebesar 0.7406709.
Pemodelan dengan Regresi Spline
Regresi spline adalah metode regresi semi-parametrik yang memodelkan hubungan antara variabel input dan variabel target dengan menggunakan fungsi spline. Fungsi spline adalah fungsi matematika yang dihasilkan dari penggabungan beberapa fungsi polinomial sederhana yang terpisah. Membentuk model regresi spline dengan cara sebagai berikut:
hyper_grid <- expand.grid(degree = 1:10,
nprune = seq(2, 50, length.out = 10) %>%
floor())
set.seed(2023)
spl_fit <- train(
x = subset(train, select = -lpsa),
y = train$lpsa,
method = "earth",
metric = "RMSE",
trControl = trainControl(method = "cv", number = 10),
tuneGrid = hyper_grid)## Loading required package: earth## Loading required package: Formula## Loading required package: plotmo## Loading required package: plotrixspl_fit$bestTune## nprune degree
## 1 2 1Berdasarkan validasi silang lipat 10, diperoleh derajat yang
menghasilkan RMSE terkecil adalah 1 dengan parameter nprune
(jumlah maksimum prediktor dalam pohon yang sudah dipangkas) sebesar 2.
Diperoleh nilai derajat optimal sebesar 1.
ggplot(spl_fit)## Warning: The shape palette can deal with a maximum of 6 discrete values because more
## than 6 becomes difficult to discriminate
## ℹ you have requested 10 values. Consider specifying shapes manually if you need
## that many have them.## Warning: Removed 40 rows containing missing values or values outside the scale range
## (`geom_point()`).
Berdasarkan plot di atas, diperoleh derajat atau banyak knot optimum untuk spline adalah sebesar 1. Selanjutnya dilakukan prediksi dengan cara sebagai berikut:
pred_spl <- predict(spl_fit, test)rmse_pred_spl <- RMSE(pred_spl, test$lpsa)
rmse_pred_spl## [1] 0.6876412Diperoleh nilai RMSE untuk model optimum spline berderajat 1 pada data uji sebesar 0.6876412.
Pemodelan dengan GAM
Generalized Additive Models (GAM) adalah model regresi non-parametrik yang digunakan untuk mempelajari hubungan antara variabel input dan variabel target dengan memperhitungkan bentuk yang kompleks dan non-linear dari variabel input. GAM dapat digunakan untuk mengatasi beberapa masalah dalam regresi linier, seperti kurva yang tidak linier, interaksi yang kompleks antara variabel, dan ketidaknormalan distribusi dari variabel input. Pemoelan dengan GAM dilakukan dengan package-package berikut:
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ lubridate 1.9.3 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ tibble::add_case() masks sjmisc::add_case()
## ✖ dplyr::filter() masks stats::filter()
## ✖ purrr::is_empty() masks sjmisc::is_empty()
## ✖ dplyr::lag() masks stats::lag()
## ✖ purrr::lift() masks caret::lift()
## ✖ tidyr::replace_na() masks sjmisc::replace_na()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(mlr3verse)## Loading required package: mlr3library(gam)## Loading required package: splines
## Loading required package: foreach
##
## Attaching package: 'foreach'
##
## The following objects are masked from 'package:purrr':
##
## accumulate, when
##
## Loaded gam 1.22-3Pada GAM kali ini, akan dibuat 3 jenis model:
GAM Spline
Model GAM Spline dibuat dengan terlebih dahulu membuang peubah
kategorik svi dan peubah dengan nilai unik sedikit
(gleason), sebagai berikut:
gam_train <- train
gam_train$svi <- as.factor(gam_train$svi)
gam_train$gleason <- as.factor(gam_train$gleason)
gam_train <- gam_train %>%
select_if(is.numeric) %>%
select(-contains("Bsmt"))%>% na.omit()
gam_train %>%
summarise_all(n_distinct) %>%
pivot_longer(cols =everything() ) %>%
filter(value<4)## # A tibble: 0 × 2
## # ℹ 2 variables: name <chr>, value <int>formula_spline1 <- str_c("s(",
names(gam_train %>% select(-lpsa)),
",df=",6,")",
collapse = "+")
formula_spline1 <- as.formula(str_c("lpsa~",formula_spline1))mod_spline1 <- gam(formula_spline1,data=gam_train,family = "gaussian")
summary(mod_spline1)##
## Call: gam(formula = formula_spline1, family = "gaussian", data = gam_train)
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.20750 -0.33767 0.02577 0.29542 1.07231
##
## (Dispersion Parameter for gaussian family taken to be 0.5862)
##
## Null Deviance: 96.2814 on 66 degrees of freedom
## Residual Deviance: 17.5874 on 30 degrees of freedom
## AIC: 176.5243
##
## Number of Local Scoring Iterations: NA
##
## Anova for Parametric Effects
## Df Sum Sq Mean Sq F value Pr(>F)
## s(lcavol, df = 6) 1 56.601 56.601 96.5481 6.877e-11 ***
## s(lweight, df = 6) 1 11.457 11.457 19.5433 0.0001188 ***
## s(age, df = 6) 1 0.238 0.238 0.4067 0.5284950
## s(lbph, df = 6) 1 1.320 1.320 2.2509 0.1439914
## s(lcp, df = 6) 1 0.041 0.041 0.0692 0.7942450
## s(pgg45, df = 6) 1 2.131 2.131 3.6358 0.0661676 .
## Residuals 30 17.587 0.586
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Anova for Nonparametric Effects
## Npar Df Npar F Pr(F)
## (Intercept)
## s(lcavol, df = 6) 5 1.25249 0.3099
## s(lweight, df = 6) 5 1.30741 0.2873
## s(age, df = 6) 5 0.19568 0.9618
## s(lbph, df = 6) 5 1.01280 0.4275
## s(lcp, df = 6) 5 0.80797 0.5532
## s(pgg45, df = 6) 5 1.08179 0.3904GAM LOESS
Dengan data yang sama, dibentuk pula model GAM LOESS sebagai berikut:
formula_loess <- str_c("lo(",
names(gam_train %>% select(-lpsa)),
")",
collapse = "+")
formula_loess <- as.formula(str_c("lpsa~",formula_loess))mod_loess <- gam(formula_loess,data=gam_train,family = "gaussian")
summary(mod_loess)##
## Call: gam(formula = formula_loess, family = "gaussian", data = gam_train)
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.279715 -0.317965 0.001584 0.349128 1.332840
##
## (Dispersion Parameter for gaussian family taken to be 0.558)
##
## Null Deviance: 96.2814 on 66 degrees of freedom
## Residual Deviance: 23.3196 on 41.7883 degrees of freedom
## AIC: 171.8497
##
## Number of Local Scoring Iterations: NA
##
## Anova for Parametric Effects
## Df Sum Sq Mean Sq F value Pr(>F)
## lo(lcavol) 1.000 54.361 54.361 97.4128 1.750e-12 ***
## lo(lweight) 1.000 10.519 10.519 18.8499 8.796e-05 ***
## lo(age) 1.000 0.057 0.057 0.1018 0.75125
## lo(lbph) 1.000 1.401 1.401 2.5108 0.12061
## lo(lcp) 1.000 0.200 0.200 0.3582 0.55272
## lo(pgg45) 1.000 2.636 2.636 4.7242 0.03546 *
## Residuals 41.788 23.320 0.558
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Anova for Nonparametric Effects
## Npar Df Npar F Pr(F)
## (Intercept)
## lo(lcavol) 3.0 1.64159 0.1946
## lo(lweight) 3.5 1.28894 0.2907
## lo(age) 3.2 0.10462 0.9628
## lo(lbph) 3.3 1.23352 0.3105
## lo(lcp) 2.8 0.98056 0.4059
## lo(pgg45) 2.6 1.11326 0.3487Model Regresi Linier
Model regresi linier juga dibuat untuk membandingkan efektifitas model lainnya dengan model regresi linier.
mod_linear <- glm(lpsa~.,data=gam_train,family = "gaussian")
summary(mod_linear)##
## Call:
## glm(formula = lpsa ~ ., family = "gaussian", data = gam_train)
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.152146 1.068953 0.142 0.8873
## lcavol 0.636019 0.106591 5.967 1.4e-07 ***
## lweight 0.692003 0.226087 3.061 0.0033 **
## age -0.020579 0.013668 -1.506 0.1374
## lbph 0.111200 0.071544 1.554 0.1254
## lcp -0.111350 0.107341 -1.037 0.3037
## pgg45 0.009751 0.004265 2.286 0.0258 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for gaussian family taken to be 0.5433958)
##
## Null deviance: 96.281 on 66 degrees of freedom
## Residual deviance: 32.604 on 60 degrees of freedom
## AIC: 157.88
##
## Number of Fisher Scoring iterations: 2Evaluasi model GAM
Model GAM dievaluasi dengan menggunakan kriteria RMSE, dengan
menggunakan package mlr3 sebagai berikut:
gam_train_task <- TaskRegr$new(id = "tr",backend = gam_train,target = "lpsa")
rcv = rsmp("cv",folds=10)set.seed(2023)
index_rcv <- rcv$instantiate(gam_train_task)$instance
head(index_rcv)## Key: <fold>
## row_id fold
## <int> <int>
## 1: 6 1
## 2: 24 1
## 3: 25 1
## 4: 29 1
## 5: 57 1
## 6: 66 1Fungsi dibentuk dengan secara otomatis mengambil hasil RMSE prediksi dari ketiga model yang telah dibuat sebagai berikut:
gam_all <- function(train,test,mape=FALSE,response){
#GAM Spline
formula_spline1 <- str_c("s(",
names(gam_train %>% select(-lpsa)),
",df=",6,")",
collapse = "+")
formula_spline1 <- as.formula(str_c("lpsa~",formula_spline1))
mod_spline1 <- gam(formula_spline1,data=train,family = "gaussian")
pred_spline1 <- predict(mod_spline1,newdata=test)
rmse_spline1<- mlr3measures::rmse(response = pred_spline1,
truth = test %>% pull(response))
mape_spline1 <- mlr3measures::mape(response = pred_spline1,
truth = test %>% pull(response))
# GAM LOESS
formula_loess <- str_c("lo(",
names(gam_train %>% select(-lpsa)),
")",
collapse = "+")
formula_loess <- as.formula(str_c("lpsa~",formula_loess))
mod_loess <- gam(formula_loess,data=train,family = "gaussian")
pred_loess <- predict(mod_loess,newdata=test)
rmse_loess <- mlr3measures::rmse(response = pred_loess,
truth = test %>% pull(response))
mape_loess <- mlr3measures::mape(response = pred_loess,
truth = test %>% pull(response))
# Regresi Linear
mod_linear <- glm(lpsa~.,data=gam_train,family = "gaussian")
pred_linear <- predict(mod_linear,newdata=test)
rmse_linear <- mlr3measures::rmse(response = pred_linear,
truth = test %>% pull(response))
mape_linear <- mlr3measures::mape(response = pred_linear,
truth = test %>% pull(response))
mape_all = c(mape_linear,mape_loess,mape_spline1)
names(mape_all) <- c("Linear","LOESS","Spline")
rmse_all = c(rmse_linear,rmse_loess,rmse_spline1)
names(rmse_all) <- c("Linear","LOESS","Spline")
if(mape){
return(mape_all)
}else{
return(rmse_all)
}
}gam_test <- test
gam_test$svi <- as.factor(gam_test$svi)
gam_test$gleason <- as.factor(gam_test$gleason)
gam_test <- gam_test %>%
select_if(is.numeric) %>%
select(-contains("Bsmt"))%>% na.omit()
gam_test %>%
summarise_all(n_distinct) %>%
pivot_longer(cols =everything() ) %>%
filter(value<4)## # A tibble: 0 × 2
## # ℹ 2 variables: name <chr>, value <int>rmse_pred_gam <- gam_all(response="lpsa",train = gam_train,
test = gam_test,
mape = TRUE
)
rmse_pred_gam## Linear LOESS Spline
## 0.2332892 0.2287372 0.2315038Diperoleh nilai RMSE untuk model regresi linier sebesar 0.2332892, model GAM-LOESS sebesar 0.2287372, dan mdel GAM Spline sebesar 0.2315038.
Perbandingan Model
Setelah diperoleh RMSE untuk semua model, selanjutnya model dibandingkan sebagai berikut:
| model | RMSE |
|---|---|
| Linear (numeric only) | 0.2332892 |
| Polynomial deg 1 | 0.7406709 |
| Spline knot 1 | 0.6876412 |
| GAM Spline | 0.2315038 |
| GAM LOESS | 0.2287372 |
Diperoleh bahwa nilai RMSE terkecil pada data uji adalah pada GAM LOESS sebesar 0.2287372. GAM LOESS dan GAM Spline memberikan nilai terkecil RMSE karena keduanya merupakan generalized model yang berbasis smoothing, di mana GAM Splines melakukan pemulusan dengan parameter \(\lambda\), sementara LOESS melakukan pemulusan secara iteratif yang melibatkan regresi lokal sehingga memberikan kekekaran (robustness) yang lebih baik. Selain itu, GAM LOESS cenderung menghasilkan akurasi prediksi yang lebih tinggi karena teknik smoothing yang digunakan dapat membantu mengatasi masalah overfitting pada model.
Bone Mineral Density Data
Selanjutnya, analisis kedua dilakukan dengan menggunakan data Bone Mineral Density Data.
bone <- read.csv("https://hastie.su.domains/ElemStatLearn/datasets/spnbmd.csv", sep = ",")
kable(head(bone, 10))| idnum | ethnic | age | sex | spnbmd |
|---|---|---|---|---|
| 1 | White | 11.2 | mal | 0.719 |
| 1 | White | 12.2 | mal | 0.732 |
| 1 | White | 13.2 | mal | 0.776 |
| 1 | White | 14.3 | mal | 0.781 |
| 2 | White | 12.7 | mal | 0.620 |
| 2 | White | 13.8 | mal | 0.627 |
| 2 | White | 14.8 | mal | 0.759 |
| 2 | White | 15.8 | mal | 0.790 |
| 3 | White | 10.9 | mal | 0.641 |
| 3 | White | 11.9 | mal | 0.622 |
glimpse(bone)## Rows: 1,003
## Columns: 5
## $ idnum <int> 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 6, …
## $ ethnic <chr> "White", "White", "White", "White", "White", "White", "White", …
## $ age <dbl> 11.2, 12.2, 13.2, 14.3, 12.7, 13.8, 14.8, 15.8, 10.9, 11.9, 12.…
## $ sex <chr> "mal", "mal", "mal", "mal", "mal", "mal", "mal", "mal", "mal", …
## $ spnbmd <dbl> 0.719, 0.732, 0.776, 0.781, 0.620, 0.627, 0.759, 0.790, 0.641, …unique(bone$ethnic)## [1] "White" "Asian" "Hispanic" "Black"Data ini memiliki 4 peubah yang terdiri dari 1 peubah respon
(spnbmd) dan 3 peubah prediktor, dengan rincian sebagai
berikut:
- ethnic - ras/etnis pasien/responden yang diamati
- age - umur responden
- sex - jenis kelamin responden
- spnbmd - bone mineral density (kepadatan mineral dalam tulang) responden
Dilakukan eksplorasi data dan diperoleh hasil sebagai berikut:
library(tidyverse)
library(GGally)## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2ggpairs(bone, columns=c("ethnic", "age", "sex", "spnbmd"),
ggplot2::aes(color=sex))## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Diperole bahwa responden laki-laki dan perempuan cenderung mrmiliki proporsi yang sama, serta tidak ditemukan pencilan peubah numerik pada data ini.
Ubah ke Faktor
data_tree <- bone[,-1]
data_tree$ethnic <- as.factor(data_tree$ethnic)
data_tree$sex <- as.factor(data_tree$sex)
kable(head(data_tree,10))| ethnic | age | sex | spnbmd |
|---|---|---|---|
| White | 11.2 | mal | 0.719 |
| White | 12.2 | mal | 0.732 |
| White | 13.2 | mal | 0.776 |
| White | 14.3 | mal | 0.781 |
| White | 12.7 | mal | 0.620 |
| White | 13.8 | mal | 0.627 |
| White | 14.8 | mal | 0.759 |
| White | 15.8 | mal | 0.790 |
| White | 10.9 | mal | 0.641 |
| White | 11.9 | mal | 0.622 |
Ubah ke Data Latih dan Uji
set.seed(2023)
sample <- sample(c(TRUE, FALSE), nrow(data_tree), replace=TRUE, prob=c(0.8,0.2))
train <- data_tree[sample, ]
test <- data_tree[!sample, ]Pembentukan Pohon dengan Tuning Parameter
library(rpart)
library(rpart.plot)
library(ipred)Regression Tree + Bagging
Regression tree dan bagging adalah dua metode dalam machine learning yang digunakan untuk memprediksi variabel target. Regression tree digunakan untuk membangun model prediksi dengan membagi data menjadi subset yang lebih kecil berdasarkan variabel input yang signifikan, sedangkan bagging digunakan untuk meningkatkan akurasi prediksi dengan membangun banyak model pada subset data yang berbeda dan menggabungkan hasil prediksi dari model-model tersebut.
hyper_grid <- expand.grid(
minsplit = seq(5, 20, 1),
maxdepth = seq(6, 15, 1)
)
head(hyper_grid)## minsplit maxdepth
## 1 5 6
## 2 6 6
## 3 7 6
## 4 8 6
## 5 9 6
## 6 10 6nrow(hyper_grid)## [1] 160Dalam regression tree, minsplit dan
maxdepth adalah dua parameter tuning yang penting untuk
mengontrol kompleksitas model dan mencegah terjadinya overfitting.
minsplit: Parameter minsplit menentukan jumlah pengamatan minimum yang diperlukan untuk membagi sebuah simpul dalam pohon. Dengan kata lain, jika jumlah pengamatan dalam simpul tersebut kurang dari nilai minsplit, maka simpul tersebut tidak akan dibagi lagi menjadi anak-anak simpul lebih lanjut. Nilai minsplit yang terlalu kecil dapat menyebabkan pohon terlalu dalam dan memungkinkan terjadinya overfitting pada data training, sedangkan nilai minsplit yang terlalu besar dapat menyebabkan pohon terlalu dangkal dan menyebabkan underfitting pada data training.maxdepth: Parameter maxdepth menentukan kedalaman maksimum dari pohon. Jika nilai maxdepth terlalu besar, maka pohon dapat menjadi terlalu dalam dan kompleks, sehingga model dapat overfitting pada data training. Sedangkan jika nilai maxdepth terlalu kecil, maka pohon dapat menjadi terlalu dangkal dan model dapat underfitting pada data training.
models <- list()
for (i in 1:nrow(hyper_grid)) {
minsplit <- hyper_grid$minsplit[i]
maxdepth <- hyper_grid$maxdepth[i]
models[[i]] <- rpart(
formula = spnbmd ~ .,
data = train,
method = "anova",
control = list(minsplit = minsplit, maxdepth = maxdepth)
)
}Complexity parameter (CP) adalah parameter tuning yang digunakan dalam model machine learning, khususnya pada model berbasis pohon, seperti decision tree, regression tree, dan random forest. Complexity parameter (disebut juga sebagai regularization parameter) digunakan untuk mengontrol kompleksitas model dengan membatasi jumlah simpul atau cabang yang diizinkan dalam pohon atau ensemble dari pohon.
get_cp <- function(x) {
min <- which.min(x$cptable[, "xerror"])
cp <- x$cptable[min, "CP"]
}
get_min_error <- function(x) {
min <- which.min(x$cptable[, "xerror"])
xerror <- x$cptable[min, "xerror"]
}
hyper_grid %>%
mutate(
cp = purrr::map_dbl(models, get_cp),
error = purrr::map_dbl(models, get_min_error)
) %>%
arrange(error) %>%
top_n(-5, wt = error)## minsplit maxdepth cp error
## 1 18 7 0.01 0.4746260
## 2 20 9 0.01 0.4751499
## 3 14 12 0.01 0.4755947
## 4 17 11 0.01 0.4758749
## 5 19 15 0.01 0.4761768Dari proses tuning parameter yang dilakukan, diperoleh nilai
parameter dengan error terkecil adalah minsplit = 18,
maxdepth = 7, dan cp = 0.01. Pohon optimal
dibentuk dengan langkah sebagai berikut:
optimal_tree <- rpart(
formula = spnbmd ~ .,
data = train,
method = "anova",
control = list(minsplit = 18, maxdepth = 7, cp = 0.01)
)
pred <- predict(optimal_tree, newdata = test)
RMSE(pred = pred, obs = test$spnbmd)## [1] 0.1356718Serta pohon regresi yang terbentuk adalah sebagai berikut:
rpart.plot(optimal_tree)
Peubah age menempati urutan paling atas dalam node akar
(root), yang artinya dia merupakan peubah prediktor terpenting dalam
membangun pohon. Selanjutnya disusul dengan peubah sex dan
ethnic.
Bagging (Bootstrap Aggregating) adalah teknik ensemble learning yang digunakan untuk meningkatkan performa model machine learning. Bagging melibatkan pembuatan banyak model machine learning dengan dataset yang sama, tetapi dengan sample data yang berbeda-beda di setiap model. Bagging dilakukan dengan langkah sebagai berikut:
ctrl <- trainControl(method = "cv", number = 10)
bagged_cv <- train(
spnbmd ~ .,
data = train,
method = "treebag",
trControl = ctrl,
importance = TRUE
)
bagged_cv## Bagged CART
##
## 816 samples
## 3 predictor
##
## No pre-processing
## Resampling: Cross-Validated (10 fold)
## Summary of sample sizes: 734, 736, 734, 733, 735, 733, ...
## Resampling results:
##
## RMSE Rsquared MAE
## 0.1206824 0.5646365 0.09533023Diperoleh nilai RMSE pada pohon dengan bagging sebesar 0.1206824 untuk data latih, lebih kecil nilainya dibandingkan RMSE pada pohon sebelum dilakukan bagging yakni sebesar 0.1356718. Teknik Bagging membantu dalam mengatasi masalah overfitting pada model machine learning dengan mengurangi varians atau noise pada model. Karena Bagging mengambil sampel acak pada setiap iterasi, model yang dihasilkan cenderung memiliki variasi yang lebih kecil.
plot(varImp(bagged_cv)) 
Sebagaimana pada pohon yang terbentuk sebelumnya, peubah
age merupakan peubah dengan nilai importance atau
kepentingan yang terbesar, disusul sex, serta
ethnic.
pred <- predict(bagged_cv, test)
rmse_bag <- RMSE(pred, test$spnbmd)
rmse_bag## [1] 0.1291784DIperoleh nilai RMSE sebesar 0.1291784 untuk data uji berdasarkan pohon regresi dengan bagging.
Regression Tree + RF
Random forest adalah salah satu jenis model ensemble yang menggunakan banyak pohon keputusan (decision tree) untuk membuat prediksi. Setiap pohon dalam random forest dibangun dengan sampel acak dari dataset dan subset variabel, sehingga menghasilkan banyak variasi model. Model ensemble kemudian menggabungkan hasil prediksi dari setiap pohon dalam satu prediksi akhir.
# Manual Search
control <- trainControl(method="repeatedcv", number=10, repeats=10, search="grid")
tunegrid <- expand.grid(.mtry=c(1,2,3))
modellist <- list()
for (ntree in c(100, 200, 300, 400, 500)) {
set.seed(2022)
fit <- train(spnbmd~., data=train, method="rf", metric="rmse", tuneGrid=tunegrid, trControl=control, ntree=ntree)
key <- toString(ntree)
modellist[[key]] <- fit
}## Warning in train.default(x, y, weights = w, ...): The metric "rmse" was not in
## the result set. RMSE will be used instead.
## Warning in train.default(x, y, weights = w, ...): The metric "rmse" was not in
## the result set. RMSE will be used instead.
## Warning in train.default(x, y, weights = w, ...): The metric "rmse" was not in
## the result set. RMSE will be used instead.
## Warning in train.default(x, y, weights = w, ...): The metric "rmse" was not in
## the result set. RMSE will be used instead.
## Warning in train.default(x, y, weights = w, ...): The metric "rmse" was not in
## the result set. RMSE will be used instead.# compare results
results <- resamples(modellist)
summary(results)##
## Call:
## summary.resamples(object = results)
##
## Models: 100, 200, 300, 400, 500
## Number of resamples: 100
##
## MAE
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 100 0.07888184 0.09081344 0.09482165 0.09558227 0.1014737 0.1125214 0
## 200 0.07392066 0.08939315 0.09531515 0.09466197 0.1007983 0.1125854 0
## 300 0.07375171 0.08943921 0.09517043 0.09461341 0.1006833 0.1122353 0
## 400 0.07374451 0.08955893 0.09511745 0.09460494 0.1007607 0.1120196 0
## 500 0.07348531 0.08957566 0.09511134 0.09458187 0.1006937 0.1118963 0
##
## RMSE
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 100 0.09921347 0.1146547 0.1211168 0.1208542 0.1264929 0.1437042 0
## 200 0.09707578 0.1120609 0.1217227 0.1207859 0.1280642 0.1485806 0
## 300 0.09713998 0.1123940 0.1216296 0.1207311 0.1280460 0.1487164 0
## 400 0.09708824 0.1124921 0.1215611 0.1207212 0.1281035 0.1483083 0
## 500 0.09699458 0.1126549 0.1215827 0.1207140 0.1280493 0.1485264 0
##
## Rsquared
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## 100 0.4238217 0.5365394 0.5788624 0.5804476 0.6324978 0.7260091 0
## 200 0.3966790 0.5155198 0.5649219 0.5651417 0.6132234 0.7134582 0
## 300 0.3997762 0.5160948 0.5660820 0.5655498 0.6153729 0.7120547 0
## 400 0.4004555 0.5163442 0.5662560 0.5656350 0.6168674 0.7124098 0
## 500 0.3997140 0.5154073 0.5664728 0.5656835 0.6165974 0.7126860 0dotplot(results)
modellist## $`100`
## Random Forest
##
## 816 samples
## 3 predictor
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 10 times)
## Summary of sample sizes: 735, 736, 734, 735, 735, 734, ...
## Resampling results across tuning parameters:
##
## mtry RMSE Rsquared MAE
## 1 0.1415146 0.5580043 0.11533345
## 2 0.1208542 0.5804476 0.09558227
## 3 0.1208734 0.5644022 0.09476277
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 2.
##
## $`200`
## Random Forest
##
## 816 samples
## 3 predictor
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 10 times)
## Summary of sample sizes: 735, 736, 734, 735, 735, 734, ...
## Resampling results across tuning parameters:
##
## mtry RMSE Rsquared MAE
## 1 0.1414685 0.5619596 0.11533948
## 2 0.1209297 0.5807524 0.09563251
## 3 0.1207859 0.5651417 0.09466197
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 3.
##
## $`300`
## Random Forest
##
## 816 samples
## 3 predictor
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 10 times)
## Summary of sample sizes: 735, 736, 734, 735, 735, 734, ...
## Resampling results across tuning parameters:
##
## mtry RMSE Rsquared MAE
## 1 0.1414393 0.5626412 0.11533016
## 2 0.1208934 0.5809960 0.09559660
## 3 0.1207311 0.5655498 0.09461341
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 3.
##
## $`400`
## Random Forest
##
## 816 samples
## 3 predictor
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 10 times)
## Summary of sample sizes: 735, 736, 734, 735, 735, 734, ...
## Resampling results across tuning parameters:
##
## mtry RMSE Rsquared MAE
## 1 0.1414250 0.5635873 0.11532767
## 2 0.1208348 0.5812240 0.09554524
## 3 0.1207212 0.5656350 0.09460494
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 3.
##
## $`500`
## Random Forest
##
## 816 samples
## 3 predictor
##
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 10 times)
## Summary of sample sizes: 735, 736, 734, 735, 735, 734, ...
## Resampling results across tuning parameters:
##
## mtry RMSE Rsquared MAE
## 1 0.1413617 0.5638481 0.11526038
## 2 0.1208149 0.5813781 0.09553594
## 3 0.1207140 0.5656835 0.09458187
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 3.Dalam random forest, terdapat dua parameter penting yaitu:
mtry: Parameter mtry menentukan jumlah variabel acak yang akan dipilih untuk digunakan dalam membangun setiap pohon keputusan pada random forest. Secara default, nilai mtry ditentukan sebagai akar kuadrat dari jumlah total variabel. Parameter mtry dapat diatur untuk mengoptimalkan kinerja model. Jika nilai mtry terlalu kecil, random forest dapat menjadi terlalu kompleks dan cenderung overfitting, sedangkan jika nilai “mtry” terlalu besar, random forest dapat menjadi terlalu sederhana dan cenderung underfitting.ntree: Parameter ntree menentukan jumlah pohon keputusan yang akan dibangun dalam random forest. Semakin banyak pohon yang dibangun, semakin akurat model akan menjadi, tetapi waktu pemrosesan yang diperlukan akan lebih lama. Sebaliknya, jika nilai ntree terlalu kecil, random forest dapat menjadi terlalu sederhana dan cenderung underfitting.samplefraction: Parameter samplefraction adalah fraksi data yang digunakan dalam membangun setiap pohon keputusan dalam random forest. Parameter ini digunakan untuk membatasi jumlah sampel dalam setiap pohon, sehingga mencegah overfitting dan mempercepat waktu pemrosesan. Secara default, nilai samplefraction ditentukan sebagai 0,632, artinya sekitar 63,2% dari total data digunakan dalam membangun setiap pohon. Parameter “sample fraction” dapat diatur untuk mengoptimalkan kinerja model.min.node.size: Parameter min.node.size menentukan jumlah minimal sampel yang harus ada di setiap node dalam pohon keputusan. Parameter ini digunakan untuk menghindari overfitting dan memperbaiki interpretasi model. Jika nilai min.node.size terlalu kecil, pohon keputusan dapat menjadi terlalu kompleks dan cenderung overfitting, sedangkan jika nilai min.node.size terlalu besar, pohon keputusan dapat menjadi terlalu sederhana dan cenderung underfitting.
Sehingga, untuk menentukan nilai parameter terbaik dilakukan tuning sebagai berikut:
library(ranger)
hyper_grid <- expand.grid(
mtry = c(1,2,3),
min.node.size = c(1, 3, 5, 10),
replace = c(TRUE, FALSE),
sample.fraction = c(.7, .8, .9),
num.trees = c(100, 300, 500),
rmse = NA
)
for(i in seq_len(nrow(hyper_grid))) {
fit <- ranger(
formula = spnbmd ~ .,
data = train,
num.trees = hyper_grid$num.trees[i],
mtry = hyper_grid$mtry[i],
min.node.size = hyper_grid$min.node.size[i],
replace = hyper_grid$replace[i],
sample.fraction = hyper_grid$sample.fraction[i],
verbose = FALSE,
seed = 123,
respect.unordered.factors = 'order',
)
# export OOB error
hyper_grid$rmse[i] <- sqrt(fit$prediction.error)
}
# assess top 10 models
hyper_grid %>%
arrange(rmse) %>%
head(10)## mtry min.node.size replace sample.fraction num.trees rmse
## 1 2 10 TRUE 0.7 500 0.1207257
## 2 2 10 TRUE 0.8 300 0.1208233
## 3 2 10 TRUE 0.8 500 0.1208761
## 4 2 10 TRUE 0.7 300 0.1209030
## 5 2 10 TRUE 0.7 100 0.1209733
## 6 2 10 TRUE 0.8 100 0.1211360
## 7 2 10 FALSE 0.7 300 0.1215054
## 8 2 10 FALSE 0.7 100 0.1215993
## 9 2 10 TRUE 0.9 500 0.1216100
## 10 2 10 FALSE 0.7 500 0.1216414Diperoleh nilai mtry = 2, min.node.size
sebesar 10, sample.fraction = 0.7, dan ntree =
500.
rf_train <- train
rf_test <- test
rf_tree <- ranger(
formula = spnbmd ~ .,
data = rf_train,
num.trees = 500,
mtry = 2,
min.node.size = 10,
sample.fraction = .70,
replace = TRUE,
importance = "impurity",
respect.unordered.factors = "order",
verbose = FALSE,
seed = 2023
)
vip::vip(rf_tree)
Sebagaimana pada model sebelumnya, diperoleh juga peubah yang paling
penting adalah age, sex dan
ethnic secara berurutan.
pred_rf <- predict(rf_tree, rf_test)
rmse_rf <- RMSE(pred_rf$predictions, test$spnbmd)
rmse_rf## [1] 0.1310451Berdasarkan pembentukan pohon dengan Random Forest, diperoleh nilai RMSE sebesar 0.1310451.
Regression Tree + Gradient Boosting
Pohon dalam gradient boosting dibentuk secara iteratif dengan menggunakan algoritma yang disebut gradient boosting decision tree (GBDT). Pada setiap iterasi, pohon keputusan baru dibangun dengan menggunakan residual dari model sebelumnya sebagai target.
gb_train <- train
gb_test <- testlibrary(gbm)## Loaded gbm 2.1.9## This version of gbm is no longer under development. Consider transitioning to gbm3, https://github.com/gbm-developers/gbm3Parameter-parameter dalam gradient boosting adalah sebagai berikut:
n.trees: Jumlah pohon yang akan dibangun. Semakin banyak pohon yang dibangun, semakin kompleks model dan semakin sulit untuk diinterpretasi. Namun, model dengan jumlah pohon yang lebih banyak cenderung memiliki performa yang lebih baik.interaction.depth: Kedalaman maksimum dari setiap pohon yang dibangun. Kedalaman pohon yang lebih dalam dapat memungkinkan model untuk menangkap hubungan yang lebih kompleks antara variabel, tetapi juga dapat menyebabkan overfitting. Oleh karena itu, penting untuk memilih kedalaman yang sesuai untuk meminimalkan overfitting.shrinkage: Faktor pengurangan yang digunakan untuk mengontrol kecepatan pembelajaran pada setiap iterasi. Semakin kecil nilai shrinkage, semakin lambat model belajar, tetapi semakin cenderung memiliki performa yang baik. Shrinkage dapat digunakan bersamaan dengan n.trees untuk menemukan keseimbangan antara performa dan kecepatan pembelajaran.n.minobsinnode: Jumlah observasi minimum yang harus ada pada setiap node dalam pohon. Semakin kecil nilai ini, semakin kompleks pohon yang dibangun, tetapi juga semakin cenderung terjadi overfitting. Penting untuk memilih nilai yang tepat untuk menghindari overfitting.
Selanjutnya dilakukan tuning parameter untuk menghasilkan nilai-nilai parameter terbaik yang meminimumkan galat sebagai berikut:
grid<-expand.grid(.n.trees=c(200, 300, 500),.interaction.depth=seq(1,6,by=1),.shrinkage=c(.001,.01,.1),
.n.minobsinnode=seq(5, 10, 1))
control<-trainControl(method = "CV")
gb_model <-train(spnbmd~.,
data=gb_train,
method='gbm',
trControl=control,
tuneGrid=grid,
verbose = FALSE)
gb_model## Stochastic Gradient Boosting
##
## 816 samples
## 3 predictor
##
## No pre-processing
## Resampling: Cross-Validated (25 fold)
## Summary of sample sizes: 784, 784, 784, 784, 784, 784, ...
## Resampling results across tuning parameters:
##
## shrinkage interaction.depth n.minobsinnode n.trees RMSE Rsquared
## 0.001 1 5 200 0.1695071 0.4519585
## 0.001 1 5 300 0.1643895 0.4553595
## 0.001 1 5 500 0.1561474 0.4610116
## 0.001 1 6 200 0.1695294 0.4521881
## 0.001 1 6 300 0.1644121 0.4550462
## 0.001 1 6 500 0.1561603 0.4602487
## 0.001 1 7 200 0.1695445 0.4510600
## 0.001 1 7 300 0.1644237 0.4549972
## 0.001 1 7 500 0.1561765 0.4600388
## 0.001 1 8 200 0.1695389 0.4520818
## 0.001 1 8 300 0.1643955 0.4553867
## 0.001 1 8 500 0.1561331 0.4611874
## 0.001 1 9 200 0.1695001 0.4522893
## 0.001 1 9 300 0.1643802 0.4550514
## 0.001 1 9 500 0.1561230 0.4606817
## 0.001 1 10 200 0.1695166 0.4522784
## 0.001 1 10 300 0.1643934 0.4555132
## 0.001 1 10 500 0.1561447 0.4609004
## 0.001 2 5 200 0.1680376 0.5007703
## 0.001 2 5 300 0.1622722 0.5060357
## 0.001 2 5 500 0.1527519 0.5173314
## 0.001 2 6 200 0.1680592 0.5010105
## 0.001 2 6 300 0.1622697 0.5071747
## 0.001 2 6 500 0.1527455 0.5181369
## 0.001 2 7 200 0.1680814 0.4999987
## 0.001 2 7 300 0.1622824 0.5063113
## 0.001 2 7 500 0.1527687 0.5174567
## 0.001 2 8 200 0.1680733 0.5001855
## 0.001 2 8 300 0.1622564 0.5071212
## 0.001 2 8 500 0.1527392 0.5177955
## 0.001 2 9 200 0.1680686 0.5011746
## 0.001 2 9 300 0.1622776 0.5074638
## 0.001 2 9 500 0.1527143 0.5189227
## 0.001 2 10 200 0.1680473 0.5018244
## 0.001 2 10 300 0.1622831 0.5072193
## 0.001 2 10 500 0.1527632 0.5174025
## 0.001 3 5 200 0.1667065 0.5351343
## 0.001 3 5 300 0.1603639 0.5389705
## 0.001 3 5 500 0.1499708 0.5461742
## 0.001 3 6 200 0.1666728 0.5380953
## 0.001 3 6 300 0.1603167 0.5408742
## 0.001 3 6 500 0.1499294 0.5474724
## 0.001 3 7 200 0.1667020 0.5351934
## 0.001 3 7 300 0.1603635 0.5388505
## 0.001 3 7 500 0.1499895 0.5461609
## 0.001 3 8 200 0.1667372 0.5333260
## 0.001 3 8 300 0.1603844 0.5377431
## 0.001 3 8 500 0.1499907 0.5463416
## 0.001 3 9 200 0.1667051 0.5350477
## 0.001 3 9 300 0.1603339 0.5391934
## 0.001 3 9 500 0.1499626 0.5464803
## 0.001 3 10 200 0.1667167 0.5352118
## 0.001 3 10 300 0.1603327 0.5402370
## 0.001 3 10 500 0.1499714 0.5466911
## 0.001 4 5 200 0.1659393 0.5536458
## 0.001 4 5 300 0.1592859 0.5572834
## 0.001 4 5 500 0.1484901 0.5643650
## 0.001 4 6 200 0.1659397 0.5532017
## 0.001 4 6 300 0.1593105 0.5572099
## 0.001 4 6 500 0.1484617 0.5639303
## 0.001 4 7 200 0.1659567 0.5532593
## 0.001 4 7 300 0.1593086 0.5570039
## 0.001 4 7 500 0.1484534 0.5642317
## 0.001 4 8 200 0.1659317 0.5551544
## 0.001 4 8 300 0.1593070 0.5583086
## 0.001 4 8 500 0.1484738 0.5647227
## 0.001 4 9 200 0.1659415 0.5531743
## 0.001 4 9 300 0.1593141 0.5566519
## 0.001 4 9 500 0.1484816 0.5642339
## 0.001 4 10 200 0.1659654 0.5525133
## 0.001 4 10 300 0.1593203 0.5561157
## 0.001 4 10 500 0.1484913 0.5636841
## 0.001 5 5 200 0.1653264 0.5662322
## 0.001 5 5 300 0.1584601 0.5692250
## 0.001 5 5 500 0.1473432 0.5745765
## 0.001 5 6 200 0.1653050 0.5677972
## 0.001 5 6 300 0.1584357 0.5701791
## 0.001 5 6 500 0.1473118 0.5755775
## 0.001 5 7 200 0.1653203 0.5670257
## 0.001 5 7 300 0.1584442 0.5704042
## 0.001 5 7 500 0.1473510 0.5751119
## 0.001 5 8 200 0.1653326 0.5651028
## 0.001 5 8 300 0.1584891 0.5678442
## 0.001 5 8 500 0.1473739 0.5733981
## 0.001 5 9 200 0.1653790 0.5637588
## 0.001 5 9 300 0.1585179 0.5679202
## 0.001 5 9 500 0.1473775 0.5745975
## 0.001 5 10 200 0.1653290 0.5667922
## 0.001 5 10 300 0.1584571 0.5698282
## 0.001 5 10 500 0.1472805 0.5756650
## 0.001 6 5 200 0.1649471 0.5752229
## 0.001 6 5 300 0.1579276 0.5776007
## 0.001 6 5 500 0.1466220 0.5808840
## 0.001 6 6 200 0.1649117 0.5759609
## 0.001 6 6 300 0.1578864 0.5787323
## 0.001 6 6 500 0.1465306 0.5824213
## 0.001 6 7 200 0.1649224 0.5758477
## 0.001 6 7 300 0.1578950 0.5781659
## 0.001 6 7 500 0.1465652 0.5818637
## 0.001 6 8 200 0.1649236 0.5755106
## 0.001 6 8 300 0.1578980 0.5777093
## 0.001 6 8 500 0.1465525 0.5819401
## 0.001 6 9 200 0.1649434 0.5752728
## 0.001 6 9 300 0.1578941 0.5779683
## 0.001 6 9 500 0.1465697 0.5819337
## 0.001 6 10 200 0.1649704 0.5742077
## 0.001 6 10 300 0.1579483 0.5771915
## 0.001 6 10 500 0.1465768 0.5818229
## 0.010 1 5 200 0.1323061 0.5221795
## 0.010 1 5 300 0.1263308 0.5504406
## 0.010 1 5 500 0.1210832 0.5727232
## 0.010 1 6 200 0.1322759 0.5220880
## 0.010 1 6 300 0.1262882 0.5505891
## 0.010 1 6 500 0.1210799 0.5724825
## 0.010 1 7 200 0.1323579 0.5209040
## 0.010 1 7 300 0.1264750 0.5490039
## 0.010 1 7 500 0.1211732 0.5714904
## 0.010 1 8 200 0.1322049 0.5216469
## 0.010 1 8 300 0.1263988 0.5497551
## 0.010 1 8 500 0.1210539 0.5726435
## 0.010 1 9 200 0.1323177 0.5210138
## 0.010 1 9 300 0.1264525 0.5490370
## 0.010 1 9 500 0.1210870 0.5721336
## 0.010 1 10 200 0.1323547 0.5203031
## 0.010 1 10 300 0.1263373 0.5501131
## 0.010 1 10 500 0.1210630 0.5722916
## 0.010 2 5 200 0.1246130 0.5658176
## 0.010 2 5 300 0.1199738 0.5818852
## 0.010 2 5 500 0.1177601 0.5914838
## 0.010 2 6 200 0.1244693 0.5670123
## 0.010 2 6 300 0.1198954 0.5825583
## 0.010 2 6 500 0.1176997 0.5918492
## 0.010 2 7 200 0.1244481 0.5667866
## 0.010 2 7 300 0.1198111 0.5830427
## 0.010 2 7 500 0.1176697 0.5916415
## 0.010 2 8 200 0.1243968 0.5673869
## 0.010 2 8 300 0.1198229 0.5831125
## 0.010 2 8 500 0.1177350 0.5914244
## 0.010 2 9 200 0.1245725 0.5659955
## 0.010 2 9 300 0.1198916 0.5824760
## 0.010 2 9 500 0.1176082 0.5922122
## 0.010 2 10 200 0.1244274 0.5672059
## 0.010 2 10 300 0.1198470 0.5826573
## 0.010 2 10 500 0.1175561 0.5925283
## 0.010 3 5 200 0.1213754 0.5824374
## 0.010 3 5 300 0.1179585 0.5924626
## 0.010 3 5 500 0.1169350 0.5965463
## 0.010 3 6 200 0.1213380 0.5831518
## 0.010 3 6 300 0.1179608 0.5926277
## 0.010 3 6 500 0.1170044 0.5961222
## 0.010 3 7 200 0.1211535 0.5840127
## 0.010 3 7 300 0.1177940 0.5934403
## 0.010 3 7 500 0.1167592 0.5978901
## 0.010 3 8 200 0.1212625 0.5833081
## 0.010 3 8 300 0.1179020 0.5931205
## 0.010 3 8 500 0.1169217 0.5966588
## 0.010 3 9 200 0.1212955 0.5829029
## 0.010 3 9 300 0.1179753 0.5923819
## 0.010 3 9 500 0.1168237 0.5975238
## 0.010 3 10 200 0.1211175 0.5843865
## 0.010 3 10 300 0.1176681 0.5945655
## 0.010 3 10 500 0.1167973 0.5976074
## 0.010 4 5 200 0.1199493 0.5904675
## 0.010 4 5 300 0.1173858 0.5956043
## 0.010 4 5 500 0.1170472 0.5956790
## 0.010 4 6 200 0.1199294 0.5904002
## 0.010 4 6 300 0.1173940 0.5956200
## 0.010 4 6 500 0.1170507 0.5957970
## 0.010 4 7 200 0.1200211 0.5894847
## 0.010 4 7 300 0.1174699 0.5952000
## 0.010 4 7 500 0.1170838 0.5958526
## 0.010 4 8 200 0.1199165 0.5903997
## 0.010 4 8 300 0.1173540 0.5959606
## 0.010 4 8 500 0.1171117 0.5959204
## 0.010 4 9 200 0.1199771 0.5895623
## 0.010 4 9 300 0.1173884 0.5956804
## 0.010 4 9 500 0.1171043 0.5958453
## 0.010 4 10 200 0.1198842 0.5903152
## 0.010 4 10 300 0.1173785 0.5958609
## 0.010 4 10 500 0.1171143 0.5959025
## 0.010 5 5 200 0.1193759 0.5929622
## 0.010 5 5 300 0.1173391 0.5958732
## 0.010 5 5 500 0.1173640 0.5940012
## 0.010 5 6 200 0.1195153 0.5913665
## 0.010 5 6 300 0.1176064 0.5935223
## 0.010 5 6 500 0.1177343 0.5913722
## 0.010 5 7 200 0.1193658 0.5928560
## 0.010 5 7 300 0.1173295 0.5953992
## 0.010 5 7 500 0.1172084 0.5949885
## 0.010 5 8 200 0.1193437 0.5934958
## 0.010 5 8 300 0.1173209 0.5960384
## 0.010 5 8 500 0.1173078 0.5946447
## 0.010 5 9 200 0.1194310 0.5919348
## 0.010 5 9 300 0.1173867 0.5949380
## 0.010 5 9 500 0.1174593 0.5933660
## 0.010 5 10 200 0.1194249 0.5919014
## 0.010 5 10 300 0.1173634 0.5951030
## 0.010 5 10 500 0.1174929 0.5935149
## 0.010 6 5 200 0.1192396 0.5923537
## 0.010 6 5 300 0.1174782 0.5944076
## 0.010 6 5 500 0.1179189 0.5906896
## 0.010 6 6 200 0.1190202 0.5945909
## 0.010 6 6 300 0.1173967 0.5950820
## 0.010 6 6 500 0.1176958 0.5920268
## 0.010 6 7 200 0.1191888 0.5930527
## 0.010 6 7 300 0.1175057 0.5942662
## 0.010 6 7 500 0.1177891 0.5914441
## 0.010 6 8 200 0.1189901 0.5942135
## 0.010 6 8 300 0.1173233 0.5955136
## 0.010 6 8 500 0.1177122 0.5917349
## 0.010 6 9 200 0.1190411 0.5938361
## 0.010 6 9 300 0.1173286 0.5953354
## 0.010 6 9 500 0.1176920 0.5921115
## 0.010 6 10 200 0.1189377 0.5950418
## 0.010 6 10 300 0.1172197 0.5963133
## 0.010 6 10 500 0.1175699 0.5930981
## 0.100 1 5 200 0.1196527 0.5787121
## 0.100 1 5 300 0.1197734 0.5777988
## 0.100 1 5 500 0.1203370 0.5732715
## 0.100 1 6 200 0.1193358 0.5809082
## 0.100 1 6 300 0.1200022 0.5764196
## 0.100 1 6 500 0.1205381 0.5720098
## 0.100 1 7 200 0.1194860 0.5800260
## 0.100 1 7 300 0.1196291 0.5795256
## 0.100 1 7 500 0.1203423 0.5745112
## 0.100 1 8 200 0.1200215 0.5767053
## 0.100 1 8 300 0.1203649 0.5743442
## 0.100 1 8 500 0.1209902 0.5700000
## 0.100 1 9 200 0.1196941 0.5791198
## 0.100 1 9 300 0.1200547 0.5764093
## 0.100 1 9 500 0.1206784 0.5720930
## 0.100 1 10 200 0.1199047 0.5772378
## 0.100 1 10 300 0.1202305 0.5747632
## 0.100 1 10 500 0.1205107 0.5722213
## 0.100 2 5 200 0.1185163 0.5871041
## 0.100 2 5 300 0.1193647 0.5817400
## 0.100 2 5 500 0.1204074 0.5764477
## 0.100 2 6 200 0.1187939 0.5851132
## 0.100 2 6 300 0.1200132 0.5779549
## 0.100 2 6 500 0.1208774 0.5731157
## 0.100 2 7 200 0.1186576 0.5855858
## 0.100 2 7 300 0.1194129 0.5798800
## 0.100 2 7 500 0.1202917 0.5741786
## 0.100 2 8 200 0.1185637 0.5871776
## 0.100 2 8 300 0.1195840 0.5800845
## 0.100 2 8 500 0.1212236 0.5702196
## 0.100 2 9 200 0.1189558 0.5839628
## 0.100 2 9 300 0.1198199 0.5779091
## 0.100 2 9 500 0.1209882 0.5714266
## 0.100 2 10 200 0.1188042 0.5845589
## 0.100 2 10 300 0.1195359 0.5802685
## 0.100 2 10 500 0.1203268 0.5752376
## 0.100 3 5 200 0.1198564 0.5790707
## 0.100 3 5 300 0.1214034 0.5687833
## 0.100 3 5 500 0.1241813 0.5525231
## 0.100 3 6 200 0.1198712 0.5793675
## 0.100 3 6 300 0.1218932 0.5670107
## 0.100 3 6 500 0.1239899 0.5542748
## 0.100 3 7 200 0.1193677 0.5821018
## 0.100 3 7 300 0.1210080 0.5708335
## 0.100 3 7 500 0.1240329 0.5541669
## 0.100 3 8 200 0.1193701 0.5819683
## 0.100 3 8 300 0.1205470 0.5736879
## 0.100 3 8 500 0.1235976 0.5556912
## 0.100 3 9 200 0.1190403 0.5835026
## 0.100 3 9 300 0.1203970 0.5756233
## 0.100 3 9 500 0.1226454 0.5620237
## 0.100 3 10 200 0.1192484 0.5825986
## 0.100 3 10 300 0.1204244 0.5760370
## 0.100 3 10 500 0.1229100 0.5609058
## 0.100 4 5 200 0.1214812 0.5680716
## 0.100 4 5 300 0.1241673 0.5525176
## 0.100 4 5 500 0.1269279 0.5357838
## 0.100 4 6 200 0.1220280 0.5653702
## 0.100 4 6 300 0.1235220 0.5574086
## 0.100 4 6 500 0.1265802 0.5396401
## 0.100 4 7 200 0.1209114 0.5720306
## 0.100 4 7 300 0.1235883 0.5559698
## 0.100 4 7 500 0.1273698 0.5333323
## 0.100 4 8 200 0.1215205 0.5682101
## 0.100 4 8 300 0.1223576 0.5645239
## 0.100 4 8 500 0.1260713 0.5426704
## 0.100 4 9 200 0.1210211 0.5717170
## 0.100 4 9 300 0.1217363 0.5678427
## 0.100 4 9 500 0.1250521 0.5498111
## 0.100 4 10 200 0.1197791 0.5790521
## 0.100 4 10 300 0.1219094 0.5663933
## 0.100 4 10 500 0.1245018 0.5530308
## 0.100 5 5 200 0.1238908 0.5537780
## 0.100 5 5 300 0.1262778 0.5400572
## 0.100 5 5 500 0.1305743 0.5160995
## 0.100 5 6 200 0.1222106 0.5645917
## 0.100 5 6 300 0.1250678 0.5476283
## 0.100 5 6 500 0.1287827 0.5255232
## 0.100 5 7 200 0.1218573 0.5675238
## 0.100 5 7 300 0.1246988 0.5497842
## 0.100 5 7 500 0.1283063 0.5311762
## 0.100 5 8 200 0.1228657 0.5615884
## 0.100 5 8 300 0.1251947 0.5482897
## 0.100 5 8 500 0.1291524 0.5253587
## 0.100 5 9 200 0.1217371 0.5676653
## 0.100 5 9 300 0.1241389 0.5522940
## 0.100 5 9 500 0.1277279 0.5329290
## 0.100 5 10 200 0.1212945 0.5716245
## 0.100 5 10 300 0.1236763 0.5569093
## 0.100 5 10 500 0.1269490 0.5367873
## 0.100 6 5 200 0.1242959 0.5517499
## 0.100 6 5 300 0.1274588 0.5336134
## 0.100 6 5 500 0.1310247 0.5125284
## 0.100 6 6 200 0.1247783 0.5487807
## 0.100 6 6 300 0.1271323 0.5359986
## 0.100 6 6 500 0.1318161 0.5092836
## 0.100 6 7 200 0.1246978 0.5479699
## 0.100 6 7 300 0.1271212 0.5363060
## 0.100 6 7 500 0.1310801 0.5120039
## 0.100 6 8 200 0.1232926 0.5581129
## 0.100 6 8 300 0.1261670 0.5419575
## 0.100 6 8 500 0.1302094 0.5188456
## 0.100 6 9 200 0.1241494 0.5523727
## 0.100 6 9 300 0.1266831 0.5386465
## 0.100 6 9 500 0.1296057 0.5226020
## 0.100 6 10 200 0.1217017 0.5692678
## 0.100 6 10 300 0.1248592 0.5493798
## 0.100 6 10 500 0.1291037 0.5253886
## MAE
## 0.13901553
## 0.13446007
## 0.12711298
## 0.13902630
## 0.13447662
## 0.12711528
## 0.13906132
## 0.13450592
## 0.12712873
## 0.13904983
## 0.13445939
## 0.12708528
## 0.13901622
## 0.13445221
## 0.12708414
## 0.13902822
## 0.13447143
## 0.12711503
## 0.13781307
## 0.13274213
## 0.12429148
## 0.13781117
## 0.13273798
## 0.12428520
## 0.13782720
## 0.13273929
## 0.12429994
## 0.13783996
## 0.13272519
## 0.12427280
## 0.13783755
## 0.13273452
## 0.12423873
## 0.13780949
## 0.13273488
## 0.12428067
## 0.13658099
## 0.13104955
## 0.12195986
## 0.13657629
## 0.13103267
## 0.12196256
## 0.13659913
## 0.13105876
## 0.12199869
## 0.13660692
## 0.13107094
## 0.12198791
## 0.13660699
## 0.13105587
## 0.12200511
## 0.13659558
## 0.13102849
## 0.12198869
## 0.13600450
## 0.13026567
## 0.12091606
## 0.13601231
## 0.13030153
## 0.12092090
## 0.13602912
## 0.13030199
## 0.12090821
## 0.13599625
## 0.13029699
## 0.12094484
## 0.13600688
## 0.13030027
## 0.12094098
## 0.13601615
## 0.13029052
## 0.12092542
## 0.13551208
## 0.12960161
## 0.12000596
## 0.13549081
## 0.12959948
## 0.11998687
## 0.13551985
## 0.12961772
## 0.12004799
## 0.13551331
## 0.12963239
## 0.12003880
## 0.13557537
## 0.12968100
## 0.12006927
## 0.13551138
## 0.12962202
## 0.11997523
## 0.13521774
## 0.12920659
## 0.11941977
## 0.13517897
## 0.12916292
## 0.11935108
## 0.13518534
## 0.12916258
## 0.11937799
## 0.13520717
## 0.12918510
## 0.11936725
## 0.13522140
## 0.12919047
## 0.11940377
## 0.13526334
## 0.12924773
## 0.11942717
## 0.10441290
## 0.09919268
## 0.09549504
## 0.10443306
## 0.09920051
## 0.09550762
## 0.10444563
## 0.09927370
## 0.09557889
## 0.10432021
## 0.09926769
## 0.09546113
## 0.10442710
## 0.09928554
## 0.09552007
## 0.10449395
## 0.09931822
## 0.09548869
## 0.09836430
## 0.09486058
## 0.09330476
## 0.09824684
## 0.09484282
## 0.09338417
## 0.09825916
## 0.09475740
## 0.09324777
## 0.09823864
## 0.09475278
## 0.09334681
## 0.09833565
## 0.09485051
## 0.09322891
## 0.09823441
## 0.09473836
## 0.09313293
## 0.09627537
## 0.09348667
## 0.09262881
## 0.09637570
## 0.09358872
## 0.09273428
## 0.09624834
## 0.09345294
## 0.09261751
## 0.09627598
## 0.09354267
## 0.09267174
## 0.09630795
## 0.09354870
## 0.09257726
## 0.09618289
## 0.09341470
## 0.09261835
## 0.09531584
## 0.09300147
## 0.09268206
## 0.09523223
## 0.09306976
## 0.09269716
## 0.09528587
## 0.09306346
## 0.09265917
## 0.09526748
## 0.09306753
## 0.09267530
## 0.09522134
## 0.09305007
## 0.09272918
## 0.09526540
## 0.09302122
## 0.09273830
## 0.09482548
## 0.09297691
## 0.09275822
## 0.09499225
## 0.09311213
## 0.09315317
## 0.09488250
## 0.09298862
## 0.09273477
## 0.09474024
## 0.09277219
## 0.09269016
## 0.09483726
## 0.09295067
## 0.09289405
## 0.09492280
## 0.09300412
## 0.09293136
## 0.09471609
## 0.09294581
## 0.09309272
## 0.09434340
## 0.09278685
## 0.09300570
## 0.09457447
## 0.09300790
## 0.09304216
## 0.09433194
## 0.09281595
## 0.09305019
## 0.09435494
## 0.09270620
## 0.09291541
## 0.09438365
## 0.09271002
## 0.09288870
## 0.09523757
## 0.09530725
## 0.09585145
## 0.09475856
## 0.09535407
## 0.09580588
## 0.09513669
## 0.09527706
## 0.09597168
## 0.09534533
## 0.09576476
## 0.09623790
## 0.09533537
## 0.09564786
## 0.09612200
## 0.09537798
## 0.09563019
## 0.09583165
## 0.09423680
## 0.09458505
## 0.09510974
## 0.09446024
## 0.09545523
## 0.09543045
## 0.09425747
## 0.09471046
## 0.09495466
## 0.09396979
## 0.09465582
## 0.09537303
## 0.09440697
## 0.09475287
## 0.09560412
## 0.09433006
## 0.09473349
## 0.09532786
## 0.09496641
## 0.09563981
## 0.09699017
## 0.09406620
## 0.09542229
## 0.09728489
## 0.09419358
## 0.09524634
## 0.09694171
## 0.09433432
## 0.09465710
## 0.09683863
## 0.09381037
## 0.09493505
## 0.09638279
## 0.09423928
## 0.09479411
## 0.09623302
## 0.09532288
## 0.09715227
## 0.09928746
## 0.09613409
## 0.09695882
## 0.09887122
## 0.09547130
## 0.09729619
## 0.10012667
## 0.09545652
## 0.09584793
## 0.09826984
## 0.09531308
## 0.09552324
## 0.09783011
## 0.09399911
## 0.09545939
## 0.09737322
## 0.09708015
## 0.09871200
## 0.10151277
## 0.09560541
## 0.09807421
## 0.10077435
## 0.09557479
## 0.09759553
## 0.10012764
## 0.09639415
## 0.09812023
## 0.10062396
## 0.09538496
## 0.09742976
## 0.10002109
## 0.09532860
## 0.09700563
## 0.09907339
## 0.09737680
## 0.09971752
## 0.10257426
## 0.09775666
## 0.09950845
## 0.10331601
## 0.09731550
## 0.09961145
## 0.10272221
## 0.09639933
## 0.09863338
## 0.10152972
## 0.09690398
## 0.09860391
## 0.10120863
## 0.09474743
## 0.09716257
## 0.10066573
##
## RMSE was used to select the optimal model using the smallest value.
## The final values used for the model were n.trees = 500, interaction.depth =
## 3, shrinkage = 0.01 and n.minobsinnode = 7.plot(gb_model)
gb_model$bestTune## n.trees interaction.depth shrinkage n.minobsinnode
## 153 500 3 0.01 7Diperoleh nilai-nilai sebagai berikut:
shrinkage = 0.01, interaction.depth = 3, n.minobsinnode = 7, dan n.trees = 500.
plot(varImp(gb_model))
Sebagaimana pada model sebelumnya, diperoleh juga peubah yang paling
penting adalah age, sex dan
ethnic secara berurutan.
gb_pred <- predict(gb_model, gb_test)
rmse_gb <- RMSE(gb_pred, test$spnbmd)
rmse_gb## [1] 0.1264681Berdasarkan pembentukan pohon dengan Gradient Boosting, diperoleh nilai RMSE sebesar 0.1264681.
Perbandingan Model
| model | RMSE |
|---|---|
| Reg Tree + Bagging | 0.1291784 |
| Reg Tree + RF | 0.1310451 |
| Reg Tree + Gradient Boosting | 0.1264681 |
Diperoleh bahwa model terbaik dengan RMSE terkecil adalah pohon regresi dengan Gradient Boosting. Hal ini mungkin dikarenakan Gradient Boosting memiliki keunggulan dibandingkan metode lain sebagai berikut:
- Kemampuan untuk menangani data yang kompleks dan non-linear : Gradient boosting dapat menangani data yang kompleks dan non-linear, karena modelnya memungkinkan untuk menangkap interaksi antara variabel. Hal ini memungkinkan model untuk memprediksi data yang lebih akurat daripada model linear atau pohon keputusan.
- Kecepatan pelatihan : Gradient boosting sering kali lebih cepat dalam pelatihan daripada bagging atau random forest, karena model dibangun secara iteratif dan biasanya memiliki jumlah pohon yang lebih sedikit. Performa yang lebih baik pada dataset kecil: Gradient boosting dapat memberikan performa yang lebih baik pada dataset kecil, karena biasanya hanya membangun beberapa pohon dan mampu menangkap hubungan yang kompleks dalam dataset yang kecil.
- Interpretasi yang lebih mudah : Gradient boosting dapat memberikan interpretasi yang lebih mudah daripada random forest atau bagging, karena model hanya terdiri dari beberapa pohon dan lebih mudah dipahami.