Bootstrap pada Regresi dan Missing Value

Praktikum Keg 8-Bootstrap pada Regresi dan Missing Value

Pendahuluan

Dalam analisis statistik, sering kali diperlukan penilaian terhadap tingkat keandalan suatu estimasi. Namun, asumsi klasik seperti normalitas residual atau homogenitas varians tidak selalu terpenuhi.

Metode bootstrap menjadi salah satu alternatif nonparametrik yang tidak bergantung pada bentuk distribusi data, sehingga sangat bermanfaat untuk mengukur ketidakpastian estimasi, seperti standard error, interval kepercayaan, dan ukuran lainnya.

Konsep Boostrap

Bootstrap merupakan teknik resampling, yaitu membentuk banyak sampel baru dari data asli melalui pengambilan ulang secara acak dengan pengembalian.

Langkah-langkah bootstrap meliputi: mengambil sampel acak dari data awal dengan ukuran yang sama, menghitung statistik yang diinginkan (misalnya koefisien regresi), mengulangi proses tersebut sebanyak R kali (misalnya 1000 kali), lalu menggunakan distribusi hasil bootstrap untuk memperoleh standard error atau interval kepercayaan.

Dalam analisis regresi, bootstrap dimanfaatkan untuk memperkirakan distribusi sampling koefisien regresi serta membentuk confidence interval tanpa memerlukan asumsi normalitas residual.

Pada data yang memiliki missing value, bootstrap juga dapat digunakan untuk menghasilkan banyak dataset hasil imputasi dan menilai ketidakpastian dari proses imputasi tersebut.

Praktikum

# Dataset Simulasi
set.seed(123)

# Jumlah observasi
n <- 100

# Generate variabel x
x <- rnorm(n, mean = 10, sd = 2)

# Generate variabel y
y <- 3 + 1.5 * x + rnorm(n, mean = 0, sd = 2)

# Gabungkan data
data <- data.frame(x, y)

# Missing value pada x
data[sample(1:n, 10), "x"] <- NA

# Lihat data
head(data)

##           x        y
## 1  8.879049 14.89776
## 2  9.539645 17.82323
## 3 13.117417 22.18274
## 4 10.141017 17.51644
## 5 10.258575 16.48463
## 6 13.430130 23.05514

Praktikum 1: Bootstrap untuk Regresi (tanpa missing)

# Hapus missing value
clean_data <- na.omit(data)

# Fungsi bootstrap regresi
boot_regression <- function(data, indices){

  d <- data[indices, ]

  model <- lm(y ~ x, data = d)

  return(coef(model))
}

library(boot)

## Warning: package 'boot' was built under R version 4.5.3

# Bootstrap 1000 kali
boot_result <- boot(
  data = clean_data,
  statistic = boot_regression,
  R = 1000
)

boot_result

## 
## ORDINARY NONPARAMETRIC BOOTSTRAP
## 
## 
## Call:
## boot(data = clean_data, statistic = boot_regression, R = 1000)
## 
## 
## Bootstrap Statistics :
##     original      bias    std. error
## t1* 3.581084  0.06067069   1.1482885
## t2* 1.412127 -0.00547455   0.1074228

# Plot bootstrap
plot(boot_result)

# Confidence interval 95%
boot.ci(
  boot_result,
  type = "perc",
  index = 2
)

## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 1000 bootstrap replicates
## 
## CALL : 
## boot.ci(boot.out = boot_result, type = "perc", index = 2)
## 
## Intervals : 
## Level     Percentile     
## 95%   ( 1.176,  1.596 )  
## Calculations and Intervals on Original Scale

Pada praktikum pertama, analisis dilakukan menggunakan data yang telah dibersihkan dari missing value dengan fungsi na.omit(). Selanjutnya diterapkan metode bootstrap sebanyak 1000 replikasi untuk mengestimasi koefisien regresi.

Hasil menunjukkan nilai intersep sebesar 3.581 dan koefisien slope variabel x sebesar 1.412. Artinya, setiap kenaikan 1 satuan pada variabel x diperkirakan akan meningkatkan nilai y sebesar 1.412 satuan. Nilai ini cukup dekat dengan model awal pembangkitan data, yaitu y=3+1.5x+error, sehingga model berhasil menangkap hubungan linear antar variabel.

Nilai standard error slope sebesar 0.107 menunjukkan bahwa estimasi koefisien cukup stabil. Selain itu, interval kepercayaan 95% untuk slope berada pada kisaran (1.176 , 1.596), yang berarti nilai koefisien sebenarnya diperkirakan berada dalam rentang tersebut. Karena interval tidak memuat nol, maka variabel x berpengaruh signifikan terhadap y.

Praktikum 2: Estimasi pada Missing Value dengan Bootstrap

# Mean x tanpa NA
mean_x <- mean(
  data$x,
  na.rm = TRUE
)

# Imputasi mean
data$ximp <- ifelse(
  is.na(data$x),
  mean_x,
  data$x
)

# Model regresi
model_imp <- lm(
  y ~ ximp,
  data = data
)

summary(model_imp)

## 
## Call:
## lm(formula = y ~ ximp, data = data)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.1153 -1.4394 -0.0902  1.2053  6.5280 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   3.6538     1.2332   2.963  0.00383 ** 
## ximp          1.4121     0.1191  11.854  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.109 on 98 degrees of freedom
## Multiple R-squared:  0.5891, Adjusted R-squared:  0.5849 
## F-statistic: 140.5 on 1 and 98 DF,  p-value: < 2.2e-16

# Fungsi bootstrap imputasi
boot_imp <- function(data, indices){

  d <- data[indices, ]

  model <- lm(
    y ~ ximp,
    data = d
  )

  return(coef(model))
}

# Bootstrap imputasi
boot_result_imp <- boot(
  data = data,
  statistic = boot_imp,
  R = 1000
)

boot_result_imp

## 
## ORDINARY NONPARAMETRIC BOOTSTRAP
## 
## 
## Call:
## boot(data = data, statistic = boot_imp, R = 1000)
## 
## 
## Bootstrap Statistics :
##     original       bias    std. error
## t1* 3.653794  0.053055397   1.1350004
## t2* 1.412127 -0.005093136   0.1064137

# Plot bootstrap imputasi
plot(boot_result_imp)

# Confidence interval
boot.ci(
  boot_result_imp,
  type = "perc",
  index = 2
)

## BOOTSTRAP CONFIDENCE INTERVAL CALCULATIONS
## Based on 1000 bootstrap replicates
## 
## CALL : 
## boot.ci(boot.out = boot_result_imp, type = "perc", index = 2)
## 
## Intervals : 
## Level     Percentile     
## 95%   ( 1.188,  1.603 )  
## Calculations and Intervals on Original Scale

Pada praktikum kedua, nilai hilang pada variabel x diatasi menggunakan metode mean imputation, yaitu mengganti seluruh nilai NA dengan rata-rata x. Setelah imputasi, dilakukan regresi linear dan bootstrap sebanyak 1000 kali.

Hasil menunjukkan intersep sebesar 3.654 dan slope sebesar 1.412. Nilai slope hampir sama dengan praktikum pertama, menandakan hubungan x terhadap y tetap konsisten meskipun terdapat imputasi data hilang.

Namun, standard error slope meningkat menjadi 0.119, lebih besar dibanding data lengkap. Hal ini menunjukkan adanya tambahan ketidakpastian akibat imputasi sederhana. Interval kepercayaan 95% berada pada rentang (1.188 , 1.603) dan tetap tidak memuat nol, sehingga pengaruh x terhadap y masih signifikan.

Metode mean imputation memang mudah diterapkan, tetapi cenderung mengurangi variasi data karena nilai hilang diganti dengan angka yang sama. Akibatnya, hasil estimasi bisa sedikit bias.

Praktikum 3: Multiple Imputation + Bootstrap

library(mice)

## Warning: package 'mice' was built under R version 4.5.3

## 
## Attaching package: 'mice'

## The following object is masked from 'package:stats':
## 
##     filter

## The following objects are masked from 'package:base':
## 
##     cbind, rbind

# Multiple imputation
imp <- mice(
  data[, c("x", "y")],
  m = 5,
  method = "pmm",
  seed = 123
)

## 
##  iter imp variable
##   1   1  x
##   1   2  x
##   1   3  x
##   1   4  x
##   1   5  x
##   2   1  x
##   2   2  x
##   2   3  x
##   2   4  x
##   2   5  x
##   3   1  x
##   3   2  x
##   3   3  x
##   3   4  x
##   3   5  x
##   4   1  x
##   4   2  x
##   4   3  x
##   4   4  x
##   4   5  x
##   5   1  x
##   5   2  x
##   5   3  x
##   5   4  x
##   5   5  x

# Data imputasi
imp_data <- complete(
  imp,
  "long"
)

# Model tiap imputasi
model_mi <- with(
  imp,
  lm(y ~ x)
)

summary(pool(model_mi))

##          term estimate std.error statistic       df      p.value
## 1 (Intercept) 3.619991 1.1112706  3.257524 78.99385 1.657655e-03
## 2           x 1.408248 0.1068028 13.185496 78.10532 1.472407e-21

Pada praktikum ketiga digunakan metode Multiple Imputation by Chained Equations (MICE) dengan pendekatan Predictive Mean Matching. Metode ini membuat beberapa dataset imputasi, kemudian hasil model digabungkan.

Diperoleh intersep sebesar 3.620 dan slope sebesar 1.408. Nilai slope sangat dekat dengan dua metode sebelumnya, menunjukkan hubungan linear x terhadap y tetap kuat dan konsisten.

Nilai standard error slope sebesar 0.107, hampir sama dengan praktikum pertama dan lebih kecil dibanding mean imputation. Hal ini menunjukkan bahwa metode MICE mampu mempertahankan variabilitas data dengan lebih baik.

Interval kepercayaan 95% untuk slope sebesar (1.196 , 1.621) juga tidak memuat nol, sehingga x tetap berpengaruh signifikan terhadap y.

Metode MICE dinilai lebih baik dibanding mean imputation karena mempertimbangkan pola hubungan antar variabel saat mengisi data hilang, sehingga hasil estimasi lebih realistis.

Gabungan Hasil

library(broom)

## Warning: package 'broom' was built under R version 4.5.3

# Model data lengkap
model_clean <- lm(
  y ~ x,
  data = clean_data
)

clean_summary <- tidy(
  model_clean,
  conf.int = TRUE
)

# Bootstrap CI
boot_ci <- boot.ci(
  boot_result_imp,
  type = "perc",
  index = 2
)

boot_summary <- tidy(
  model_imp,
  conf.int = TRUE
)

# Ringkasan MICE
model_mice <- with(
  imp,
  lm(y ~ x)
)

mice_summary <- summary(
  pool(model_mice),
  conf.int = TRUE
)

# Tabel hasil
results_table <- data.frame(

  Metode = c(
    "Data Lengkap",
    "Mean Imputation + Bootstrap",
    "MICE"
  ),

  Intercept = c(
    clean_summary$estimate[1],
    boot_summary$estimate[1],
    mice_summary$estimate[1]
  ),

  Slope = c(
    clean_summary$estimate[2],
    boot_summary$estimate[2],
    mice_summary$estimate[2]
  ),

  SE_Slope = c(
    clean_summary$std.error[2],
    boot_summary$std.error[2],
    mice_summary$std.error[2]
  ),

  CI_Slope = c(
    sprintf(
      "(%.3f, %.3f)",
      clean_summary$conf.low[2],
      clean_summary$conf.high[2]
    ),

    sprintf(
      "(%.3f, %.3f)",
      boot_ci$percent[4],
      boot_ci$percent[5]
    ),

    sprintf(
      "(%.3f, %.3f)",
      mice_summary$`2.5 %`[2],
      mice_summary$`97.5 %`[2]
    )
  ),

  stringsAsFactors = FALSE
)

print(results_table)

##                        Metode Intercept    Slope  SE_Slope       CI_Slope
## 1                Data Lengkap  3.581084 1.412127 0.1079083 (1.198, 1.627)
## 2 Mean Imputation + Bootstrap  3.653794 1.412127 0.1191314 (1.188, 1.603)
## 3                        MICE  3.619991 1.408248 0.1068028 (1.196, 1.621)

# Visualisasi

library(ggplot2)

## Warning: package 'ggplot2' was built under R version 4.5.3

results <- data.frame(

  Method = c(
    "Data Lengkap",
    "Mean Imp + Bootstrap",
    "MICE"
  ),

  Slope = c(
    1.412127,
    1.412127,
    1.408248
  ),

  SE = c(
    0.1079083,
    0.1191314,
    0.1068028
  ),

  CI_lower = c(
    1.198,
    1.188,
    1.196
  ),

  CI_upper = c(
    1.627,
    1.603,
    1.621
  )
)

ggplot(
  results,
  aes(
    x = Method,
    y = Slope,
    color = Method
  )
) +
geom_point(size = 3) +
geom_errorbar(
  aes(
    ymin = CI_lower,
    ymax = CI_upper
  ),
  width = 0.2
) +
labs(
  title = "Perbandingan Estimasi Slope",
  y = "Estimasi Slope (y ~ x)"
) +
theme_minimal()

Kesimpulan Umum

Ketiga metode menghasilkan nilai slope yang hampir sama, yaitu sekitar 1.41, sehingga hubungan antara x dan y tergolong stabil meskipun terdapat data hilang.

Praktikum 1 (Data Lengkap) memberikan hasil paling murni karena tanpa imputasi. Praktikum 2 (Mean Imputation) mudah dilakukan, tetapi menambah ketidakpastian dan berpotensi bias. Praktikum 3 (MICE) memberikan hasil paling baik untuk data hilang karena mempertahankan variasi data dan menghasilkan estimasi yang lebih akurat.