r - 在不分离分组变量的情况下均匀拆分数据框

Question

我有一个类似于下面的数据框:

library(tidyverse)
set.seed(4214)

df <- data.frame(value = sample(x = 1:50, 70, replace = TRUE),
                 group = sample(x = letters, 70, replace = TRUE),
                 stringsAsFactors = FALSE) %>% 
  as_tibble() %>% 
  arrange(group)

group 是我的分组变量，每个值以不同的频率出现(例如 group == "a" 出现 5 次，group == "b" 出现 6 次，等等)。

我需要将此数据尽可能均匀地拆分为 n = 9 子集数据帧。但是，要注意的是我不能在子集之间拆分相同的分组变量。例如，group == "b" 不能同时出现在子集 1 和子集 2 中。

n <- 9
df %>% 
  mutate(divider = rep(x = 1:n, 
                       each = ceiling(nrow(.)/n), 
                       length.out = nrow(.))) %>%
  split(.$divider)

我在这里创建了一个 divider 列，希望将数据拆分成子集。但是 group 的给定值可能有两个不同的 divider 值。因此，分组变量在此处的子集之间进行划分。我一直在尝试使用 nest 和 lag 来改进这一点，但到目前为止都没有成功。

我知道子集不会有相同的行号，但我希望像下面这样:

$`1`
# A tibble: 11 x 3
  value group divider
  <int> <chr>   <int>
1    43 a           1
2    22 a           1
3     1 a           1
4     5 a           1
5     4 a           1
6    18 b           1
7    32 b           1
8    33 b           1
9    47 b           1
10   43 b           1
11   35 b           1

$`2`
# A tibble: 6 x 3
  value group divider
  <int> <chr>   <int>
1    24 c           2
2     3 d           2
3    12 d           2
4    13 e           2
5     6 e           2
6    45 f           2

$`3`
...

Answer 1

一种方法(但这取决于您的数据的顺序)是按组计算实例，并用最接近您想要的组数的整数将它们分开。

如果您需要 9 个组，请将累积频率相加并除以 9。取整数并将其用作数据集的新拆分变量

dftab <- as.data.frame(table(df$group)) %>%
  mutate(nobs = cumsum(Freq),
         newgrouping = ceiling(nobs/9)) %>%
  group_by(newgrouping ) %>%
  summarise(number_obs = sum(Freq))

dftab

# A tibble: 8 x 2
  newgrouping number_obs
        <dbl>      <int>
1           1          5
2           2         12
3           3          9
4           4         10
5           5          9
6           6          7
7           7         11
8           8          7

至于“尽可能均匀”，我们可以对跨组观测值的标准差进行愚蠢的优化。在这里，依靠组变量的排序有助于此过程。

set.seed(4214)

df <- data.frame(value = sample(x = 1:50, 70, replace = TRUE),
                 group = sample(x = letters, 70, replace = TRUE),
                 stringsAsFactors = FALSE) %>% 
  as_tibble() %>% 
  arrange(group)


store_group <- list()
store_sd <- NA_integer_

for(i in 1:1000){

  dftab <- table(df$group) %>%
    as.data.frame() %>% 

    # important step is to shuffle the group variable every iteration
    mutate(group = factor(Var1, levels = df$group %>%
                            unique %>%
                            sample)) %>%
    arrange(group) %>%

    mutate(nobs = cumsum(Freq),
           newgrouping = ceiling(nobs/9)) %>%

    select(newgrouping, group, Freq)

  store_group[[i]] <- dftab

  df_sd <- dftab %>%
    group_by(newgrouping) %>%
    summarise(number_obs = sum(Freq))

  store_sd[i] <- sd(df_sd$number_obs)
}

结果是

store_group[[which.min(store_sd)]] %>%
       group_by(newgrouping) %>%
       summarise(number_obs = sum(Freq))

  newgrouping number_obs
        <dbl>      <int>
1           1          9
2           2          9
3           3          9
4           4          8
5           5          9
6           6          9
7           7          8
8           8          9

其中 store_group[[which.min(store_sd)]] 具有可能具有“最佳”分组的原始数据(给定循环中的迭代次数)而没有相同的 当您通过 newgrouping 变量

拆分它们时，跨数据集分组