Data disimulasikan dengan hubungan non-linier (kuadratik) antara
x dan y.
set.seed(123)
n <- 100
x <- seq(0, 10, length.out = n)
y <- 5 + 2*x - 0.3*x^2 + rnorm(n, mean = 0, sd = 2)
data <- data.frame(x = x, y = y)
head(data)
## x y
## 1 0.0000000 3.879049
## 2 0.1010101 4.738604
## 3 0.2020202 8.509213
## 4 0.3030303 5.719529
## 5 0.4040404 6.017682
## 6 0.5050505 9.363708
Tiga model dicocokkan sebagai pembanding: linier, polinomial derajat 2, dan derajat 3.
model_linier <- lm(y ~ x, data = data)
model_poli2 <- lm(y ~ poly(x, 2, raw = TRUE), data = data)
model_poli3 <- lm(y ~ poly(x, 3, raw = TRUE), data = data)
summary(model_poli2)
##
## Call:
## lm(formula = y ~ poly(x, 2, raw = TRUE), data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.8136 -1.1977 -0.0533 1.3549 4.3891
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.33982 0.53777 9.929 <2e-16 ***
## poly(x, 2, raw = TRUE)1 1.80266 0.24855 7.253 1e-10 ***
## poly(x, 2, raw = TRUE)2 -0.27529 0.02405 -11.447 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.829 on 97 degrees of freedom
## Multiple R-squared: 0.788, Adjusted R-squared: 0.7837
## F-statistic: 180.3 on 2 and 97 DF, p-value: < 2.2e-16
anova(model_linier, model_poli2, model_poli3)
## Analysis of Variance Table
##
## Model 1: y ~ x
## Model 2: y ~ poly(x, 2, raw = TRUE)
## Model 3: y ~ poly(x, 3, raw = TRUE)
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 98 762.42
## 2 97 324.33 1 438.09 129.6931 <2e-16 ***
## 3 96 324.28 1 0.05 0.0155 0.9012
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
AIC(model_linier, model_poli2, model_poli3)
## df AIC
## model_linier 3 492.9204
## model_poli2 4 409.4469
## model_poli3 5 411.4307
##Interpretasi:
#Berdasarkan hasil perhitungan Akaike Information Criterion (AIC), model polinomial orde 2 dipilih sebagai model yang paling sesuai karena menghasilkan nilai AIC terendah, yaitu 409,4469. Nilai tersebut lebih kecil dibandingkan model linear dengan AIC sebesar 492,9204 dan model polinomial orde 3 sebesar 411,4307. Oleh karena itu, model polinomial orde 2 dinilai lebih optimal dalam menjelaskan hubungan antara variabel X dan Y, dengan mempertimbangkan keseimbangan antara tingkat kecocokan model dan kompleksitasnya.
data$pred_linier <- predict(model_linier)
data$pred_poli2 <- predict(model_poli2)
data$pred_poli3 <- predict(model_poli3)
ggplot(data, aes(x = x, y = y)) +
geom_point(alpha = 0.5) +
geom_line(aes(y = pred_linier, color = "Linier"), linewidth = 1) +
geom_line(aes(y = pred_poli2, color = "Polinomial derajat 2"), linewidth = 1) +
geom_line(aes(y = pred_poli3, color = "Polinomial derajat 3"), linewidth = 1) +
labs(title = "Perbandingan Regresi Linier vs Polinomial",
x = "X", y = "Y", color = "Model") +
theme_minimal()
##Interpretasi:
#Berdasarkan grafik perbandingan, model regresi linear menunjukkan hubungan negatif yang bersifat linear antara X dan Y, sedangkan model polinomial derajat 2 dan derajat 3 mampu menangkap pola hubungan yang melengkung. Terlihat bahwa kedua model polinomial memiliki pola prediksi yang relatif serupa, meskipun polinomial derajat 3 menghasilkan kurva yang lebih kompleks pada nilai X yang tinggi. Berdasarkan nilai AIC, polinomial derajat 2 memiliki nilai AIC terendah sebesar 409,4469, sehingga dipilih sebagai model yang paling sesuai untuk menggambarkan hubungan antara X dan Y.
rmse <- function(actual, predicted) sqrt(mean((actual - predicted)^2))
data.frame(
Model = c("Linier", "Polinomial derajat 2", "Polinomial derajat 3"),
RMSE = c(rmse(data$y, data$pred_linier),
rmse(data$y, data$pred_poli2),
rmse(data$y, data$pred_poli3))
)
## Model RMSE
## 1 Linier 2.761195
## 2 Polinomial derajat 2 1.800917
## 3 Polinomial derajat 3 1.800772
##Interpretasi:
#Berdasarkan grafik perbandingan yang diperoleh, model regresi linear memperlihatkan adanya kecenderungan hubungan negatif antara X dan Y dalam pola yang linear. Sementara itu, model polinomial orde 2 dan orde 3 menunjukkan pola hubungan yang tidak linear dengan bentuk kurva. Kedua model polinomial memiliki hasil prediksi yang relatif mirip, meskipun model orde 3 menghasilkan bentuk kurva yang lebih kompleks, terutama pada nilai X yang lebih tinggi. Jika mempertimbangkan nilai AIC, model polinomial orde 2 memiliki nilai terendah, yaitu 409,4469, sehingga model tersebut dianggap paling tepat untuk merepresentasikan hubungan antara X dan Y.
Skema 10-fold cross-validation diulang 5 kali untuk menguji derajat polinomial 1 sampai 6.
names(data)
## [1] "x" "y" "pred_linier" "pred_poli2" "pred_poli3"
library(caret)
set.seed(42)
kontrol <- trainControl(
method = "repeatedcv",
number = 10,
repeats = 5
)
derajat_max <- 6
hasil_cv <- data.frame(
derajat = integer(),
RMSE = numeric()
)
for (d in 1:derajat_max) {
data_cv <- data
# Membuat variabel polynomial
if (d == 1) {
data_cv$x_poly <- data_cv$x
} else {
poly_x <- poly(data_cv$x, degree = d, raw = TRUE)
data_cv$x_poly <- poly_x[, 1]
for (j in 2:d) {
data_cv[[paste0("x_poly", j)]] <- poly_x[, j]
}
}
# Formula sesuai derajat
if (d == 1) {
formula_model <- y ~ x_poly
} else {
variabel <- paste0("x_poly", 2:d)
formula_model <- as.formula(
paste("y ~ x_poly +", paste(variabel, collapse = " + "))
)
}
model_cv <- train(
formula_model,
data = data_cv,
method = "lm",
trControl = kontrol
)
hasil_cv <- rbind(
hasil_cv,
data.frame(
derajat = d,
RMSE = min(model_cv$results$RMSE)
)
)
}
hasil_cv
## derajat RMSE
## 1 1 2.757805
## 2 2 1.825068
## 3 3 1.859968
## 4 4 1.877628
## 5 5 1.871701
## 6 6 1.880719
derajat_optimal <- hasil_cv$derajat[which.min(hasil_cv$RMSE)]
cat("Derajat optimal berdasarkan CV:", derajat_optimal, "\n")
## Derajat optimal berdasarkan CV: 2
ggplot(hasil_cv, aes(x = derajat, y = RMSE)) +
geom_line(
color = "steelblue",
linewidth = 1
) +
geom_point(
size = 3,
color = "steelblue"
) +
geom_vline(
xintercept = derajat_optimal,
linetype = "dashed",
color = "firebrick"
) +
scale_x_continuous(
breaks = 1:derajat_max
) +
labs(
title = "Pemilihan Derajat Optimal via 10-Fold Cross-Validation",
x = "Derajat Polinomial",
y = "RMSE Rata-rata (Validasi Silang)"
) +
theme_minimal()
##Inerpretasi:
#Berdasarkan penerapan 10-fold repeated cross-validation sebanyak 5 kali pengulangan, model polinomial orde 2 menghasilkan nilai RMSE validasi paling rendah, yaitu 1,825068. Hasil ini menunjukkan performa prediksi yang lebih baik dibandingkan model linear dengan RMSE 2,757805 maupun model polinomial dengan orde yang lebih tinggi, yaitu orde 3 sampai 6. Peningkatan orde setelah orde 2 tidak memberikan perbaikan terhadap akurasi prediksi, bahkan menyebabkan nilai RMSE cenderung meningkat. Oleh sebab itu, model polinomial orde 2 ditetapkan sebagai model optimal, karena mampu menghasilkan prediksi yang paling baik dengan tingkat kompleksitas yang masih relatif rendah.
model_final <- lm(y ~ poly(x, derajat_optimal, raw = TRUE), data = data)
summary(model_final)
##
## Call:
## lm(formula = y ~ poly(x, derajat_optimal, raw = TRUE), data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.8136 -1.1977 -0.0533 1.3549 4.3891
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.33982 0.53777 9.929 <2e-16 ***
## poly(x, derajat_optimal, raw = TRUE)1 1.80266 0.24855 7.253 1e-10 ***
## poly(x, derajat_optimal, raw = TRUE)2 -0.27529 0.02405 -11.447 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.829 on 97 degrees of freedom
## Multiple R-squared: 0.788, Adjusted R-squared: 0.7837
## F-statistic: 180.3 on 2 and 97 DF, p-value: < 2.2e-16
data$Ytopi <- predict(model_final)
data$residual <- data$y - data$Ytopi
data.frame(
X = data$x,
Y = data$y,
Ytopi = data$Ytopi,
Residual = data$residual
)
## X Y Ytopi Residual
## 1 0.0000000 3.87904871 5.33982287 -1.460774162
## 2 0.1010101 4.73860431 5.51910079 -0.780496476
## 3 0.2020202 8.50921338 5.69276104 2.816452348
## 4 0.3030303 5.71952918 5.86080361 -0.141274434
## 5 0.4040404 6.01768168 6.02322852 -0.005546837
## 6 0.5050505 9.36370818 6.18003576 3.183672422
## 7 0.6060606 7.02376079 6.33122532 0.692535462
## 8 0.7070707 3.73403425 6.47679722 -2.742762972
## 9 0.8080808 5.04655753 6.61675145 -1.570193912
## 10 0.9090909 5.67892399 6.75108800 -1.072164008
## 11 1.0101010 9.16227440 6.87980689 2.282467513
## 12 1.1111111 7.57147951 7.00290810 0.568571404
## 13 1.2121212 7.78501398 7.12039165 0.664622330
## 14 1.3131313 7.33033390 7.23225752 0.098076385
## 15 1.4141414 6.11666178 7.33850572 -1.221843946
## 16 1.5151515 10.91542407 7.43913626 3.476287814
## 17 1.6161616 8.44443068 7.53414912 0.910281560
## 18 1.7171717 3.61650551 7.62354431 -4.007038800
## 19 1.8181818 9.04733990 7.70732183 1.340018071
## 20 1.9191919 6.78781174 7.78548168 -0.997669946
## 21 2.0202020 5.68039177 7.85802386 -2.177632095
## 22 2.1212121 7.45661215 7.92494837 -0.468336219
## 23 2.2222222 5.91095407 7.98625521 -2.075301147
## 24 2.3232323 6.56945966 8.04194438 -1.472484723
## 25 2.4242424 6.83532091 8.09201588 -1.256694968
## 26 2.5252525 4.76404833 8.13646971 -3.372421376
## 27 2.6262626 9.85892273 8.17530587 1.683616859
## 28 2.7272727 8.52988673 8.20852436 0.321362376
## 29 2.8282828 5.98053666 8.23612517 -2.255588517
## 30 2.9292929 10.79198858 8.25810832 2.533880261
## 31 3.0303030 9.15871357 8.27447380 0.884239771
## 32 3.1313131 7.73094672 8.28522160 -0.554274883
## 33 3.2323232 10.12052374 8.29035174 1.830172006
## 34 3.3333333 10.08960031 8.28986420 1.799736106
## 35 3.4343434 9.97343458 8.28375900 1.689675587
## 36 3.5353535 9.69837019 8.27203612 1.426334071
## 37 3.6363636 9.41362043 8.25469558 1.158924856
## 38 3.7373737 8.16053532 8.23173736 -0.071202041
## 39 3.8383838 7.64488520 8.20316147 -0.558276270
## 40 3.9393939 7.46219849 8.16896791 -0.706769420
## 41 4.0404040 6.79393468 8.12915669 -1.335222006
## 42 4.1414141 7.72160040 8.08372779 -0.362127388
## 43 4.2424242 5.55460675 8.03268122 -2.478074473
## 44 4.3434343 12.36515405 7.97601698 4.389137069
## 45 4.4444444 10.37888696 7.91373507 2.465151889
## 46 4.5454545 5.64634482 7.84583549 -2.199490673
## 47 4.6464646 7.01026951 7.77231824 -0.762048731
## 48 4.7474747 6.80008384 7.69318332 -0.893099475
## 49 4.8484848 9.20455834 7.60843073 1.596127608
## 50 4.9494949 7.38300169 7.51806047 -0.135058776
## 51 5.0505051 7.95536675 7.42207253 0.533294216
## 52 5.1515152 7.28450429 7.32046693 -0.035962646
## 53 5.2525253 7.14260313 7.21324366 -0.070640526
## 54 5.3535354 9.84617304 7.10040271 2.745770326
## 55 5.4545455 6.53192910 6.98194410 -0.450014998
## 56 5.5555556 9.88479306 6.85786782 3.026925244
## 57 5.6565657 3.61660520 6.72817386 -3.111568665
## 58 5.7575758 7.73947543 6.59286224 1.146613197
## 59 5.8585859 6.66797173 6.45193294 0.216038785
## 60 5.9595960 6.69603986 6.30538598 0.390653881
## 61 6.0606061 6.86120734 6.15322134 0.707986002
## 62 6.1616162 4.92893130 5.99543903 -1.066507732
## 63 6.2626263 5.09269145 5.83203905 -0.739347608
## 64 6.3636364 3.54136163 5.66302141 -2.121659776
## 65 6.4646465 3.24821430 5.48838609 -2.240171786
## 66 6.5656566 5.80601657 5.30813310 0.497883473
## 67 6.6666667 5.89641956 5.12226244 0.774157116
## 68 6.7676768 4.90092734 4.93077411 -0.029846772
## 69 6.8686869 6.42825088 4.73366811 1.694582772
## 70 6.9696970 8.46656056 4.53094444 3.935616115
## 71 7.0707071 3.16088227 4.32260310 -1.161720835
## 72 7.1717172 -0.70496157 4.10864409 -4.813605655
## 73 7.2727273 5.68916300 3.88906741 1.800095591
## 74 7.3737374 2.01747237 3.66387306 -1.646400691
## 75 7.4747475 1.81192277 3.43306103 -1.621138260
## 76 7.5757576 4.98502704 3.19663134 1.788395696
## 77 7.6767677 2.10416075 2.95458398 -0.850423227
## 78 7.7777778 -0.03402802 2.70691894 -2.740946961
## 79 7.8787879 2.49759319 2.45363624 0.043956946
## 80 7.9797980 1.57866050 2.19473586 -0.616075370
## 81 8.0808081 1.58330676 1.93021782 -0.346911058
## 82 8.1818182 2.05155254 1.66008210 0.391470433
## 83 8.2828283 0.24276319 1.38432872 -1.141565525
## 84 8.3838384 1.96980605 1.10295766 0.866848389
## 85 8.4848485 -0.06907230 0.81596894 -0.885041233
## 86 8.5858586 0.72019080 0.52336254 0.196828264
## 87 8.6868687 1.92890913 0.22513847 1.703770654
## 88 8.7878788 0.27807648 -0.07870327 0.356779747
## 89 8.8888889 -1.57778910 -0.38816268 -1.189626421
## 90 8.9898990 1.03192806 -0.70323975 1.735167817
## 91 9.0909091 0.37543746 -1.02393450 1.399371968
## 92 9.1919192 -0.86678123 -1.35024692 0.483465697
## 93 9.2929293 -1.84423840 -1.68217701 -0.162061383
## 94 9.3939394 -3.94176257 -2.01972477 -1.922037791
## 95 9.4949495 -0.33501589 -2.36289021 2.027874319
## 96 9.5959596 -4.63333215 -2.71167331 -1.921658846
## 97 9.6969697 0.55923899 -3.06607408 3.625313067
## 98 9.7979798 -1.13894159 -3.42609252 2.287150932
## 99 9.8989899 -5.07042123 -3.79172863 -1.278692593
## 100 10.0000000 -7.05284180 -4.16298242 -2.889859384
##Interpretasi:
#Berdasarkan hasil analisis residual, nilai residual diperoleh dari perbedaan antara nilai aktual Y dan nilai prediksi Y ̂. Residual bernilai positif menunjukkan bahwa nilai aktual berada di atas hasil prediksi model, sedangkan residual negatif menunjukkan bahwa nilai aktual berada di bawah nilai yang diperkirakan. Hasil pengamatan menunjukkan bahwa residual tersebar pada sisi positif maupun negatif, dengan beberapa nilai residual yang relatif besar. Kondisi tersebut mengindikasikan bahwa masih terdapat variasi pada data yang belum dapat dijelaskan sepenuhnya oleh model polinomial orde 2. Sementara itu, residual yang nilainya mendekati nol menunjukkan bahwa hasil prediksi model semakin mendekati nilai aktual.
poly(x, derajat, raw = TRUE) digunakan agar koefisien
dapat diinterpretasi langsung sebagai \(\beta_1 x + \beta_2 x^2 + \dots\)x distandardisasi terlebih dahulu
(scale(x)) agar model lebih stabil secara numerik.