Стратифицированная случайная выборка из фрейма данных
У меня есть фрейм данных в формате:
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)
Но это не тот код, который я хочу.
8 ответов
Я бы предложил использовать либо stratified из моего пакета "splitstackshape", или sample_n из пакета "dplyr":
## 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)
Смотрите функцию 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
Вот некоторые данные:
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
Вот однострочник с использованием 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
Если я не понял вопрос, это смехотворно легко сделать с помощью простых функций.
Шаг 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
Вот обновленный
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
# there are 10 unique combos of age/lc:
> 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]>
> 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. Поэтому я создал функцию, используя пакет SplitTools:
library("splitTools")
stratified_sampling <- function(y_values, k_folds, set_seed = 54321) {
index_array <- rep(0,length(y_values))
CVfolds <- create_folds(y_values, k = k_folds, type = "stratified", seed=set_seed)
for(i in 1:k_fold) {
index_array[!c(1:length(y_values)) %in% CVfolds[[i]]] <- i
}
return(index_array)
}
Однострочник с использованием моей функцииfslice_sample(). .
Синтаксис основан на аккуратности, но группировка выполняется с использованием сочетанияcollapseиdata.table.
Это также немного более гибко, чемdplyr::slice_sample().
# remotes::install_github("NicChr/timeplyr")
library(timeplyr)
fslice_sample(d, n = 30, .by = c(age, lc), seed = 1)
#> # A tibble: 300 x 3
#> age lc ants
#> * <int> <int> <int>
#> 1 1 0 1
#> 2 1 0 1
#> 3 1 0 0
#> 4 1 0 0
#> 5 1 0 0
#> 6 1 0 1
#> 7 1 0 1
#> 8 1 0 0
#> 9 1 0 0
#> 10 1 0 0
#> # ... with 290 more rows
Создано 18 апреля 2023 г. с использованием reprex v2.0.2.