Utilizzando bootstrap sotto H0 per eseguire un test per la differenza di due mezzi: sostituzione all'interno dei gruppi o all'interno del campione in pool

Supponiamo che io abbia un dato con due gruppi indipendenti:

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)

È evidente che la dimensione del campione per gruppo è distorta in cui g1 ha 6 osservazioni e g2 ha 22 . L'ANOVA tradizionale suggerisce che i gruppi hanno mezzi diversi quando il valore critico è impostato su 0,05 (il valore p è 0,0044 ).

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

Dato che il mio obiettivo è confrontare la differenza media, dati sbilanciati e così piccoli campionati potrebbero dare risultati inappropriati con un approccio tradizionale. Pertanto, voglio eseguire il test di permutazione e il bootstrap.

TEST DI PERMUTAZIONE

L'ipotesi nulla (H0) afferma che i mezzi del gruppo sono gli stessi. Questa ipotesi nel test di permutazione è giustificata raggruppando i gruppi in un campione. Ciò garantisce che i campioni per due gruppi siano stati estratti dalla distribuzione identica. Ripetendo il campionamento (o più precisamente - rimescolamento) dai dati aggregati, le osservazioni vengono riallocate (mescolate) ai campioni in modo nuovo e viene calcolata la statistica del test. Eseguendo questa operazione n volte, verrà fornita la distribuzione campionaria delle statistiche del test partendo dal presupposto che H0 sia VERO. Alla fine, sotto H0, il valore p è probabilità che la statistica del test sia uguale o superiore al valore osservato.

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)

Il valore p riportato del test di permutazione è 0,0053 . OK, se l'ho fatto correttamente, permutazioni e ANOVA parametrico danno risultati quasi identici.

BOOTSTRAP

Prima di tutto, sono consapevole che bootstrap non può essere d'aiuto quando le dimensioni del campione sono troppo piccole. Questo post ha dimostrato che può essere anche peggio e fuorviante . Inoltre, il secondo ha evidenziato che il test di permutazione è generalmente migliore del bootstrap quando il test di ipotesi è l'obiettivo principale. Tuttavia, questo grande post affronta importanti differenze tra i metodi ad alta intensità di computer. Tuttavia, qui voglio sollevare (credo) una domanda diversa.

Consentitemi di introdurre innanzitutto l'approccio bootstrap più comune (Bootstrap1: ricampionamento all'interno dell'esempio in pool ):

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)

Il valore P del bootstrap eseguito in questo modo è 0,005 . Anche se questo sembra ragionevole e quasi identico all'ANOVA parametrico e al test di permutazione, è appropriato giustificare H0 in questo bootstrap sulla base del fatto che abbiamo appena unito i campioni da cui abbiamo estratto campioni successivi?

Approccio diverso che ho trovato in diversi articoli scientifici. In particolare, ho visto che i ricercatori modificano i dati per soddisfare H0 prima del bootstrap. Cercando in giro, ho trovato post molto interessanti in CV dove @ jan.s ha spiegato risultati insoliti di bootstrap nella domanda post in cui l'obiettivo era quello di confrontare due mezzi. Tuttavia, in quel post non è spiegato come eseguire bootstrap quando i dati vengono modificati prima di bootstrap. L'approccio in cui i dati vengono modificati prima del bootstrap è simile al seguente:

1. H0 afferma che i mezzi di due gruppi sono gli stessi
2. H0 è vero se sottraggiamo singole osservazioni dalla media del campione aggregato

In questo caso, la modifica dei dati dovrebbe influenzare i mezzi dei gruppi, e quindi la loro differenza, ma non la variazione all'interno (e tra) dei gruppi.

3. I dati modificati saranno la base per ulteriori bootstrap, con avvertenze che il campionamento viene effettuato all'interno di ciascun gruppo separatamente .
4. La differenza tra la media bootstpped di g1 e g2 viene calcolata e confrontata con la differenza osservata (non modificata) tra i gruppi.
5. La proporzione di valori uguali o più estremi di quella osservata divisa per il numero di iterazioni darà valore p.

Ecco il codice (Bootstrap2: ricampionamento all'interno dei gruppi dopo la modifica che H0 è VERO ):

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)

Tale bootstrap eseguito darà un valore di p di 0,514 che è tremendamente diverso rispetto ai test precedenti. Credo che questo abbia a che fare con la spiegazione di @ jan.s , ma non riesco a capire dove sia la chiave ...

Ecco la mia opinione, basata sul capitolo 16 di An Introduction to the bootstrap di Efron e Tibshirani (pagina 220-224). Il fatto è che il tuo secondo algoritmo bootstrap è stato implementato in modo errato, ma l'idea generale è corretta.

Quando si eseguono test bootstrap, è necessario assicurarsi che il metodo di ricampionamento generi dati che corrispondono all'ipotesi nulla. Userò i dati del sonno in R per illustrare questo post. Nota che sto usando la statistica del test studentizzato piuttosto che solo la differenza di mezzi, che è raccomandata dal libro di testo.

Il classico test t, che utilizza un risultato analitico per ottenere informazioni sulla distribuzione campionaria della statistica t, produce il seguente risultato:

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

Questa volta abbiamo finito con valori p simili per i tre approcci. Spero che sia di aiuto!