数据帧的分层随机抽样
Posted
技术标签:
【中文标题】数据帧的分层随机抽样【英文标题】：Stratified random sampling from data frame 【发布时间】：2014-06-22 04:05:19 【问题描述】：我有一个格式如下的数据框：
head(subset)
# ants 0 1 1 0 1
# age 1 2 2 1 3
# lc 1 1 0 1 0
我需要根据年龄和 lc 使用随机样本创建新数据框。例如，我想要来自 age:1 和 lc:1 的 30 个样本，来自 age:1 和 lc:0 的 30 个样本等。
我确实看过随机抽样方法，例如；
newdata <- function(subset, age, 30)
但这不是我想要的代码。
【问题讨论】：
【参考方案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，您基本上可以指定数据集、分层列和一个表示您希望从每组中获得的大小的整数或表示您希望返回的分数的小数（例如，0.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)
【讨论】：
如果您需要返回采样集和非采样集（就像我在 A/B 测试中创建处理/控制拆分时的情况），bothSets = T 的 @987654331 参数@方法是你的朋友。
age=1 是否可以达到 100%，age=2 可以达到 30%，等等？ （改变每组的最终样本）
截至 2020 年，sample_n 和 sample_frac 函数已被弃用并替换为 slice_sample，可以在 group_by 调用之后使用，如下所示：slice_sample(n = 30 或 @987654337 @【参考方案2】：
请参阅包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
【讨论】：
如果我想根据两个或三个变量将数据集分成两个“相等”的组怎么办？ @user3116753，这似乎超出了范围。请将其定义为新问题。 不再需要了。使用 K-means 实现这一目标【参考方案3】：这是一些数据：
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
【讨论】：
这就是我想做的。我确实尝试了 split 和 lapply 函数，但是 r 给出了超出内存的错误。对于庞大的数据集，还有其他方法吗？谢谢 @user3525533 你的数据集有多大？ 大约 2GB。我有 30 个变量和 16826950 个 obs。虽然在我的数据框中。当我使用拆分功能时，它会出现内存错误。 对不起，我是setDT(d)[d[, sample(.I, 30L, FALSE), by="age,lc"]$V1]
@Thomas；对行索引而不是行进行采样会更快——如果有很多列/行，会快很多。 sp <- split(seq_len(nrow(d)), list(d$age, d$lc)) ; samples <- lapply(sp, sample, 30) ; d[unlist(samples), ]【参考方案4】：
这是使用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
【讨论】：
这是一个快速方便的分层方法的绝佳答案。【参考方案5】：用简单的函数可以很容易地做到这一点。
第 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
【讨论】：
【参考方案6】：这是一个更新的dplyr 版本，当您需要来自每组的不同数量的样本（即在我的情况下为 1:5 或其他什么，但您可以为每个组组合指定 n）时，分层抽样。
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
【讨论】：
以上是关于数据帧的分层随机抽样的主要内容，如果未能解决你的问题，请参考以下文章
R语言对dataframe（data.table）数据分层随机抽样实战