# Load libraries
library(car)      
library(lmtest)
library(knitr)
library(ggplot2)  
library(dplyr)
library(tidyr)
library(tidyverse)
library(sandwich)
library(MASS)
library(glmnet)
library(gridExtra)
library(splines)
library(caret)
library(reshape2)
library(nlme)
library(tibble)
library(broom)
library(nlstools)

TUGAS BAB 1

PRAKTIKUM

No. 1

Data mtcars

# Load data
data(mtcars)
model_ols <- lm(mpg ~ wt + hp + disp + drat, data = mtcars)

Uji Heteroskedastisitas: Breusch–Pagan Test

bp_test <- bptest(model_ols)
print(bp_test)
## 
##  studentized Breusch-Pagan test
## 
## data:  model_ols
## BP = 1.4406, df = 4, p-value = 0.8371
hetero_flag <- ifelse(bp_test$p.value < 0.05, TRUE, FALSE)
if(hetero_flag){
  cat("Interpretasi: Ada indikasi heteroskedastisitas (p < 0.05).\n")
  cat("Rekomendasi: Gunakan regresi robust (Huber-White SE) atau model robust.\n\n")
} else {
  cat("Interpretasi: Tidak ada indikasi heteroskedastisitas.\n\n")
}
## Interpretasi: Tidak ada indikasi heteroskedastisitas.

Uji Multikolinearitas: Variance Inflation Factor (VIF)

vif_values <- vif(model_ols)
print(vif_values)
##       wt       hp     disp     drat 
## 5.096601 2.894373 8.209402 2.279547
multi_flag <- FALSE
if(any(vif_values > 10)){
  cat("Interpretasi: Ada multikolinearitas kuat (VIF > 10).\n")
  cat("Rekomendasi: Gunakan Ridge Regression atau Lasso.\n")
  multi_flag <- TRUE
} else if(any(vif_values > 5)){
  cat("Interpretasi: Ada indikasi multikolinearitas moderat (VIF > 5).\n")
  cat("Rekomendasi: Cermati variabel, atau coba regularisasi (Ridge).\n")
  multi_flag <- TRUE
} else {
  cat("Interpretasi: Tidak ada masalah multikolinearitas serius.\n")
}
## Interpretasi: Ada indikasi multikolinearitas moderat (VIF > 5).
## Rekomendasi: Cermati variabel, atau coba regularisasi (Ridge).

Outlier & Pengaruh: Cook’s Distance

cooksd <- cooks.distance(model_ols)
threshold <- 4/(nrow(mtcars) - length(coef(model_ols)) - 2)
influential_points <- which(cooksd > threshold)

if(length(influential_points) > 0){
  cat("Observasi berpengaruh besar:", paste(influential_points, collapse = ", "), "\n")
  cat("Rekomendasi: Pertimbangkan robust regression atau analisis sensitivitas.\n\n")
  outlier_flag <- TRUE
} else {
  cat("Tidak ada observasi berpengaruh besar.\n\n")
  outlier_flag <- FALSE
}
## Observasi berpengaruh besar: 17, 31 
## Rekomendasi: Pertimbangkan robust regression atau analisis sensitivitas.

Normalitas Residual: QQ-Plot & Shapiro-Wilk Test

residuals_ols <- residuals(model_ols)
shapiro_test <- shapiro.test(residuals_ols)

print(shapiro_test)
## 
##  Shapiro-Wilk normality test
## 
## data:  residuals_ols
## W = 0.91661, p-value = 0.01684
normal_flag <- ifelse(shapiro_test$p.value < 0.05, FALSE, TRUE)
if(normal_flag){
  cat("Interpretasi: Residual berdistribusi normal.\n\n")
} else {
  cat("Interpretasi: Residual tidak berdistribusi normal.\n")
  cat("Rekomendasi: Gunakan transformasi variabel atau regresi robust.\n\n")
}
## Interpretasi: Residual tidak berdistribusi normal.
## Rekomendasi: Gunakan transformasi variabel atau regresi robust.

Visualisasi

# 1. VIF Bar Plot
vif_df <- data.frame(Variable = names(vif_values), VIF = vif_values)
p1 <- ggplot(vif_df, aes(x = Variable, y = VIF, fill = VIF > 5)) +
  geom_bar(stat = "identity") +
  geom_hline(yintercept = 5, linetype = "dashed", color = "black") +
  geom_hline(yintercept = 10, linetype = "dashed", color = "red") +
  scale_fill_manual(values = c("FALSE" = "steelblue", "TRUE" = "firebrick")) +
  labs(title = "Variance Inflation Factor (VIF)",
       y = "VIF", x = "Variabel") +
  theme_minimal() +
  theme(legend.position = "none")

# 2. Cook's Distance Plot
p2 <- ggplot(data.frame(Index = 1:length(cooksd), CookD = cooksd), aes(x = Index, y = CookD)) +
  geom_bar(stat = "identity", fill = "lightblue") +
  geom_hline(yintercept = threshold, color = "black", linetype = "dashed") +
  labs(title = "Cook's Distance", y = "Distance", x = "Observasi") +
  theme_minimal()

# 3. QQ-Plot Residual
p3 <- ggplot(data.frame(residuals = residuals_ols), aes(sample = residuals)) +
  stat_qq() + stat_qq_line(color = "red") +
  labs(title = "QQ-Plot Residual") +
  theme_minimal()

# 4. Histogram Residual
p4 <- ggplot(data.frame(residuals = residuals_ols), aes(x = residuals)) +
  geom_histogram(bins = 15, fill = "skyblue", color = "black") +
  labs(title = "Histogram Residual", x = "Residual", y = "Frekuensi") +
  theme_minimal()

# Tampilkan plot grid
grid.arrange(p1, p2, p3, p4, ncol = 2)

diagnostic_summary <- data.frame(
  Test = c("Breusch-Pagan (Heteroskedastisitas)", "Multikolinearitas (VIF max)", 
           "Cook's Distance (Jumlah Influential)", "Shapiro-Wilk (Normalitas Residual)"),
  Result = c(
    paste0("p-value = ", round(bp_test$p.value,4)),
    paste0("Max VIF = ", round(max(vif_values),2)),
    length(influential_points),
    paste0("p-value = ", round(shapiro_test$p.value,4))
  ),
  Interpretation = c(
    ifelse(hetero_flag, "Ada heteroskedastisitas", "Tidak ada heteroskedastisitas"),
    ifelse(multi_flag, "Ada multikolinearitas", "Tidak ada multikolinearitas serius"),
    ifelse(outlier_flag, "Ada observasi berpengaruh besar", "Tidak ada observasi berpengaruh besar"),
    ifelse(normal_flag, "Residual normal", "Residual tidak normal")
  ),
  Recommendation = c(
    ifelse(hetero_flag, "Gunakan regresi robust", "-"),
    ifelse(multi_flag, "Gunakan Ridge/Lasso", "-"),
    ifelse(outlier_flag, "Gunakan regresi robust / analisis sensitivitas", "-"),
    ifelse(normal_flag, "-", "Transformasi variabel / regresi robust")
  ),
  stringsAsFactors = FALSE
)

kable(diagnostic_summary, 
      col.names = c("Uji", "Hasil", "Interpretasi", "Rekomendasi"),
      caption = "Ringkasan Hasil Diagnostik Model OLS")
Ringkasan Hasil Diagnostik Model OLS
Uji Hasil Interpretasi Rekomendasi
Breusch-Pagan (Heteroskedastisitas) p-value = 0.8371 Tidak ada heteroskedastisitas -
Multikolinearitas (VIF max) Max VIF = 8.21 Ada multikolinearitas Gunakan Ridge/Lasso
Cook’s Distance (Jumlah Influential) 2 Ada observasi berpengaruh besar Gunakan regresi robust / analisis sensitivitas
Shapiro-Wilk (Normalitas Residual) p-value = 0.0168 Residual tidak normal Transformasi variabel / regresi robust

No. 2

Data Simulasi Heteroskedastik

set.seed(123)

n <- 200
beta0 <- 1
beta1 <- 2
sigma2 <- 1
gamma <- 5

x <- rnorm(n)
var_e <- sigma2 * (1 + gamma * x^2)
e <- rnorm(n, 0, sqrt(var_e))
y <- beta0 + beta1 * x + e

dat <- data.frame(y = y, x = x, w_opt = 1/var_e)
# OLS biasa
m_ols <- lm(y ~ x, data = dat)

# OLS + Robust SE (HC3)
# - gunakan vcovHC(type="HC3") lalu coeftest untuk SE & p-value robust
rob_vcov <- vcovHC(m_ols, type = "HC3")
ct_hc3   <- coeftest(m_ols, vcov = rob_vcov)

# WLS (menggunakan bobot "benar" yang diketahui dari DGP)
m_wls <- lm(y ~ x, data = dat, weights = w_opt)

Koefisien, SE, p-value

grab_coef <- function(fit) {
  s <- summary(fit)$coefficients
  # kembalikan matrix 2 kolom: Estimate, Std. Error, t value, Pr(>|t|)
  s
}

tab_ols <- grab_coef(m_ols)
tab_wls <- grab_coef(m_wls)

# Ambil untuk koefisien Intercept dan x saja
# Robust HC3 (coeftest) sudah berisi Estimate, Std. Error, z/t, p-value
tab_hc3 <- as.matrix(ct_hc3)

# Buat tabel perbandingan rapi untuk koefisien "x"
pick_row <- "x"

comp <- data.frame(
  Term          = pick_row,
  Estimate_OLS  = unname(tab_ols[pick_row, "Estimate"]),
  SE_OLS        = unname(tab_ols[pick_row, "Std. Error"]),
  pval_OLS      = unname(tab_ols[pick_row, "Pr(>|t|)"]),
  Estimate_HC3  = unname(tab_hc3[pick_row, "Estimate"]),
  SE_HC3        = unname(tab_hc3[pick_row, "Std. Error"]),
  pval_HC3      = unname(tab_hc3[pick_row, ncol(tab_hc3)]),
  Estimate_WLS  = unname(tab_wls[pick_row, "Estimate"]),
  SE_WLS        = unname(tab_wls[pick_row, "Std. Error"]),
  pval_WLS      = unname(tab_wls[pick_row, "Pr(>|t|)"])
)

print("Perbandingan koefisien, standar error, dan p-value (koefisien x)")
## [1] "Perbandingan koefisien, standar error, dan p-value (koefisien x)"
print(comp, row.names = FALSE)
##  Term Estimate_OLS    SE_OLS     pval_OLS Estimate_HC3    SE_HC3     pval_HC3
##     x     2.068284 0.1777202 3.441094e-24     2.068284 0.3032203 1.071761e-10
##  Estimate_WLS   SE_WLS     pval_WLS
##      1.825802 0.208609 9.183308e-16

No. 3

Model Polinomial & Spline

m_poly2   <- lm(mpg ~ poly(wt, 2), data = mtcars)
m_poly3   <- lm(mpg ~ poly(wt, 3), data = mtcars)
m_spline3 <- lm(mpg ~ ns(wt, df = 3), data = mtcars)
m_spline4 <- lm(mpg ~ ns(wt, df = 4), data = mtcars)

Hitung AIC & BIC

aic_vals <- c(AIC(m_poly2), AIC(m_poly3), AIC(m_spline3), AIC(m_spline4))
bic_vals <- c(BIC(m_poly2), BIC(m_poly3), BIC(m_spline3), BIC(m_spline4))

Cross-Validation (5-fold)

set.seed(123)
ctrl <- trainControl(method = "cv", number = 5)

cv_poly2   <- train(mpg ~ poly(wt, 2), data = mtcars, method = "lm", trControl = ctrl)
cv_poly3   <- train(mpg ~ poly(wt, 3), data = mtcars, method = "lm", trControl = ctrl)
cv_spline3 <- train(mpg ~ ns(wt, df = 3), data = mtcars, method = "lm", trControl = ctrl)
cv_spline4 <- train(mpg ~ ns(wt, df = 4), data = mtcars, method = "lm", trControl = ctrl)

rmse_vals <- c(cv_poly2$results$RMSE, cv_poly3$results$RMSE,
               cv_spline3$results$RMSE, cv_spline4$results$RMSE)
rsq_vals  <- c(cv_poly2$results$Rsquared, cv_poly3$results$Rsquared,
               cv_spline3$results$Rsquared, cv_spline4$results$Rsquared)

Perbandingan Model: Polinomial vs Spline

summary_table <- data.frame(
  Model = c("Poly(2)", "Poly(3)", "Spline(df=3)", "Spline(df=4)"),
  AIC   = aic_vals,
  BIC   = bic_vals,
  RMSE  = rmse_vals,
  R2    = rsq_vals
)

print("AIC, BIC, RMSE, R²")
## [1] "AIC, BIC, RMSE, R²"
print(summary_table, row.names = FALSE)
##         Model      AIC      BIC     RMSE        R2
##       Poly(2) 158.0484 163.9113 2.912290 0.8047133
##       Poly(3) 160.0365 167.3652 2.955384 0.8514997
##  Spline(df=3) 159.8492 167.1778 2.841644 0.8431953
##  Spline(df=4) 161.6686 170.4630 2.957625 0.8323083
wt_seq <- seq(min(mtcars$wt), max(mtcars$wt), length = 100)

pred_df <- data.frame(
  wt      = wt_seq,
  Poly2   = predict(m_poly2, newdata = data.frame(wt = wt_seq)),
  Poly3   = predict(m_poly3, newdata = data.frame(wt = wt_seq)),
  Spline3 = predict(m_spline3, newdata = data.frame(wt = wt_seq)),
  Spline4 = predict(m_spline4, newdata = data.frame(wt = wt_seq))
)

pred_df_long <- melt(pred_df, id.vars = "wt")

ggplot(mtcars, aes(x = wt, y = mpg)) +
  geom_point(size = 2) +
  geom_line(data = pred_df_long, aes(x = wt, y = value, color = variable), linewidht = 1) +
  theme_minimal() +
  labs(title = "Perbandingan Model: Polinomial vs Spline",
       x = "Weight (wt)", y = "Miles per Gallon (mpg)", color = "Model")

No. 4

AR(1) GLS dengan sinyal musiman

set.seed(123) 

#data musiman dengan error AR(1)
n  <- 120                # panjang data (mis. 10 tahun bulanan)
t  <- 1:n
x  <- sin(2*pi*t/12)     # sinyal musiman (periode tahunan)
beta0 <- 1
beta1 <- 2
rho   <- 0.6             # parameter AR(1) sebenarnya
sigma <- 1

# bangun error AR(1)
e <- numeric(n)
e[1] <- rnorm(1, 0, sigma/sqrt(1-rho^2))
for (i in 2:n) {
  e[i] <- rho*e[i-1] + rnorm(1, 0, sigma)
}

y <- beta0 + beta1*x + e
dat <- data.frame(t, x, y)

Estimasi OLS dan GLS dengan error AR(1)

m_ols <- lm(y ~ x, data = dat)
summary(m_ols)
## 
## Call:
## lm(formula = y ~ x, data = dat)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.68118 -0.76059 -0.02124  0.71461  2.93298 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   1.0570     0.1018   10.38   <2e-16 ***
## x             1.9386     0.1440   13.46   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.115 on 118 degrees of freedom
## Multiple R-squared:  0.6057, Adjusted R-squared:  0.6024 
## F-statistic: 181.3 on 1 and 118 DF,  p-value: < 2.2e-16
m_gls <- gls(y ~ x, data = dat,
             correlation = corAR1(form = ~ t))

summary(m_gls)
## Generalized least squares fit by REML
##   Model: y ~ x 
##   Data: dat 
##        AIC     BIC    logLik
##   323.7353 334.818 -157.8676
## 
## Correlation Structure: AR(1)
##  Formula: ~t 
##  Parameter estimate(s):
##       Phi 
## 0.6144209 
## 
## Coefficients:
##                Value Std.Error  t-value p-value
## (Intercept) 1.024939 0.2097921 4.885499       0
## x           1.917188 0.2075959 9.235195       0
## 
##  Correlation: 
##   (Intr)
## x -0.006
## 
## Standardized residuals:
##          Min           Q1          Med           Q3          Max 
## -2.311709980 -0.628226523  0.003615931  0.660274232  2.622006399 
## 
## Residual standard error: 1.137918 
## Degrees of freedom: 120 total; 118 residual

Perbandingan SE

coef_tab <- data.frame(
  Term       = names(coef(m_ols)),
  Estimate_OLS = coef(m_ols),
  SE_OLS       = summary(m_ols)$coefficients[,2],
  Estimate_GLS = coef(m_gls),
  SE_GLS       = sqrt(diag(vcov(m_gls)))
)

print("Perbandingan Koefisien & Standard Error")
## [1] "Perbandingan Koefisien & Standard Error"
print(coef_tab, row.names = FALSE)
##         Term Estimate_OLS    SE_OLS Estimate_GLS    SE_GLS
##  (Intercept)     1.057022 0.1018100     1.024939 0.2097921
##            x     1.938622 0.1439811     1.917188 0.2075959

SOAL LATIHAN

ESSAY 1

A. OLS Tetap Unbiased di Bawah Heteroskedastisitas

Estimator Ordinary Least Squares (OLS) didasarkan pada asumsi bahwa residual (error) memiliki nilai harapan nol dan tidak berkorelasi dengan variabel independen, yaitu:

\[ E[\epsilon_i | X] = 0 \]

Asumsi ini cukup untuk menjamin bahwa estimator OLS adalah unbiased, artinya nilai harapan estimator sama dengan parameter sebenarnya:

\[ E[\hat{\beta}_{OLS}] = \beta \]

Heteroskedastisitas, yaitu varians residual yang tidak konstan:

\[ Var(\epsilon_i | X) = \sigma_i^2 \neq \sigma^2 \]

tidak melanggar asumsi nilai harapan nol residual. Oleh karena itu, heteroskedastisitas tidak menyebabkan bias pada estimator OLS.

B. OLS Tidak Efisien di Bawah Heteroskedastisitas

Meskipun OLS tetap unbiased, heteroskedastisitas menyebabkan estimator OLS menjadi tidak efisien. Efisiensi di sini berarti memiliki varians terkecil di antara estimator linear unbiased (BLUE — Best Linear Unbiased Estimator).

Ketika varians residual tidak konstan, OLS tidak memanfaatkan informasi tentang pola varians residual. Estimator yang mempertimbangkan varians residual yang berbeda-beda, seperti Weighted Least Squares (WLS), dapat memberikan estimator dengan varians lebih kecil.

Secara matematis, varians estimator OLS di bawah heteroskedastisitas adalah:

\[ Var(\hat{\beta}_{OLS}) = (X^T X)^{-1} X^T \Omega X (X^T X)^{-1} \]

dengan \[\Omega = \text{diag}(\sigma_1^2, \sigma_2^2, ..., \sigma_n^2)\] Jika \[\Omega \neq \sigma^2 I\] maka varians OLS lebih besar dibandingkan varians estimator yang menggunakan bobot invers varians residual.

C. Robust Standard Errors Mengatasi Masalah Inferensi

Masalah utama heteroskedastisitas bukan pada bias estimator, tetapi pada kesalahan standar (standard errors) yang salah hitung jika diasumsikan homoskedastisitas. Kesalahan standar yang salah menyebabkan uji statistik (t-test, F-test) dan interval kepercayaan menjadi tidak valid.

Robust standard errors (juga dikenal sebagai White standard errors atau heteroskedasticity-consistent standard errors) adalah metode untuk menghitung kesalahan standar yang konsisten meskipun terjadi heteroskedastisitas.

Prinsipnya adalah mengganti estimasi varians residual homogen dengan estimasi varians residual yang tidak mengasumsikan kesamaan varians, sehingga:

\[ \widehat{Var}(\hat{\beta}{OLS}){robust} = (X^T X)^{-1} \left( \sum_{i=1}^n \hat{\epsilon}_i^2 x_i x_i^T \right) (X^T X)^{-1} \] dengan \[\hat{\epsilon}_i\] adalah residual OLS.

Dengan robust SE, inferensi statistik menjadi valid meskipun heteroskedastisitas ada, karena kesalahan standar yang digunakan untuk uji hipotesis dan interval kepercayaan sudah disesuaikan.

ESSAY 2

Penurunan Estimator WLS untuk Varian yang Proporsional terhadap ∣x ∣ Misalkan kita memiliki model regresi linear sederhana:

\[ y_i = \beta_0 + \beta_1 x_i + \epsilon_i \]

dengan asumsi bahwa varians residual (\(\sigma^2_{\epsilon_i}\)) proporsional terhadap \(|x_i|\). Dengan kata lain:

\[ Var(\epsilon_i) = \sigma^2 w_i = \sigma^2 |x_i| \]

di mana \(w_i = |x_i|\) adalah bobot dan \(\sigma^2\) adalah konstanta yang tidak diketahui.

Tujuan WLS adalah untuk meminimalkan jumlah kuadrat residual yang diboboti, yang dapat ditulis sebagai:

\[ S(\beta_0, \beta_1) = \sum_{i=1}^{n} \frac{(y_i - \beta_0 - \beta_1 x_i)^2}{w_i} = \sum_{i=1}^{n} \frac{(y_i - \beta_0 - \beta_1 x_i)^2}{|x_i|} \]

Untuk menurunkan estimator WLS, kita mengambil turunan parsial dari \(S(\beta_0, \beta_1)\) terhadap \(\beta_0\) dan \(\beta_1\) dan menyamakannya dengan nol.

Turunan Parsial terhadap \(\beta_0\):

\[ \frac{\partial S}{\partial \beta_0} = \sum_{i=1}^{n} \frac{2(y_i - \beta_0 - \beta_1 x_i)(-1)}{|x_i|} = 0 \]

\[ \sum_{i=1}^{n} \frac{y_i}{|x_i|} - \beta_0 \sum_{i=1}^{n} \frac{1}{|x_i|} - \beta_1 \sum_{i=1}^{n} \frac{x_i}{|x_i|} = 0 \]

\[ \hat{\beta_0} \sum_{i=1}^{n} \frac{1}{|x_i|} + \hat{\beta_1} \sum_{i=1}^{n} \frac{x_i}{|x_i|} = \sum_{i=1}^{n} \frac{y_i}{|x_i|} \] Turunan Parsial terhadap \(\beta_1\):

\[ \frac{\partial S}{\partial \beta_1} = \sum_{i=1}^{n} \frac{2(y_i - \beta_0 - \beta_1 x_i)(-x_i)}{|x_i|} = 0 \]

\[ \sum_{i=1}^{n} \frac{x_i y_i}{|x_i|} - \beta_0 \sum_{i=1}^{n} \frac{x_i}{|x_i|} - \beta_1 \sum_{i=1}^{n} \frac{x_i^2}{|x_i|} = 0 \]

\[ \hat{\beta_0} \sum_{i=1}^{n} \frac{x_i}{|x_i|} + \hat{\beta_1} \sum_{i=1}^{n} \frac{x_i^2}{|x_i|} = \sum_{i=1}^{n} \frac{x_i y_i}{|x_i|} \] Dari kedua persamaan di atas, kita mendapatkan sistem persamaan normal WLS:

\[ \begin{bmatrix} \sum_{i=1}^{n} \frac{1}{|x_i|} & \sum_{i=1}^{n} \frac{x_i}{|x_i|} \\ \sum_{i=1}^{n} \frac{x_i}{|x_i|} & \sum_{i=1}^{n} \frac{x_i^2}{|x_i|} \end{bmatrix} \begin{bmatrix} \hat{\beta_0} \\ \hat{\beta_1} \end{bmatrix} = \begin{bmatrix} \sum_{i=1}^{n} \frac{y_i}{|x_i|} \\ \sum_{i=1}^{n} \frac{x_i y_i}{|x_i|} \end{bmatrix} \] Solusi dari sistem ini memberikan estimator WLS.

ESSAY 3

# Create a data frame for the comparison
comparison_df <- tribble(
  ~Fitur, ~"Ridge Regression", ~"Lasso Regression",
  "Penalti", "L2 (∑β²)", "L1 (∑|β|)",
  "Tujuan Utama", "Mengurangi varians; mengatasi multikolinearitas", "Mengurangi varians; seleksi variabel",
  "Bias", "Menambah bias sedikit", "Menambah bias lebih dari Ridge (bisa lebih besar)",
  "Variance", "Mengurangi varians secara signifikan", "Mengurangi varians secara signifikan",
  "Seleksi Variabel", "Tidak melakukan seleksi variabel (koefisien mendekati nol tetapi tidak nol)", "Melakukan seleksi variabel (koefisien bisa menjadi nol)",
)

# Render the table using kable for a clean format
kable(comparison_df, 
      caption = "Tabel Perbandingan Ridge vs. Lasso",
      align = 'l')
Tabel Perbandingan Ridge vs. Lasso
Fitur Ridge Regression Lasso Regression
Penalti L2 (∑β²) L1 (∑|β|)
Tujuan Utama Mengurangi varians; mengatasi multikolinearitas Mengurangi varians; seleksi variabel
Bias Menambah bias sedikit Menambah bias lebih dari Ridge (bisa lebih besar)
Variance Mengurangi varians secara signifikan Mengurangi varians secara signifikan
Seleksi Variabel Tidak melakukan seleksi variabel (koefisien mendekati nol tetapi tidak nol) Melakukan seleksi variabel (koefisien bisa menjadi nol)

HITUNGAN

# Contoh data: X (dengan intercept) dan y
X <- matrix(c(1,1,
              1,2,
              1,3,
              1,4,
              1,5), ncol=2, byrow=TRUE)
y <- c(1.2, 1.9, 3.0, 3.9, 5.1)

# 1. Hitung β̂ OLS = (X'X)^(-1) X'y
beta_hat <- solve(t(X) %*% X) %*% t(X) %*% y
beta_hat
##      [,1]
## [1,] 0.08
## [2,] 0.98
# 2. Matriks hat H = X (X'X)^(-1) X'
H <- X %*% solve(t(X) %*% X) %*% t(X)
H
##               [,1]         [,2] [,3]         [,4]          [,5]
## [1,]  6.000000e-01 4.000000e-01  0.2 2.220446e-16 -2.000000e-01
## [2,]  4.000000e-01 3.000000e-01  0.2 1.000000e-01  1.110223e-16
## [3,]  2.000000e-01 2.000000e-01  0.2 2.000000e-01  2.000000e-01
## [4,]  1.665335e-16 1.000000e-01  0.2 3.000000e-01  4.000000e-01
## [5,] -2.000000e-01 3.330669e-16  0.2 4.000000e-01  6.000000e-01
# 3. Leverage = diag(H)
leverage <- diag(H)
leverage
## [1] 0.6 0.3 0.2 0.3 0.6
# Identifikasi leverage maksimum
max_lev <- max(leverage)
which_max_lev <- which.max(leverage)

list(beta_hat = beta_hat,
     leverage = leverage,
     max_leverage_value = max_lev,
     max_leverage_obs = which_max_lev)
## $beta_hat
##      [,1]
## [1,] 0.08
## [2,] 0.98
## 
## $leverage
## [1] 0.6 0.3 0.2 0.3 0.6
## 
## $max_leverage_value
## [1] 0.6
## 
## $max_leverage_obs
## [1] 5

GANDA

  1. VIF (Variance Inflation Factor) yang tinggi menunjukkan adanya multikolinearitas antar variabel prediktor. Ini berarti satu variabel prediktor dapat diprediksi dengan baik oleh variabel prediktor lainnya, yang menyebabkan koefisien regresi menjadi tidak stabil dan standar errornya membesar.

  2. Cook’s D digunakan untuk mengukur pengaruh suatu observasi terhadap model regresi. Nilai Cook’s D yang besar menunjukkan bahwa menghapus observasi tersebut akan secara signifikan mengubah hasil regresi.

  3. Dalam proses AR(1) (Autoregressive orde 1), kovarians antara \(\epsilon_t\) dan \(\epsilon_{t-k}\) adalah \(\sigma^2 \rho^k\), di mana \(\sigma^2\) adalah varians dan \(\rho\) adalah parameter korelasi. Hubungan ini menunjukkan bahwa galat yang terpisah sejauh \(k\) periode waktu akan memiliki kovarians yang menurun secara eksponensial seiring dengan bertambahnya jarak \(k\).

TUGAS BAB 2

TUGAS BAB 3