dplyr sample_n 按組，每組具有唯一的大小參數

Question

我試圖從數據集中抽取一個分層樣本，其中存在一個變量，表明每組的樣本量應該有多大。

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”

Answer 1

這有效：

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

不知道為什么當你嘗試它時它不起作用。

Answer 2

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)

Answer 3

不推薦以下答案，只是展示了一種不同的方法，沒有嵌套/地圖，有些人可能會覺得更容易理解。 可能對處理小型數據集的人有用，他們想要做一些與原始問題略有不同的事情，有點害怕或沒有時間玩他們並不真正理解的功能，而且不是太擔心效率。 您只需要回憶基 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相同，那么您最好執行sample(seq_len(x))不是sample(x) 。 這樣，在x為零的情況下，您將獲得零長度向量integer(0)而不是長度為 1 的向量0 。 在我的代碼中， mutate永遠不會在n()為零的行上工作（如果n()為零，則該組為空，因此那里不可能有一行），這不是問題。 如果您在其他地方采用這種方法，則需要注意一些事情。

---

比較基准：

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)

結果強烈支持@thc 的df %>% group_by(grp) %>% sample_n(frq[1])兩者都具有幾千或幾百萬行的數據框。 我的天真方法需要兩到三倍的時間，@AntoniosK 更快的解決方案是帶有nest和map2解決方案（對於較小的數據幀比我的更糟糕，但對於較大的數據幀更好）。

Unit: milliseconds
            expr       min         lq        mean     median         uq       max neval
  f1(df_n(1000))   12.0007   12.27295   12.479760   12.34190   12.46475   13.6403    20
  f2(df_n(1000))    9.5841    9.82185    9.905120    9.87820    9.98865   10.2993    20
  f3(df_n(1000))    1.3729    1.53470    1.593015    1.56755    1.68910    1.8456    20
  f4(df_n(1000))    3.1732    3.21600    3.558855    3.27500    3.57350    5.4715    20
 f1(df_n(1e+06)) 1582.3807 1695.15655 1699.288195 1714.13435 1727.53300 1744.2654    20
 f2(df_n(1e+06))  323.3649  336.94280  407.581130  346.95390  463.69935  911.6647    20
 f3(df_n(1e+06))  216.3265  235.85830  268.756465  247.63620  259.02640  395.9372    20
 f4(df_n(1e+06))  641.5119  663.03510  737.089355  682.69730  803.98205 1132.6586    20