基于多因素的引导抽样

Question

我有一个类似这样的数据框：

   Factor1 Factor2      Value
1        A       1 -0.1169027
2        B       1  0.4153005
3        B       2 -1.8824073
4        B       3  0.2627502
5        C       1  0.8822784
6        C       2  0.5011568
7        C       3  0.2332566
8        C       4  0.1897866
9        C       5 -1.4404080
10       C       6  0.3414159

我感兴趣的是编写一段代码，该代码将根据 Factor2 中不同样本的最大数量存储在每个 Factor1 级别的新数据帧引导样本中。

library(tidyverse)    
sampleGroups <- df %>%
        group_by(Factor1) %>%
        select(Factor1, Factor2) %>%
        summarise(n_distinct(Factor2))
    sampleGroups ## max = 6

一旦在 Factor1 的每个级别内选择了 Factor2 的所有唯一级别后，需要对样本进行替换。

因此，上表的合适输出如下所示：

   Factor1 Factor2      Value
1        A       1 -0.1169027
2        A       1 -0.1169027
3        A       1 -0.1169027
4        A       1 -0.1169027
5        A       1 -0.1169027
6        A       1 -0.1169027
7        B       1  0.4153005
8        B       2  1.8824073
9        B       3  0.2627502
10       B       1  0.4153005
11       B       2 -1.8824073
12       B       2 -1.8824073
13       C       1  0.8822784
14       C       2  0.5011568
15       C       3  0.2332566
16       C       4  0.1897866
17       C       5 -1.4404080
18       C       6  0.3414159

你可以看到 Factor1 = A 被重复了 6 次，Factor1 = B 被重复了 6 次，但是 Factor1(B) 中的 Factor2 在选择了 Factor1(B) 中的所有级别的 Factor2 后被引导重复，然后Factor1(C) 被选择了 6 次，因为这是发现 Factor2 的唯一级别数量最多的地方。

我的真实数据集有 20 个级别的 Factor1，以及嵌套在 Factor1 中的 17 个不同级别的 Factor2。

这样的事情在 R 中很容易实现吗？也许使用 dplyr？我的代码会为 Factor1 的每个级别从 Factor2 中随机选择一个样本，但我无法弄清楚如何强制它为 Factor1 的每个级别选择所有级别的 Factor2 并替换（在必要时）。

dfBoot <- tibble(Bootstrap = integer(0), Factor1 = character(0), Factor2 = character(0))
for (i in 1:10) {
    selected <- df %>%
        group_by(Factor1) %>%
        select(Factor1, Factor2) %>%
        sample_n(1) %>%
        mutate(Bootstrap = i)
    dfBoot <- bind_rows(dfBoot, selected)
}
dfBoot
# A tibble: 30 x 3
   Bootstrap Factor1 Factor2
       <int> <chr>   <chr>  
 1         1 A       1      
 2         1 B       2      
 3         1 C       1      
 4         2 A       1      
 5         2 B       1      
 6         2 C       5      
 7         3 A       1      
 8         3 B       2      
 9         3 C       3      
10         4 A       1      
# ... with 20 more rows

并将replace = TRUE 添加到上面的sample_n 行中，会产生一个具有正确样本数的数据框，但是 Factor2 的每个级别都是随机采样的，我需要替换只发生一次 Factor2 的所有级别已经被选中了。

dfBoot <- tibble(Bootstrap = integer(0), Factor1 = character(0), Factor2 = character(0))
for (i in 1:10) {
    selected <- df %>%
        group_by(Factor1) %>%
        select(Factor1, Factor2) %>%
        # sample with replacement this time
        sample_n(6, replace = TRUE) %>%
        mutate(Bootstrap = i)
    dfBoot <- bind_rows(dfBoot, selected)
}

# A tibble: 180 x 3
   Bootstrap Factor1 Factor2
       <int> <chr>   <chr>  
 1         1 A       1      
 2         1 A       1      
 3         1 A       1      
 4         1 A       1      
 5         1 A       1      
 6         1 A       1      
 7         1 B       1      
 8         1 B       3      
 9         1 B       2      
10         1 B       2      
# ... with 170 more rows
dfBoot

Answer 1

这应该可以解决问题。这个想法是通过Factor1分割数据，然后rbind每个分割用一个重新采样，其大小为原始数据集中Factor1的最大数量与每个Factor1中的因子数量之差分裂。

df %>%
  mutate(max_n = max(Factor2)) %>%
  split(.$Factor1) %>%
  map_dfr(~rbind(., sample_n(., if(max(.$Factor2) == mean(.$max_n)) 0 else(mean(.$max_n) - max(.$Factor2)), replace = TRUE))) %>%
  select(-max_n)

#    Factor1 Factor2   Value
# 1        A       1 -0.1169
# 2        A       1 -0.1169
# 3        A       1 -0.1169
# 4        A       1 -0.1169
# 5        A       1 -0.1169
# 6        A       1 -0.1169
# 7        B       1  0.4153
# 8        B       2 -1.8824
# 9        B       3  0.2628
# 10       B       1  0.4153
# 11       B       1  0.4153
# 12       B       1  0.4153
# 13       C       1  0.8823
# 14       C       2  0.5012
# 15       C       3  0.2333
# 16       C       4  0.1898
# 17       C       5 -1.4404
# 18       C       6  0.3414