Menggunakan bootstrap di bawah H0 untuk melakukan tes untuk perbedaan dua cara: penggantian dalam kelompok atau dalam sampel yang dikumpulkan

Misalkan saya memiliki data dengan dua grup independen:

g1.lengths <- c (112.64, 97.10, 84.18, 106.96, 98.42, 101.66)

g2.lengths <- c (84.44, 82.10, 83.26, 81.02, 81.86, 86.80, 
                     85.84, 97.08, 79.64, 83.32, 91.04, 85.92,
                     73.52, 85.58, 97.70, 89.72, 88.92, 103.72,
                     105.02, 99.48, 89.50, 81.74)

group = rep (c ("g1", "g2"), c (length (g1.lengths), length (g2.lengths)))

lengths = data.frame( lengths = c(g1.lengths, g2.lengths), group)

Jelas bahwa ukuran sampel per kelompok bias di mana g1 memiliki 6 pengamatan dan g2 memiliki 22 . ANOVA tradisional menunjukkan bahwa kelompok memiliki cara yang berbeda ketika nilai kritis diatur ke 0,05 (nilai p 0,0044 ).

summary (aov (lengths~group, data = lengths))  

Mengingat bahwa tujuan saya adalah untuk membandingkan perbedaan rata-rata, data sampel yang tidak seimbang dan kecil seperti itu mungkin memberikan hasil yang tidak sesuai dengan pendekatan tradisional. Oleh karena itu, saya ingin melakukan tes permutasi dan bootstrap.

UJI PERMUTASI

Hipotesis nol (H0) menyatakan bahwa rata-rata kelompok adalah sama. Asumsi ini dalam uji permutasi dibenarkan dengan menggabungkan kelompok menjadi satu sampel. Ini memastikan bahwa sampel untuk dua kelompok diambil dari distribusi yang sama. Dengan pengambilan sampel berulang (atau lebih tepatnya - perombakan ulang) dari data yang dikumpulkan, pengamatan dialokasikan kembali (dikocok) ke sampel dengan cara baru, dan statistik uji dihitung. Dengan melakukan ini sebanyak n kali, akan memberikan distribusi sampling dari statistik uji dengan asumsi di mana H0 BENAR. Pada akhirnya, di bawah H0, nilai p adalah probabilitas bahwa statistik uji sama atau melebihi nilai yang diamati.

s.size.g1 <- length (g1.lengths)
s.size.g2 <- length (g2.lengths)

pool <- lengths$lengths
obs.diff.p <- mean (g1.lengths) - mean (g2.lengths)
iterations <- 10000
sampl.dist.p <- NULL

set.seed (5)
for (i in 1 : iterations) {
        resample <- sample (c(1:length (pool)), length(pool))

        g1.perm = pool[resample][1 : s.size.g1]
        g2.perm = pool[resample][(s.size.g1+1) : length(pool)]
        sampl.dist.p[i] = mean (g1.perm) - mean (g2.perm) 
}
p.permute <- (sum (abs (sampl.dist.p) >= abs(obs.diff.p)) + 1)/ (iterations+1)

Nilai p yang dilaporkan dari uji permutasi adalah 0,0053 . OK, jika saya melakukannya dengan benar, permutasi dan parametrik ANOVA memberikan hasil yang hampir sama.

BOOTSTRAP

Pertama-tama, saya sadar bahwa bootstrap tidak dapat membantu ketika ukuran sampel terlalu kecil. Posting ini menunjukkan bahwa itu bisa lebih buruk dan menyesatkan . Juga, yang kedua menyoroti bahwa uji permutasi umumnya lebih baik daripada bootstrap ketika pengujian hipotesis adalah tujuan utama. Meskipun demikian, tulisan hebat ini membahas perbedaan penting di antara metode intensif komputer. Namun, di sini saya ingin mengajukan (saya percaya) pertanyaan yang berbeda.

Biarkan saya memperkenalkan pendekatan bootstrap yang paling umum terlebih dahulu (Bootstrap1: resampling dalam sampel yang dikumpulkan ):

s.size.g1 <- length (g1.lengths)
s.size.g2 <- length (g2.lengths)

pool <- lengths$lengths
obs.diff.b1 <- mean (g1.lengths) - mean (g2.lengths)
iterations <- 10000
sampl.dist.b1 <- NULL

set.seed (5)
for (i in 1 : iterations) {
        resample <- sample (c(1:length (pool)), length(pool), replace = TRUE) 
        # "replace = TRUE" is the only difference between bootstrap and permutations

        g1.perm = pool[resample][1 : s.size.g1]
        g2.perm = pool[resample][(s.size.g1+1) : length(pool)]
        sampl.dist.b1[i] = mean (g1.perm) - mean (g2.perm) 
}
p.boot1 <- (sum (abs (sampl.dist.b1) >= obs.diff.b1) + 1)/ (iterations+1)

Nilai P bootstrap yang dilakukan dengan cara ini adalah 0,005 . Meskipun ini terdengar masuk akal dan hampir identik dengan parametrik ANOVA dan uji permutasi, apakah pantas untuk membenarkan H0 dalam bootstrap ini dengan dasar bahwa kami hanya mengumpulkan sampel dari mana kami mengambil sampel berikutnya?

Pendekatan berbeda saya temukan di beberapa makalah ilmiah. Secara khusus, saya melihat bahwa para peneliti memodifikasi data untuk memenuhi H0 sebelum bootstrap. Mencari di sekitar, saya telah menemukan posting yang sangat menarik di CV di mana @ jan.s menjelaskan hasil bootstrap yang tidak biasa dalam pertanyaan posting di mana tujuannya adalah untuk membandingkan dua cara. Namun, dalam posting itu tidak dibahas bagaimana melakukan bootstrap ketika data dimodifikasi sebelum bootstrap. Pendekatan tempat data diubah sebelum bootstrap terlihat seperti ini:

1. H0 menyatakan bahwa rata-rata dua kelompok adalah sama
2. H0 berlaku jika kita mengurangi pengamatan individu dari rata-rata sampel yang dikumpulkan

Dalam hal ini, modifikasi data harus memengaruhi rata-rata kelompok, dan karenanya perbedaannya, tetapi bukan variasi di dalam (dan di antara) kelompok.

3. Data yang dimodifikasi akan menjadi dasar untuk bootstrap lebih lanjut, dengan peringatan bahwa pengambilan sampel dilakukan dalam setiap kelompok secara terpisah .
4. Perbedaan antara rata-rata bootstrap dari g1 dan g2 dihitung dan dibandingkan dengan perbedaan yang diamati (tidak dimodifikasi) antara kelompok.
5. Proporsi nilai yang sama atau lebih ekstrem daripada yang diamati yang dibagi dengan jumlah iterasi akan memberikan nilai p.

Berikut adalah kode (Bootstrap2: resampling dalam grup setelah modifikasi bahwa H0 BENAR ):

s.size.g1 <- length (g1.lengths)
s.size.g2 <- length (g2.lengths)

pool <- lengths$lengths
obs.diff.b2 <- mean (g1.lengths) - mean (g2.lengths)

# make H0 to be true (no difference between means of two groups)
H0 <- pool - mean (pool)

# g1 from H0 
g1.H0 <- H0[1:s.size.g1] 

# g2 from H0
g2.H0 <- H0[(s.size.g1+1):length(pool)]

iterations <- 10000
sampl.dist.b2 <- NULL

set.seed (5)
for (i in 1 : iterations) {
        # Sample with replacement in g1
        g1.boot = sample (g1.H0, replace = T)

        # Sample with replacement in g2
        g2.boot = sample (g2.H0, replace = T)

        # bootstrapped difference
        sampl.dist.b2[i] <- mean (g1.boot) - mean (g2.boot)  
}
p.boot2 <- (sum (abs (sampl.dist.b2) >= obs.diff.b2) + 1)/ (iterations+1)

Bootstrap yang dilakukan seperti itu akan memberikan nilai p 0,514 yang sangat berbeda dibandingkan dengan tes sebelumnya. Saya percaya bahwa ini harus berurusan dengan penjelasan @ jan.s , tapi saya tidak tahu di mana kuncinya ...

Inilah pendapat saya tentang hal ini, berdasarkan bab 16 dari Pengantar Efron dan Tibshirani tentang Bootstrap (halaman 220-224). Pendeknya adalah bahwa algoritma bootstrap kedua Anda diimplementasikan secara salah, tetapi ide umumnya benar.

Ketika melakukan tes bootstrap, kita harus memastikan bahwa metode re-sampling menghasilkan data yang sesuai dengan hipotesis nol. Saya akan menggunakan data tidur dalam R untuk menggambarkan posting ini. Perhatikan bahwa saya menggunakan statistik uji siswa daripada hanya perbedaan cara, yang direkomendasikan oleh buku teks.

Uji-t klasik, yang menggunakan hasil analisis untuk memperoleh informasi tentang distribusi sampling t-statistik, menghasilkan hasil sebagai berikut:

x <- sleep$extra[sleep$group==1] y <- sleep$extra[sleep$group==2]
t.test(x,y)
t = -1.8608, df = 17.776, p-value = 0.07939

$n1$$n2$

# pooled sample, assumes equal variance
pooled <- c(x,y)
for (i in 1:10000){
  sample.index <- sample(c(1:length(pooled)),replace=TRUE)
  sample.x <- pooled[sample.index][1:length(x)]
  sample.y <- pooled[sample.index][-c(1:length(y))]
  boot.t[i] <- t.test(sample.x,sample.y)$statistic
}
p.pooled <-  (1 + sum(abs(boot.t) > abs(t.test(x,y)$statistic))) / (10000+1) 
p.pooled
[1] 0.07929207

$H_0$$H_0$$H_0$$\bar{z}$

$\tilde{x}/\tilde{y}$$\bar{z}$$H_0$

# sample from H0 separately, no assumption about equal variance
xt <- x - mean(x) + mean(sleep$extra) #
yt <- y - mean(y) + mean(sleep$extra)

boot.t <- c(1:10000)
for (i in 1:10000){
  sample.x <- sample(xt,replace=TRUE)
  sample.y <- sample(yt,replace=TRUE)
  boot.t[i] <- t.test(sample.x,sample.y)$statistic
}
p.h0 <-  (1 + sum(abs(boot.t) > abs(t.test(x,y)$statistic))) / (10000+1)  # 
p.h0
[1] 0.08049195

Kali ini kami berakhir dengan nilai-p yang sama untuk tiga pendekatan. Semoga ini membantu!