使用H0下的引导程序来测试两种方法之间的差异：在组内还是在合并样本中进行替换

假设我有一个包含两个独立组的数据：

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)

显然，每组的样本量存在偏差，其中g1有6个观测值，g2有22 个观测值。传统的方差分析表明，当临界值设置为0.05（p值为0.0044）时，组具有不同的平均值。

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

鉴于我的目的是比较均值差异，因此这种不平衡且样本量较小的数据可能会与传统方法产生不合适的结果。因此，我要执行置换测试和引导程序。

置换测试

空假设（H0）表示组的均值相同。置换测试中的这一假设是通过将组合并到一个样本中来证明的。这样可以确保从相同的分布中抽取两组样本。通过从合并的数据中重复采样（或更准确地说是重新组合），可以以新的方式将观测值重新分配（重新组合）到样本中，并计算测试统计量。执行此n次，将在假设H0为TRUE的假设下给出测试统计信息的采样分布。最后，在H0下，p值是检验统计量等于或超过观察值的概率。

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)

报告的置换检验的p值为0.0053。好的，如果我做对了，排列和参数方差分析将得出几乎相同的结果。

自举

首先，我知道当样本量太小时，引导程序无济于事。这篇文章表明，情况可能更糟，而且会产生误导。另外，第二篇文章强调了以假设检验为主要目标时，置换检验通常比自举更好。尽管如此，这篇出色的文章解决了计算机密集型方法之间的重要差异。但是，我想在这里提出（我相信）一个不同的问题。

让我首先介绍最常见的引导方法（Bootstrap1：在合并样本中进行重采样）：

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)

以这种方式执行的自举的P值为0.005。即使这听起来合理且几乎与参数方差分析和置换测试相同，但在我们只是合并了样本并从中抽取后续样本的基础上，是否有必要在此自举中对H0进行证明呢？

我在几篇科学论文中发现了不同的方法。具体来说，我看到研究人员修改了数据，以便在引导之前达到H0。到处搜索，我在CV中发现了一个非常有趣的帖子，其中@ jan.s在帖子问题中解释了引导程序的异常结果，目的是比较两种方法。但是，在那篇文章中没有介绍在引导之前修改数据时如何执行引导。引导之前修改数据的方法如下所示：

1. H0表示两组的均值相同
2. 如果我们从合并样本的平均值中减去单个观察值，则H0成立

在这种情况下，数据的修改应影响组的均值，从而影响其均值，但不会影响组内（组之间）的差异。

3. 修改后的数据将作为进一步引导的基础，但需要注意的是，每个组中分别进行采样。
4. 计算g1和g2的自举平均值之间的差异，并将其与组之间观察到的（未修改的）差异进行比较。
5. 等于或大于所观察到的极值的比例除以迭代次数将得到p值。

这是代码（Bootstrap2：修改后的H0为TRUE后在组内重采样）：

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)

这样执行的自举将给出0.514的 p值，与先前的测试相比有很大不同。我相信这必须处理@ jan.s的解释，但是我不知道关键在哪里...

这是我的看法，它是基于Efron和Tibshirani的“ bootstrap简介”（第220-224页）的第16章。简而言之，您的第二个引导算法执行有误，但总体思路是正确的。

在进行自举测试时，必须确保重新采样方法生成的数据与原假设相对应。我将使用R中的sleep数据来说明这篇文章。请注意，我使用的是学生化的测试统计数据，而不仅仅是教科书建议的均值差异。

经典t检验使用分析结果来获取有关t统计量的抽样分布的信息，得出以下结果：

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

这次，我们得出了三种方法的相似p值。希望这可以帮助！