我正试图从存在变量的数据集中抽取分层样本，该变量指示每个组的样本量应多大。
library(dplyr)
# example data
df <- data.frame(id = 1:15,
grp = rep(1:3,each = 5),
frq = rep(c(3,2,4), each = 5))
在此示例中，grp指的是我要根据其采样的组，而frq是为该组指定的样本量。
使用split，我想出了这个可能的解决方案，它给出了预期的结果，但效率似乎很低：
s <- split(df, df$grp)
lapply(s,function(x) sample_n(x, size = unique(x$frq))) %>%
do.call(what = rbind)
是否可以仅使用dplyr的group_by和sample_n来做到这一点？
我的第一个念头是：
df %>% group_by(grp) %>% sample_n(size = frq)
但这会导致错误：
is_scalar_integerish（size）错误：找不到对象'frq'
答案 0 :(得分：3)
library(tidyverse)
# example data
df <- data.frame(id = 1:15,
grp = rep(1:3,each = 5),
frq = rep(c(3,2,4), each = 5))
set.seed(22)
df %>%
group_by(grp) %>% # for each group
nest() %>% # nest data
mutate(v = map(data, ~sample_n(data.frame(id=.$id), unique(.$frq)))) %>% # sample using id values and (unique) frq value
unnest(v) # unnest the sampled values
# # A tibble: 9 x 2
# grp id
# <int> <int>
# 1 1 2
# 2 1 5
# 3 1 3
# 4 2 8
# 5 2 9
# 6 3 14
# 7 3 13
# 8 3 15
# 9 3 11
如果您将id的数据帧（不是id的矢量）和一个频率值（对于每个组）作为输入传递，则功能sample_n将起作用。
使用map2并预先生成sample_n的输入的替代版本：
df %>%
group_by(grp) %>% # for every group
summarise(d = list(data.frame(id=id)), # create a data frame of ids
frq = unique(frq)) %>% # get the unique frq value
mutate(v = map2(d, frq, ~sample_n(.x, .y))) %>% # sample using data frame of ids and frq value
unnest(v) %>% # unnest sampled values
select(-frq) # remove frq column (if needed)
答案 1 :(得分：2)
这有效：
df %>% group_by(grp) %>% sample_n(frq[1])
# A tibble: 9 x 3
# Groups: grp [3]
id grp frq
<int> <int> <dbl>
1 3 1 3
2 4 1 3
3 2 1 3
4 6 2 2
5 8 2 2
6 13 3 4
7 14 3 4
8 12 3 4
9 11 3 4
不确定尝试时为何不起作用。
答案 2 :(得分：1)
不建议使用以下答案，它仅显示了一种不带嵌套/贴图的方法，有些人可能会更容易理解。可能适用于处理较小数据集的人员，该人员想要执行与原始问题略有不同的操作，有点害怕或没有时间去使用他们不太了解的功能，也不太可能担心效率。您只需要回顾一下基数R中原始sample函数的行为：当提供（正）整数参数x时，它将输出一个向量，随机排列1:x中的整数。
> sample(5)
[1] 5 1 4 2 3
如果我们有五个元素，则只需选择排列1、2和3的位置即可获得大小为3的随机样本-在这种情况下，我们将选择第二，第四和第五个元素。全清？然后类似地，我们可以在每个组中执行此操作，将1的随机整数分配给组大小，然后选择随机id小于或等于该组所需样本大小的位置作为我们的样本。
library(tidyverse)
# The iris data set has three different species
# I want to sample 2, 5 and 3 flowers respectively from each
sample_sizes <- data.frame(
Species = unique(iris$Species),
n_to_sample = c(2, 5, 3)
)
iris %>%
left_join(sample_sizes, by = "Species") %>% # adds column for how many to sample from this species
group_by(Species) %>% # each species is a group, the size of the group can be found by n()
mutate(random_id = sample(n())) %>% # give each flower in the group a random id between 1 and n()
ungroup() %>%
filter(random_id <= n_to_sample)
哪个给了我输出：
# A tibble: 10 x 7
Sepal.Length Sepal.Width Petal.Length Petal.Width Species n_to_sample random_id
<dbl> <dbl> <dbl> <dbl> <fct> <dbl> <int>
1 4.9 3.1 1.5 0.1 setosa 2 1
2 5.7 4.4 1.5 0.4 setosa 2 2
3 6.2 2.2 4.5 1.5 versicolor 5 3
4 6.3 2.5 4.9 1.5 versicolor 5 2
5 6.4 2.9 4.3 1.3 versicolor 5 5
6 6 2.9 4.5 1.5 versicolor 5 4
7 5.5 2.4 3.8 1.1 versicolor 5 1
8 7.3 2.9 6.3 1.8 virginica 3 1
9 7.2 3 5.8 1.6 virginica 3 3
10 6.2 3.4 5.4 2.3 virginica 3 2
如果您对最后两列不再有任何用处，当然可以通过管道传递到select(-random_id, -n_to_sample)，但是我把它们留了下来，因此从输出中可以清楚地看到代码的工作方式。
对于问题中给出的示例数据：
library(dplyr)
# example data
df <- data.frame(id = 1:15,
grp = rep(1:3,each = 5),
frq = rep(c(3,2,4), each = 5))
df %>%
group_by(grp) %>%
mutate(random_id = sample(n())) %>%
ungroup() %>%
filter(random_id <= frq) %>%
select(-random_id)
# A tibble: 9 x 3
id grp frq
<int> <int> <dbl>
1 1 1 3
2 2 1 3
3 3 1 3
4 8 2 2
5 9 2 2
6 11 3 4
7 12 3 4
8 13 3 4
9 15 3 4
请注意，如果您是安全狂热者，并且x可能为零，并且您想保证输出的长度与x相同，那么最好执行{{ 1}}比sample(seq_len(x))。这样，在sample(x)为零的情况下，您将获得零长度向量integer(0)而不是长度一向量0。在我的代码中，x永远不会在mutate为零的行上工作（如果n()为零，则该组为空，因此那里没有行）这不是问题。如果您在其他地方采用这种方法，则需要注意一些事情。
比较基准：
n()结果强烈支持@thc的f1 <- function(df) { # @AntoniosK with nest and map
df %>%
group_by(grp) %>% # for each group
nest() %>% # nest data
mutate(v = map(data, ~sample_n(data.frame(id=.$id), unique(.$frq)))) %>% # sample using id values and (unique) frq value
unnest(v) # unnest the sampled values
}
f2 <- function(df) { # @AntoniosK with nest and map2
df %>%
group_by(grp) %>% # for every group
summarise(d = list(data.frame(id=id)), # create a data frame of ids
frq = unique(frq)) %>% # get the unique frq value
mutate(v = map2(d, frq, ~sample_n(.x, .y))) %>% # sample using data frame of ids and frq value
unnest(v) %>% # unnest sampled values
select(-frq) # remove frq column (if needed)
}
f3 <- function(df) { # @thc
df %>% group_by(grp) %>% sample_n(frq[1])
}
f4 <- function(df) { # @Silverfish
df %>%
group_by(grp) %>%
mutate(random_id = sample(n())) %>%
ungroup() %>%
filter(random_id <= frq) %>%
select(-random_id)
}
# example data of variable size
df_n <- function(n) {
data.frame(id = seq_len(3*n),
grp = rep(1:3,each = n),
frq = rep(c(3,2,4), each = n))
}
require(microbenchmark)
microbenchmark(f1(df_n(1e3)), f2(df_n(1e3)), f3(df_n(1e3)), f4(df_n(1e3)),
f1(df_n(1e6)), f2(df_n(1e6)), f3(df_n(1e6)), f4(df_n(1e6)),
times=20)
都适用于具有数千行或数百万行的数据帧。我幼稚的方法要花两倍或三倍的时间，而@AntoniosK更快的解决方案是使用df %>% group_by(grp) %>% sample_n(frq[1])和nest的解决方案（对于较小的数据帧，它比我的更糟，对于较大的数据帧，它更佳）。 >
map2