1 Pendahuluan

1.1 Latar Belakang

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:

  • Komputasi manual, menggunakan standardisasi eksplisit dan solusi matriks Ridge.
  • Komputasi package R, menggunakan 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).

1.2 Rumusan Masalah

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?

  1. Bagaimana penerapan Ridge regression secara manual pada red wine dan white wine?
  2. Apakah hasil komputasi manual konsisten dengan implementasi package R?
  3. Berapa nilai \(\lambda\) yang dipilih melalui cross-validation?
  4. Bagaimana performa Ridge pada data test?
  5. Bagaimana hasil Ridge dibandingkan dengan OLS dan Random Forest sebagai benchmark prediksi?
  6. Apakah hubungan prediktor dengan quality dan akurasi prediksi berubah jika data dibagi berdasarkan skor (Tengah vs Ekstrem, dan di median quality)?

1.3 Tujuan

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.

2 Landasan Teori

2.1 Model Regresi Linear

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. \]

2.2 Standardisasi Prediktor

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.

2.3 Ridge Regression

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.

2.4 Pemilihan λ

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.

2.5 Metrik Evaluasi

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.

2.6 Inferensi Statistik dan Predictive Accuracy

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.

2.7 Diagnostik, Validasi, dan Ketidakpastian

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.

3 Data dan Fungsi Umum

3.1 Sumber Data

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.

3.2 Variabel Analisis

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.

3.3 Fungsi Evaluasi

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)
    )
  })
}

3.4 Fungsi Analisis Lanjutan (Pembagian Kelompok Berdasarkan Skor)

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")
}

4 Data 1 : Red Wine

4.1 Import Data

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
cat("Variabel:", ncol(red_model), "\n")
## Variabel: 12

4.2 Pemeriksaan Data

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"
)
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
cat("Duplikasi:", red_duplicates)
## 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.

4.3 Eksplorasi Data

4.3.1 Distribusi Quality

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")
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.

4.3.2 Statistik Deskriptif

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")
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

4.3.3 Distribusi Variabel

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 / p2

4.3.4 Hubungan Prediktor dengan Quality

red_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.

4.4 Pembagian Training dan Test

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
cat("Testing :", nrow(red_test), "\n")
## 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.

4.5 Korelasi dan Multikolinearitas

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")
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.

4.6 Komputasi Manual Ridge

4.6.1 Standardisasi Manual

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")
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

4.6.2 Rumus Matriks Ridge

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.

4.6.3 Kandidat λ

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_best

4.6.4 Visualisasi CV Manual

ggplot(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.

4.6.5 Final Manual Ridge

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")
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

4.6.6 Prediksi dan Evaluasi Manual

red_manual_pred <- predict_manual_ridge(red_manual_fit, red_test)
red_manual_metrics <- metric_table(red_test$quality, red_manual_pred)
red_manual_metrics

Pada \(\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.

4.7 Komputasi Ridge dengan Package R

4.7.1 Preprocessing dengan 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_recipe <- recipe(quality ~ ., data = red_train) %>%
  step_normalize(all_numeric_predictors())

4.7.2 Spesifikasi Ridge

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().

4.7.3 Cross-Validation Package

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_best

4.7.4 Final Package Ridge

red_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

4.7.5 Signifikansi Prediktor terhadap Red Wine Quality

# ============================================================
# 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"
)
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 ***

4.7.6 Perbandingan Koefisien Manual dan Package

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")
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

4.7.7 Perbandingan Prediksi

red_prediction_comparison <- tibble(
  actual = red_test$quality,
  manual = red_manual_pred,
  package = red_package_pred
)

red_prediction_comparison %>% head(10)

4.7.8 Evaluasi Manual vs Package

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")
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.

4.7.9 Diagnostik Residual

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)

4.7.10 Actual vs Predicted

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.

4.8 Benchmark Red Wine

4.8.1 OLS

red_ols <- linear_reg() %>% set_engine("lm") %>% fit(quality ~ ., data = red_train)
red_ols_pred <- predict(red_ols, new_data = red_test)$.pred
red_ols_metrics <- metric_table(red_test$quality, red_ols_pred)

4.8.2 Random Forest

set.seed(12345)
red_rf <- randomForest(
  quality ~ ., data = red_train,
  ntree = 500,
  mtry = floor(sqrt(length(predictors))),
  importance = TRUE
)
red_rf_pred <- predict(red_rf, red_test)
red_rf_metrics <- metric_table(red_test$quality, red_rf_pred)

4.8.3 Perbandingan Model

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")
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.

4.9 Diagnostik Lanjutan, Influential Observations, dan Uncertainty

4.9.1 Pemeriksaan Asumsi dan Residual

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_scale

Pemeriksaan 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.

4.9.2 Influential Observations

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"
)
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
cat("Batas Cook's distance:", round(4 / nrow(red_train), 4), "\n")
## Batas Cook's distance: 0.0031
cat("Jumlah observasi melewati batas Cook's distance:",
    sum(red_influence$cooks_flag), "\n")
## Jumlah observasi melewati batas Cook's distance: 76
cat("Jumlah observasi dengan leverage tinggi:",
    sum(red_influence$leverage_flag), "\n")
## 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.

4.9.3 Ketidakpastian Validasi

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"
)
Variasi RMSE 10-Fold CV — Red Wine
mean_RMSE sd_RMSE lower_RMSE upper_RMSE
0.6511 0.0404 0.5894 0.7163
kable(
  red_boot$summary,
  digits = 4,
  caption = "Bootstrap Uncertainty Metrik Test — Red Wine"
)
Bootstrap Uncertainty Metrik Test — Red Wine
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.

4.9.4 Prediksi Interaktif

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.

4.9.5 Benchmark

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.

4.10 Analisis Lanjutan : Ridge pada Kelompok Skor Tengah dan Ekstrem

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:

  • Kelompok ditentukan dari nilai \(Y\), sehingga rentang \(Y\) di tiap kelompok terpangkas. Koefisien tiap kelompok dapat bias terhadap model penuh dan \(R^2\) tidak dapat dibandingkan langsung dengan model penuh.
  • Pada data baru nilai quality belum diketahui, sehingga tidak dapat ditentukan model kelompok mana yang dipakai. Analisis ini bersifat eksploratif, bukan model prediksi.
  • Pada kelompok Ekstrem, \(Y\) hanya mengambil beberapa nilai terpisah (3, 4, dan 8), sehingga satu garis regresi pada kelompok tersebut terutama menangkap perbedaan antara kualitas sangat rendah dan sangat tinggi.
  • Jumlah sampel kelompok Ekstrem kecil, terutama di test set, sehingga metrik test pada kelompok ini berisik. Rata-rata RMSE hasil cross-validation berulang lebih dapat diandalkan daripada RMSE test.
  • Koefisien tiap model terstandardisasi dengan mean dan SD data yang dipakai untuk model tersebut, sehingga perbandingan antar kelompok lebih tepat dibaca pada tanda dan urutan besarnya daripada selisih angkanya.
red_group <- run_group_analysis(red_train, red_test, red_package_fit, red_lambda_grid)

4.10.1 Ukuran Kelompok

kable(red_group$counts, caption = "Jumlah Observasi per Kelompok — Red Wine")
Jumlah Observasi per Kelompok — Red Wine
kelompok Training Test
Tengah 1210 308
Ekstrem 68 13

4.10.2 Hasil Cross-Validation

kable(red_group$cv, digits = 4, caption = "Hasil CV per Kelompok — Red Wine")
Hasil CV per Kelompok — Red Wine
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

4.10.3 Performa pada Data Test

kable(red_group$perf, digits = 4,
      caption = "Performa Test: Ridge Kelompok vs Ridge Data Penuh pada Baris Test yang Sama — Red Wine")
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

4.10.4 Perbandingan Koefisien

plot_group_coef(red_group$coef, "Koefisien Ridge: Data Penuh vs Kelompok — Red Wine")

kable(
  red_group$coef %>% pivot_wider(names_from = model, values_from = estimate),
  digits = 4,
  caption = "Koefisien Ridge per Model — Red Wine"
)
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.

4.10.5 Pembagian di Median Quality pada Red Wine

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")
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")
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")
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
plot_group_coef(red_group_med$coef, "Koefisien Ridge: Data Penuh vs Kelompok Median — Red Wine")

kable(
  red_group_med$coef %>% pivot_wider(names_from = model, values_from = estimate),
  digits = 4,
  caption = "Koefisien Ridge per Model (Pembagian Median) — Red Wine"
)
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.

5 Data 2 : White Wine

5.1 Import Data

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
cat("Variabel:", ncol(white_model), "\n")
## Variabel: 12

5.2 Pemeriksaan Data

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"
)
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
cat("Duplikasi:", white_duplicates)
## 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.

5.3 Eksplorasi Data

5.3.1 Distribusi Quality

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")
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.

5.3.2 Statistik Deskriptif

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")
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

5.3.3 Distribusi Variabel

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 / p2

5.3.4 Hubungan Prediktor dengan Quality

white_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.

5.4 Pembagian Training dan Test

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
cat("Testing :", nrow(white_test), "\n")
## 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.

5.5 Korelasi dan Multikolinearitas

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")
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.

5.6 Komputasi Manual Ridge

5.6.1 Standardisasi Manual

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")
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

5.6.2 Cross-Validation Manual

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_best

5.6.3 Visualisasi CV Manual

ggplot(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.

5.6.4 Final Manual Ridge

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")
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

5.6.5 Prediksi dan Evaluasi Manual

white_manual_pred <- predict_manual_ridge(white_manual_fit, white_test)
white_manual_metrics <- metric_table(white_test$quality, white_manual_pred)
white_manual_metrics

Pada \(\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.

5.7 Komputasi Ridge dengan Package R

5.7.1 Preprocessing dengan recipe()

white_recipe <- recipe(quality ~ ., data = white_train) %>%
  step_normalize(all_numeric_predictors())

5.7.2 Spesifikasi Ridge

white_ridge_spec <- linear_reg(
  penalty = tune(),
  mixture = 0
) %>%
  set_engine("glmnet", standardize = FALSE)

5.7.3 Cross-Validation Package

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_best

5.7.4 Final Package Ridge

white_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

5.7.5 Signifikansi Prediktor terhadap White Wine Quality

# ============================================================
# 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"
)
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 ***

5.7.6 Perbandingan Koefisien Manual dan Package

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")
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

5.7.7 Evaluasi Manual vs Package

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")
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.

5.7.8 Actual vs Predicted

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.

5.7.9 Diagnostik Residual

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)

5.8 Benchmark White Wine

5.8.1 OLS

white_ols <- linear_reg() %>% set_engine("lm") %>% fit(quality ~ ., data = white_train)
white_ols_pred <- predict(white_ols, new_data = white_test)$.pred
white_ols_metrics <- metric_table(white_test$quality, white_ols_pred)

5.8.2 Random Forest

set.seed(12345)
white_rf <- randomForest(
  quality ~ ., data = white_train,
  ntree = 500,
  mtry = floor(sqrt(length(predictors))),
  importance = TRUE
)
white_rf_pred <- predict(white_rf, white_test)
white_rf_metrics <- metric_table(white_test$quality, white_rf_pred)

5.8.3 Perbandingan Model

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")
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.

5.9 Diagnostik Lanjutan, Influential Observations, dan Uncertainty

5.9.1 Pemeriksaan Asumsi dan Residual

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_scale

Pemeriksaan 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.

5.9.2 Influential Observations

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"
)
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
cat("Batas Cook's distance:", round(4 / nrow(white_train), 4), "\n")
## Batas Cook's distance: 0.001
cat("Jumlah observasi melewati batas Cook's distance:",
    sum(white_influence$cooks_flag), "\n")
## Jumlah observasi melewati batas Cook's distance: 191
cat("Jumlah observasi dengan leverage tinggi:",
    sum(white_influence$leverage_flag), "\n")
## 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.

5.9.3 Ketidakpastian Validasi

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"
)
Variasi RMSE 10-Fold CV — White Wine
mean_RMSE sd_RMSE lower_RMSE upper_RMSE
0.7506 0.0387 0.689 0.7946
kable(
  white_boot$summary,
  digits = 4,
  caption = "Bootstrap Uncertainty Metrik Test — White Wine"
)
Bootstrap Uncertainty Metrik Test — White Wine
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.

5.9.4 Prediksi Interaktif

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.

5.9.5 Benchmark

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.

5.10 Analisis Lanjutan : Ridge pada Kelompok Skor Tengah dan Ekstrem

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.

white_group <- run_group_analysis(white_train, white_test, white_package_fit, white_lambda_grid)

5.10.1 Ukuran Kelompok

kable(white_group$counts, caption = "Jumlah Observasi per Kelompok — White Wine")
Jumlah Observasi per Kelompok — White Wine
kelompok Training Test
Tengah 3631 904
Ekstrem 287 76

5.10.2 Hasil Cross-Validation

kable(white_group$cv, digits = 4, caption = "Hasil CV per Kelompok — White Wine")
Hasil CV per Kelompok — White Wine
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

5.10.3 Performa pada Data Test

kable(white_group$perf, digits = 4,
      caption = "Performa Test: Ridge Kelompok vs Ridge Data Penuh pada Baris Test yang Sama — White Wine")
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

5.10.4 Perbandingan Koefisien

plot_group_coef(white_group$coef, "Koefisien Ridge: Data Penuh vs Kelompok — White Wine")

kable(
  white_group$coef %>% pivot_wider(names_from = model, values_from = estimate),
  digits = 4,
  caption = "Koefisien Ridge per Model — White Wine"
)
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.

5.10.5 Pembagian di Median Quality pada White Wine

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")
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")
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")
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"
)
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\).

6 Asumsi yang Terlanggar, Dampak, dan Penanganannya

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")
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 -

6.1 Uji Homoskedastisitas

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"
)
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.

6.2 Investigasi Observasi Berpengaruh

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)")
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)")
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.

6.3 Analisis Sensitivitas terhadap Observasi Berpengaruh

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")
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
kable(red_sens$coefs, digits = 4, caption = "Sensitivitas Koefisien Ridge — Red Wine")
Sensitivitas Koefisien Ridge — Red Wine
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
kable(white_sens$metrics, digits = 4, caption = "Sensitivitas Metrik Test — White Wine")
Sensitivitas Metrik Test — White Wine
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
kable(white_sens$coefs, digits = 4, caption = "Sensitivitas Koefisien Ridge — White Wine")
Sensitivitas Koefisien Ridge — White Wine
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.

7 Perbandingan Akhir Red dan White Wine

7.1 Konsistensi Manual vs Package

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")
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

7.2 Nilai Lambda

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")
Lambda Optimal Manual dan Package
dataset lambda_manual lambda_package
Red Wine 0.053367 0.04037
White Wine 0.013219 0.00010

7.3 Interpretasi

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.

8 Kelebihan dan Kekurangan Ridge

Kelebihan

  • Menstabilkan estimasi koefisien ketika prediktor saling berkorelasi (VIF tinggi), karena penalti \(L_2\) menurunkan varians estimasi dengan imbalan sedikit bias.
  • Semua prediktor tetap dipakai, sehingga tidak ada variabel yang dibuang dan seluruh karakteristik fisikokimia tetap dapat diinterpretasikan.
  • Memiliki solusi tertutup sehingga mudah direproduksi secara manual dan konsisten dengan implementasi package.
  • Kekuatan penalti (\(\lambda\)) dipilih secara objektif melalui cross-validation tanpa menyentuh test set.

Kekurangan

  • Estimasi koefisien bias (menyusut ke arah nol), dan besar koefisien bergantung pada standardisasi dan nilai \(\lambda\).
  • Tidak melakukan seleksi variabel: koefisien menjadi kecil tetapi tidak pernah tepat nol.
  • Tidak menyediakan standard error atau p-value secara langsung, sehingga inferensi klasik memakai OLS sebagai baseline.
  • Tetap model linear dan aditif; pola non-linear tidak ditangkap, seperti terlihat dari keunggulan Random Forest pada data test.
  • Tetap sensitif terhadap pencilan dan observasi berpengaruh karena meminimumkan jumlah kuadrat error.
  • Pada data ini jumlah observasi jauh lebih besar daripada jumlah prediktor, sehingga Ridge hampir identik dengan OLS (selisih RMSE test kurang dari 0,003) dan keuntungan prediktifnya kecil; manfaat utamanya adalah kestabilan koefisien.

9 Kesimpulan

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

  • Ridge menjelaskan sekitar 31% (red wine) dan 27% (white wine) variasi 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.
  • Prediktor dengan koefisien terstandardisasi terbesar pada red wine adalah 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.
  • Ridge hampir identik dengan OLS pada dataset ini (selisih RMSE test kurang dari 0,003) karena jumlah observasi jauh lebih besar daripada jumlah prediktor, dan nilai \(\lambda\) optimal sangat kecil. Manfaat utama Ridge di sini adalah kestabilan koefisien di bawah multikolinearitas, bukan peningkatan akurasi prediksi.
  • Hasil tidak sensitif terhadap observasi berpengaruh: membuang observasi dengan Cook’s D > 4/n mengubah RMSE test paling banyak 0,0013 dan tidak membalik tanda koefisien mana pun.

**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.

10 Keterbatasan

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.

Daftar Pustaka

  1. 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

  2. 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

  3. 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

  4. Kuhn, M., & Johnson, K. (2013). Applied Predictive Modeling. Springer. https://doi.org/10.1007/978-1-4614-6849-3

  5. Kuhn, M. (2026). recipes: Preprocessing and Feature Engineering Steps for Modeling. R package documentation. https://recipes.tidymodels.org/reference/step_normalize.html

  6. 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

  7. 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

Verifikasi Standardisasi

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")
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
kable(white_check, digits = 6, caption = "Verifikasi Standardisasi White Wine")
Verifikasi Standardisasi White 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

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()