Question

我有一个格式为的数据框：

head(subset)
# ants  0 1 1 0 1 
# age   1 2 2 1 3
# lc    1 1 0 1 0

我需要根据年龄和lc创建带有随机样本的新数据框。例如，我想要30个样本来自年龄：1和lc：1,30个样本来自年龄：1和lc：0等。

我确实看过随机抽样方法;

newdata <- function(subset, age, 30)

但这不是我想要的代码。

Answer 1

我建议使用我的“splitstackshape”软件包中的stratified或“dplyr”软件包中的sample_n：

## Sample data
set.seed(1)
n <- 1e4
d <- data.table(age = sample(1:5, n, T), 
                lc = rbinom(n, 1 , .5),
                ants = rbinom(n, 1, .7))
# table(d$age, d$lc)

对于stratified，您基本上指定了数据集，分层列和表示每个组所需大小的整数或表示要返回的分数的小数（例如，.1代表10％来自每个小组）。

library(splitstackshape)
set.seed(1)
out <- stratified(d, c("age", "lc"), 30)
head(out)
#    age lc ants
# 1:   1  0    1
# 2:   1  0    0
# 3:   1  0    1
# 4:   1  0    1
# 5:   1  0    0
# 6:   1  0    1

table(out$age, out$lc)
#    
#      0  1
#   1 30 30
#   2 30 30
#   3 30 30
#   4 30 30
#   5 30 30

对于sample_n，您首先要创建一个分组表（使用group_by），然后指定所需的观察数量。如果您想要比例抽样，则应使用sample_frac。

library(dplyr)
set.seed(1)
out2 <- d %>%
  group_by(age, lc) %>%
  sample_n(30)

# table(out2$age, out2$lc)

Answer 2

以下是一些数据：

set.seed(1)
n <- 1e4
d <- data.frame(age = sample(1:5,n,TRUE), 
                lc = rbinom(n,1,.5),
                ants = rbinom(n,1,.7))

您需要一个拆分应用合并策略，您需要split data.frame（此示例中为d），对每个子样本中的行/观察值进行采样，然后再将它们组合在一起rbind。以下是它的工作原理：

sp <- split(d, list(d$age, d$lc))
samples <- lapply(sp, function(x) x[sample(1:nrow(x), 30, FALSE),])
out <- do.call(rbind, samples)

结果：

> str(out)
'data.frame':   300 obs. of  3 variables:
 $ age : int  1 1 1 1 1 1 1 1 1 1 ...
 $ lc  : int  0 0 0 0 0 0 0 0 0 0 ...
 $ ants: int  1 1 0 1 1 1 1 1 1 1 ...
> head(out)
         age lc ants
1.0.2242   1  0    1
1.0.4417   1  0    1
1.0.389    1  0    0
1.0.4578   1  0    1
1.0.8170   1  0    1
1.0.5606   1  0    1

Answer 3

查看包sampling中的函数strata。该函数选择分层简单随机抽样并作为结果给出样本。添加了额外的两列 - 包含概率（Prob）和分层指标（Stratum）。参见示例。

require(data.table)
require(sampling)

set.seed(1)
n <- 1e4
d <- data.table(age = sample(1:5, n, T), 
                lc = rbinom(n, 1 , .5),
                ants = rbinom(n, 1, .7))

# Sort
setkey(d, age, lc)

# Population size by strata
d[, .N, keyby = list(age, lc)]
#     age lc    N
#  1:   1  0 1010
#  2:   1  1 1002
#  3:   2  0  993
#  4:   2  1 1026
#  5:   3  0 1021
#  6:   3  1  982
#  7:   4  0  958
#  8:   4  1  940
#  9:   5  0 1012
# 10:   5  1 1056

# Select sample
set.seed(2)
s <- data.table(strata(d, c("age", "lc"), rep(30, 10), "srswor"))

# Sample size by strata
s[, .N, keyby = list(age, lc)]
#     age lc  N
#  1:   1  0 30
#  2:   1  1 30
#  3:   2  0 30
#  4:   2  1 30
#  5:   3  0 30
#  6:   3  1 30
#  7:   4  0 30
#  8:   4  1 30
#  9:   5  0 30
# 10:   5  1 30

Answer 4

除非我误解了这个问题，否则使用简单的函数就会非常容易。

步骤1：使用interaction功能创建一个层指示符。

步骤2：对一系列行指示符使用tapply来识别随机样本的索引。

步骤3：使用这些索引对数据进行子集

使用@Thomas中的数据示例：

set.seed(1)
n <- 1e4
d <- data.frame(age = sample(1:5,n,TRUE), 
                lc = rbinom(n,1,.5),
                ants = rbinom(n,1,.7))

## stratum indicator
d$group <- interaction(d[, c('age', 'lc')])

## sample selection
indices <- tapply(1:nrow(d), d$group, sample, 30)

## obtain subsample
subsampd <- d[unlist(indices, use.names = FALSE), ]

验证适当的分层

> table(subsampd$group)

1.0 2.0 3.0 4.0 5.0 1.1 2.1 3.1 4.1 5.1 
 30  30  30  30  30  30  30  30  30  30

Answer 5

这是使用data.table的单线纸：

set.seed(1)
n <- 1e4
d <- data.table(age  = sample(1:5, n, T),
                lc   = rbinom(n,   1, .5),
                ants = rbinom(n,   1, .7))

out <- d[, .SD[sample(1:.N, 30)], by=.(age, lc)]

# Check
out[, table(age, lc)]
##    lc
## age  0  1
##   1 30 30
##   2 30 30
##   3 30 30
##   4 30 30
##   5 30 30

Answer 6

当您需要来自每个组的不同数量的样本（即 1:5 比率或在我的情况下，但您可以为每个组组合指定 n）时，这是分层抽样的更新 dplyr 版本。

set.seed(1)
n <- 1e4
d <- tibble::tibble(age = sample(1:5, n, T), 
                    lc = rbinom(n, 1 , .5),
                    ants = rbinom(n, 1, .7))
> d
# A tibble: 10,000 x 3
     age    lc  ants
   <int> <int> <int>
 1     2     0     1
 2     2     1     1
 3     3     1     1
 4     5     0     1
 5     2     0     1
 6     5     0     1
 7     5     1     1
 8     4     1     1
 9     4     1     1
10     1     0     1
# … with 9,990 more rows

年龄/lc有10个独特的组合：

> d %>% group_by(age, lc) %>% nest()
# A tibble: 10 x 3
# Groups:   age, lc [10]
     age    lc data                
   <int> <int> <list>              
 1     2     0 <tibble [993 × 1]>  
 2     2     1 <tibble [1,026 × 1]>
 3     3     1 <tibble [982 × 1]>  
 4     5     0 <tibble [1,012 × 1]>
 5     5     1 <tibble [1,056 × 1]>
 6     4     1 <tibble [940 × 1]>  
 7     1     0 <tibble [1,010 × 1]>
 8     1     1 <tibble [1,002 × 1]>
 9     4     0 <tibble [958 × 1]>  
10     3     0 <tibble [1,021 × 1]>

我们可以从每组年龄/lc 组合中抽取预先指定数量的行：

> d %>% 
  group_by(age, lc) %>% 
  nest() %>% 
  ungroup() %>% 
  # you must supply `n` for each combination of groups in `group_by(age, lc)`
  mutate(n = c(1, 1, 1, 2, 3, 1, 2, 3, 1, 1)) %>%  
  mutate(samp = purrr::map2(.x = data, .y= n, 
                            .f = function(.x, .y) slice_sample(.data = .x, n = .y))) %>% 
  select(-data, -n) %>% 
  unnest(samp)
# A tibble: 16 x 3
     age    lc  ants
   <int> <int> <int>
 1     2     0     0
 2     2     1     1
 3     3     1     1
 4     5     0     0
 5     5     0     1
 6     5     1     1
 7     5     1     1
 8     5     1     1
 9     4     1     1
10     1     0     1
11     1     0     1
12     1     1     1
13     1     1     1
14     1     1     0
15     4     0     1
16     3     0     1

从数据帧分层随机抽样

6 个答案: