在R中高效实现随机抽样

Question

从数据框中，我想随机抽取1-20个观测值，对于每个观测值的数量，我想重复这个过程4次。我已经想出了一个可行的解决方案，但是由于涉及到crossing()函数，需要多次复制大型数据框，所以速度非常慢。有没有人能指向一个更有效的解决方案？

library(tidyverse)

mtcars %>% 
  group_by(cyl) %>% 
  nest() %>% 
  crossing(n_random_sample = 1:20, n_replicate = 1:4) %>% 
  mutate(res = map2_dbl(data, n_random_sample, function(data, n) {

    data %>%
      sample_n(n, replace = TRUE) %>%
      summarise(mean_mpg = mean(mpg)) %>%
      pull(mean_mpg)

  }))
#> # A tibble: 240 x 5
#>      cyl data              n_random_sample n_replicate   res
#>    <dbl> <list>                      <int>       <int> <dbl>
#>  1     6 <tibble [7 × 10]>               1           1  17.8
#>  2     6 <tibble [7 × 10]>               1           2  21  
#>  3     6 <tibble [7 × 10]>               1           3  19.2
#>  4     6 <tibble [7 × 10]>               1           4  18.1
#>  5     6 <tibble [7 × 10]>               2           1  19.6
#>  6     6 <tibble [7 × 10]>               2           2  19.4
#>  7     6 <tibble [7 × 10]>               2           3  19.6
#>  8     6 <tibble [7 × 10]>               2           4  20.4
#>  9     6 <tibble [7 × 10]>               3           1  20.1
#> 10     6 <tibble [7 × 10]>               3           2  18.9
#> # ... with 230 more rows

^{本文创建于2018年11月19日，使用了reprex工具包（版本为0.2.1）}

编辑：我现在正在处理一个更大的数据集。是否可以使用data.table更高效地完成？

- Philippe Massicotte

---

只需使用示例行索引，并每次使用数据子集，而不是复制数据。 - Gregor Thomas

Answer 1

这是一种替代方案，它使用一个函数对你的原始数据集进行子集筛选，并选择一部分行作为样本，而不是使用 nest 创建子数据集并将其存储为列表变量，然后使用 map 进行采样。

library(tidyverse)

# create function to sample rows
f = function(c, n) {
  mtcars %>%
    filter(cyl == c) %>%
    sample_n(n, replace = TRUE) %>%
    summarise(mean_mpg = mean(mpg)) %>%
    pull(mean_mpg)
}

# vectorise function
f = Vectorize(f)

# set seed for reproducibility
set.seed(11)

tbl_df(mtcars) %>%
  distinct(cyl) %>%
  crossing(n_random_sample = 1:20, n_replicate = 1:4) %>%
  mutate(res = f(cyl, n_random_sample))

# # A tibble: 240 x 4
#     cyl n_random_sample n_replicate   res
#   <dbl>           <int>       <int> <dbl>
# 1     6               1           1  21  
# 2     6               1           2  21  
# 3     6               1           3  18.1
# 4     6               1           4  21  
# 5     6               2           1  20.4
# 6     6               2           2  21.2
# 7     6               2           3  20.4
# 8     6               2           4  19.6
# 9     6               3           1  18.4
#10     6               3           2  19.6
# # ... with 230 more rows

- AntoniosK

Answer 2

mm<-lapply(rep(1:20, each=4), sample_n, tbl=mtcars)

这将会给你一份由1到20行的表格列表，每个表格出现4次。

你可以使用以下代码为列表中的元素命名：

names(mm)<-paste0("sample.",apply(expand.grid(1:4,1:20),1,paste,collapse="-"))

结果：

head(mm,5)
$`sample.1-1`
              mpg cyl disp  hp drat    wt qsec vs am gear carb
Lotus Europa 30.4   4 95.1 113 3.77 1.513 16.9  1  1    5    2

$`sample.2-1`
              mpg cyl disp  hp drat   wt qsec vs am gear carb
Ferrari Dino 19.7   6  145 175 3.62 2.77 15.5  0  1    5    6

$`sample.3-1`
             mpg cyl disp hp drat    wt  qsec vs am gear carb
Honda Civic 30.4   4 75.7 52 4.93 1.615 18.52  1  1    4    2

$`sample.4-1`
               mpg cyl  disp hp drat    wt  qsec vs am gear carb
Toyota Corona 21.5   4 120.1 97  3.7 2.465 20.01  1  0    3    1

$`sample.1-2`
              mpg cyl disp  hp drat   wt qsec vs am gear carb
Ferrari Dino 19.7   6  145 175 3.62 2.77 15.5  0  1    5    6
Volvo 142E   21.4   4  121 109 4.11 2.78 18.6  1  1    4    2

- iod