R（和 dplyr？） - 按组从数据帧中采样，最大样本大小为 n

Question

我有一个数据框，其中每组包含多个样本（1-n）。我想对这个数据集进行采样，而不进行替换，以便每组最多有 5 个样本 (1-5)。

此问题之前已在此处进行过描述和解答。在这个问题中，@evolvedmicrobe的答案对我来说是最满意的，并且在过去一直有效。这种情况似乎在去年左右就被打破了。

这是我想做的一个可行的例子：

从 mtcars 中，按“cyl”分组时有不同数量的行。

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

我想创建一个子样本，其中每组气缸的最大汽车数量为 10 辆。理论上，生成的行数如下所示：

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

我对此的天真尝试是：

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

但是，因为一组的行数少于 10：

错误：size必须小于或等于 7（数据大小），设置replace= TRUE 以使用带替换的采样

@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 =sizes[i], 中的错误：未使用的参数 (tbl = tbl) 调用自：FUN(X[[i]], ...)

有没有人有更好的按组采样的方法，无需更换，最多可达每组的最大大小？我通常不是 dplyr 的大用户，因此也欢迎来自基本 R 或其他软件包的所有选项。

否则，有谁知道为什么之前的解决方法停止工作？

感谢大家的时间。

Answer 1

这是一个简单的解决方案，使用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

Answer 2

该函数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)