R (и dplyr?) - выборка из кадра данных по группе, до максимального размера выборки n - PullRequest
Новая
       34

R (и dplyr?) - выборка из кадра данных по группе, до максимального размера выборки n

0 голосов
/ 15 октября 2018

У меня есть фрейм данных, который содержит несколько выборок (1-n) на группу.Я хотел бы взять этот набор данных без замены, чтобы у меня было максимум 5 выборок на группу (1-5).

Ранее эта проблема была описана и дана здесь ответ .В этом вопросе ответ @ evolvedmicrobe был для меня наиболее удовлетворительным и работал в прошлом.Кажется, что это сломалось в прошлом году или около того.

Вот рабочий пример того, что я хотел бы сделать:

Из mtcars, при группировании по "разное количество строк"цил ". 

table(mtcars$cyl)
 4  6  8 
11  7 14

Я хотел бы создать подвыборку, в которой максимальное количество автомобилей на группу цил составляет десять.Полученное число строк теоретически будет выглядеть так: 

table(subsample$cyl)
 4  6  8
10  7 10

Моя наивная попытка сделать это была: 

library(dplyr)
subsample <- mtcars %>% group_by(cyl) %>% sample_n(10) %>% ungroup()

Однако, поскольку в одной группе меньше 10 строк:

Ошибка: size должно быть меньше или равно 7 (размер данных), установите replace = ИСТИНА для использования выборки с заменой

@ evolvedmicrobe Ответ на это состоял в том, чтобы создать пользовательскую функцию выборки: 

### Custom sampler function to sample min(data, sample) which can't be done with dplyr
 ### it's a modified copy of sample_n.grouped_df
 sample_vals <- function (tbl, size, replace = FALSE, weight = NULL, .env = parent.frame()) 
 {
   #assert_that(is.numeric(size), length(size) == 1, size >= 0)
   weight <- substitute(weight)
   index <- attr(tbl, "indices")
   sizes = sapply(index, function(z) min(length(z), size)) # here's my contribution
   sampled <- lapply(1:length(index), function(i) dplyr:::sample_group(index[[i]],  frac = FALSE, tbl = tbl, 
                                       size = sizes[i], replace = replace, weight = weight, .env = .env))
   idx <- unlist(sampled) + 1
   grouped_df(tbl[idx, , drop = FALSE], vars = groups(tbl))
 }

 samped_data = dataset %>% group_by(something) %>% sample_vals(size = 50000) %>% ungroup()

Эта функция работала в прошлом, я только что попробовал перезапустить ее, но она больше не работает, вместо этого она выдаетвернемся к той же ошибке, что и в настоящее время для примера mtcars: 

library(dplyr)
subsample <- mtcars %>% group_by(cyl) %>% sample_vals(10) %>% ungroup()

Ошибка в dplyr ::: sample_group (index [[i]], frac = FALSE, tbl = tbl, size =размеры [i],: неиспользованный аргумент (tbl = tbl) Вызывается из: FUN (X [[i]], ...)

Кто-нибудь получил лучший способ выборки по группам, беззамена, до максимального размера на группу? Я обычно не большой пользователь dplyr, поэтому все опции из базы R или других пакетов также приветствуютсяome.

Иначе, у кого-нибудь есть идея, почему предыдущий обходной путь перестал работать?

Спасибо за всеобщее время.

Ответы [ 4 ]

0 голосов
/ 15 октября 2018

С базой R это тоже довольно просто, например: 

do.call(rbind, lapply(split(mtcars, mtcars$cyl), function(x) {
  n <- nrow(x)
  s <- min(n, 10)
  x[sample(seq_len(n), s),]
}))

Строки в выводе будут отсортированы по cyl - но порядок строк, вероятно, все равно не будет иметь значения.

0 голосов
/ 15 октября 2018

Вот простое решение с использованием slice - 

samples_per_group <- 10

subsample <- mtcars %>%
  group_by(cyl) %>%
  slice(sample(n(), min(samples_per_group, n()))) %>%
  ungroup()

table(subsample$cyl)

#  4  6  8 
# 10  7 10
0 голосов
/ 15 октября 2018

Функция sample_group обновлена, а аргументы tbl и .env удалены.Удаление этих аргументов из вашей функции sample_vals и избавление от +1 восстанавливают функциональность вашей функции. 

require(dplyr)

sample_vals <- function (tbl, size, replace = FALSE, weight = NULL){
    ## assert_that(is.numeric(size), length(size) == 1, size >= 0)
    weight <- substitute(weight)
    index <- attr(tbl, "indices")
    sizes <- sapply(index, function(z) min(length(z), size)) # here's my contribution
    sampled <- lapply(1:length(index),
                      function(i) dplyr:::sample_group(index[[i]],  frac = FALSE, 
                                                       size = sizes[i],
                                                       replace = replace,
                                                       weight = weight))
    idx <- unlist(sampled) ## + 1
    grouped_df(tbl[idx, , drop = FALSE], vars = groups(tbl))
}

samped_data <- mtcars %>% group_by(cyl) %>% sample_vals(size = 10) %>% ungroup()

table(samped_data$cyl)
0 голосов
/ 15 октября 2018

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

library(dplyr)
library(tidyr)

size <- 10

subsample <- mtcars %>% 
  group_by(cyl) %>% 
  mutate(group_count = n(), 
         group_count_along = 1:n()) %>% 
  ungroup() %>% 
  complete(cyl, group_count_along) %>% 
  group_by(cyl) %>% 
  filter(group_count_along <= max(group_count, size, na.rm = T)) %>% 
  sample_n(size) %>% 
  ungroup() %>% 
  filter(group_count_along <= group_count)

table(subsample$cyl)
 4  6  8 
10  7 10
...