Question

我有一个数据框，每组包含多个样本（1-n）。我想对这个数据集进行采样，而无需替换，因此每组（1-5）最多有5个采样。

此问题以前是described and answered here。在这个问题中，@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 = size [i] ，：未使用的参数（tbl = tbl）调用来自：FUN（X [[i]]，...）

有没有人能更好地按组抽样而不更换，每组最大抽样？我通常不是dplyr的大用户，因此也欢迎使用R或其他软件包提供的所有选项。

否则，是否有人知道为什么以前的解决方法已停止工作？

感谢大家的时间。

Answer 1

这是使用userData-

的简单解决方案

where

Answer 2

对于一个简单的功能，您可以使用以下解决方法，该方法首先使样本不足的组破裂，然后最后将其过滤掉：

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

Answer 3

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

Answer 4

对于基数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进行排序-但行顺序可能根本没关系。

R（和dplyr？）-按数据组分组采样，最大采样量为n

4 个答案: