R：组内采样相等的 Ns

Question

我有一个数据集，其中观察结果被分为组和子组以及类型。 以下是此类数据的示例：

data <- data.frame(group    = sample(c(1:30),    10000, replace = TRUE),
                   subgroup = sample(c(1:100),   10000, replace = TRUE),
                   type    = sample(c("A", "B"), 10000, replace = TRUE),
                   value   = sample(c(1:100),    10000, replace = TRUE))

我需要在组和子组的每个组合内对每种类型的相等 N 进行采样。

在这个例子中，以及在实际数据中，组+子组+类型的许多组合都是空的。 N = 0 的此类组合将被删除。

我的解决方案如下：

---

首先，我找到每个组和子组要采样的 N 个。我计算每个组合中有多少个 A 和 B，然后选择较小的数字：

library(tidyverse)

n_to_sample <- data %>%
  group_by(group, subgroup, type) %>% 
  summarise(n = n()) %>%
  pivot_wider(id_cols = c("group", "subgroup"),
              names_from =  "type",
              values_from = "n") %>%
  rowwise() %>%
  mutate(lowestN = min(A, B)) %>%
  ungroup() %>% 
  filter(!is.na(lowestN)) %>%
  select (group, subgroup, lowestN)

其次，我根据之前计算的 Ns 对观察结果进行抽样：

data_sampled <- data %>%
  left_join(n_to_sample, by = c("group", "subgroup")) %>% 
  filter(!is.na(lowestN)) %>%
  arrange(group, type) %>%
  filter(row_number() %in% c(sample(which(type == "A"), mean(lowestN)),
                             sample(which(type == "B"), mean(lowestN))),
         .by = c("group", "subgroup")) 

为了验证该过程，我检查组+子组+类型的每个组合中还剩下多少个观察值：

data %>%
  count(group, type, subgroup) %>%
  arrange(group, subgroup, type) %>%
  pivot_wider(id_cols = c("group", "subgroup"),
              names_from =  "type",
              values_from = "n")

但是，此检查会导致计数变量中存在许多 NA。所以我的解决方案并不成功。 我哪里做错了？ 我可以做什么来纠正它？

（注意：我对效率不太感兴趣，效率可能会更好。我只是希望它能正常工作）

Answer 1

这是一种可能的方法，在计算每个组、子组和类型的

lowestN

后。然后我按这些变量分割数据，绘制样本并绑定。

注意：我删除了您的示例数据以使其更加简洁。

set.seed(1)

n <- 20
data <- data.frame(
  group = sample(c(1:2), n, replace = TRUE),
  subgroup = sample(c(1:2), n, replace = TRUE),
  type = sample(c("A", "B"), n, replace = TRUE),
  value = sample(c(1:100), n, replace = TRUE)
)

library(dplyr, warn = FALSE)

data |>
  add_count(group, subgroup, type, name = "lowestN") |>
  mutate(
    lowestN = if (length(unique(type)) == 2) min(lowestN) else NA,
    .by = c(group, subgroup)
  ) |>
  filter(!is.na(lowestN)) |> 
  split(~ group + subgroup + type, drop = TRUE) |>
  lapply(\(x) {
    x[sample(nrow(x), size = unique(x$lowestN)), ]
  }) |>
  bind_rows() |> 
  arrange(group, subgroup, type)
#>    group subgroup type value lowestN
#> 1      1        1    A     6       2
#> 2      1        1    A    70       2
#> 3      1        1    B    70       2
#> 4      1        1    B    51       2
#> 5      1        2    A    40       2
#> 6      1        2    A    65       2
#> 7      1        2    B     2       2
#> 8      1        2    B    87       2
#> 9      2        1    A    18       2
#> 10     2        1    A    75       2
#> 11     2        1    B    32       2
#> 12     2        1    B    42       2
#> 13     2        2    A    22       1
#> 14     2        2    B    81       1