R(和 dplyr?)- 按组从数据帧中采样,最大样本大小为 n
R (and dplyr?) - Sampling from a dataframe by group, up to a maximum sample size of n
我有一个数据框,其中每组包含多个样本 (1-n)。我想对这个数据集进行采样,而不进行替换,这样每组 (1-5) 最多有 5 个样本。
这个问题以前. In this question @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 行:
Error: size
must be less or equal than 7 (size of data), set replace
= TRUE to use sampling with replacement
@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()
Error in dplyr:::sample_group(index[[i]], frac = FALSE, tbl = tbl, size = sizes[i], :
unused argument (tbl = tbl)
Called from: FUN(X[[i]], ...)
有没有人有更好的按组抽样的方法,无需替换,达到每组的最大大小?我通常不是 dplyr 的大用户,因此也欢迎来自 base R 或其他软件包的所有选项。
否则,有没有人知道为什么之前的解决方法已停止工作?
感谢大家的宝贵时间。
对于一个简单的函数,你可以使用这个变通方法,它首先炸毁样本不足的组,然后在最后过滤掉它们:
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
这是一个使用 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
函数 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)
使用 base 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
排序——但行顺序可能并不重要。
我有一个数据框,其中每组包含多个样本 (1-n)。我想对这个数据集进行采样,而不进行替换,这样每组 (1-5) 最多有 5 个样本。
这个问题以前
这是我想做的一个可行的例子:
来自 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 行:
Error:
size
must be less or equal than 7 (size of data), setreplace
= TRUE to use sampling with replacement
@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()
Error in dplyr:::sample_group(index[[i]], frac = FALSE, tbl = tbl, size = sizes[i], : unused argument (tbl = tbl) Called from: FUN(X[[i]], ...)
有没有人有更好的按组抽样的方法,无需替换,达到每组的最大大小?我通常不是 dplyr 的大用户,因此也欢迎来自 base R 或其他软件包的所有选项。
否则,有没有人知道为什么之前的解决方法已停止工作?
感谢大家的宝贵时间。
对于一个简单的函数,你可以使用这个变通方法,它首先炸毁样本不足的组,然后在最后过滤掉它们:
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
这是一个使用 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
函数 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)
使用 base 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
排序——但行顺序可能并不重要。