Использование весов для выборки с заменой функцией sample_n () - PullRequest
Новая
       35

Использование весов для выборки с заменой функцией sample_n ()

2 голосов
/ 18 апреля 2020

Все,

У меня есть вопрос dplyr sample_n(). Я пытаюсь сделать выборку с заменой, используя опцию веса, и мне кажется, что я попал в ловушку. А именно, выборка с заменой последовательно передискретизирует группу. Это не проблема, которую я получаю при выборке без замены, но я действительно хотел бы сделать выборку с заменой, если бы мог.

Вот минимальный рабочий пример, который использует знакомые apistrat и apipop данные из пакета survey. Исследователи в R хорошо знают эти данные. В демографических данных (apipop) начальные школы (stype == E) составляют около 71,4% всех школ. Средние школы (stype == M) составляют около 12,2% всех школ, а средние школы (stype == H) - около 16,4% всех школ. У apistrat есть преднамеренный дисбаланс, при котором начальные школы составляют 50% данных, в то время как средние и средние школы - остальные 25% выборки из 200 строк.

Что я хотел бы do - выборка данных apistrat с заменой с использованием функции sample_n(). Тем не менее, я, кажется, последовательно превышаю выборку в начальных школах и недостаточно выборки в средних школах и средних школах. Вот минимальный рабочий пример в коде R Пожалуйста, прости мой код зацикливания корнбола. Я знаю, что мне нужно поправиться в purrr, но я еще не совсем там. : P 

library(survey)
library(tidyverse)

apistrat %>% tbl_df() -> strat
apipop %>% tbl_df() -> pop

pop %>%
  group_by(stype) %>% 
  summarize(prop = n()/6194) -> Census

Census
# p(E) = ~.714
# p(H) = ~.122
# p(M) = ~.164

strat %>%
  left_join(., Census) -> strat

# Sampling with replacement seems to consistently oversample E and undersample H and M.
with_replace <- tibble()
set.seed(8675309) # Jenny, I got your number...

for (i in 1:1000) {
strat %>%
    sample_n(100, replace=T, weight = prop) %>%
    group_by(stype) %>%
    summarize(i = i,
              n = n(),
              prop = n/100) -> hold_this
with_replace <- bind_rows(with_replace, hold_this)

}

# group_by means with 95% intervals
with_replace %>%
  group_by(stype) %>%
  summarize(meanprop = mean(prop),
            lwr = quantile(prop, .025),
            upr = quantile(prop, .975))

# ^ consistently oversampled E.
# meanprop of E = ~.835.
# meanprop of H = ~.070 and meanprop of M = ~.095
# 95% intervals don't include true probability for either E, H, or M.

# Sampling without replacement doesn't seem to have this same kind of sampling problem.
wo_replace <- tibble()
set.seed(8675309)  # Jenny, I got your number...

for (i in 1:1000) {
  strat %>%
    sample_n(100, replace=F, weight = prop) %>%
    group_by(stype) %>%
    summarize(i = i,
              n = n(),
              prop = n/100) -> hold_this
  wo_replace <- bind_rows(wo_replace, hold_this)

}

# group_by means with 95% intervals
wo_replace %>%
  group_by(stype) %>%
  summarize(meanprop = mean(prop),
            lwr = quantile(prop, .025),
            upr = quantile(prop, .975))


# ^ better in orbit of the true probability
# meanprob of E = ~.757. meanprob of H = ~.106. meanprob of M = ~.137
# 95% intervals include true probability as well.

Я не уверен, если это проблема dplyr (v. 0.8.3). Интервалы 95% для выборки с заменой не включают в себя истинную вероятность, и каждая выборка (если вы их достигаете максимума) постоянно находится в этом диапазоне середины 80-х годов для выборки из начальных школ. Только три из 1000 выборок (с заменой) имели состав, где начальные школы составляли менее 72% от выборки из 100 рядов. Это так последовательно. Мне любопытно, если кто-нибудь здесь расскажет о том, что происходит, или, возможно, о том, что я делаю неправильно, и если я неправильно истолковываю функциональность sample_n().

Заранее спасибо.

1 Ответ

1 голос
/ 18 апреля 2020

Функция sample_n() в dplyr является обработчиком для base::sample.int(). Глядя на base::sample.int() - и фактическая функция реализована в C. И мы видим, что проблема исходит из источника: 

rows <- sample(nrow(strat), size = 100, replace=F, prob = strat$prop)
strat[rows, ] %>% count(stype)
# A tibble: 3 x 2
  stype     n
  <fct> <int>
1 E        74
2 H        14
3 M        12

rows <- sample(nrow(strat), size = 100, replace=T, prob = strat$prop)
strat[rows, ] %>% count(stype)
# A tibble: 3 x 2
  stype     n
  <fct> <int>
1 E        85
2 H         8
3 M         7

Я, честно говоря, не совсем уверен, почему это так, но если вы сделаете вероятности равными 1 и сделаете их однородными в группе, затем он дает ожидаемые размеры выборки: 

library(tidyverse)
library(survey)

data(api)

apistrat %>% tbl_df() -> strat
apipop %>% tbl_df() -> pop

pop %>%
  group_by(stype) %>% 
  summarize(prop = n()/6194) -> Census


strat %>%
  left_join(., Census) -> strat
#> Joining, by = "stype"

set.seed(8675309) # Jenny, I got your number...
with_replace <- tibble()

for (i in 1:1000) {
  strat %>%
    group_by(stype) %>%
    mutate(per_prob = sample(prop/n())) %>% 
    ungroup() %>% 
    sample_n(100, replace=T, weight = per_prob) %>%
    group_by(stype) %>%
    summarize(i = i,
              n = n(),
              prop = n/100) -> hold_this
  with_replace <- bind_rows(with_replace, hold_this)

}

with_replace %>%
  group_by(stype) %>%
  summarize(meanprop = mean(prop),
            lwr = quantile(prop, .025),
            upr = quantile(prop, .975))
#> # A tibble: 3 x 4
#>   stype meanprop   lwr   upr
#>   <fct>    <dbl> <dbl> <dbl>
#> 1 E        0.713  0.63  0.79
#> 2 H        0.123  0.06  0.19
#> 3 M        0.164  0.09  0.24

Создано в 2020-04-17 пакетом представительство (v0.3.0)

Я предполагаю, что это как-то связано с тем, что сущности в векторе p не уменьшаются на replace = TRUE, но на самом деле я понятия не имею, что происходит под капотом. Кто-то со C знаниями должен взглянуть!

...