使用两个人口统计变量（性别和年龄）重新采样数据以匹配人口概况（使用 R）

Question

我正在为我想象的 R 中的多级采样程序而苦苦挣扎。 假设我有一个由非常有偏差的采样方法组成的数据集。因此，与参与者获得的结果是有偏差的。我想调整数据集以匹配两个人口统计变量（性别和年龄），这些变量在数据集中被编码为因素。下图描述了这种情况。

我假设我需要执行“循环”计算。举个例子：要调整第一个年龄区间 (15-19) 的样本量，我需要定义一个新的总数，其中这个最终样本符合 50% 50% 的定义。所有其他年龄间隔都需要相同的程序。

That's the most related topic I've found.

x<-structure(list(age_cat = c("25-29", "30-34", "25-29", "20-24", 
                              "25-29", "20-24", "35-39", "30-34", "25-29", "30-34", "25-29", 
                              "30-34", "35-39", "45-49", "40-45", "20-24", "20-24", "25-29", 
                              "35-39", "35-39", "25-29", "20-24", "30-34", "30-34", "40-45", 
                              "25-29", "25-29", "25-29", "20-24", "40-45", "20-24", "40-45", 
                              "30-34", "25-29", "45-49", "30-34", "45-49", "40-45", "25-29", 
                              "35-39", "40-45", "25-29", "45-49", "35-39", "45-49", "40-45", 
                              "20-24", "45-49", "40-45", "25-29", "35-39", "30-34", "30-34", 
                              "25-29", "20-24", "20-24", "40-45", "35-39", "25-29", "25-29", 
                              "20-24", "40-45", "20-24", "20-24", "45-49", "20-24", "35-39", 
                              "20-24", "35-39", "45-49", "15-19", "45-49", "35-39", "35-39", 
                              "30-34", "35-39", "45-49", "35-39", "30-34", "20-24", "35-39", 
                              "40-45", "40-45", "40-45", "30-34", "45-49", "20-24", "30-34", 
                              "45-49", "35-39", "20-24", "20-24", "20-24", "45-49", "20-24", 
                              "45-49", "35-39", "25-29", "40-45", "40-45", "25-29", "35-39", 
                              "45-49", "30-34", "45-49", "45-49", "45-49", "15-19", "30-34", 
                              "45-49", "30-34", "30-34", "35-39", "25-29", "40-45", "15-19", 
                              "20-24", "20-24", "40-45", "40-45", "45-49", "45-49", "35-39", 
                              "40-45", "30-34", "35-39", "35-39", "25-29", "25-29", "20-24", 
                              "20-24", "40-45", "20-24", "35-39", "20-24", "20-24", "30-34", 
                              "25-29", "45-49", "25-29", "35-39", "20-24", "35-39", "35-39", 
                              "35-39", "40-45", "35-39", "35-39", "20-24", "30-34", "25-29", 
                              "15-19", "30-34", "35-39", "15-19", "20-24", "20-24", "35-39", 
                              "25-29", "25-29", "25-29", "25-29", "30-34", "40-45", "35-39", 
                              "30-34", "35-39", "40-45", "25-29", "30-34", "25-29", "25-29", 
                              "45-49", "30-34", "30-34", "25-29", "15-19", "25-29", "20-24", 
                              "15-19", "20-24", "30-34", "20-24", "40-45", "25-29", "25-29", 
                              "30-34", "30-34", "25-29", "20-24", "40-45", "45-49", "25-29", 
                              "25-29", "40-45", "35-39", "25-29", "45-49", "35-39", "30-34", 
                              "45-49", "30-34", "30-34", "45-49", "35-39", "20-24", "45-49", 
                              "30-34", "25-29", "45-49", "45-49", "40-45", "25-29", "20-24", 
                              "40-45", "30-34", "35-39", "30-34", "20-24", "35-39", "20-24", 
                              "30-34", "20-24", "35-39", "35-39", "30-34", "45-49", "40-45", 
                              "45-49", "25-29", "35-39", "40-45", "30-34", "35-39", "30-34", 
                              "35-39", "20-24", "25-29", "35-39", "30-34", "30-34", "25-29", 
                              "45-49", "45-49", "40-45", "40-45", "35-39", "30-34", "25-29", 
                              "35-39", "20-24", "40-45", "20-24", "30-34", "40-45", "20-24", 
                              "45-49", "20-24", "40-45", "25-29", "40-45", "25-29", "45-49", 
                              "30-34", "30-34", "45-49", "40-45", "30-34", "30-34", "20-24", 
                              "20-24", "35-39", "30-34", "15-19", "35-39", "25-29", "45-49", 
                              "30-34", "25-29", "35-39", "15-19", "40-45", "45-49", "15-19", 
                              "35-39", "45-49", "45-49", "25-29"), sex_cat = structure(c(1L, 
                                                                                         2L, 1L, 2L, 1L, 1L, 1L, 2L, 2L, 1L, 1L, 2L, 1L, 2L, 1L, 1L, 1L, 
                                                                                         1L, 1L, 1L, 2L, 1L, 1L, 1L, 2L, 2L, 2L, 1L, 2L, 2L, 1L, 2L, 2L, 
                                                                                         2L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 1L, 1L, 2L, 2L, 1L, 1L, 2L, 2L, 
                                                                                         2L, 1L, 2L, 1L, 1L, 2L, 2L, 1L, 2L, 2L, 1L, 1L, 1L, 1L, 2L, 1L, 
                                                                                         1L, 2L, 1L, 2L, 2L, 1L, 2L, 1L, 1L, 1L, 2L, 2L, 1L, 1L, 2L, 1L, 
                                                                                         1L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 1L, 2L, 1L, 2L, 1L, 1L, 
                                                                                         1L, 1L, 1L, 2L, 1L, 1L, 2L, 1L, 1L, 2L, 1L, 2L, 1L, 1L, 1L, 1L, 
                                                                                         1L, 1L, 2L, 2L, 2L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 2L, 2L, 1L, 
                                                                                         1L, 1L, 1L, 2L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 2L, 2L, 1L, 
                                                                                         1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 2L, 2L, 1L, 2L, 1L, 2L, 1L, 1L, 
                                                                                         2L, 2L, 1L, 2L, 1L, 1L, 1L, 1L, 2L, 2L, 1L, 1L, 1L, 2L, 1L, 2L, 
                                                                                         1L, 1L, 2L, 1L, 2L, 2L, 2L, 1L, 2L, 2L, 2L, 1L, 2L, 1L, 2L, 1L, 
                                                                                         1L, 2L, 1L, 2L, 1L, 1L, 1L, 1L, 2L, 2L, 1L, 2L, 1L, 1L, 2L, 1L, 
                                                                                         2L, 1L, 1L, 1L, 2L, 2L, 1L, 1L, 1L, 2L, 1L, 2L, 2L, 1L, 1L, 2L, 
                                                                                         1L, 2L, 1L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 
                                                                                         1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 1L, 1L, 2L, 1L, 2L, 2L, 1L, 2L, 
                                                                                         1L, 1L, 1L, 1L, 1L, 2L, 1L, 2L, 2L, 2L, 1L, 1L, 2L, 1L, 2L, 1L, 
                                                                                         2L, 1L, 1L, 2L, 1L, 1L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("M", 
                                                                                                                                                                 "F"), class = "factor")), row.names = c(NA, -288L), class = c("tbl_df", 
                                                                                                                                                                                                                               "tbl", "data.frame"))

Answer 1

好的，所以这有点糟糕！这是我所做的：

library(tidyverse)
library(data.table)
library(splitstackshape)

x <- x %>% mutate(id = row_number(),
                  sex_cats = paste("N", sex_cat, sep = "_"))

x_dt <- data.table(x)
x_cts <- x %>% group_by(age_cat, sex_cat) %>% summarise(n = n()) %>% ungroup(sex_cat)
x_raw <- data.frame(age_cat  = rep(unique(x_cts$age_cat), each = 2), 
                    sex_cat  = rep(unique(x_cts$sex_cat), times = length(unique(x_cts$age_cat))),
                    percents = c(0.5, 0.5, 0.8, 0.2, 0.34, 0.66, 0.5, 0.5, 0.75, 0.25, 0.5, 0.5, 0.6, 0.4)

x_raw_wd <- x_raw %>% pivot_wider(names_from = sex_cat, values_from = percents, names_prefix = "per_")

x_raw_wd <- x_raw_wd %>% mutate(N_M = round(per_M * total_n),
                                N_F = round(per_F * total_n))

x_raw_wd$total_n <- c(6, 30, 30, 30, 20, 10, 20)

x_raw_wd_fin <- x_raw_wd %>% 
                select(age_cat, N_M, N_F) %>% 
                pivot_longer(cols = starts_with("N_"), names_to = "sex_cats") %>% 
                arrange(age_cat, sex_cats) 

x_raw_wd_dt <- data.table(x_raw_wd_fin)

stratified(x_dt[, KEY := paste(age_cat, sex_cats)], "KEY", keep.rownames = T, 
           with(x_raw_wd_dt, setNames(value, paste(age_cat, sex_cats))))

有些人比我更擅长使用data.table，但我在这里所做的是首先创建一个id 列和sex_cats。 sex_cats 稍后使用，但暂时保留在这里。创建x_cts 是为了检查并确保您发送的数据被正确复制和粘贴。

然后我创建x_raw，这是请求的模拟版本；在这里，我们为每个age_cat 和sex_cat 包括一个percents，每个sex_cat 在每个age_cat 中。这些加起来必须达到 100%。

然后我pivot_wider 将percents 转换为每个sex_cat 的宽格式。然后我从每个age_cat 模拟您想要的样本数量：这是手动插入的，因此如果您需要更改每个age_cat 的数量，请随意。从这里我们为每个sex_cat 计算x_raw_wd 中的样本总数。

然后我们得到这个长格式，因为来自splitstackshape 的函数stratified 的要求。如果您查看names_to 选项，则会将其转换为N_M 或N_F，这与sex_cat (sex_cat = 'M', 'F') 不同。这就是为什么一开始我们创建了sex_cats。

最后，我们将所有内容提交到stratified。我们创建一个KEY 列来将x_raw_wd_fin$value（age_cat 和sex_cat 所需的样本总数）链接到age_cat 和sex_cat 的组合x 中的每个观察值。

根据我的百分比（主要是为了演示目的而编造的），我需要 146 个样本。

这是我的输出：

     age_cat sex_cat  id paste("N", sex_cat)       KEY sex_cats
  1:   15-19       F 281                 N F 15-19 N_F      N_F
  2:   15-19       F 155                 N F 15-19 N_F      N_F
  3:   15-19       F 177                 N F 15-19 N_F      N_F
  4:   15-19       M 108                 N M 15-19 N_M      N_M
  5:   15-19       M 284                 N M 15-19 N_M      N_M
 ---                                                           
142:   45-49       M 105                 N M 45-49 N_M      N_M
143:   45-49       M  37                 N M 45-49 N_M      N_M
144:   45-49       M 207                 N M 45-49 N_M      N_M
145:   45-49       M 173                 N M 45-49 N_M      N_M
146:   45-49       M 103                 N M 45-49 N_M      N_M