Равномерное разбиение кадра данных без разделения группирующей переменной

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

Предполагая, что вам нужно алфавитное решение, как показано в ожидаемом результате; Вы могли бы округлить cumsum s, деленное на желаемое количество разбиений (то есть 9), что должно изменить потолок и пол и распределить группы более равномерно. В результате получается вектор x с индикаторами разделения, назначенными каждой категории вашей переменной group. x, разделенный сам по себе, затем дает список, на который можно разделить фрейм данных с помощью lapply.

x <- round(cumsum(table(dat$group)) / (nrow(dat) / 9))
result <- lapply(lapply(split(x, x), names), function(i) dat[dat$group %in% i, ])

Распределение строк в списке результатов

t(Map(nrow, result))
#      1  2 3 4 5 6 7 8 9
# [1,] 11 6 9 8 7 7 8 7 7

> sapply(result, "[", 2)
$`1.group`
 [1] "a" "a" "a" "a" "a" "b" "b" "b" "b" "b" "b"

$`2.group`
[1] "c" "d" "d" "e" "e" "f"

$`3.group`
[1] "g" "g" "g" "g" "i" "j" "j" "j" "j"

$`4.group`
[1] "k" "k" "l" "l" "l" "l" "l" "l"

$`5.group`
[1] "n" "n" "o" "p" "p" "p" "p"

$`6.group`
[1] "q" "q" "q" "q" "r" "r" "r"

$`7.group`
[1] "s" "s" "s" "t" "u" "u" "u" "v"

$`8.group`
[1] "w" "w" "w" "x" "x" "x" "x"

$`9.group`
[1] "y" "y" "y" "y" "z" "z" "z"

Данные

dat <- structure(list(value = c(43L, 22L, 1L, 5L, 4L, 18L, 32L, 33L, 
47L, 43L, 35L, 24L, 3L, 12L, 13L, 6L, 45L, 12L, 5L, 22L, 47L, 
35L, 20L, 36L, 34L, 15L, 22L, 9L, 41L, 1L, 7L, 2L, 21L, 3L, 8L, 
33L, 12L, 39L, 19L, 2L, 34L, 45L, 7L, 22L, 24L, 25L, 20L, 19L, 
45L, 36L, 25L, 23L, 47L, 13L, 45L, 36L, 23L, 14L, 12L, 15L, 12L, 
11L, 25L, 31L, 41L, 14L, 38L, 15L, 13L, 6L), group = c("a", "a", 
"a", "a", "a", "b", "b", "b", "b", "b", "b", "c", "d", "d", "e", 
"e", "f", "g", "g", "g", "g", "i", "j", "j", "j", "j", "k", "k", 
"l", "l", "l", "l", "l", "l", "n", "n", "o", "p", "p", "p", "p", 
"q", "q", "q", "q", "r", "r", "r", "s", "s", "s", "t", "u", "u", 
"u", "v", "w", "w", "w", "x", "x", "x", "x", "y", "y", "y", "y", 
"z", "z", "z")), row.names = c(6L, 21L, 50L, 66L, 69L, 15L, 36L, 
46L, 48L, 62L, 67L, 34L, 18L, 54L, 31L, 51L, 3L, 7L, 9L, 24L, 
39L, 55L, 8L, 11L, 27L, 29L, 59L, 70L, 19L, 23L, 40L, 45L, 52L, 
68L, 26L, 43L, 44L, 16L, 38L, 63L, 65L, 10L, 49L, 56L, 61L, 1L, 
13L, 64L, 22L, 35L, 47L, 4L, 25L, 33L, 53L, 37L, 14L, 17L, 60L, 
2L, 5L, 12L, 57L, 28L, 32L, 41L, 42L, 20L, 30L, 58L), class = "data.frame")

Answer 2

Один из способов сделать это, но это зависит от порядка ваших данных, - это подсчитать количество экземпляров по группам и разделить их по ближайшему целому числу на количество групп, которое вы хотите.

Если вам нужно 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)]] содержит исходные данные с «наилучшей» возможной группировкой (с учетом количества итераций в цикле) без одинакового group по наборам данных при их разбиении на newgrouping переменную