Dataset Wine Quality dari UCI Machine Learning Repository
berisi sampel Vinho Verde dari Portugal. Dataset menyediakan
sebelas karakteristik fisikokimia sebagai prediktor dan skor
quality sebagai respons. UCI menyediakan dua kelompok data,
yaitu red wine dan white wine, dan
keduanya dapat dianalisis sebagai masalah regresi maupun klasifikasi.
Pada project ini quality diperlakukan sebagai variabel
numerik sehingga fokus analisis adalah regresi (Cortez et al.,
2009).
Ridge regression digunakan karena penalti \(L_2\) dapat membantu menstabilkan estimasi ketika prediktor saling berkorelasi. Analisis dilakukan melalui dua jalur yang sengaja dipisahkan:
tidymodels dan glmnet dengan preprocessing
yang direproduksi melalui recipe().Kedua jalur menggunakan pembagian data, fold cross-validation, dan grid kandidat \(\lambda\) yang sama sehingga hasilnya dapat dibandingkan secara langsung. Nilai \(\lambda\) optimal dipilih secara terpisah oleh masing-masing jalur.
Pada komputasi manual, standardisasi dilakukan secara eksplisit
menggunakan rumus \(Z=(X-\bar X)/s\).
Pada komputasi package, standardisasi dilakukan melalui
step_normalize() yang mempelajari mean dan simpangan baku
dari training set. Karena standardisasi sudah dilakukan oleh
recipe, standardisasi internal glmnet
dinonaktifkan dengan standardize = FALSE. Dokumentasi
recipes menjelaskan bahwa step_normalize()
mengestimasi mean dan SD dari data training dan menerapkannya pada data
baru (recipes documentation).
Pertanyaan utama:
Bagaimana Ridge regression dapat digunakan untuk memodelkan
quality wine berdasarkan karakteristik fisikokimia secara
terukur, dapat direproduksi, dan dapat dijelaskan, dengan
mempertimbangkan multikolinearitas, validasi out-of-sample, serta
perbandingan dengan model benchmark?
quality dan akurasi
prediksi berubah jika data dibagi berdasarkan skor (Tengah vs Ekstrem,
dan di median quality)?Analisis bertujuan untuk memahami struktur data, memeriksa multikolinearitas, melakukan standardisasi, menghitung Ridge secara manual, mengimplementasikan Ridge dengan package R, menentukan \(\lambda\) melalui cross-validation, mengevaluasi prediksi out-of-sample, dan membandingkan hasil kedua pendekatan.
Secara lebih khusus, tujuan analisis adalah: 1. merumuskan masalah
statistik/aplikatif yang terukur dengan quality sebagai
response dan karakteristik fisikokimia sebagai prediktor; 2. memahami
struktur, kualitas, dan keterbatasan data serta melakukan EDA yang
terarah; 3. menerapkan Ridge regression secara manual dan menggunakan
package R dengan pipeline yang dapat direproduksi; 4. melakukan
diagnostik model, memeriksa multikolinearitas dan observasi yang
berpotensi berpengaruh, serta mengevaluasi ketidakpastian hasil
prediksi; 5. membandingkan akurasi prediksi Ridge dengan OLS dan Random
Forest tanpa menyamakan predictive accuracy dengan inferensi
statistik.
Model regresi linear dengan \(p\) prediktor ditulis sebagai:
\[ Y_i=\beta_0+\sum_{j=1}^{p}\beta_jX_{ij}+\varepsilon_i. \]
OLS memperoleh koefisien dengan meminimumkan jumlah kuadrat residual:
\[ \hat\beta_{OLS}=\arg\min_{\beta}\sum_{i=1}^{n}(y_i-\beta_0-X_i\beta)^2. \]
Karena penalti Ridge bekerja pada besar koefisien, perbedaan skala antar-prediktor perlu dikendalikan. Standardisasi menggunakan:
\[ Z_{ij}=\frac{X_{ij}-\bar X_j}{s_j}, \]
dengan \(\bar X_j\) sebagai mean dan \(s_j\) sebagai simpangan baku prediktor ke-\(j\).
Dalam project ini standardisasi hanya menggunakan informasi training set. Dengan demikian, mean dan SD dari test set tidak digunakan untuk membentuk model.
Ridge menambahkan penalti kuadrat koefisien. Untuk regresi Gaussian,
formulasi yang konsisten dengan glmnet adalah:
\[ \hat\beta_{Ridge}=\arg\min_{\beta_0,\beta}\left\{\frac{1}{2n}\lVert y-\beta_0-Z\beta\rVert_2^2+\frac{\lambda}{2}\lVert\beta\rVert_2^2\right\}. \]
Karena prediktor telah dipusatkan, intercept dapat dipisahkan dan solusi slope manual menjadi:
\[ \hat\beta_{Ridge}=(Z^TZ+n\lambda I)^{-1}Z^T(y-\bar y). \]
Intercept dapat diperoleh kembali dari mean response karena prediktor telah dipusatkan:
\[ \hat\beta_0=\bar y. \]
Nilai \(\lambda\) mengendalikan kekuatan shrinkage. Ketika \(\lambda=0\), solusi kembali ke OLS. Semakin besar \(\lambda\), koefisien semakin menyusut menuju nol, tetapi Ridge tidak melakukan seleksi variabel secara langsung.
Nilai \(\lambda\) tidak dipilih berdasarkan test set. Pada project ini, \(\lambda\) dipilih menggunakan 10-fold cross-validation pada training set dengan RMSE sebagai metrik utama.
RMSE:
\[ RMSE=\sqrt{\frac{1}{n}\sum_{i=1}^{n}(y_i-\hat y_i)^2}. \]
MAE:
\[ MAE=\frac{1}{n}\sum_{i=1}^{n}|y_i-\hat y_i|. \]
Koefisien determinasi yang dilaporkan pada seluruh hasil test
dihitung sebagai kuadrat korelasi antara nilai aktual dan prediksi
(fungsi rsq_vec() dari paket yardstick):
\[ R^2=\left[\operatorname{cor}(y_i,\hat y_i)\right]^2. \]
Pada data test, nilai ini dapat sedikit berbeda dari ukuran \(1-\sum_i(y_i-\hat y_i)^2/\sum_i(y_i-\bar y)^2\), terutama bila prediksi memiliki bias sistematis.
Untuk RMSE dan MAE, nilai yang lebih kecil menunjukkan error prediksi yang lebih rendah. Untuk \(R^2\), nilai yang lebih besar menunjukkan proporsi variasi response yang lebih banyak dijelaskan oleh prediksi model.
Dalam project ini, inferensi statistik dan
akurasi prediksi dibedakan. Koefisien Ridge digunakan
untuk memahami arah dan besarnya hubungan linear bersyarat antara
karakteristik fisikokimia dan quality, dengan interpretasi
yang perlu mempertimbangkan standardisasi dan penalti Ridge. Sebaliknya,
RMSE, MAE, dan \(R^2\) pada data test
digunakan untuk menilai predictive accuracy, yaitu
seberapa baik model menghasilkan prediksi pada data yang tidak digunakan
saat fitting. Random Forest digunakan sebagai benchmark komputasi untuk
membandingkan kemampuan prediksi, bukan sebagai pengganti inferensi
terhadap koefisien Ridge. Karena itu, performa prediksi Random Forest
yang berbeda tidak dapat langsung ditafsirkan sebagai bukti bahwa
hubungan statistik tertentu lebih benar atau lebih kuat.
Diagnostik diarahkan pada beberapa aspek yang relevan untuk model regresi: pola residual terhadap nilai fitted untuk menilai kecukupan bentuk linear dan kemungkinan heteroskedastisitas, QQ plot untuk melihat penyimpangan distribusi residual, serta pemeriksaan observasi berpengaruh. Pemeriksaan Cook’s distance dan leverage dilakukan menggunakan model OLS sebagai diagnostik tambahan, karena ukuran pengaruh klasik tersebut didefinisikan untuk model least squares dan tidak secara langsung merupakan ukuran inferensial untuk Ridge. Untuk validasi, pemilihan \(\lambda\) dilakukan hanya pada training set melalui 10-fold cross-validation, sedangkan test set digunakan sekali pada evaluasi akhir. Variasi RMSE antar-fold dan interval bootstrap pada metrik test digunakan sebagai ukuran ketidakpastian empiris performa prediksi, bukan sebagai interval kepercayaan parameter Ridge.
Data berasal dari UCI Machine Learning Repository, yang menyediakan
file winequality-red.csv dan
winequality-white.csv. UCI mencatat 11 fitur fisikokimia
dan quality sebagai output sensorik (UCI Machine Learning
Repository).
Unit observasi dalam analisis ini adalah satu sampel
wine. Setiap baris data merepresentasikan satu sampel dengan
pengukuran karakteristik fisikokimia dan satu skor quality.
Dua dataset dianalisis secara terpisah, yaitu red wine dan white wine,
sehingga model tidak mencampurkan kedua kelompok wine dalam satu proses
fitting.
Menurut Cortez et al. (2009), setiap sampel dinilai secara blind
tasting oleh minimal tiga penilai pada skala 0 (sangat buruk)
sampai 10 (sangat baik), dan skor akhir yang dicatat adalah
median dari penilaian tersebut. Data yang tersedia
hanya memuat skor 3-8 pada red wine dan 3-9 pada white wine. Paper yang
sama menyatakan bahwa satu baris pada data merepresentasikan satu sampel
wine yang berbeda, dan memilih pendekatan regresi untuk memodelkan skor
karena pendekatan tersebut mempertahankan urutan skor (misalnya,
memprediksi 4 saat skor sebenarnya 3 lebih baik daripada memprediksi 7).
Alasan yang sama digunakan di sini untuk memperlakukan
quality sebagai respons numerik.
predictors <- c(
"fixed.acidity", "volatile.acidity", "citric.acid",
"residual.sugar", "chlorides", "free.sulfur.dioxide",
"total.sulfur.dioxide", "density", "pH", "sulphates", "alcohol"
)
response <- "quality"quality digunakan sebagai target/response
numerik karena pada project ini skor kualitas dimodelkan
sebagai outcome kontinu untuk tujuan regresi. Sebelas prediktor yang
digunakan adalah seluruh karakteristik fisikokimia yang tercantum dalam
dokumentasi dataset, yaitu fixed.acidity,
volatile.acidity, citric.acid,
residual.sugar, chlorides,
free.sulfur.dioxide, total.sulfur.dioxide,
density, pH, sulphates, dan
alcohol. Pemilihan ini mengikuti struktur data UCI dan
menjaga agar tidak ada variabel yang berasal dari hasil evaluasi test
atau informasi di luar karakteristik fisikokimia yang tersedia. Tidak
ada prediktor yang dibentuk dari quality, sehingga target
tidak bocor ke sisi prediktor.
metric_table <- function(truth, estimate) {
tibble(
RMSE = rmse_vec(truth, estimate),
MAE = mae_vec(truth, estimate),
R2 = rsq_vec(truth, estimate)
)
}
manual_ridge <- function(train_data, predictors, response, lambda) {
X <- as.matrix(train_data[, predictors])
y <- train_data[[response]]
x_mean <- colMeans(X)
x_sd <- apply(X, 2, sd)
Z <- scale(X, center = x_mean, scale = x_sd)
p <- ncol(Z)
penalty_matrix <- diag(p)
n <- nrow(Z)
# glmnet Gaussian Ridge uses: RSS/(2n) + lambda/2 * ||beta||^2.
# Multiplying the objective by 2n gives: RSS + n*lambda*||beta||^2.
beta <- solve(
crossprod(Z) + n * lambda * penalty_matrix,
crossprod(Z, y - mean(y))
)
beta <- as.numeric(beta)
names(beta) <- predictors
intercept <- mean(y)
list(
beta = beta,
intercept = intercept,
means = x_mean,
sds = x_sd,
lambda = lambda
)
}
predict_manual_ridge <- function(model, new_data) {
X_new <- as.matrix(new_data[names(model$beta)])
Z_new <- sweep(X_new, 2, model$means, "-")
Z_new <- sweep(Z_new, 2, model$sds, "/")
as.numeric(model$intercept + Z_new %*% model$beta)
}
# REVISI: kuantil dihitung dari seluruh draw bootstrap. Pada versi sebelumnya,
# nama kolom hasil summarise() menimpa kolom draw sehingga batas bawah, batas
# atas, dan rata-rata bernilai sama.
bootstrap_metric_ci <- function(truth, estimate, B = 500, seed = 12345) {
set.seed(seed)
n <- length(truth)
boot_metrics <- map_dfr(seq_len(B), function(i) {
idx <- sample.int(n, size = n, replace = TRUE)
tibble(
RMSE = rmse_vec(truth[idx], estimate[idx]),
MAE = mae_vec(truth[idx], estimate[idx]),
R2 = rsq_vec(truth[idx], estimate[idx])
)
})
boot_summary <- boot_metrics %>%
pivot_longer(everything(), names_to = "metric", values_to = "value") %>%
group_by(metric) %>%
summarise(
mean = mean(value),
lower = quantile(value, .025),
upper = quantile(value, .975),
.groups = "drop"
) %>%
mutate(metric = factor(metric, levels = c("RMSE", "MAE", "R2"))) %>%
arrange(metric)
list(draws = boot_metrics, summary = boot_summary)
}
cv_fold_rmse <- function(folds, predictors, response, lambda) {
map_dfr(seq_along(folds$splits), function(i) {
s <- folds$splits[[i]]
tr <- analysis(s)
va <- assessment(s)
fit <- manual_ridge(tr, predictors, response, lambda)
pred <- predict_manual_ridge(fit, va)
tibble(
fold = i,
RMSE = rmse_vec(va[[response]], pred)
)
})
}Fungsi berikut dipakai pada bagian Analisis Lanjutan untuk
red wine dan white wine. Terdapat dua skema pembagian: (1)
Tengah vs Ekstrem, dengan skor yang dianggap “tengah”
ditetapkan pada satu tempat (mid_levels) setelah melihat
tabel frekuensi quality pada bagian EDA; dan (2)
pembagian di median quality pada training
set.
mid_levels <- 5:7 # skor 'tengah'; skor lainnya = 'ekstrem'
add_group <- function(df, scheme = "strata", med = NA_real_) {
if (scheme == "strata") {
lv <- c("Tengah", "Ekstrem")
g <- if_else(df$quality %in% mid_levels, lv[1], lv[2])
} else {
lv <- c("Bawah median", "Atas median")
g <- if_else(df$quality >= med, lv[2], lv[1])
}
df %>% mutate(kelompok = factor(g, levels = lv))
}
# fold CV berstrata quality; bila data terlalu kecil untuk stratifikasi,
# gunakan fold tanpa strata
make_folds <- function(data, v, repeats = 1, seed = 12345) {
set.seed(seed)
tryCatch(
vfold_cv(data, v = v, repeats = repeats, strata = quality),
error = function(e) vfold_cv(data, v = v, repeats = repeats)
)
}
# Ridge (jalur package) untuk satu kelompok: tuning lambda dengan CV, fit final,
# prediksi pada test kelompok tersebut
fit_group_ridge <- function(train_g, test_g, folds, lambda_grid) {
rec <- recipe(quality ~ ., data = train_g) %>%
step_zv(all_predictors()) %>%
step_normalize(all_numeric_predictors())
spec <- linear_reg(penalty = tune(), mixture = 0) %>%
set_engine("glmnet", standardize = FALSE)
wf <- workflow() %>%
add_recipe(rec) %>%
add_model(spec)
tuned <- tune_grid(
wf,
resamples = folds,
grid = tibble(penalty = lambda_grid),
metrics = metric_set(rmse, mae, rsq)
)
best <- select_best(tuned, metric = "rmse")
final_fit <- fit(finalize_workflow(wf, best), data = train_g)
cv_rmse <- collect_metrics(tuned, summarize = FALSE) %>%
filter(.metric == "rmse", .config == best$.config)
list(
fit = final_fit,
penalty = best$penalty,
cv = tibble(
mean_RMSE_CV = mean(cv_rmse$.estimate),
sd_RMSE_CV = sd(cv_rmse$.estimate),
n_resample = nrow(cv_rmse)
),
pred = predict(final_fit, new_data = test_g)$.pred,
coef = tidy(extract_fit_parsnip(final_fit)) %>%
filter(term != "(Intercept)") %>%
select(term, estimate)
)
}
# Jalankan analisis untuk dua kelompok pada satu dataset.
# scheme = "strata": kelompok Tengah 10-fold CV; kelompok Ekstrem 5-fold CV
# diulang 10 kali (data kecil; 5-fold juga dipakai oleh Cortez et al., 2009).
# scheme = "median": kedua kelompok besar, keduanya 10-fold CV.
run_group_analysis <- function(train, test, full_fit, lambda_grid, scheme = "strata") {
med <- median(train$quality)
train_g <- add_group(train, scheme, med)
test_g <- add_group(test, scheme, med)
counts <- bind_rows(
train_g %>% count(kelompok) %>% mutate(set = "Training"),
test_g %>% count(kelompok) %>% mutate(set = "Test")
) %>%
pivot_wider(names_from = set, values_from = n)
res <- map(set_names(levels(train_g$kelompok)), function(g) {
tr <- train_g %>% filter(kelompok == g) %>% select(-kelompok)
te <- test_g %>% filter(kelompok == g) %>% select(-kelompok)
small <- scheme == "strata" && g == "Ekstrem"
v <- if (small) 5 else 10
reps <- if (small) 10 else 1
out <- fit_group_ridge(tr, te, make_folds(tr, v = v, repeats = reps), lambda_grid)
out$truth <- te$quality
out$full_pred <- predict(full_fit, new_data = te)$.pred
out$design <- paste0(v, "-fold", if (reps > 1) paste0(" x ", reps) else "")
out$n_train <- nrow(tr)
out
})
cv_tbl <- imap_dfr(res, function(r, g) {
bind_cols(
tibble(kelompok = g, n_training = r$n_train, desain_CV = r$design,
lambda = r$penalty),
r$cv
)
})
perf <- imap_dfr(res, function(r, g) {
bind_rows(
metric_table(r$truth, r$pred) %>% mutate(model = "Ridge kelompok"),
metric_table(r$truth, r$full_pred) %>% mutate(model = "Ridge data penuh")
) %>%
mutate(kelompok = g, n_test = length(r$truth))
}) %>%
select(kelompok, model, n_test, RMSE, MAE, R2)
full_coef <- tidy(extract_fit_parsnip(full_fit)) %>%
filter(term != "(Intercept)") %>%
transmute(term, estimate, model = "Data penuh")
coef_tbl <- bind_rows(
full_coef,
imap_dfr(res, function(r, g) r$coef %>% mutate(model = paste("Kelompok", g)))
)
list(counts = counts, cv = cv_tbl, perf = perf, coef = coef_tbl, res = res)
}
plot_group_coef <- function(coef_tbl, title) {
ord <- coef_tbl %>%
filter(model == "Data penuh") %>%
arrange(estimate) %>%
pull(term)
coef_tbl %>%
mutate(term = factor(term, levels = ord)) %>%
ggplot(aes(estimate, term, fill = model)) +
geom_col(position = position_dodge(width = .8), width = .7) +
geom_vline(xintercept = 0, linetype = "dashed") +
labs(title = title, x = "Koefisien Ridge (terstandardisasi pada masing-masing model)",
y = NULL, fill = NULL) +
theme_minimal(base_size = 11) +
theme(legend.position = "bottom")
}red_url <- paste0(
"https://archive.ics.uci.edu/ml/machine-learning-databases/",
"wine-quality/winequality-red.csv"
)
red_wine <- read.csv(red_url, sep = ";")
red_model <- red_wine %>% select(all_of(c(predictors, response)))
cat("Observasi:", nrow(red_model), "\n")## Observasi: 1599
## Variabel: 12
red_missing <- colSums(is.na(red_model))
red_duplicates <- sum(duplicated(red_model))
kable(
tibble(variable = names(red_missing), missing = as.integer(red_missing)),
caption = "Missing Value Red Wine"
)| variable | missing |
|---|---|
| fixed.acidity | 0 |
| volatile.acidity | 0 |
| citric.acid | 0 |
| residual.sugar | 0 |
| chlorides | 0 |
| free.sulfur.dioxide | 0 |
| total.sulfur.dioxide | 0 |
| density | 0 |
| pH | 0 |
| sulphates | 0 |
| alcohol | 0 |
| quality | 0 |
## Duplikasi: 240
Tidak ada missing value. Terdapat 240 baris duplikat (15% dari data), yaitu baris yang identik pada seluruh 12 variabel. Baris duplikat tidak dihapus. Cortez et al. (2009) menyatakan bahwa satu baris merepresentasikan satu sampel wine yang berbeda, sehingga baris yang identik diperlakukan sebagai sampel berbeda yang kebetulan memiliki hasil uji laboratorium dan skor yang sama (misalnya berasal dari batch yang sama), bukan kesalahan entri. Jumlah observasi pada paper tersebut juga sama dengan data yang dipakai di sini. Konsekuensinya, baris yang identik dapat berada di training set dan test set sekaligus; hal ini dicatat pada bagian Keterbatasan.
red_freq <- red_model %>%
count(quality, name = "n") %>%
mutate(
persen = 100 * n / sum(n),
persen_kumulatif = cumsum(persen)
)
kable(red_freq, digits = 1, caption = "Distribusi Skor Quality — Red Wine")| quality | n | persen | persen_kumulatif |
|---|---|---|---|
| 3 | 10 | 0.6 | 0.6 |
| 4 | 53 | 3.3 | 3.9 |
| 5 | 681 | 42.6 | 46.5 |
| 6 | 638 | 39.9 | 86.4 |
| 7 | 199 | 12.4 | 98.9 |
| 8 | 18 | 1.1 | 100.0 |
Skor quality hanya teramati pada beberapa nilai bulat
dan distribusinya sangat tidak merata: sebagian besar sampel berada pada
skor 5-7 (sekitar 95% pada red wine), sedangkan skor 3, 4, dan 8 hanya
berjumlah puluhan baris. Pola ini sejalan dengan Cortez et al. (2009)
yang menggambarkan distribusi skor berbentuk lonceng dengan lebih banyak
nilai tengah daripada nilai ekstrem. Ketidakmerataan ini menjadi alasan
pembagian training-test dan fold cross-validation dibuat berstrata
quality, dan menjadi dasar analisis lanjutan pada kelompok
skor tengah dan ekstrem.
red_desc <- red_model %>%
summarise(across(
everything(),
list(Mean = mean, SD = sd, Min = min, Median = median, Max = max),
.names = "{.col}__{.fn}"
)) %>%
pivot_longer(everything(), names_to = c("Variabel", "Statistik"),
names_sep = "__", values_to = "nilai") %>%
pivot_wider(names_from = Statistik, values_from = nilai)
kable(red_desc, digits = 3, caption = "Statistik Deskriptif — Red Wine")| Variabel | Mean | SD | Min | Median | Max |
|---|---|---|---|---|---|
| fixed.acidity | 8.320 | 1.741 | 4.600 | 7.900 | 15.900 |
| volatile.acidity | 0.528 | 0.179 | 0.120 | 0.520 | 1.580 |
| citric.acid | 0.271 | 0.195 | 0.000 | 0.260 | 1.000 |
| residual.sugar | 2.539 | 1.410 | 0.900 | 2.200 | 15.500 |
| chlorides | 0.087 | 0.047 | 0.012 | 0.079 | 0.611 |
| free.sulfur.dioxide | 15.875 | 10.460 | 1.000 | 14.000 | 72.000 |
| total.sulfur.dioxide | 46.468 | 32.895 | 6.000 | 38.000 | 289.000 |
| density | 0.997 | 0.002 | 0.990 | 0.997 | 1.004 |
| pH | 3.311 | 0.154 | 2.740 | 3.310 | 4.010 |
| sulphates | 0.658 | 0.170 | 0.330 | 0.620 | 2.000 |
| alcohol | 10.423 | 1.066 | 8.400 | 10.200 | 14.900 |
| quality | 5.636 | 0.808 | 3.000 | 6.000 | 8.000 |
p1 <- ggplot(red_model, aes(factor(quality))) +
geom_bar() +
geom_text(stat = "count", aes(label = after_stat(count)), vjust = -0.3, size = 3) +
labs(title = "Distribusi Quality — Red Wine", x = "Quality", y = "Frekuensi") +
theme_minimal(base_size = 12)
red_long <- red_model %>%
pivot_longer(all_of(predictors), names_to = "variable", values_to = "value")
p2 <- ggplot(red_long, aes(value)) +
geom_histogram(bins = 30, color = "white") +
facet_wrap(~variable, scales = "free", ncol = 3) +
labs(title = "Distribusi Prediktor — Red Wine", x = NULL, y = "Frekuensi") +
theme_minimal(base_size = 10)
p1 / p2red_quality_long <- red_model %>%
pivot_longer(all_of(predictors), names_to = "variable", values_to = "value")
ggplot(red_quality_long, aes(x = quality, y = value)) +
geom_jitter(alpha = .12, width = .15) +
geom_smooth(method = "lm", se = FALSE) +
facet_wrap(~variable, scales = "free_y", ncol = 3) +
labs(
title = "Hubungan Prediktor dengan Quality — Red Wine",
x = "Quality", y = "Nilai Prediktor"
) +
theme_minimal(base_size = 11)Visualisasi ini digunakan sebagai EDA terarah untuk melihat apakah
terdapat pola hubungan linear yang masuk akal antara
quality dan masing-masing karakteristik fisikokimia. Karena
quality hanya memiliki beberapa skor diskret, titik pada
setiap kategori dapat bertumpuk; karena itu, jitter digunakan untuk
membantu melihat kepadatan pengamatan. Grafik ini bersifat eksploratif
dan tidak digunakan sebagai dasar tunggal untuk menyimpulkan hubungan
kausal.
ggplot(red_quality_long, aes(x = factor(quality), y = value)) +
geom_boxplot(outlier.alpha = .3) +
facet_wrap(~variable, scales = "free_y", ncol = 3) +
labs(
title = "Sebaran Prediktor per Skor Quality — Red Wine",
x = "Quality", y = "Nilai Prediktor"
) +
theme_minimal(base_size = 11)Boxplot per skor memperlihatkan perubahan median tiap prediktor antar tingkat kualitas, termasuk pada skor ekstrem yang jumlah sampelnya sedikit, serta keberadaan nilai pencilan pada tiap prediktor.
set.seed(12345)
red_split <- initial_split(red_model, prop = .80, strata = quality)
red_train <- training(red_split)
red_test <- testing(red_split)
cat("Training:", nrow(red_train), "\n")## Training: 1278
## Testing : 321
Pembagian menggunakan strata quality agar proporsi skor
di training dan test sama. Hal ini penting karena distribusi
quality sangat tidak merata: pada pembagian acak biasa,
skor yang jarang dapat hampir tidak muncul pada salah satu bagian. Untuk
strata yang sangat kecil, rsample dapat menggabungkannya
secara otomatis saat mengacak, sehingga stratifikasi pada skor paling
langka bersifat pendekatan.
red_train_tmp <- red_train
red_ols_tmp <- lm(quality ~ ., data = red_train_tmp)
red_vif <- car::vif(red_ols_tmp)
red_vif_table <- tibble(
variable = names(red_vif),
VIF = as.numeric(red_vif)
) %>% arrange(desc(VIF))
kable(red_vif_table, digits = 3, caption = "VIF Red Wine")| variable | VIF |
|---|---|
| fixed.acidity | 7.967 |
| density | 6.600 |
| pH | 3.459 |
| alcohol | 3.209 |
| citric.acid | 3.064 |
| total.sulfur.dioxide | 2.190 |
| free.sulfur.dioxide | 1.960 |
| volatile.acidity | 1.754 |
| residual.sugar | 1.704 |
| chlorides | 1.544 |
| sulphates | 1.503 |
Hasil VIF menunjukkan bahwa fixed.acidity memiliki nilai VIF paling tinggi, yaitu 7,967, diikuti oleh density sebesar 6,600. Nilai ini menunjukkan bahwa kedua variabel tersebut memiliki keterkaitan yang cukup kuat dengan prediktor lainnya sehingga berpotensi menimbulkan multikolinearitas. Sementara itu, variabel pH, alcohol, dan citric.acid memiliki VIF sekitar 3, sedangkan variabel lainnya berada di bawah 2,2, sehingga hubungan linear dengan prediktor lain relatif lebih rendah. Secara keseluruhan, hasil ini menunjukkan adanya multikolinearitas terutama pada fixed.acidity dan density, yang mendukung penggunaan Ridge Regression untuk membantu menstabilkan estimasi koefisien ketika prediktor saling berkorelasi.
red_cor <- cor(red_model[predictors], use = "complete.obs")
red_cor_long <- as.data.frame(red_cor) %>%
rownames_to_column("v1") %>%
pivot_longer(-v1, names_to = "v2", values_to = "r")
ggplot(red_cor_long, aes(v1, v2, fill = r)) +
geom_tile() +
geom_text(aes(label = sprintf("%.2f", r)), size = 2.5) +
scale_fill_gradient2(low = "#2166AC", mid = "white", high = "#B2182B", midpoint = 0, limits = c(-1,1)) +
labs(title = "Korelasi Prediktor — Red Wine", x = NULL, y = NULL, fill = "r") +
theme_minimal(base_size = 9) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))Matriks korelasi menunjukkan beberapa hubungan yang cukup kuat antar prediktor. Korelasi positif paling terlihat antara fixed.acidity dengan citric.acid (r = 0,67), fixed.acidity dengan density (r = 0,67), serta free.sulfur.dioxide dengan total.sulfur.dioxide (r = 0,67). Sebaliknya, hubungan negatif yang cukup kuat terlihat antara pH dengan fixed.acidity (r = −0,68) dan pH dengan citric.acid (r = −0,54). Pola ini memperlihatkan bahwa beberapa karakteristik kimia wine bergerak bersama, terutama variabel yang berkaitan dengan tingkat keasaman dan sulfur dioksida. Hasil korelasi ini sejalan dengan nilai VIF yang menunjukkan bahwa fixed.acidity dan density merupakan variabel yang perlu mendapat perhatian dalam masalah multikolinearitas.
X_red <- as.matrix(red_train[predictors])
y_red <- red_train$quality
red_means <- colMeans(X_red)
red_sds <- apply(X_red, 2, sd)
Z_red <- scale(X_red, center = red_means, scale = red_sds)
red_standardization <- tibble(
variable = predictors,
mean_training = as.numeric(red_means),
sd_training = as.numeric(red_sds)
)
kable(red_standardization, digits = 4, caption = "Parameter Standardisasi Manual — Red Wine")| variable | mean_training | sd_training |
|---|---|---|
| fixed.acidity | 8.3111 | 1.7418 |
| volatile.acidity | 0.5310 | 0.1816 |
| citric.acid | 0.2701 | 0.1957 |
| residual.sugar | 2.5420 | 1.4072 |
| chlorides | 0.0882 | 0.0493 |
| free.sulfur.dioxide | 15.7750 | 10.1708 |
| total.sulfur.dioxide | 46.1287 | 32.3489 |
| density | 0.9967 | 0.0019 |
| pH | 3.3098 | 0.1559 |
| sulphates | 0.6603 | 0.1739 |
| alcohol | 10.4157 | 1.0717 |
Dengan \(Z\) sebagai matriks prediktor terstandardisasi, perhitungan manual mengikuti:
\[ \hat\beta(\lambda)=(Z^TZ+n\lambda I)^{-1}Z^T(y-\bar y). \]
Intercept dihitung sebagai \(\hat\beta_0=\bar y\) karena kolom prediktor telah dipusatkan.
Agar perbandingan manual dan package adil, kandidat \(\lambda\) menggunakan grid yang sama.
red_lambda_grid <- 10^seq(-4, 2, length.out = 100)
set.seed(12345)
red_manual_folds <- vfold_cv(red_train, v = 10, strata = quality)
red_manual_cv <- map_dfr(red_lambda_grid, function(lambda) {
fold_rmse <- map_dbl(red_manual_folds$splits, function(s) {
tr <- analysis(s)
va <- assessment(s)
fit <- manual_ridge(tr, predictors, response, lambda)
pred <- predict_manual_ridge(fit, va)
rmse_vec(va$quality, pred)
})
tibble(
penalty = lambda,
RMSE = mean(fold_rmse)
)
})
red_manual_best <- red_manual_cv %>% slice_min(RMSE, n = 1)
red_manual_bestggplot(red_manual_cv, aes(penalty, RMSE)) +
geom_line(linewidth = .8) +
geom_point(data = red_manual_best, size = 3) +
scale_x_log10() +
labs(title = "10-Fold CV Manual Ridge — Red Wine", x = expression(lambda), y = "Mean RMSE") +
theme_minimal(base_size = 12)Hasil 10-fold cross-validation menunjukkan bahwa nilai RMSE berada di sekitar 0,65 pada sebagian besar nilai \(\lambda\) yang kecil, kemudian meningkat cukup tajam ketika \(\lambda\) semakin besar. Nilai RMSE minimum diperoleh pada \(\lambda \approx 0{,}05\), dengan rata-rata RMSE CV ≈ 0,651, sehingga nilai tersebut dipilih sebagai \(\lambda\) optimal karena memberikan kesalahan prediksi rata-rata terkecil pada data validasi. Ketika \(\lambda\) semakin besar, penalti Ridge semakin kuat sehingga koefisien semakin menyusut dan performa prediksi menurun, yang terlihat dari kenaikan RMSE hingga sekitar 0,81.
red_lambda_manual <- red_manual_best$penalty
red_manual_fit <- manual_ridge(red_train, predictors, response, red_lambda_manual)
red_manual_coef <- tibble(
term = predictors,
estimate = unname(red_manual_fit$beta)
)
kable(red_manual_coef, digits = 5, caption = "Koefisien Manual Ridge — Red Wine")| term | estimate |
|---|---|
| fixed.acidity | 0.05370 |
| volatile.acidity | -0.19479 |
| citric.acid | -0.01029 |
| residual.sugar | 0.03302 |
| chlorides | -0.09225 |
| free.sulfur.dioxide | 0.04596 |
| total.sulfur.dioxide | -0.11194 |
| density | -0.04489 |
| pH | -0.05403 |
| sulphates | 0.13112 |
| alcohol | 0.27578 |
red_manual_pred <- predict_manual_ridge(red_manual_fit, red_test)
red_manual_metrics <- metric_table(red_test$quality, red_manual_pred)
red_manual_metricsPada \(\lambda\) terpilih, model menghasilkan MAE = 0,4956 dan R² = 0,3052, yang berarti model mampu menjelaskan sekitar 30,52% variasi kualitas wine pada data yang dievaluasi.
recipe()step_normalize() mempelajari mean dan SD dari training
data lalu menggunakan parameter tersebut ketika data baru diproses.
Dengan demikian, standardisasi tidak menggunakan informasi test set
(recipes documentation).
red_ridge_spec <- linear_reg(
penalty = tune(),
mixture = 0
) %>%
set_engine("glmnet", standardize = FALSE)mixture = 0 menyatakan penalti Ridge murni.
standardize = FALSE digunakan karena standardisasi sudah
dilakukan oleh step_normalize().
red_folds <- red_manual_folds
red_grid <- tibble(penalty = red_lambda_grid)
red_workflow <- workflow() %>%
add_recipe(red_recipe) %>%
add_model(red_ridge_spec)
red_tuned <- tune_grid(
red_workflow,
resamples = red_folds,
grid = red_grid,
metrics = metric_set(rmse, mae, rsq)
)
red_best <- select_best(red_tuned, metric = "rmse")
red_bestred_final_workflow <- finalize_workflow(red_workflow, red_best)
red_package_fit <- fit(red_final_workflow, data = red_train)
red_package_pred <- predict(red_package_fit, new_data = red_test)$.pred
red_package_metrics <- metric_table(red_test$quality, red_package_pred)
red_package_metrics# ============================================================
# SIGNIFIKANSI PREDIKTOR TERHADAP QUALITY - RED WINE
# OLS digunakan sebagai baseline inferensial
# ============================================================
red_ols_infer <- lm(
quality ~ fixed.acidity +
volatile.acidity +
citric.acid +
residual.sugar +
chlorides +
free.sulfur.dioxide +
total.sulfur.dioxide +
density +
pH +
sulphates +
alcohol,
data = red_train
)
# Ringkasan model OLS
summary(red_ols_infer)##
## Call:
## lm(formula = quality ~ fixed.acidity + volatile.acidity + citric.acid +
## residual.sugar + chlorides + free.sulfur.dioxide + total.sulfur.dioxide +
## density + pH + sulphates + alcohol, data = red_train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.68120 -0.37393 -0.04833 0.46469 2.11778
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 14.5026104 24.2667267 0.598 0.5502
## fixed.acidity 0.0216323 0.0293769 0.736 0.4616
## volatile.acidity -1.1432650 0.1321986 -8.648 < 0.0000000000000002 ***
## citric.acid -0.1497120 0.1621184 -0.923 0.3559
## residual.sugar 0.0198091 0.0168175 1.178 0.2391
## chlorides -1.9369452 0.4571406 -4.237 0.00002428445 ***
## free.sulfur.dioxide 0.0054362 0.0024951 2.179 0.0295 *
## total.sulfur.dioxide -0.0037351 0.0008292 -4.504 0.00000727539 ***
## density -10.1202611 24.7517801 -0.409 0.6827
## pH -0.4755029 0.2162594 -2.199 0.0281 *
## sulphates 0.7719168 0.1278089 6.040 0.00000000203 ***
## alcohol 0.2840138 0.0303026 9.373 < 0.0000000000000002 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6478 on 1266 degrees of freedom
## Multiple R-squared: 0.3722, Adjusted R-squared: 0.3668
## F-statistic: 68.25 on 11 and 1266 DF, p-value: < 0.00000000000000022
red_significance <- broom::tidy(red_ols_infer) %>%
filter(term != "(Intercept)") %>%
mutate(
Signifikansi = case_when(
p.value < 0.001 ~ "***",
p.value < 0.01 ~ "**",
p.value < 0.05 ~ "*",
p.value < 0.10 ~ ".",
TRUE ~ "Tidak signifikan"
)
) %>%
select(
Prediktor = term,
Estimate = estimate,
`Std. Error` = std.error,
`t-value` = statistic,
`p-value` = p.value,
Signifikansi
)
knitr::kable(
red_significance,
digits = 4,
caption = "Signifikansi Prediktor terhadap Quality pada Red Wine"
)| Prediktor | Estimate | Std. Error | t-value | p-value | Signifikansi |
|---|---|---|---|---|---|
| fixed.acidity | 0.0216 | 0.0294 | 0.7364 | 0.4616 | Tidak signifikan |
| volatile.acidity | -1.1433 | 0.1322 | -8.6481 | 0.0000 | *** |
| citric.acid | -0.1497 | 0.1621 | -0.9235 | 0.3559 | Tidak signifikan |
| residual.sugar | 0.0198 | 0.0168 | 1.1779 | 0.2391 | Tidak signifikan |
| chlorides | -1.9369 | 0.4571 | -4.2371 | 0.0000 | *** |
| free.sulfur.dioxide | 0.0054 | 0.0025 | 2.1788 | 0.0295 | * |
| total.sulfur.dioxide | -0.0037 | 0.0008 | -4.5042 | 0.0000 | *** |
| density | -10.1203 | 24.7518 | -0.4089 | 0.6827 | Tidak signifikan |
| pH | -0.4755 | 0.2163 | -2.1988 | 0.0281 | * |
| sulphates | 0.7719 | 0.1278 | 6.0396 | 0.0000 | *** |
| alcohol | 0.2840 | 0.0303 | 9.3726 | 0.0000 | *** |
REVISI: koefisien package diambil pada \(\lambda\) terpilih (tidy()
pada objek parsnip), bukan seluruh jalur \(\lambda\) dari objek glmnet.
Karena \(\lambda\) optimal manual dan
package tidak identik, kolom manual_at_package_lambda
menunjukkan koefisien manual yang dihitung pada \(\lambda\) package, sehingga kedua jalur
dibandingkan pada \(\lambda\) yang
sama.
red_package_coef <- tidy(extract_fit_parsnip(red_package_fit)) %>%
filter(term != "(Intercept)") %>%
transmute(term, package_estimate = estimate)
red_manual_at_package <- manual_ridge(red_train, predictors, response, red_best$penalty)
red_coef_comparison <- red_manual_coef %>%
rename(manual_estimate = estimate) %>%
left_join(red_package_coef, by = "term") %>%
mutate(
manual_at_package_lambda = unname(red_manual_at_package$beta[term]),
abs_difference = abs(manual_estimate - package_estimate),
abs_difference_same_lambda = abs(manual_at_package_lambda - package_estimate)
)
kable(red_coef_comparison, digits = 6, caption = "Perbandingan Koefisien Manual dan Package — Red Wine")| term | manual_estimate | package_estimate | manual_at_package_lambda | abs_difference | abs_difference_same_lambda |
|---|---|---|---|---|---|
| fixed.acidity | 0.053696 | 0.053921 | 0.052110 | 0.000225 | 0.001811 |
| volatile.acidity | -0.194787 | -0.195471 | -0.197540 | 0.000684 | 0.002069 |
| citric.acid | -0.010290 | -0.011303 | -0.014369 | 0.001013 | 0.003066 |
| residual.sugar | 0.033016 | 0.033117 | 0.032536 | 0.000101 | 0.000581 |
| chlorides | -0.092246 | -0.092403 | -0.092974 | 0.000157 | 0.000570 |
| free.sulfur.dioxide | 0.045962 | 0.046482 | 0.047938 | 0.000520 | 0.001456 |
| total.sulfur.dioxide | -0.111936 | -0.112434 | -0.113830 | 0.000497 | 0.001397 |
| density | -0.044894 | -0.044462 | -0.041168 | 0.000432 | 0.003295 |
| pH | -0.054031 | -0.054538 | -0.057348 | 0.000507 | 0.002810 |
| sulphates | 0.131124 | 0.131494 | 0.132189 | 0.000370 | 0.000695 |
| alcohol | 0.275780 | 0.276938 | 0.281044 | 0.001158 | 0.004106 |
red_prediction_comparison <- tibble(
actual = red_test$quality,
manual = red_manual_pred,
package = red_package_pred
)
red_prediction_comparison %>% head(10)red_metrics_comparison <- bind_rows(
red_manual_metrics %>% mutate(method = "Manual Ridge"),
red_package_metrics %>% mutate(method = "Package Ridge")
) %>%
select(method, everything())
kable(red_metrics_comparison, digits = 4, caption = "Performa Manual vs Package — Red Wine")| method | RMSE | MAE | R2 |
|---|---|---|---|
| Manual Ridge | 0.6515 | 0.4956 | 0.3052 |
| Package Ridge | 0.6515 | 0.4955 | 0.3052 |
Hasil evaluasi menunjukkan bahwa Manual Ridge dan Package Ridge menghasilkan performa yang hampir identik. Keduanya memiliki RMSE = 0,6515 dan R² = 0,3052, sedangkan nilai MAE hanya berbeda sangat kecil, yaitu 0,4956 pada metode manual dan 0,4955 pada package. Kesamaan hasil ini menunjukkan bahwa perhitungan Ridge secara manual telah mengikuti formulasi dan proses standardisasi yang konsisten dengan implementasi package, sehingga kedua pendekatan menghasilkan prediksi yang praktis sama. Dengan demikian, package R dapat digunakan untuk memperoleh hasil yang setara dengan perhitungan manual tanpa mengubah hasil model secara berarti.
red_residual_df <- tibble(
fitted = red_package_pred,
residual = red_test$quality - red_package_pred
)
ggplot(red_residual_df, aes(fitted, residual)) +
geom_point(alpha = .45) +
geom_hline(yintercept = 0, linetype = "dashed") +
geom_smooth(method = "loess", se = TRUE) +
labs(title = "Residual vs Predicted — Red Wine", x = "Predicted", y = "Residual") +
theme_minimal(base_size = 12)red_plot <- tibble(
actual = red_test$quality,
manual = red_manual_pred,
package = red_package_pred
) %>%
pivot_longer(-actual, names_to = "method", values_to = "predicted")
ggplot(red_plot, aes(actual, predicted)) +
geom_point(alpha = .35) +
geom_abline(slope = 1, intercept = 0, linetype = "dashed") +
facet_wrap(~method) +
labs(title = "Actual vs Predicted — Red Wine", x = "Actual Quality", y = "Predicted Quality") +
theme_minimal(base_size = 12)Plot actual vs predicted menunjukkan pola yang hampir sama antara hasil manual dan package. Titik prediksi pada kedua metode tersebut tersebar pada rentang kualitas yang serupa, tetapi sebagian besar prediksi cenderung terkonsentrasi di sekitar nilai 5-6, sementara nilai kualitas aktual yang lebih tinggi tidak selalu diikuti prediksi yang sama tinggi. Garis putus-putus menunjukkan kondisi prediksi ideal, yaitu ketika nilai prediksi sama dengan nilai aktual. Jarak titik-titik terhadap garis tersebut menunjukkan adanya kesalahan prediksi, terutama pada pengamatan dengan kualitas aktual yang lebih rendah atau lebih tinggi. Secara visual, kedua metode menghasilkan pola prediksi yang sangat mirip.
red_model_comparison <- bind_rows(
red_package_metrics %>% mutate(model = "Ridge Package"),
red_ols_metrics %>% mutate(model = "OLS"),
red_rf_metrics %>% mutate(model = "Random Forest")
) %>% select(model, everything())
kable(red_model_comparison, digits = 4, caption = "Benchmark Model — Red Wine")| model | RMSE | MAE | R2 |
|---|---|---|---|
| Ridge Package | 0.6515 | 0.4955 | 0.3052 |
| OLS | 0.6524 | 0.4952 | 0.3049 |
| Random Forest | 0.5822 | 0.4192 | 0.4466 |
Pada Red Wine, Ridge Package dan OLS juga menghasilkan performa yang hampir sama, dengan RMSE masing-masing 0,6515 dan 0,6524, MAE 0,4955 dan 0,4952, serta R² 0,3052 dan 0,3049. Random Forest menghasilkan RMSE 0,5822, MAE 0,4192, dan R² 0,4466. Dengan demikian, hasil benchmark memperlihatkan bahwa kedua pendekatan regresi linear memberikan hasil yang sangat berdekatan, sementara Random Forest menghasilkan nilai RMSE dan MAE yang lebih rendah serta R² yang lebih tinggi pada data Red Wine.
red_train_fitted <- predict(red_package_fit, new_data = red_train)$.pred
red_train_resid <- red_train$quality - red_train_fitted
red_diag <- tibble(
fitted = red_train_fitted,
residual = red_train_resid,
sqrt_abs_resid = sqrt(abs(red_train_resid))
)
p_resid <- ggplot(red_diag, aes(fitted, residual)) +
geom_point(alpha = .35) +
geom_hline(yintercept = 0, linetype = "dashed") +
geom_smooth(method = "loess", se = FALSE) +
labs(title = "Residual vs Fitted — Red Wine",
x = "Fitted", y = "Residual") +
theme_minimal(base_size = 11)
p_qq <- ggplot(red_diag, aes(sample = residual)) +
stat_qq(alpha = .35) +
stat_qq_line() +
labs(title = "QQ Plot Residual — Red Wine") +
theme_minimal(base_size = 11)
p_scale <- ggplot(red_diag, aes(fitted, sqrt_abs_resid)) +
geom_point(alpha = .35) +
geom_smooth(method = "loess", se = FALSE) +
labs(title = "Scale-Location — Red Wine",
x = "Fitted", y = "sqrt(|Residual|)") +
theme_minimal(base_size = 11)
p_resid / p_qq / p_scalePemeriksaan residual digunakan untuk menilai apakah pola hubungan linear cukup masuk akal dan apakah penyebaran residual relatif stabil. Garis LOESS yang mendekati horizontal dan pola residual yang tidak membentuk struktur sistematis mendukung kecukupan bentuk linear, sedangkan pola kipas atau lengkungan yang jelas menunjukkan kemungkinan heteroskedastisitas atau ketidaklinearan. QQ plot digunakan untuk melihat penyimpangan residual dari distribusi normal. Normalitas residual bukan syarat utama untuk memperoleh prediksi Ridge, tetapi penting sebagai informasi diagnostik jika hasil akan dibahas dari sudut pandang inferensial.
red_ols_diag <- lm(quality ~ ., data = red_train)
red_influence <- tibble(
row = seq_len(nrow(red_train)),
cooks_distance = cooks.distance(red_ols_diag),
leverage = hatvalues(red_ols_diag),
standardized_residual = rstandard(red_ols_diag)
) %>%
mutate(
cooks_flag = cooks_distance > 4 / nrow(red_train),
leverage_flag = leverage > 2 * (length(coef(red_ols_diag)) / nrow(red_train))
) %>%
arrange(desc(cooks_distance))
kable(
head(red_influence, 10),
digits = 4,
caption = "10 Observasi dengan Cook's Distance Tertinggi — Red Wine"
)| row | cooks_distance | leverage | standardized_residual | cooks_flag | leverage_flag |
|---|---|---|---|---|---|
| 265 | 0.0845 | 0.0592 | -4.0136 | TRUE | TRUE |
| 84 | 0.0677 | 0.1115 | -2.5447 | TRUE | TRUE |
| 454 | 0.0664 | 0.0707 | -3.2362 | TRUE | TRUE |
| 55 | 0.0297 | 0.0713 | -2.1540 | TRUE | TRUE |
| 1228 | 0.0266 | 0.0869 | 1.8311 | TRUE | TRUE |
| 307 | 0.0221 | 0.0521 | -2.1959 | TRUE | TRUE |
| 359 | 0.0206 | 0.0141 | -4.1682 | TRUE | FALSE |
| 203 | 0.0187 | 0.0846 | -1.5582 | TRUE | TRUE |
| 26 | 0.0173 | 0.0216 | -3.0708 | TRUE | TRUE |
| 1135 | 0.0169 | 0.0183 | 3.2993 | TRUE | FALSE |
## Batas Cook's distance: 0.0031
## Jumlah observasi melewati batas Cook's distance: 76
## Jumlah observasi dengan leverage tinggi: 92
Cook’s distance dan leverage digunakan sebagai pemeriksaan tambahan terhadap observasi yang berpotensi memberikan pengaruh besar pada model. Karena ukuran tersebut merupakan diagnostik klasik untuk least squares, pemeriksaan dilakukan pada OLS baseline, bukan diperlakukan sebagai uji formal terhadap parameter Ridge. Observasi yang melewati batas heuristik tidak otomatis dianggap salah atau harus dihapus; hasil tersebut hanya menunjukkan bahwa observasi tersebut perlu diperiksa lebih lanjut.
red_cv_fold <- cv_fold_rmse(
red_manual_folds, predictors, response, red_lambda_manual
)
red_cv_uncertainty <- red_cv_fold %>%
summarise(
mean_RMSE = mean(RMSE),
sd_RMSE = sd(RMSE),
lower_RMSE = quantile(RMSE, .025),
upper_RMSE = quantile(RMSE, .975)
)
red_boot <- bootstrap_metric_ci(
red_test$quality, red_package_pred, B = 500, seed = 12345
)
kable(
red_cv_uncertainty,
digits = 4,
caption = "Variasi RMSE 10-Fold CV — Red Wine"
)| mean_RMSE | sd_RMSE | lower_RMSE | upper_RMSE |
|---|---|---|---|
| 0.6511 | 0.0404 | 0.5894 | 0.7163 |
| metric | mean | lower | upper |
|---|---|---|---|
| RMSE | 0.6483 | 0.5898 | 0.7081 |
| MAE | 0.4933 | 0.4520 | 0.5353 |
| R2 | 0.3081 | 0.2257 | 0.3896 |
Variasi RMSE antar-fold menunjukkan seberapa sensitif performa validasi terhadap pembagian data training. Bootstrap pada data test memberikan rentang empiris untuk RMSE, MAE, dan \(R^2\) dengan mengambil ulang pasangan nilai aktual dan prediksi. Rentang tersebut digunakan untuk menggambarkan ketidakpastian performa prediksi dan bukan sebagai confidence interval untuk koefisien Ridge.
red_interactive <- tibble(
actual = red_test$quality,
predicted = red_package_pred,
residual = red_test$quality - red_package_pred
)
red_interactive_plot <- ggplot(
red_interactive,
aes(
x = actual, y = predicted,
text = paste0(
"Actual: ", round(actual, 2),
"<br>Predicted: ", round(predicted, 2),
"<br>Residual: ", round(residual, 2)
)
)
) +
geom_point(alpha = .45) +
geom_abline(slope = 1, intercept = 0, linetype = "dashed") +
labs(
title = "Prediksi Interaktif — Red Wine",
x = "Actual Quality",
y = "Predicted Quality"
) +
theme_minimal(base_size = 12)
if (knitr::is_html_output()) {
ggplotly(red_interactive_plot, tooltip = "text")
} else {
red_interactive_plot
}Visualisasi interaktif memungkinkan pengguna mengarahkan kursor ke
setiap titik untuk melihat nilai actual,
predicted, dan residual secara langsung. Fitur ini membantu
pemeriksaan individual terhadap hasil prediksi, tetapi tetap merupakan
visualisasi prediksi dan bukan model inferensial interaktif.
Random Forest digunakan sebagai benchmark untuk melihat apakah pendekatan non-linear berbasis ensemble memberikan akurasi prediksi yang berbeda dari model linear Ridge. Jika Random Forest memiliki error test yang lebih rendah, temuan tersebut menunjukkan perbedaan predictive accuracy pada dataset yang digunakan. Hal tersebut tidak berarti bahwa Random Forest memberikan penjelasan kausal atau inferensi statistik yang lebih baik, karena tujuan benchmark ini adalah membandingkan kemampuan prediksi, sedangkan Ridge tetap menyediakan koefisien yang dapat digunakan untuk membahas hubungan linear bersyarat.
Distribusi quality sangat tidak merata: sebagian besar
sampel berada pada skor 5-7, sedangkan skor ekstrem (3, 4, dan 8) hanya
berjumlah puluhan baris. Sebagai analisis lanjutan, training set dan
test set yang sama dibagi menjadi dua kelompok berdasarkan skor:
kelompok Tengah (skor 5-7) dan kelompok
Ekstrem (skor lainnya, digabung). Pada setiap kelompok
dibangun satu model Ridge dengan prosedur yang sama dengan model utama
(jalur package), untuk melihat apakah arah dan besar hubungan prediktor
dengan quality berbeda antar kelompok. Kelompok Tengah
memakai 10-fold CV, sedangkan kelompok Ekstrem memakai 5-fold CV yang
diulang 10 kali karena datanya kecil; 5-fold CV juga digunakan oleh
Cortez et al. (2009). Pada akhir bagian ini, data juga dibagi di median
quality sebagai skema pembagian kedua.
Hal yang perlu diperhatikan saat membaca hasil:
quality belum diketahui, sehingga
tidak dapat ditentukan model kelompok mana yang dipakai. Analisis ini
bersifat eksploratif, bukan model prediksi.| kelompok | Training | Test |
|---|---|---|
| Tengah | 1210 | 308 |
| Ekstrem | 68 | 13 |
| kelompok | n_training | desain_CV | lambda | mean_RMSE_CV | sd_RMSE_CV | n_resample |
|---|---|---|---|---|---|---|
| Tengah | 1210 | 10-fold | 0.0001 | 0.5524 | 0.0285 | 10 |
| Ekstrem | 68 | 5-fold x 10 | 0.4329 | 1.0047 | 0.2268 | 50 |
kable(red_group$perf, digits = 4,
caption = "Performa Test: Ridge Kelompok vs Ridge Data Penuh pada Baris Test yang Sama — Red Wine")| kelompok | model | n_test | RMSE | MAE | R2 |
|---|---|---|---|---|---|
| Tengah | Ridge kelompok | 308 | 0.5599 | 0.4544 | 0.3576 |
| Tengah | Ridge data penuh | 308 | 0.5639 | 0.4458 | 0.3531 |
| Ekstrem | Ridge kelompok | 13 | 1.3430 | 1.1294 | 0.3264 |
| Ekstrem | Ridge data penuh | 13 | 1.7167 | 1.6740 | 0.3590 |
kable(
red_group$coef %>% pivot_wider(names_from = model, values_from = estimate),
digits = 4,
caption = "Koefisien Ridge per Model — Red Wine"
)| term | Data penuh | Kelompok Tengah | Kelompok Ekstrem |
|---|---|---|---|
| fixed.acidity | 0.0539 | 0.0887 | 0.1577 |
| volatile.acidity | -0.1955 | -0.1121 | -0.3602 |
| citric.acid | -0.0113 | -0.0025 | 0.2781 |
| residual.sugar | 0.0331 | 0.0441 | -0.0948 |
| chlorides | -0.0924 | -0.0599 | -0.3753 |
| free.sulfur.dioxide | 0.0465 | 0.0408 | 0.0013 |
| total.sulfur.dioxide | -0.1124 | -0.1338 | -0.1182 |
| density | -0.0445 | -0.0561 | -0.4131 |
| pH | -0.0545 | 0.0114 | -0.3814 |
| sulphates | 0.1315 | 0.1242 | 0.2181 |
| alcohol | 0.2769 | 0.2342 | 0.7489 |
Pada kelompok Tengah (n test = 308), Ridge kelompok hampir tidak berbeda dari Ridge data penuh pada baris test yang sama (RMSE 0,560 vs 0,564; R² 0,358 vs 0,353; MAE 0,454 vs 0,446). Model data penuh sudah cukup menggambarkan sampel skor 5-7, sehingga pemisahan tidak memberi perbaikan berarti. Nilai λ terpilih pada kelompok ini berada di batas bawah grid (0,0001), yang konsisten dengan temuan sebelumnya bahwa penalti hampir tidak diperlukan ketika n jauh lebih besar daripada p. Koefisien kelompok Tengah searah dengan model penuh (alcohol, sulphates positif; volatile.acidity, total.sulfur.dioxide, chlorides negatif); satu-satunya perubahan tanda ada pada pH, yang nilainya mendekati nol pada kedua model (−0,055 vs 0,011).
Kelompok Ekstrem (68 training, 13 test) berbeda lebih jelas. Galat CV rata-rata kelompok ini sekitar 1,00 (SD antar-resample 0,23), jauh lebih besar daripada kelompok Tengah (0,55), dan koefisiennya 2-3 kali lebih besar serta tidak stabil: citric.acid berubah dari −0,011 menjadi +0,278, residual.sugar dari +0,033 menjadi −0,095, dan pH dari −0,055 menjadi −0,381. Alcohol tetap menjadi prediktor terbesar (0,749) dan volatile.acidity tetap negatif. Pada test, Ridge kelompok memiliki RMSE dan MAE lebih rendah daripada model penuh (1,343 vs 1,717 dan 1,129 vs 1,674), tetapi R² tidak lebih baik (0,326 vs 0,359). Perbandingan ini tidak adil bagi model penuh karena model kelompok mengetahui bahwa baris tersebut berskor ekstrem (kelompok ditentukan dari Y), sedangkan model penuh memprediksi mendekati rata-rata sehingga selalu meleset jauh dari skor 3, 4, atau 8. Dengan hanya 13 baris test dan 11 prediktor pada 68 baris training, hasil kelompok Ekstrem sebaiknya dibaca sebagai indikasi, bukan kesimpulan.
Skema kedua memotong data di median quality pada
training set (median = 6). Kelompok Bawah median berisi
skor di bawah median, dan kelompok Atas median berisi
skor yang sama dengan atau di atas median. Berbeda dari pembagian
Tengah/Ekstrem, kedua kelompok berukuran besar sehingga estimasi lebih
stabil, dan keduanya memakai 10-fold CV. Pertanyaan yang dijawab juga
berbeda: bagaimana hubungan prediktor dengan quality pada
wine yang kualitasnya lebih rendah dibandingkan yang lebih tinggi.
Catatan yang sama tetap berlaku: kelompok ditentukan dari nilai \(Y\), sehingga rentang \(Y\) terpangkas, hasilnya eksploratif, dan
model kelompok tidak dapat dipakai untuk memprediksi data baru.
red_group_med <- run_group_analysis(red_train, red_test, red_package_fit, red_lambda_grid,
scheme = "median")kable(red_group_med$counts, caption = "Jumlah Observasi per Kelompok (Pembagian Median) — Red Wine")| kelompok | Training | Test |
|---|---|---|
| Bawah median | 595 | 149 |
| Atas median | 683 | 172 |
kable(red_group_med$cv, digits = 4, caption = "Hasil CV per Kelompok (Pembagian Median) — Red Wine")| kelompok | n_training | desain_CV | lambda | mean_RMSE_CV | sd_RMSE_CV | n_resample |
|---|---|---|---|---|---|---|
| Bawah median | 595 | 10-fold | 0.0464 | 0.3250 | 0.0674 | 10 |
| Atas median | 683 | 10-fold | 0.0933 | 0.4418 | 0.0350 | 10 |
kable(red_group_med$perf, digits = 4,
caption = "Performa Test: Ridge Kelompok vs Ridge Data Penuh pada Baris Test yang Sama (Pembagian Median) — Red Wine")| kelompok | model | n_test | RMSE | MAE | R2 |
|---|---|---|---|---|---|
| Bawah median | Ridge kelompok | 149 | 0.2998 | 0.1650 | 0.0132 |
| Bawah median | Ridge data penuh | 149 | 0.6709 | 0.4897 | 0.0137 |
| Atas median | Ridge kelompok | 172 | 0.4413 | 0.3514 | 0.1187 |
| Atas median | Ridge data penuh | 172 | 0.6343 | 0.5006 | 0.1257 |
kable(
red_group_med$coef %>% pivot_wider(names_from = model, values_from = estimate),
digits = 4,
caption = "Koefisien Ridge per Model (Pembagian Median) — Red Wine"
)| term | Data penuh | Kelompok Bawah median | Kelompok Atas median |
|---|---|---|---|
| fixed.acidity | 0.0539 | -0.0230 | 0.0251 |
| volatile.acidity | -0.1955 | -0.0887 | -0.0308 |
| citric.acid | -0.0113 | -0.0142 | 0.0506 |
| residual.sugar | 0.0331 | -0.0072 | 0.0510 |
| chlorides | -0.0924 | -0.0261 | -0.0426 |
| free.sulfur.dioxide | 0.0465 | 0.0080 | -0.0124 |
| total.sulfur.dioxide | -0.1124 | 0.0366 | -0.0324 |
| density | -0.0445 | 0.0050 | -0.0532 |
| pH | -0.0545 | -0.0519 | -0.0205 |
| sulphates | 0.1315 | -0.0043 | 0.0644 |
| alcohol | 0.2769 | -0.0070 | 0.1204 |
Kedua kelompok berukuran cukup besar (Bawah median: 595 training dan 149 test; Atas median: 683 dan 172), dan nilai \(\lambda\) terpilih berada di dalam grid (0,046 dan 0,093), sehingga Ridge pada kelompok ini memberi penyusutan yang nyata. RMSE test model kelompok jauh lebih rendah daripada model data penuh pada baris yang sama (Bawah 0,300 vs 0,671; Atas 0,441 vs 0,634), tetapi ini tidak menunjukkan prediksi yang lebih baik: \(R^2\) kelompok sangat rendah dan hampir sama dengan model penuh (Bawah 0,013 vs 0,014; Atas 0,119 vs 0,126). Rentang \(Y\) di dalam kelompok sempit (Bawah median: 3-5, Atas median: 6-8, dengan mayoritas pada satu nilai, yaitu skor 5 dan skor 6), sehingga model kelompok yang prediksinya dekat dengan rata-rata kelompok sudah menghasilkan RMSE kecil, sedangkan model penuh dievaluasi tanpa informasi kelompok.
Koefisien menunjukkan pola yang sama. Pada kelompok Bawah median
hampir semua koefisien mendekati nol (misalnya alcohol −0,007 dan
sulphates −0,004, dibandingkan 0,277 dan 0,132 pada model penuh). Pada
kelompok Atas median arah koefisien utama sama dengan model penuh tetapi
lebih kecil (alcohol 0,120; sulphates 0,064; volatile.acidity −0,031;
total.sulfur.dioxide −0,032), dengan dua koefisien kecil yang berbalik
tanda (citric.acid dan free.sulfur.dioxide). Artinya hubungan kuat
alcohol dan sulphates dengan quality pada model penuh
terutama berasal dari perbedaan antara wine berkualitas lebih rendah dan
lebih tinggi, bukan dari pengurutan wine di dalam masing-masing
kelompok. Pemangkasan rentang \(Y\)
pada dasarnya memperkecil koefisien dan \(R^2\), sehingga hasil ini tidak membuktikan
bahwa hubungan di dalam kelompok tidak ada.
white_url <- paste0(
"https://archive.ics.uci.edu/ml/machine-learning-databases/",
"wine-quality/winequality-white.csv"
)
white_wine <- read.csv(white_url, sep = ";")
white_model <- white_wine %>% select(all_of(c(predictors, response)))
cat("Observasi:", nrow(white_model), "\n")## Observasi: 4898
## Variabel: 12
white_missing <- colSums(is.na(white_model))
white_duplicates <- sum(duplicated(white_model))
kable(
tibble(variable = names(white_missing), missing = as.integer(white_missing)),
caption = "Missing Value White Wine"
)| variable | missing |
|---|---|
| fixed.acidity | 0 |
| volatile.acidity | 0 |
| citric.acid | 0 |
| residual.sugar | 0 |
| chlorides | 0 |
| free.sulfur.dioxide | 0 |
| total.sulfur.dioxide | 0 |
| density | 0 |
| pH | 0 |
| sulphates | 0 |
| alcohol | 0 |
| quality | 0 |
## Duplikasi: 937
Tidak ada missing value. Terdapat 937 baris duplikat (19.1% dari data), yaitu baris yang identik pada seluruh 12 variabel. Seperti pada red wine, baris duplikat tidak dihapus: Cortez et al. (2009) menyatakan bahwa satu baris merepresentasikan satu sampel wine yang berbeda, sehingga baris yang identik diperlakukan sebagai sampel berbeda yang kebetulan memiliki hasil uji laboratorium dan skor yang sama, bukan kesalahan entri. Jumlah observasi pada paper tersebut juga sama dengan data yang dipakai di sini. Konsekuensinya, baris yang identik dapat berada di training set dan test set sekaligus; hal ini dicatat pada bagian Keterbatasan.
white_freq <- white_model %>%
count(quality, name = "n") %>%
mutate(
persen = 100 * n / sum(n),
persen_kumulatif = cumsum(persen)
)
kable(white_freq, digits = 1, caption = "Distribusi Skor Quality — White Wine")| quality | n | persen | persen_kumulatif |
|---|---|---|---|
| 3 | 20 | 0.4 | 0.4 |
| 4 | 163 | 3.3 | 3.7 |
| 5 | 1457 | 29.7 | 33.5 |
| 6 | 2198 | 44.9 | 78.4 |
| 7 | 880 | 18.0 | 96.3 |
| 8 | 175 | 3.6 | 99.9 |
| 9 | 5 | 0.1 | 100.0 |
Seperti pada red wine, distribusi quality pada white
wine sangat tidak merata: sebagian besar sampel berada pada skor 5-7
(sekitar 93%), sedangkan skor 3, 4, 8, dan 9 berjumlah relatif sedikit,
dengan skor 9 hanya sekitar lima sampel. Karena itu pembagian
training-test dan fold cross-validation dibuat berstrata
quality.
white_desc <- white_model %>%
summarise(across(
everything(),
list(Mean = mean, SD = sd, Min = min, Median = median, Max = max),
.names = "{.col}__{.fn}"
)) %>%
pivot_longer(everything(), names_to = c("Variabel", "Statistik"),
names_sep = "__", values_to = "nilai") %>%
pivot_wider(names_from = Statistik, values_from = nilai)
kable(white_desc, digits = 3, caption = "Statistik Deskriptif — White Wine")| Variabel | Mean | SD | Min | Median | Max |
|---|---|---|---|---|---|
| fixed.acidity | 6.855 | 0.844 | 3.800 | 6.800 | 14.200 |
| volatile.acidity | 0.278 | 0.101 | 0.080 | 0.260 | 1.100 |
| citric.acid | 0.334 | 0.121 | 0.000 | 0.320 | 1.660 |
| residual.sugar | 6.391 | 5.072 | 0.600 | 5.200 | 65.800 |
| chlorides | 0.046 | 0.022 | 0.009 | 0.043 | 0.346 |
| free.sulfur.dioxide | 35.308 | 17.007 | 2.000 | 34.000 | 289.000 |
| total.sulfur.dioxide | 138.361 | 42.498 | 9.000 | 134.000 | 440.000 |
| density | 0.994 | 0.003 | 0.987 | 0.994 | 1.039 |
| pH | 3.188 | 0.151 | 2.720 | 3.180 | 3.820 |
| sulphates | 0.490 | 0.114 | 0.220 | 0.470 | 1.080 |
| alcohol | 10.514 | 1.231 | 8.000 | 10.400 | 14.200 |
| quality | 5.878 | 0.886 | 3.000 | 6.000 | 9.000 |
p1 <- ggplot(white_model, aes(factor(quality))) +
geom_bar() +
geom_text(stat = "count", aes(label = after_stat(count)), vjust = -0.3, size = 3) +
labs(title = "Distribusi Quality — White Wine", x = "Quality", y = "Frekuensi") +
theme_minimal(base_size = 12)
white_long <- white_model %>%
pivot_longer(all_of(predictors), names_to = "variable", values_to = "value")
p2 <- ggplot(white_long, aes(value)) +
geom_histogram(bins = 30, color = "white") +
facet_wrap(~variable, scales = "free", ncol = 3) +
labs(title = "Distribusi Prediktor — White Wine", x = NULL, y = "Frekuensi") +
theme_minimal(base_size = 10)
p1 / p2white_quality_long <- white_model %>%
pivot_longer(all_of(predictors), names_to = "variable", values_to = "value")
ggplot(white_quality_long, aes(x = quality, y = value)) +
geom_jitter(alpha = .12, width = .15) +
geom_smooth(method = "lm", se = FALSE) +
facet_wrap(~variable, scales = "free_y", ncol = 3) +
labs(
title = "Hubungan Prediktor dengan Quality — White Wine",
x = "Quality", y = "Nilai Prediktor"
) +
theme_minimal(base_size = 11)Visualisasi ini digunakan sebagai EDA terarah untuk melihat apakah
terdapat pola hubungan linear yang masuk akal antara
quality dan masing-masing karakteristik fisikokimia. Karena
quality hanya memiliki beberapa skor diskret, titik pada
setiap kategori dapat bertumpuk; karena itu, jitter digunakan untuk
membantu melihat kepadatan pengamatan. Grafik ini bersifat eksploratif
dan tidak digunakan sebagai dasar tunggal untuk menyimpulkan hubungan
kausal.
ggplot(white_quality_long, aes(x = factor(quality), y = value)) +
geom_boxplot(outlier.alpha = .3) +
facet_wrap(~variable, scales = "free_y", ncol = 3) +
labs(
title = "Sebaran Prediktor per Skor Quality — White Wine",
x = "Quality", y = "Nilai Prediktor"
) +
theme_minimal(base_size = 11)Boxplot per skor memperlihatkan perubahan median tiap prediktor antar tingkat kualitas, termasuk pada skor ekstrem yang jumlah sampelnya sedikit, serta keberadaan nilai pencilan pada tiap prediktor.
set.seed(12345)
white_split <- initial_split(white_model, prop = .80, strata = quality)
white_train <- training(white_split)
white_test <- testing(white_split)
cat("Training:", nrow(white_train), "\n")## Training: 3918
## Testing : 980
Pembagian menggunakan strata quality dengan alasan yang
sama seperti pada red wine. Skor yang sangat jarang (misalnya skor 9)
mungkin digabungkan dengan strata lain oleh rsample,
sehingga proporsinya di training dan test hanya dijaga secara
pendekatan.
white_train_tmp <- white_train
white_ols_tmp <- lm(quality ~ ., data = white_train_tmp)
white_vif <- car::vif(white_ols_tmp)
white_vif_table <- tibble(
variable = names(white_vif),
VIF = as.numeric(white_vif)
) %>% arrange(desc(VIF))
kable(white_vif_table, digits = 3, caption = "VIF White Wine")| variable | VIF |
|---|---|
| density | 26.544 |
| residual.sugar | 12.255 |
| alcohol | 7.128 |
| fixed.acidity | 2.624 |
| total.sulfur.dioxide | 2.191 |
| pH | 2.169 |
| free.sulfur.dioxide | 1.747 |
| chlorides | 1.249 |
| citric.acid | 1.151 |
| volatile.acidity | 1.139 |
| sulphates | 1.126 |
Hasil VIF menunjukkan bahwa density memiliki VIF paling tinggi, yaitu 26,544, diikuti oleh residual.sugar sebesar 12,255 dan alcohol sebesar 7,128. Nilai tersebut menunjukkan adanya multikolinearitas yang cukup kuat pada ketiga variabel tersebut, terutama density dan residual.sugar. Sementara itu, fixed.acidity, total.sulfur.dioxide, dan pH memiliki VIF sekitar 2-3, sedangkan variabel lainnya memiliki VIF mendekati 1 sehingga keterkaitannya dengan prediktor lain relatif rendah. Kondisi ini menunjukkan bahwa masalah multikolinearitas pada White Wine lebih menonjol dibandingkan Red Wine, terutama pada density, residual.sugar, dan alcohol, sehingga penggunaan Ridge Regression relevan untuk membantu menstabilkan estimasi koefisien.
white_cor <- cor(white_model[predictors], use = "complete.obs")
white_cor_long <- as.data.frame(white_cor) %>%
rownames_to_column("v1") %>%
pivot_longer(-v1, names_to = "v2", values_to = "r")
ggplot(white_cor_long, aes(v1, v2, fill = r)) +
geom_tile() +
geom_text(aes(label = sprintf("%.2f", r)), size = 2.5) +
scale_fill_gradient2(low = "#2166AC", mid = "white", high = "#B2182B", midpoint = 0, limits = c(-1,1)) +
labs(title = "Korelasi Prediktor — White Wine", x = NULL, y = NULL, fill = "r") +
theme_minimal(base_size = 9) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))Matriks korelasi menunjukkan beberapa hubungan yang cukup kuat antar prediktor. Hubungan positif paling kuat terlihat antara residual.sugar dengan density (r = 0,84), sedangkan hubungan negatif paling kuat terlihat antara alcohol dengan density (r = −0,78). Selain itu, terdapat korelasi positif antara free.sulfur.dioxide dengan total.sulfur.dioxide (r = 0,62) dan antara density dengan total.sulfur.dioxide (r = 0,53). Pola ini membantu menjelaskan hasil VIF, terutama tingginya VIF pada density, residual.sugar, dan alcohol, karena ketiga variabel tersebut memiliki hubungan yang cukup kuat dengan prediktor lain. Jadi, pada White Wine, struktur korelasi antarvariabel terlihat lebih kuat pada beberapa pasangan dibandingkan Red Wine dan menjadi salah satu alasan penting penggunaan Ridge Regression.
X_white <- as.matrix(white_train[predictors])
y_white <- white_train$quality
white_means <- colMeans(X_white)
white_sds <- apply(X_white, 2, sd)
Z_white <- scale(X_white, center = white_means, scale = white_sds)
white_standardization <- tibble(
variable = predictors,
mean_training = as.numeric(white_means),
sd_training = as.numeric(white_sds)
)
kable(white_standardization, digits = 4, caption = "Parameter Standardisasi Manual — White Wine")| variable | mean_training | sd_training |
|---|---|---|
| fixed.acidity | 6.8462 | 0.8485 |
| volatile.acidity | 0.2776 | 0.1003 |
| citric.acid | 0.3349 | 0.1210 |
| residual.sugar | 6.4213 | 5.1262 |
| chlorides | 0.0457 | 0.0216 |
| free.sulfur.dioxide | 35.2633 | 16.5755 |
| total.sulfur.dioxide | 138.5966 | 42.0873 |
| density | 0.9940 | 0.0030 |
| pH | 3.1885 | 0.1510 |
| sulphates | 0.4902 | 0.1145 |
| alcohol | 10.5071 | 1.2323 |
white_lambda_grid <- 10^seq(-4, 2, length.out = 100)
set.seed(12345)
white_manual_folds <- vfold_cv(white_train, v = 10, strata = quality)
white_manual_cv <- map_dfr(white_lambda_grid, function(lambda) {
fold_rmse <- map_dbl(white_manual_folds$splits, function(s) {
tr <- analysis(s)
va <- assessment(s)
fit <- manual_ridge(tr, predictors, response, lambda)
pred <- predict_manual_ridge(fit, va)
rmse_vec(va$quality, pred)
})
tibble(penalty = lambda, RMSE = mean(fold_rmse))
})
white_manual_best <- white_manual_cv %>% slice_min(RMSE, n = 1)
white_manual_bestggplot(white_manual_cv, aes(penalty, RMSE)) +
geom_line(linewidth = .8) +
geom_point(data = white_manual_best, size = 3) +
scale_x_log10() +
labs(title = "10-Fold CV Manual Ridge — White Wine", x = expression(lambda), y = "Mean RMSE") +
theme_minimal(base_size = 12)Hasil 10-fold cross-validation pada White Wine menunjukkan bahwa RMSE berada di sekitar 0,75 pada nilai \(\lambda\) yang kecil, kemudian meningkat ketika \(\lambda\) semakin besar. Nilai RMSE minimum diperoleh pada \(\lambda\) sekitar 0,01, dengan rata-rata RMSE CV ≈ 0,751. Hal ini menunjukkan bahwa penalti Ridge yang relatif kecil memberikan kesalahan prediksi yang lebih rendah, sedangkan peningkatan \(\lambda\) yang terlalu besar menyebabkan RMSE meningkat cukup tajam.
white_lambda_manual <- white_manual_best$penalty
white_manual_fit <- manual_ridge(white_train, predictors, response, white_lambda_manual)
white_manual_coef <- tibble(
term = predictors,
estimate = unname(white_manual_fit$beta)
)
kable(white_manual_coef, digits = 5, caption = "Koefisien Manual Ridge — White Wine")| term | estimate |
|---|---|
| fixed.acidity | 0.02517 |
| volatile.acidity | -0.18912 |
| citric.acid | -0.00388 |
| residual.sugar | 0.30481 |
| chlorides | -0.01402 |
| free.sulfur.dioxide | 0.08441 |
| total.sulfur.dioxide | -0.02040 |
| density | -0.29457 |
| pH | 0.06209 |
| sulphates | 0.06681 |
| alcohol | 0.30576 |
white_manual_pred <- predict_manual_ridge(white_manual_fit, white_test)
white_manual_metrics <- metric_table(white_test$quality, white_manual_pred)
white_manual_metricsPada \(\lambda\) terpilih, model menghasilkan MAE = 0,5851 dan R² = 0,2721, sehingga model menjelaskan sekitar 27,21% variasi kualitas White Wine pada data yang dievaluasi.
recipe()white_folds <- white_manual_folds
white_grid <- tibble(penalty = white_lambda_grid)
white_workflow <- workflow() %>%
add_recipe(white_recipe) %>%
add_model(white_ridge_spec)
white_tuned <- tune_grid(
white_workflow,
resamples = white_folds,
grid = white_grid,
metrics = metric_set(rmse, mae, rsq)
)
white_best <- select_best(white_tuned, metric = "rmse")
white_bestwhite_final_workflow <- finalize_workflow(white_workflow, white_best)
white_package_fit <- fit(white_final_workflow, data = white_train)
white_package_pred <- predict(white_package_fit, new_data = white_test)$.pred
white_package_metrics <- metric_table(white_test$quality, white_package_pred)
white_package_metrics# ============================================================
# SIGNIFIKANSI PREDIKTOR TERHADAP QUALITY - WHITE WINE
# OLS digunakan sebagai baseline inferensial
# ============================================================
white_ols_infer <- lm(
quality ~ fixed.acidity +
volatile.acidity +
citric.acid +
residual.sugar +
chlorides +
free.sulfur.dioxide +
total.sulfur.dioxide +
density +
pH +
sulphates +
alcohol,
data = white_train
)
# Ringkasan model OLS
summary(white_ols_infer)##
## Call:
## lm(formula = quality ~ fixed.acidity + volatile.acidity + citric.acid +
## residual.sugar + chlorides + free.sulfur.dioxide + total.sulfur.dioxide +
## density + pH + sulphates + alcohol, data = white_train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.5617 -0.4969 -0.0375 0.4660 3.1163
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 139.1706494 20.0482890 6.942 0.00000000000451448 ***
## fixed.acidity 0.0643983 0.0228557 2.818 0.00486 **
## volatile.acidity -1.8957170 0.1273922 -14.881 < 0.0000000000000002 ***
## citric.acid -0.0293209 0.1061674 -0.276 0.78243
## residual.sugar 0.0768837 0.0081757 9.404 < 0.0000000000000002 ***
## chlorides -0.3024975 0.6201894 -0.488 0.62575
## free.sulfur.dioxide 0.0048006 0.0009547 5.028 0.00000051717822537 ***
## total.sulfur.dioxide -0.0003233 0.0004211 -0.768 0.44264
## density -138.9687255 20.3465000 -6.830 0.00000000000980020 ***
## pH 0.5730440 0.1167559 4.908 0.00000095740025493 ***
## sulphates 0.6482434 0.1109539 5.842 0.00000000556328110 ***
## alcohol 0.2089696 0.0259383 8.056 0.00000000000000103 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7493 on 3906 degrees of freedom
## Multiple R-squared: 0.283, Adjusted R-squared: 0.281
## F-statistic: 140.2 on 11 and 3906 DF, p-value: < 0.00000000000000022
white_significance <- broom::tidy(white_ols_infer) %>%
filter(term != "(Intercept)") %>%
mutate(
Signifikansi = case_when(
p.value < 0.001 ~ "***",
p.value < 0.01 ~ "**",
p.value < 0.05 ~ "*",
p.value < 0.10 ~ ".",
TRUE ~ "Tidak signifikan"
)
) %>%
select(
Prediktor = term,
Estimate = estimate,
`Std. Error` = std.error,
`t-value` = statistic,
`p-value` = p.value,
Signifikansi
)
knitr::kable(
white_significance,
digits = 4,
caption = "Signifikansi Prediktor terhadap Quality pada White Wine"
)| Prediktor | Estimate | Std. Error | t-value | p-value | Signifikansi |
|---|---|---|---|---|---|
| fixed.acidity | 0.0644 | 0.0229 | 2.8176 | 0.0049 | ** |
| volatile.acidity | -1.8957 | 0.1274 | -14.8809 | 0.0000 | *** |
| citric.acid | -0.0293 | 0.1062 | -0.2762 | 0.7824 | Tidak signifikan |
| residual.sugar | 0.0769 | 0.0082 | 9.4039 | 0.0000 | *** |
| chlorides | -0.3025 | 0.6202 | -0.4878 | 0.6258 | Tidak signifikan |
| free.sulfur.dioxide | 0.0048 | 0.0010 | 5.0283 | 0.0000 | *** |
| total.sulfur.dioxide | -0.0003 | 0.0004 | -0.7678 | 0.4426 | Tidak signifikan |
| density | -138.9687 | 20.3465 | -6.8301 | 0.0000 | *** |
| pH | 0.5730 | 0.1168 | 4.9081 | 0.0000 | *** |
| sulphates | 0.6482 | 0.1110 | 5.8425 | 0.0000 | *** |
| alcohol | 0.2090 | 0.0259 | 8.0564 | 0.0000 | *** |
REVISI: seperti pada red wine, koefisien package diambil pada \(\lambda\) terpilih, dan kolom
manual_at_package_lambda membandingkan koefisien manual
pada \(\lambda\) package.
white_package_coef <- tidy(extract_fit_parsnip(white_package_fit)) %>%
filter(term != "(Intercept)") %>%
transmute(term, package_estimate = estimate)
white_manual_at_package <- manual_ridge(white_train, predictors, response, white_best$penalty)
white_coef_comparison <- white_manual_coef %>%
rename(manual_estimate = estimate) %>%
left_join(white_package_coef, by = "term") %>%
mutate(
manual_at_package_lambda = unname(white_manual_at_package$beta[term]),
abs_difference = abs(manual_estimate - package_estimate),
abs_difference_same_lambda = abs(manual_at_package_lambda - package_estimate)
)
kable(white_coef_comparison, digits = 6, caption = "Perbandingan Koefisien Manual dan Package — White Wine")| term | manual_estimate | package_estimate | manual_at_package_lambda | abs_difference | abs_difference_same_lambda |
|---|---|---|---|---|---|
| fixed.acidity | 0.025170 | 0.001438 | 0.054290 | 0.023732 | 0.052852 |
| volatile.acidity | -0.189117 | -0.182982 | -0.190152 | 0.006136 | 0.007170 |
| citric.acid | -0.003877 | -0.002797 | -0.003556 | 0.001080 | 0.000759 |
| residual.sugar | 0.304811 | 0.226975 | 0.393072 | 0.077835 | 0.166097 |
| chlorides | -0.014023 | -0.023567 | -0.006603 | 0.009543 | 0.016964 |
| free.sulfur.dioxide | 0.084415 | 0.086934 | 0.079634 | 0.002520 | 0.007300 |
| total.sulfur.dioxide | -0.020402 | -0.026875 | -0.013686 | 0.006473 | 0.013189 |
| density | -0.294568 | -0.195789 | -0.419758 | 0.098779 | 0.223969 |
| pH | 0.062090 | 0.042448 | 0.086255 | 0.019642 | 0.043808 |
| sulphates | 0.066813 | 0.060048 | 0.074143 | 0.006766 | 0.014095 |
| alcohol | 0.305760 | 0.329996 | 0.258146 | 0.024236 | 0.071850 |
white_metrics_comparison <- bind_rows(
white_manual_metrics %>% mutate(method = "Manual Ridge"),
white_package_metrics %>% mutate(method = "Package Ridge")
) %>%
select(method, everything())
kable(white_metrics_comparison, digits = 4, caption = "Performa Manual vs Package — White Wine")| method | RMSE | MAE | R2 |
|---|---|---|---|
| Manual Ridge | 0.7624 | 0.5851 | 0.2721 |
| Package Ridge | 0.7638 | 0.5860 | 0.2696 |
Hasil evaluasi menunjukkan bahwa Manual Ridge dan Package Ridge memiliki performa yang sangat berdekatan. Manual Ridge menghasilkan RMSE = 0,7624, MAE = 0,5851, dan R² = 0,2721, sedangkan Package Ridge menghasilkan RMSE = 0,7638, MAE = 0,5860, dan R² = 0,2696. Selisih pada ketiga metrik tersebut relatif kecil, sehingga kedua metode memberikan hasil yang hampir sama. Hal ini menunjukkan bahwa implementasi Ridge secara manual telah menghasilkan model yang konsisten dengan implementasi menggunakan package R, meskipun terdapat sedikit perbedaan pada hasil evaluasinya.
white_plot <- tibble(
actual = white_test$quality,
manual = white_manual_pred,
package = white_package_pred
) %>%
pivot_longer(-actual, names_to = "method", values_to = "predicted")
ggplot(white_plot, aes(actual, predicted)) +
geom_point(alpha = .25) +
geom_abline(slope = 1, intercept = 0, linetype = "dashed") +
facet_wrap(~method) +
labs(title = "Actual vs Predicted — White Wine", x = "Actual Quality", y = "Predicted Quality") +
theme_minimal(base_size = 12)Plot actual vs predicted menunjukkan bahwa hasil prediksi Manual Ridge dan Package Ridge memiliki pola yang sangat mirip. Pada kedua metode, prediksi cenderung terkonsentrasi di sekitar kualitas 5-7, sedangkan nilai aktual yang lebih rendah maupun lebih tinggi memiliki penyebaran prediksi yang cukup lebar. Garis putus-putus menunjukkan kondisi prediksi ideal, yaitu ketika nilai prediksi sama dengan nilai aktual. Banyak titik yang berada cukup jauh dari garis tersebut, terutama pada kualitas aktual 4, 5, dan 7, sehingga masih terdapat kesalahan prediksi yang cukup besar. Meskipun demikian, pola kedua metode hampir sama secara visual, yang menunjukkan bahwa hasil perhitungan manual dan package memberikan prediksi yang relatif konsisten.
white_residual_df <- tibble(
fitted = white_package_pred,
residual = white_test$quality - white_package_pred
)
ggplot(white_residual_df, aes(fitted, residual)) +
geom_point(alpha = .3) +
geom_hline(yintercept = 0, linetype = "dashed") +
geom_smooth(method = "loess", se = TRUE) +
labs(title = "Residual vs Predicted — White Wine", x = "Predicted", y = "Residual") +
theme_minimal(base_size = 12)white_model_comparison <- bind_rows(
white_package_metrics %>% mutate(model = "Ridge Package"),
white_ols_metrics %>% mutate(model = "OLS"),
white_rf_metrics %>% mutate(model = "Random Forest")
) %>% select(model, everything())
kable(white_model_comparison, digits = 4, caption = "Benchmark Model — White Wine")| model | RMSE | MAE | R2 |
|---|---|---|---|
| Ridge Package | 0.7638 | 0.5860 | 0.2696 |
| OLS | 0.7612 | 0.5849 | 0.2744 |
| Random Forest | 0.6112 | 0.4374 | 0.5413 |
Pada White Wine, hasil benchmark menunjukkan bahwa Ridge Package dan OLS memiliki performa yang sangat berdekatan, dengan RMSE masing-masing 0,7638 dan 0,7612, MAE 0,5860 dan 0,5849, serta R² 0,2696 dan 0,2744. Sementara itu, Random Forest menghasilkan RMSE 0,6112, MAE 0,4374, dan R² 0,5413. Ini menunjukkan bahwa pada data White Wine, performa kedua model regresi linear relatif mirip, sedangkan Random Forest menghasilkan kesalahan prediksi yang lebih kecil dan mampu menjelaskan proporsi variasi kualitas wine yang lebih besar berdasarkan metrik evaluasi yang digunakan.
white_train_fitted <- predict(white_package_fit, new_data = white_train)$.pred
white_train_resid <- white_train$quality - white_train_fitted
white_diag <- tibble(
fitted = white_train_fitted,
residual = white_train_resid,
sqrt_abs_resid = sqrt(abs(white_train_resid))
)
p_resid <- ggplot(white_diag, aes(fitted, residual)) +
geom_point(alpha = .18) +
geom_hline(yintercept = 0, linetype = "dashed") +
geom_smooth(method = "loess", se = FALSE) +
labs(title = "Residual vs Fitted — White Wine",
x = "Fitted", y = "Residual") +
theme_minimal(base_size = 11)
p_qq <- ggplot(white_diag, aes(sample = residual)) +
stat_qq(alpha = .25) +
stat_qq_line() +
labs(title = "QQ Plot Residual — White Wine") +
theme_minimal(base_size = 11)
p_scale <- ggplot(white_diag, aes(fitted, sqrt_abs_resid)) +
geom_point(alpha = .20) +
geom_smooth(method = "loess", se = FALSE) +
labs(title = "Scale-Location — White Wine",
x = "Fitted", y = "sqrt(|Residual|)") +
theme_minimal(base_size = 11)
p_resid / p_qq / p_scalePemeriksaan residual digunakan untuk menilai apakah pola hubungan linear cukup masuk akal dan apakah penyebaran residual relatif stabil. Garis LOESS yang mendekati horizontal dan pola residual yang tidak membentuk struktur sistematis mendukung kecukupan bentuk linear, sedangkan pola kipas atau lengkungan yang jelas menunjukkan kemungkinan heteroskedastisitas atau ketidaklinearan. QQ plot digunakan untuk melihat penyimpangan residual dari distribusi normal. Normalitas residual bukan syarat utama untuk memperoleh prediksi Ridge, tetapi penting sebagai informasi diagnostik jika hasil akan dibahas dari sudut pandang inferensial.
white_ols_diag <- lm(quality ~ ., data = white_train)
white_influence <- tibble(
row = seq_len(nrow(white_train)),
cooks_distance = cooks.distance(white_ols_diag),
leverage = hatvalues(white_ols_diag),
standardized_residual = rstandard(white_ols_diag)
) %>%
mutate(
cooks_flag = cooks_distance > 4 / nrow(white_train),
leverage_flag = leverage > 2 * (length(coef(white_ols_diag)) / nrow(white_train))
) %>%
arrange(desc(cooks_distance))
kable(
head(white_influence, 10),
digits = 4,
caption = "10 Observasi dengan Cook's Distance Tertinggi — White Wine"
)| row | cooks_distance | leverage | standardized_residual | cooks_flag | leverage_flag |
|---|---|---|---|---|---|
| 2253 | 1.1899 | 0.3980 | 4.6471 | TRUE | TRUE |
| 956 | 0.0270 | 0.0139 | -4.7869 | TRUE | TRUE |
| 381 | 0.0145 | 0.0168 | -3.1877 | TRUE | TRUE |
| 442 | 0.0140 | 0.0112 | -3.8565 | TRUE | TRUE |
| 285 | 0.0110 | 0.0282 | -2.1286 | TRUE | TRUE |
| 1237 | 0.0109 | 0.0140 | -3.0395 | TRUE | TRUE |
| 568 | 0.0097 | 0.0103 | -3.3462 | TRUE | TRUE |
| 1079 | 0.0087 | 0.0290 | -1.8646 | TRUE | TRUE |
| 218 | 0.0064 | 0.0042 | -4.2943 | TRUE | FALSE |
| 86 | 0.0064 | 0.0039 | -4.4291 | TRUE | FALSE |
## Batas Cook's distance: 0.001
## Jumlah observasi melewati batas Cook's distance: 191
## Jumlah observasi dengan leverage tinggi: 211
Cook’s distance dan leverage digunakan sebagai pemeriksaan tambahan terhadap observasi yang berpotensi memberikan pengaruh besar pada model. Karena ukuran tersebut merupakan diagnostik klasik untuk least squares, pemeriksaan dilakukan pada OLS baseline, bukan diperlakukan sebagai uji formal terhadap parameter Ridge. Observasi yang melewati batas heuristik tidak otomatis dianggap salah atau harus dihapus; hasil tersebut hanya menunjukkan bahwa observasi tersebut perlu diperiksa lebih lanjut.
white_cv_fold <- cv_fold_rmse(
white_manual_folds, predictors, response, white_lambda_manual
)
white_cv_uncertainty <- white_cv_fold %>%
summarise(
mean_RMSE = mean(RMSE),
sd_RMSE = sd(RMSE),
lower_RMSE = quantile(RMSE, .025),
upper_RMSE = quantile(RMSE, .975)
)
white_boot <- bootstrap_metric_ci(
white_test$quality, white_package_pred, B = 500, seed = 12345
)
kable(
white_cv_uncertainty,
digits = 4,
caption = "Variasi RMSE 10-Fold CV — White Wine"
)| mean_RMSE | sd_RMSE | lower_RMSE | upper_RMSE |
|---|---|---|---|
| 0.7506 | 0.0387 | 0.689 | 0.7946 |
| metric | mean | lower | upper |
|---|---|---|---|
| RMSE | 0.7623 | 0.7147 | 0.8066 |
| MAE | 0.5856 | 0.5531 | 0.6152 |
| R2 | 0.2721 | 0.2169 | 0.3247 |
Variasi RMSE antar-fold menunjukkan seberapa sensitif performa validasi terhadap pembagian data training. Bootstrap pada data test memberikan rentang empiris untuk RMSE, MAE, dan \(R^2\) dengan mengambil ulang pasangan nilai aktual dan prediksi. Rentang tersebut digunakan untuk menggambarkan ketidakpastian performa prediksi dan bukan sebagai confidence interval untuk koefisien Ridge.
white_interactive <- tibble(
actual = white_test$quality,
predicted = white_package_pred,
residual = white_test$quality - white_package_pred
)
white_interactive_plot <- ggplot(
white_interactive,
aes(
x = actual, y = predicted,
text = paste0(
"Actual: ", round(actual, 2),
"<br>Predicted: ", round(predicted, 2),
"<br>Residual: ", round(residual, 2)
)
)
) +
geom_point(alpha = .30) +
geom_abline(slope = 1, intercept = 0, linetype = "dashed") +
labs(
title = "Prediksi Interaktif — White Wine",
x = "Actual Quality",
y = "Predicted Quality"
) +
theme_minimal(base_size = 12)
if (knitr::is_html_output()) {
ggplotly(white_interactive_plot, tooltip = "text")
} else {
white_interactive_plot
}Visualisasi interaktif memungkinkan pengguna mengarahkan kursor ke
setiap titik untuk melihat nilai actual,
predicted, dan residual secara langsung. Fitur ini membantu
pemeriksaan individual terhadap hasil prediksi, tetapi tetap merupakan
visualisasi prediksi dan bukan model inferensial interaktif.
Random Forest digunakan sebagai benchmark untuk melihat apakah pendekatan non-linear berbasis ensemble memberikan akurasi prediksi yang berbeda dari model linear Ridge. Jika Random Forest memiliki error test yang lebih rendah, temuan tersebut menunjukkan perbedaan predictive accuracy pada dataset yang digunakan. Hal tersebut tidak berarti bahwa Random Forest memberikan penjelasan kausal atau inferensi statistik yang lebih baik, karena tujuan benchmark ini adalah membandingkan kemampuan prediksi, sedangkan Ridge tetap menyediakan koefisien yang dapat digunakan untuk membahas hubungan linear bersyarat.
Analisis ini mengulang prosedur yang sama dengan red wine. Kelompok Tengah berisi skor 5-7, sedangkan kelompok Ekstrem menggabungkan skor 3, 4, 8, dan 9. Catatan interpretasi pada bagian analisis lanjutan red wine (kelompok dibentuk dari nilai \(Y\), bersifat eksploratif, jumlah sampel kelompok Ekstrem kecil, dan koefisien terstandardisasi per model) berlaku sama di sini. Skor 9 hanya berjumlah sekitar lima sampel pada seluruh data, sehingga di test set kelompok Ekstrem sangat sedikit.
| kelompok | Training | Test |
|---|---|---|
| Tengah | 3631 | 904 |
| Ekstrem | 287 | 76 |
| kelompok | n_training | desain_CV | lambda | mean_RMSE_CV | sd_RMSE_CV | n_resample |
|---|---|---|---|---|---|---|
| Tengah | 3631 | 10-fold | 0.0001 | 0.6072 | 0.0168 | 10 |
| Ekstrem | 287 | 5-fold x 10 | 0.0001 | 1.5469 | 0.1386 | 50 |
kable(white_group$perf, digits = 4,
caption = "Performa Test: Ridge Kelompok vs Ridge Data Penuh pada Baris Test yang Sama — White Wine")| kelompok | model | n_test | RMSE | MAE | R2 |
|---|---|---|---|---|---|
| Tengah | Ridge kelompok | 904 | 0.5975 | 0.4920 | 0.2833 |
| Tengah | Ridge data penuh | 904 | 0.6030 | 0.4930 | 0.2769 |
| Ekstrem | Ridge kelompok | 76 | 1.7704 | 1.3042 | 0.3258 |
| Ekstrem | Ridge data penuh | 76 | 1.7883 | 1.6928 | 0.3817 |
kable(
white_group$coef %>% pivot_wider(names_from = model, values_from = estimate),
digits = 4,
caption = "Koefisien Ridge per Model — White Wine"
)| term | Data penuh | Kelompok Tengah | Kelompok Ekstrem |
|---|---|---|---|
| fixed.acidity | 0.0014 | 0.0076 | 0.1071 |
| volatile.acidity | -0.1830 | -0.1258 | -0.5373 |
| citric.acid | -0.0028 | -0.0060 | -0.1079 |
| residual.sugar | 0.2270 | 0.1510 | 0.7109 |
| chlorides | -0.0236 | -0.0243 | 0.0272 |
| free.sulfur.dioxide | 0.0869 | 0.0474 | 0.4113 |
| total.sulfur.dioxide | -0.0269 | -0.0351 | -0.0458 |
| density | -0.1958 | -0.1237 | -0.7065 |
| pH | 0.0424 | 0.0409 | 0.1524 |
| sulphates | 0.0600 | 0.0544 | 0.0580 |
| alcohol | 0.3300 | 0.2720 | 0.7520 |
Pada kelompok Tengah (n test = 904), Ridge kelompok dan Ridge data penuh hampir sama (RMSE 0,598 vs 0,603; R² 0,283 vs 0,277; MAE 0,492 vs 0,493), sehingga pola yang sama dengan red wine terulang: pemisahan tidak memberi perbaikan berarti. Seluruh koefisien kelompok Tengah searah dengan model penuh, tetapi besarnya lebih kecil (misalnya alcohol 0,272 vs 0,330, residual.sugar 0,151 vs 0,227, density −0,124 vs −0,196). Pengecilan ini sejalan dengan rentang Y yang terpangkas pada kelompok Tengah, sehingga tidak otomatis berarti hubungan yang sesungguhnya lebih lemah.
Pada kelompok Ekstrem (287 training, 76 test), galat CV rata-rata sekitar 1,55 (SD 0,14), jauh di atas kelompok Tengah (0,61), karena kelompok ini menggabungkan skor rendah (3, 4) dan tinggi (8, 9) sehingga Y bersifat dua kelompok. Koefisiennya besar dan sebagian besar searah dengan model penuh: alcohol (0,752), residual.sugar (0,711), free.sulfur.dioxide (0,411) positif, serta density (−0,707) dan volatile.acidity (−0,537) negatif. Hal ini menunjukkan bahwa model kelompok Ekstrem terutama menangkap perbedaan karakteristik wine berskor sangat rendah dan sangat tinggi. Pada test, RMSE Ridge kelompok hampir sama dengan model penuh (1,770 vs 1,788), MAE lebih rendah (1,304 vs 1,693), dan R² justru lebih rendah (0,326 vs 0,382). Karena kelompok dibentuk dari nilai Y, perbandingan ini tetap menguntungkan model kelompok, dan hasilnya tidak menunjukkan keunggulan yang jelas. Secara keseluruhan, pemisahan skor tengah dan ekstrem tidak memperbaiki prediksi secara meyakinkan pada kedua jenis wine, dan model data penuh tetap menjadi model utama.
Pembagian di median quality (median training = 6)
dilakukan dengan prosedur yang sama dengan red wine: kelompok
Bawah median dan Atas median, keduanya
dengan 10-fold CV, dan catatan interpretasi yang sama berlaku.
white_group_med <- run_group_analysis(white_train, white_test, white_package_fit, white_lambda_grid,
scheme = "median")kable(white_group_med$counts, caption = "Jumlah Observasi per Kelompok (Pembagian Median) — White Wine")| kelompok | Training | Test |
|---|---|---|
| Bawah median | 1312 | 328 |
| Atas median | 2606 | 652 |
kable(white_group_med$cv, digits = 4, caption = "Hasil CV per Kelompok (Pembagian Median) — White Wine")| kelompok | n_training | desain_CV | lambda | mean_RMSE_CV | sd_RMSE_CV | n_resample |
|---|---|---|---|---|---|---|
| Bawah median | 1312 | 10-fold | 0.0614 | 0.3399 | 0.0653 | 10 |
| Atas median | 2606 | 10-fold | 0.0001 | 0.5597 | 0.0316 | 10 |
kable(white_group_med$perf, digits = 4,
caption = "Performa Test: Ridge Kelompok vs Ridge Data Penuh pada Baris Test yang Sama (Pembagian Median) — White Wine")| kelompok | model | n_test | RMSE | MAE | R2 |
|---|---|---|---|---|---|
| Bawah median | Ridge kelompok | 328 | 0.3902 | 0.2215 | 0.0254 |
| Bawah median | Ridge data penuh | 328 | 0.9092 | 0.7350 | 0.0013 |
| Atas median | Ridge kelompok | 652 | 0.5522 | 0.4546 | 0.1287 |
| Atas median | Ridge data penuh | 652 | 0.6790 | 0.5111 | 0.1201 |
plot_group_coef(white_group_med$coef, "Koefisien Ridge: Data Penuh vs Kelompok Median — White Wine")kable(
white_group_med$coef %>% pivot_wider(names_from = model, values_from = estimate),
digits = 4,
caption = "Koefisien Ridge per Model (Pembagian Median) — White Wine"
)| term | Data penuh | Kelompok Bawah median | Kelompok Atas median |
|---|---|---|---|
| fixed.acidity | 0.0014 | -0.0277 | 0.0349 |
| volatile.acidity | -0.1830 | -0.0636 | -0.0247 |
| citric.acid | -0.0028 | 0.0053 | -0.0157 |
| residual.sugar | 0.2270 | 0.0242 | 0.1108 |
| chlorides | -0.0236 | -0.0079 | -0.0199 |
| free.sulfur.dioxide | 0.0869 | 0.0207 | 0.0476 |
| total.sulfur.dioxide | -0.0269 | 0.0156 | -0.0186 |
| density | -0.1958 | -0.0132 | -0.1259 |
| pH | 0.0424 | -0.0262 | 0.0383 |
| sulphates | 0.0600 | 0.0064 | 0.0255 |
| alcohol | 0.3300 | -0.0209 | 0.1394 |
Polanya sama dengan red wine. RMSE test model kelompok jauh lebih rendah daripada model penuh pada baris yang sama (Bawah median 0,390 vs 0,909; Atas median 0,552 vs 0,679), tetapi \(R^2\) hampir sama atau sangat rendah (Bawah 0,025 vs 0,001; Atas 0,129 vs 0,120). Perbedaan RMSE terutama mencerminkan rentang \(Y\) yang sempit di dalam kelompok (mayoritas skor 5 pada Bawah median dan skor 6 pada Atas median), bukan kemampuan prediksi yang lebih baik. Pada kelompok Bawah median semua koefisien mendekati nol (alcohol −0,021; residual.sugar 0,024; density −0,013; volatile.acidity −0,064), sedangkan pada kelompok Atas median seluruh koefisien searah dengan model penuh tetapi lebih kecil: alcohol 0,139 (0,330 pada model penuh), density −0,126 (−0,196), residual.sugar 0,111 (0,227). Nilai \(\lambda\) pada kelompok Atas median berada di batas bawah grid (0,0001), sehingga Ridge di sana praktis sama dengan OLS. Seperti pada red wine, hubungan kuat pada model penuh terutama berasal dari perbedaan antara wine berkualitas lebih rendah dan lebih tinggi, dan hasil ini dibaca sebagai analisis eksploratif karena kelompok dibentuk dari \(Y\).
Ridge hanya mengatasi satu masalah asumsi, yaitu multikolinearitas (varians koefisien yang membengkak). Ridge tetap model linear dan aditif, sehingga asumsi lain tidak hilang. Dampaknya bergantung pada tujuan analisis: untuk prediksi titik, yang terutama penting adalah kecukupan bentuk linear; untuk inferensi (p-value dan interval), asumsi homoskedastisitas dan normalitas menjadi penting. Karena estimasi Ridge bias dan tidak memiliki p-value klasik, inferensi pada project ini memakai OLS sebagai baseline. Ridge juga tidak kebal terhadap pencilan karena tetap meminimumkan jumlah kuadrat error.
Tabel berikut merangkum hasil pemeriksaan dari bagian diagnostik, dampaknya, dan opsi penanganannya.
assumption_tbl <- tibble(
Asumsi = c("Multikolinearitas", "Linearitas", "Homoskedastisitas",
"Normalitas residual", "Observasi berpengaruh", "Independensi"),
`Hasil pemeriksaan` = c(
paste0("VIF tertinggi: ", red_vif_table$variable[1], " ", round(red_vif_table$VIF[1], 2),
" (Red), ", white_vif_table$variable[1], " ", round(white_vif_table$VIF[1], 2), " (White)"),
"LOESS residual mendekati nol; Red turun di ujung atas fitted (skor tinggi diprediksi terlalu tinggi), White hampir datar; Random Forest lebih akurat (indikasi pola non-linear)",
"Breusch-Pagan menolak H0 pada Red dan White (p < 0,001); scale-location Red berbentuk U, White hampir datar",
"Q-Q lurus di tengah, ekor menyimpang; respons diskret membuat residual berpola bertingkat",
paste0("Cook's D > 4/n: Red ", sum(red_influence$cooks_flag), " observasi, White ",
sum(white_influence$cooks_flag), " observasi"),
"Satu baris = satu sampel, tanpa urutan waktu; baris identik dipertahankan (lihat Keterbatasan)"
),
Dampak = c(
"Koefisien OLS tidak stabil (tanda dan besar mudah berubah)",
"Bias sistematis pada ujung rentang prediksi",
"Koefisien tetap tak bias, tetapi SE, p-value, dan interval OLS tidak valid; prediksi titik tidak banyak terpengaruh",
"Prediksi titik aman; interval dan uji kurang akurat (n besar relatif aman)",
"Koefisien tertarik ke titik tertentu; Ridge dan OLS sama-sama sensitif",
"Tidak ada pelanggaran struktural yang terdeteksi"
),
Penanganan = c(
"Ridge (penalti L2) sudah diterapkan",
"Suku non-linear (spline atau kuadrat) atau interaksi, tetap dapat dipenalti dengan Ridge",
"Periksa pencilan lebih dulu; transformasi prediktor yang miring; WLS (bobot per observasi, didukung `glmnet`); robust SE untuk inferensi OLS",
"Bootstrap untuk interval; transformasi `quality` tidak dipaksakan karena respons diskret",
"Investigasi nilai observasi, lalu analisis sensitivitas (fit dengan dan tanpa); regresi robust bila perlu",
"-"
)
)
kable(assumption_tbl, caption = "Ringkasan Asumsi, Dampak, dan Penanganan")| Asumsi | Hasil pemeriksaan | Dampak | Penanganan |
|---|---|---|---|
| Multikolinearitas | VIF tertinggi: fixed.acidity 7.97 (Red), density 26.54 (White) | Koefisien OLS tidak stabil (tanda dan besar mudah berubah) | Ridge (penalti L2) sudah diterapkan |
| Linearitas | LOESS residual mendekati nol; Red turun di ujung atas fitted (skor tinggi diprediksi terlalu tinggi), White hampir datar; Random Forest lebih akurat (indikasi pola non-linear) | Bias sistematis pada ujung rentang prediksi | Suku non-linear (spline atau kuadrat) atau interaksi, tetap dapat dipenalti dengan Ridge |
| Homoskedastisitas | Breusch-Pagan menolak H0 pada Red dan White (p < 0,001); scale-location Red berbentuk U, White hampir datar | Koefisien tetap tak bias, tetapi SE, p-value, dan interval OLS tidak valid; prediksi titik tidak banyak terpengaruh | Periksa pencilan lebih dulu; transformasi prediktor
yang miring; WLS (bobot per observasi, didukung glmnet);
robust SE untuk inferensi OLS |
| Normalitas residual | Q-Q lurus di tengah, ekor menyimpang; respons diskret membuat residual berpola bertingkat | Prediksi titik aman; interval dan uji kurang akurat (n besar relatif aman) | Bootstrap untuk interval; transformasi
quality tidak dipaksakan karena respons diskret |
| Observasi berpengaruh | Cook’s D > 4/n: Red 76 observasi, White 191 observasi | Koefisien tertarik ke titik tertentu; Ridge dan OLS sama-sama sensitif | Investigasi nilai observasi, lalu analisis sensitivitas (fit dengan dan tanpa); regresi robust bila perlu |
| Independensi | Satu baris = satu sampel, tanpa urutan waktu; baris identik dipertahankan (lihat Keterbatasan) | Tidak ada pelanggaran struktural yang terdeteksi | - |
Uji Breusch-Pagan (versi car::ncvTest, varians
dibandingkan terhadap nilai fitted) dijalankan pada OLS training sebagai
pelengkap plot scale-location. Pada n yang besar, uji ini mudah menolak
H0 untuk penyimpangan kecil, sehingga hasilnya dibaca bersama plot.
bp_red <- car::ncvTest(red_ols_diag)
bp_white <- car::ncvTest(white_ols_diag)
kable(
tibble(
Dataset = c("Red Wine", "White Wine"),
Chisq = c(bp_red$ChiSquare, bp_white$ChiSquare),
df = c(bp_red$Df, bp_white$Df),
`p-value` = c(bp_red$p, bp_white$p)
),
digits = 4,
caption = "Uji Non-Constant Variance (Breusch-Pagan) pada OLS Training"
)| Dataset | Chisq | df | p-value |
|---|---|---|---|
| Red Wine | 14.8819 | 1 | 0.0001 |
| White Wine | 11.4888 | 1 | 0.0007 |
Kedua dataset menolak H0 homoskedastisitas (p = 0,0001 untuk red wine dan p = 0,0007 untuk white wine). Plot scale-location memperlihatkan pola yang berbeda: pada red wine garis LOESS berbentuk U dan naik di kedua ujung nilai fitted, sedangkan pada white wine hampir datar. Pola “V” yang berulang pada plot adalah akibat respons diskret (residual berada pada jalur bertingkat) dan bukan heteroskedastisitas. Dampaknya terutama pada inferensi OLS (standard error dan p-value kurang akurat), sedangkan prediksi titik dan koefisien tidak banyak terpengaruh. Karena n besar, uji ini sensitif terhadap penyimpangan kecil, dan analisis sensitivitas di bawah menunjukkan bahwa observasi berpengaruh bukan penyebab utama.
Sebelum menangani heteroskedastisitas atau pengaruh observasi, pencilan diperiksa terlebih dahulu. Tabel berikut menampilkan nilai prediktor pada lima observasi dengan Cook’s distance tertinggi.
top_influential <- function(train, infl, n = 5) {
train %>%
mutate(row = row_number()) %>%
inner_join(infl %>% select(row, cooks_distance, leverage, standardized_residual), by = "row") %>%
arrange(desc(cooks_distance)) %>%
slice_head(n = n)
}
kable(top_influential(red_train, red_influence), digits = 4,
caption = "Lima Observasi Paling Berpengaruh — Red Wine (training)")| fixed.acidity | volatile.acidity | citric.acid | residual.sugar | chlorides | free.sulfur.dioxide | total.sulfur.dioxide | density | pH | sulphates | alcohol | quality | row | cooks_distance | leverage | standardized_residual |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 15.9 | 0.36 | 0.65 | 7.5 | 0.096 | 22.0 | 71 | 0.9976 | 2.98 | 0.84 | 14.9 | 5 | 265 | 0.0845 | 0.0592 | -4.0136 |
| 9.2 | 0.52 | 1.00 | 3.4 | 0.610 | 32.0 | 69 | 0.9996 | 2.74 | 2.00 | 9.4 | 4 | 84 | 0.0677 | 0.1115 | -2.5447 |
| 6.0 | 0.33 | 0.32 | 12.9 | 0.054 | 6.0 | 113 | 0.9957 | 3.30 | 0.56 | 11.5 | 4 | 454 | 0.0664 | 0.0707 | -3.2362 |
| 8.6 | 0.49 | 0.29 | 2.0 | 0.110 | 19.0 | 133 | 0.9972 | 2.93 | 1.98 | 9.8 | 5 | 55 | 0.0297 | 0.0713 | -2.1540 |
| 7.9 | 0.30 | 0.68 | 8.3 | 0.050 | 37.5 | 278 | 0.9932 | 3.01 | 0.51 | 12.3 | 7 | 1228 | 0.0266 | 0.0869 | 1.8311 |
kable(top_influential(white_train, white_influence), digits = 4,
caption = "Lima Observasi Paling Berpengaruh — White Wine (training)")| fixed.acidity | volatile.acidity | citric.acid | residual.sugar | chlorides | free.sulfur.dioxide | total.sulfur.dioxide | density | pH | sulphates | alcohol | quality | row | cooks_distance | leverage | standardized_residual |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 7.8 | 0.965 | 0.60 | 65.80 | 0.074 | 8.0 | 160.0 | 1.0390 | 3.39 | 0.69 | 11.7 | 6 | 2253 | 1.1899 | 0.3980 | 4.6471 |
| 9.4 | 0.240 | 0.29 | 8.50 | 0.037 | 124.0 | 208.0 | 0.9940 | 2.90 | 0.38 | 11.0 | 3 | 956 | 0.0270 | 0.0139 | -4.7869 |
| 8.6 | 0.550 | 0.35 | 15.55 | 0.057 | 35.5 | 366.5 | 1.0001 | 3.04 | 0.63 | 11.0 | 3 | 381 | 0.0145 | 0.0168 | -3.1877 |
| 6.7 | 0.250 | 0.26 | 1.55 | 0.041 | 118.5 | 216.0 | 0.9949 | 3.55 | 0.63 | 9.4 | 3 | 442 | 0.0140 | 0.0112 | -3.8565 |
| 7.9 | 0.640 | 0.46 | 10.60 | 0.244 | 33.0 | 227.0 | 0.9983 | 2.87 | 0.74 | 9.1 | 3 | 285 | 0.0110 | 0.0282 | -2.1286 |
Nilai ekstrem pada prediktor perlu dibandingkan dengan rentang pada
data sumber. Cortez et al. (2009, Tabel 1) mencatat, misalnya, nilai
maksimum residual.sugar sebesar 65,8 g/dm³ dan
density sebesar 1,039 g/cm³ pada white wine. Jika observasi
dengan Cook’s distance tertinggi memuat nilai seperti ini, nilai
tersebut merupakan pengukuran ekstrem yang tercatat di data sumber dan
bukan kesalahan ketik, sehingga tidak dihapus secara otomatis.
Sebagai pemeriksaan kekokohan hasil, model Ridge package dipasang ulang tanpa observasi training yang melewati batas Cook’s distance, dengan \(\lambda\) yang sama seperti model utama (tidak dituning ulang). Metrik dihitung pada test set yang sama.
refit_without_influential <- function(final_workflow, full_fit, train, test, infl) {
flag_rows <- infl$row[infl$cooks_flag]
fit_trim <- fit(final_workflow, data = train %>% slice(-flag_rows))
p_full <- predict(full_fit, new_data = test)$.pred
p_trim <- predict(fit_trim, new_data = test)$.pred
metrics <- bind_rows(
metric_table(test$quality, p_full) %>% mutate(model = "Semua observasi training"),
metric_table(test$quality, p_trim) %>% mutate(model = "Tanpa observasi Cook's D > 4/n")
) %>%
mutate(n_training = c(nrow(train), nrow(train) - length(flag_rows))) %>%
select(model, n_training, RMSE, MAE, R2)
coefs <- full_join(
tidy(extract_fit_parsnip(full_fit)) %>% filter(term != "(Intercept)") %>% select(term, semua = estimate),
tidy(extract_fit_parsnip(fit_trim)) %>% filter(term != "(Intercept)") %>% select(term, tanpa = estimate),
by = "term"
) %>%
mutate(selisih = tanpa - semua)
list(metrics = metrics, coefs = coefs)
}
red_sens <- refit_without_influential(red_final_workflow, red_package_fit, red_train, red_test, red_influence)
white_sens <- refit_without_influential(white_final_workflow, white_package_fit, white_train, white_test, white_influence)
kable(red_sens$metrics, digits = 4, caption = "Sensitivitas Metrik Test — Red Wine")| model | n_training | RMSE | MAE | R2 |
|---|---|---|---|---|
| Semua observasi training | 1278 | 0.6515 | 0.4955 | 0.3052 |
| Tanpa observasi Cook’s D > 4/n | 1202 | 0.6502 | 0.4954 | 0.3082 |
| term | semua | tanpa | selisih |
|---|---|---|---|
| fixed.acidity | 0.0539 | 0.0792 | 0.0253 |
| volatile.acidity | -0.1955 | -0.1672 | 0.0283 |
| citric.acid | -0.0113 | -0.0318 | -0.0205 |
| residual.sugar | 0.0331 | 0.0439 | 0.0108 |
| chlorides | -0.0924 | -0.0734 | 0.0190 |
| free.sulfur.dioxide | 0.0465 | 0.0332 | -0.0132 |
| total.sulfur.dioxide | -0.1124 | -0.1131 | -0.0007 |
| density | -0.0445 | -0.0372 | 0.0073 |
| pH | -0.0545 | -0.0237 | 0.0308 |
| sulphates | 0.1315 | 0.1405 | 0.0090 |
| alcohol | 0.2769 | 0.2696 | -0.0073 |
| model | n_training | RMSE | MAE | R2 |
|---|---|---|---|---|
| Semua observasi training | 3918 | 0.7638 | 0.586 | 0.2696 |
| Tanpa observasi Cook’s D > 4/n | 3727 | 0.7631 | 0.586 | 0.2709 |
| term | semua | tanpa | selisih |
|---|---|---|---|
| fixed.acidity | 0.0014 | 0.0107 | 0.0093 |
| volatile.acidity | -0.1830 | -0.1636 | 0.0194 |
| citric.acid | -0.0028 | -0.0002 | 0.0026 |
| residual.sugar | 0.2270 | 0.2011 | -0.0259 |
| chlorides | -0.0236 | -0.0331 | -0.0096 |
| free.sulfur.dioxide | 0.0869 | 0.0797 | -0.0072 |
| total.sulfur.dioxide | -0.0269 | -0.0399 | -0.0130 |
| density | -0.1958 | -0.1808 | 0.0150 |
| pH | 0.0424 | 0.0525 | 0.0100 |
| sulphates | 0.0600 | 0.0620 | 0.0020 |
| alcohol | 0.3300 | 0.3177 | -0.0123 |
Membuang observasi training dengan Cook’s D > 4/n (76 baris pada red wine, 191 pada white wine) hampir tidak mengubah performa test. Pada red wine RMSE berubah dari 0,6515 menjadi 0,6502 dan R² dari 0,3052 menjadi 0,3082; pada white wine RMSE dari 0,7638 menjadi 0,7631 dan R² dari 0,2696 menjadi 0,2709. Selisih koefisien juga kecil (maksimum sekitar 0,031 pada red wine, yaitu pH, dan 0,026 pada white wine, yaitu residual.sugar), tidak ada tanda yang berbalik, dan urutan prediktor terpenting tetap sama dengan alcohol di posisi pertama. Dengan demikian, kesimpulan model tidak bergantung pada observasi berpengaruh, sehingga observasi tersebut dipertahankan pada model utama.
Observasi dengan Cook’s D tertinggi pada white wine (Cook’s D = 1,19, baris 2253) memuat residual.sugar = 65,8 dan density = 1,039, yang sama dengan nilai maksimum yang dilaporkan Cortez et al. (2009). Nilai ini adalah pengukuran ekstrem yang nyata di data sumber, bukan kesalahan ketik. Pada red wine, lima observasi teratas memuat nilai ekstrem pada beberapa prediktor (misalnya fixed.acidity 15,9 dan chlorides 0,61) tetapi tidak ada yang tampak sebagai kesalahan pencatatan yang jelas. Catatan: hasil sensitivitas ini memakai λ yang sama dengan model utama dan tidak dituning ulang.
Penanganan lain pada tabel ringkasan (transformasi prediktor, WLS, robust SE, suku non-linear) tidak dijalankan pada laporan ini dan dicantumkan sebagai opsi pengembangan.
final_method_comparison <- bind_rows(
red_manual_metrics %>% mutate(dataset = "Red Wine", method = "Manual Ridge"),
red_package_metrics %>% mutate(dataset = "Red Wine", method = "Package Ridge"),
white_manual_metrics %>% mutate(dataset = "White Wine", method = "Manual Ridge"),
white_package_metrics %>% mutate(dataset = "White Wine", method = "Package Ridge")
) %>%
select(dataset, method, everything())
kable(final_method_comparison, digits = 4, caption = "Manual vs Package")| dataset | method | RMSE | MAE | R2 |
|---|---|---|---|---|
| Red Wine | Manual Ridge | 0.6515 | 0.4956 | 0.3052 |
| Red Wine | Package Ridge | 0.6515 | 0.4955 | 0.3052 |
| White Wine | Manual Ridge | 0.7624 | 0.5851 | 0.2721 |
| White Wine | Package Ridge | 0.7638 | 0.5860 | 0.2696 |
tibble(
dataset = c("Red Wine", "White Wine"),
lambda_manual = c(red_lambda_manual, white_lambda_manual),
lambda_package = c(red_best$penalty, white_best$penalty)
) %>%
kable(digits = 6, caption = "Lambda Optimal Manual dan Package")| dataset | lambda_manual | lambda_package |
|---|---|---|
| Red Wine | 0.053367 | 0.04037 |
| White Wine | 0.013219 | 0.00010 |
Hasil perbandingan menunjukkan bahwa Manual Ridge dan Package Ridge menghasilkan performa yang sangat dekat pada kedua dataset, meskipun nilai \(\lambda\) optimal yang dipilih tidak selalu sama. Pada Red Wine, \(\lambda\) optimal sebesar 0,053367 untuk manual dan 0,04037 untuk package, sedangkan pada White Wine perbedaannya lebih besar, yaitu 0,013219 pada manual dan 0,00010 pada package. Meskipun demikian, perbedaan \(\lambda\) tersebut tidak menyebabkan perubahan besar pada performa model. Pada Red Wine, kedua metode menghasilkan RMSE = 0,6515 dan R² = 0,3052, dengan perbedaan MAE yang sangat kecil (0,4956 dan 0,4955). Pada White Wine, performanya juga berdekatan, yaitu RMSE 0,7624 dan 0,7638, MAE 0,5851 dan 0,5860, serta R² 0,2721 dan 0,2696. Hal ini menunjukkan bahwa meskipun proses pemilihan \(\lambda\) menghasilkan nilai yang berbeda, terutama pada White Wine, solusi Ridge yang diperoleh tetap memberikan prediksi dan performa yang hampir sama. Perbedaan nilai \(\lambda\) dapat terjadi karena titik minimum hasil cross-validation tidak selalu menghasilkan perbedaan performa yang besar di sekitar nilai optimum. Perbandingan Red Wine dan White Wine di sini hanya digunakan untuk melihat perilaku model pada dua dataset yang berbeda, bukan sebagai ranking kualitas wine.
Pada White Wine, \(\lambda\) optimal package (0,0001) berada tepat di batas bawah grid (\(10^{-4}\)), sehingga kurva CV hampir datar di sekitar \(\lambda\) kecil dan penalti optimal sangat kecil. Artinya Ridge praktis mendekati OLS pada dataset ini, sejalan dengan jumlah observasi yang jauh lebih besar daripada jumlah prediktor.
Kelebihan
Kekurangan
Analisis Ridge Regression dilakukan melalui dua alur komputasi, yaitu perhitungan manual menggunakan standardisasi eksplisit dan solusi matriks \(\left(Z^TZ+n\lambda I\right)^{-1}Z^T(y-\bar{y})\), serta perhitungan menggunakan package R melalui recipe() dan glmnet. Pada jalur package, step_normalize() melakukan standardisasi berdasarkan data training dan glmnet diatur dengan standardize = FALSE agar tidak terjadi standardisasi ganda. Pemilihan \(\lambda\) dilakukan menggunakan 10-fold cross-validation pada data training, kemudian model dievaluasi menggunakan data test. Hasil menunjukkan bahwa Manual Ridge dan Package Ridge memberikan performa yang sangat konsisten pada Red Wine maupun White Wine, meskipun nilai \(\lambda\) optimal berbeda, terutama pada White Wine. Kedekatan nilai RMSE, MAE, dan R² menunjukkan bahwa kedua implementasi menghasilkan model yang secara praktis serupa, sehingga hasil tersebut sekaligus menjadi pemeriksaan bahwa implementasi manual telah mengikuti formulasi Ridge dan menghasilkan prediksi yang konsisten dengan implementasi package.
Secara aplikatif, Ridge digunakan untuk memodelkan
quality berdasarkan sebelas karakteristik fisikokimia yang
tersedia pada dataset. Pemeriksaan VIF dan korelasi menunjukkan adanya
multikolinearitas, terutama pada beberapa prediktor seperti
fixed.acidity dan density pada Red Wine serta
density, residual.sugar, dan
alcohol pada White Wine. Kondisi tersebut memberikan alasan
statistik untuk menggunakan penalti \(L_2\) agar estimasi koefisien lebih stabil.
Validasi dilakukan dengan pemisahan training-test dan 10-fold
cross-validation pada training set, sedangkan variasi antar-fold dan
bootstrap test digunakan untuk memberikan gambaran tambahan mengenai
ketidakpastian performa prediksi.
Hasil benchmark juga perlu dibaca sesuai tujuan masing-masing metode. OLS berfungsi sebagai baseline regresi linear, Ridge sebagai model linear dengan regularisasi untuk menghadapi korelasi antar-prediktor, dan Random Forest sebagai benchmark predictive accuracy yang mampu menangkap pola non-linear. Perbedaan performa test di antara metode tersebut tidak dengan sendirinya menunjukkan hubungan sebab-akibat atau menentukan model mana yang secara substantif paling benar. Temuan utama yang dapat dipertanggungjawabkan adalah bahwa Ridge memberikan performa prediksi yang terukur, implementasi manual dan package menghasilkan hasil yang sangat dekat, dan kualitas prediksi tetap memiliki ketidakpastian serta keterbatasan yang perlu diperhatikan.
Temuan Utama
quality pada data test (R² 0,305 dan 0,270; RMSE
0,652 dan 0,764; MAE 0,496 dan 0,586). Akurasi prediksi tergolong
moderat: karakteristik fisikokimia memuat informasi tentang
quality, tetapi tidak cukup untuk memprediksinya secara
tepat.alcohol (positif), volatile.acidity
(negatif), sulphates (positif), dan
total.sulfur.dioxide (negatif); pada white wine adalah
alcohol (positif), residual.sugar (positif),
density (negatif), dan volatile.acidity
(negatif). Ini adalah hubungan linear bersyarat, bukan hubungan
sebab-akibat. Pada white wine, density,
residual.sugar, dan alcohol saling berkorelasi
kuat sehingga koefisiennya perlu dibaca bersama.**Asumsi** Multikolinearitas ditangani oleh Ridge. Linearitas dan homoskedastisitas terlanggar sebagian: uji Breusch-Pagan menolak H0 pada kedua dataset, dan pada red wine residual cenderung turun di ujung atas nilai fitted. Dampaknya terutama pada inferensi OLS (standard error dan p-value), sedangkan prediksi titik relatif aman. Penanganan lanjutan (transformasi prediktor, WLS, robust SE, suku non-linear) tidak dijalankan dan dicantumkan sebagai pengembangan.
**Analisis lanjutan berdasarkan skor** Pembagian data menjadi kelompok Tengah (skor 5-7) dan Ekstrem tidak memperbaiki prediksi secara meyakinkan. Pada kelompok Tengah, Ridge kelompok hampir sama dengan Ridge data penuh pada baris test yang sama, dan tanda koefisien hampir seluruhnya searah. Kelompok Ekstrem berukuran kecil, koefisiennya tidak stabil, dan perbandingannya menguntungkan model kelompok karena kelompok ditentukan dari \(Y\); hasilnya dibaca sebagai indikasi. Karena kelompok dibentuk dari \(Y\), model kelompok tidak dapat dipakai pada data baru dan tidak digabung menjadi satu model prediksi; model utama tetap Ridge data penuh. Pembagian di median memberi gambaran serupa: \(R^2\) di dalam kelompok sangat rendah (0,01 sampai 0,13) dan hampir sama dengan model penuh pada baris yang sama, sedangkan RMSE kelompok yang lebih kecil mencerminkan rentang \(Y\) yang sempit. Arah hubungan utama (alcohol dan sulphates pada red wine; alcohol, density, dan residual.sugar pada white wine) tetap terlihat pada kelompok Atas median, tetapi pada kelompok Bawah median koefisien mendekati nol, sehingga hubungan kuat pada model penuh terutama membedakan wine berkualitas lebih rendah dari yang lebih tinggi.
**Peran benchmark model** Random Forest memiliki error test yang lebih rendah daripada Ridge dan OLS pada kedua dataset, yang menunjukkan adanya pola non-linear atau interaksi. Hal ini menyangkut akurasi prediksi saja, tidak menunjukkan penyebab, dan perlu dibaca dengan catatan bahwa baris identik dipertahankan sehingga keunggulan Random Forest dapat sedikit optimistis.
**Kelemahan pada skor ekstrem** Model data penuh cenderung
memprediksi wine berskor sangat rendah atau sangat tinggi ke arah nilai
tengah (sekitar 5-6), sehingga galat pada skor ekstrem besar. Hal ini
wajar karena sebelas karakteristik fisikokimia hanya menjelaskan
sebagian kecil variasi quality, dan Ridge menyusutkan
koefisien ke arah nol. Karena sekitar 95% (red) dan 93% (white) sampel
berada pada skor 5-7, RMSE keseluruhan sebagian besar ditentukan oleh
wine bermutu menengah. Model ini lebih tepat dipakai untuk memahami
hubungan umum dan memprediksi wine tipikal daripada mengenali wine yang
sangat buruk atau sangat istimewa.
Beberapa keterbatasan perlu diperhatikan. Pertama, dataset hanya
memuat karakteristik fisikokimia dan skor sensorik. Informasi lain
seperti merek, varietas anggur, harga, atau jenis anggur tidak tersedia
(UCI Machine Learning Repository). Kedua, quality merupakan
skor sensorik sehingga hubungan dengan karakteristik kimia tidak harus
sepenuhnya linear. Ketiga, Ridge terutama menangani stabilitas koefisien
akibat korelasi antar-prediktor dan tidak otomatis menjamin bahwa bentuk
linear merupakan bentuk hubungan yang paling tepat. Keempat, benchmark
Random Forest digunakan untuk konteks prediksi dan tidak menggantikan
interpretasi koefisien Ridge.
Kelima, quality adalah median dari minimal tiga penilai
pada skala 0-10 dan hanya teramati pada beberapa nilai bulat (3-8 pada
red wine, 3-9 pada white wine). Memodelkannya sebagai respons numerik
mengikuti pendekatan Cortez et al. (2009), yang memilih regresi karena
mempertahankan urutan skor; ini bukan satu-satunya kemungkinan
pemodelan, dan karena respons diskret, residual model linear hampir
pasti berpola bertingkat. Keenam, diagnostik influential observations
menggunakan OLS sebagai baseline karena Cook’s distance dan leverage
klasik tidak secara langsung merupakan ukuran inferensial Ridge.
Ketujuh, interval bootstrap yang digunakan menggambarkan ketidakpastian
metrik prediksi pada sampel yang tersedia dan tidak dapat dianggap
sebagai confidence interval untuk koefisien Ridge. Kedelapan,
visualisasi prediksi interaktif digunakan untuk eksplorasi hasil
prediksi, bukan sebagai sistem prediksi baru atau bukti hubungan
kausal.
Kesembilan, baris yang identik (240 pada red wine dan 937 pada white wine) dipertahankan karena Cortez et al. (2009) memperlakukan setiap baris sebagai sampel yang berbeda. Akibatnya baris dengan nilai yang sama dapat berada di training dan test sekaligus, sehingga performa test dapat sedikit lebih optimistis, terutama untuk Random Forest yang mudah menghafal baris. Ridge dan OLS kurang terpengaruh, dan kesimpulan utama tentang Ridge tidak bergantung pada hal ini, tetapi keunggulan Random Forest sebaiknya dibaca dengan catatan tersebut. Kesepuluh, analisis lanjutan berdasarkan skor (Tengah vs Ekstrem dan pembagian di median) bersifat eksploratif: kelompok dibentuk dari nilai \(Y\) sehingga koefisien dapat bias, rentang \(Y\) terpangkas, dan model kelompok tidak dapat dipakai untuk memprediksi data baru karena nilai \(Y\) data baru tidak diketahui. Model kelompok juga tidak digabung menjadi satu model prediksi; menggabungkannya memerlukan aturan pemilihan model yang hanya memakai prediktor. Jumlah sampel kelompok Ekstrem kecil sehingga metrik test pada kelompok tersebut berisik. Kesebelas, galat prediksi pada skor ekstrem besar karena prediksi model cenderung menyusut ke nilai tengah dan karakteristik fisikokimia yang tersedia tidak cukup membedakan wine ekstrem; membobotkan baris ekstrem dapat menurunkan galat di sana tetapi menaikkan galat pada wine bermutu menengah yang merupakan sebagian besar data.
Pengembangan berikutnya dapat mempertimbangkan model non-linear atau
model yang dirancang khusus untuk respons diskret, mixture of
regressions yang menemukan kelompok secara probabilistik tanpa memotong
data berdasarkan \(Y\) (misalnya paket
flexmix; Leisch, 2004), repeated cross-validation pada
seluruh analisis, membandingkan beberapa strategi tuning yang lebih
luas, penanganan heteroskedastisitas (transformasi prediktor, WLS,
robust SE), serta menambahkan informasi domain yang tidak tersedia dalam
dataset saat ini.
Cortez, P., Cerdeira, A., Almeida, F., Matos, T., & Reis, J. (2009). Modeling wine preferences by data mining from physicochemical properties. Decision Support Systems, 47(4), 547-553. https://doi.org/10.1016/j.dss.2009.05.016
UCI Machine Learning Repository. Wine Quality. Dataset red and white Vinho Verde wine. DOI: 10.24432/C56S3T. https://archive.ics.uci.edu/dataset/186/wine+quality
Hastie, T., Tibshirani, R., & Friedman, J. (2009). The Elements of Statistical Learning (2nd ed.). Springer. https://doi.org/10.1007/978-0-387-84858-7
Kuhn, M., & Johnson, K. (2013). Applied Predictive Modeling. Springer. https://doi.org/10.1007/978-1-4614-6849-3
Kuhn, M. (2026). recipes: Preprocessing and Feature Engineering Steps for Modeling. R package documentation. https://recipes.tidymodels.org/reference/step_normalize.html
Friedman, J., Hastie, T., Tibshirani, R., et al. glmnet: Lasso and Elastic-Net Regularized Generalized Linear Models. CRAN documentation. https://CRAN.R-project.org/package=glmnet
Leisch, F. (2004). FlexMix: A general framework for finite mixture models and latent class regression in R. Journal of Statistical Software, 11(8), 1-18. https://doi.org/10.18637/jss.v011.i08
Memastikan bahwa data yang digunakan oleh dua jalur memiliki konsep standardisasi yang sama.
red_check <- tibble(
variable = predictors,
manual_mean = colMeans(Z_red),
manual_sd = apply(Z_red, 2, sd)
)
white_check <- tibble(
variable = predictors,
manual_mean = colMeans(Z_white),
manual_sd = apply(Z_white, 2, sd)
)
kable(red_check, digits = 6, caption = "Verifikasi Standardisasi Red Wine")| variable | manual_mean | manual_sd |
|---|---|---|
| fixed.acidity | 0 | 1 |
| volatile.acidity | 0 | 1 |
| citric.acid | 0 | 1 |
| residual.sugar | 0 | 1 |
| chlorides | 0 | 1 |
| free.sulfur.dioxide | 0 | 1 |
| total.sulfur.dioxide | 0 | 1 |
| density | 0 | 1 |
| pH | 0 | 1 |
| sulphates | 0 | 1 |
| alcohol | 0 | 1 |
| variable | manual_mean | manual_sd |
|---|---|---|
| fixed.acidity | 0 | 1 |
| volatile.acidity | 0 | 1 |
| citric.acid | 0 | 1 |
| residual.sugar | 0 | 1 |
| chlorides | 0 | 1 |
| free.sulfur.dioxide | 0 | 1 |
| total.sulfur.dioxide | 0 | 1 |
| density | 0 | 1 |
| pH | 0 | 1 |
| sulphates | 0 | 1 |
| alcohol | 0 | 1 |
Secara numerik, mean prediktor terstandardisasi akan mendekati 0 dan
simpangan baku mendekati 1. Pada implementasi package, parameter yang
digunakan berasal dari training data melalui
step_normalize()