基于概率数据框的加权抽样答案

【问题标题】：Weighted Sampling Based on a data.frame of Probabilities基于概率数据框的加权抽样
【发布时间】：2019-11-23 02:06:28
【问题描述】：

我有一个包含 4 列的 data.frame，其中包含采样权重。

probs <- data.frame(
    group=rep(c(1,2,3), each=4), 
    metric=rep(rep(c("A", "B"), each=2), each=1), 
    measurement=rep(c("HI", "LO"), 6), 
    probability=c(0.8,0.2,0.5,0.5,0.7,0.3,0.4,0.6,0.1,0.9,0.05,0.95)
)

probs
   group metric measurement probability
1      1      A          HI        0.80
2      1      A          LO        0.20
3      1      B          HI        0.50
4      1      B          LO        0.50
5      2      A          HI        0.70
6      2      A          LO        0.30
7      2      B          HI        0.40
8      2      B          LO        0.60
9      3      A          HI        0.10
10     3      A          LO        0.90
11     3      B          HI        0.05
12     3      B          LO        0.95

我们将其解读为：“在第 1 组中，度量 A 的值为 HI，概率为 0.8，LO 值为概率 0.2。”

我有另一个观察数据框架：

data <- data.frame(
    group=sample(c(1,2), size=12, replace=TRUE), 
    metric=sample(c("A", "B"), replace=TRUE, size=12),
    measurement=NA  # To be sampled
)

   group metric measurement
1      2      B          NA
2      2      A          NA
3      2      A          NA
4      1      A          NA
5      2      A          NA
6      1      A          NA
7      1      A          NA
8      2      B          NA
9      2      B          NA
10     2      B          NA
11     1      A          NA
12     1      A          NA

如何使用probs 中的条件分布对data 中的每一行有效地采样measurement 的值（值HI 和LO）？

【问题讨论】：

我想看看有没有其他人有想法。如果没有，我会接受其中之一。

标签： r dplyr

【解决方案1】：

这是另一种方式：

首先，我们定义一个函数，在给定概率的情况下通过group 和metric 进行采样：

sim_meas <- function(x,y){
  bb <- probs %>% 
    group_by(group,metric) %>% 
    mutate(sim_meas = sample(measurement, size = 1, replace = TRUE, prob = probability)) %>% 
    filter(group == x & metric == y)   
  return(bb$sim_meas[1])
}

其次，我们使用这个函数模拟测量：

data$measurement <- apply(data,1,function(x) sim_meas(x[1],x[2]))

模拟结果：

> data
   group metric measurement
1      1      A          HI
2      2      A          HI
3      2      A          HI
4      1      A          HI
5      2      B          LO
6      1      A          HI
7      2      A          HI
8      1      A          HI
9      1      B          HI
10     2      B          HI
11     1      B          LO
12     1      B          LO

【讨论】：

这种方法快 10 倍。

【解决方案2】：

这是一种方法：

通过将您定义的每个组合基本设为 10000 行来扩展您的初始概率值表（因此 1 和 A 代表 .8 和 .2，您将在测量列中获得 8000 HI 和 2000 行 LO）

probs <- probs %>%
      mutate(probability = 10000*probability) %>%
      mutate(measurement =as.character(measurement)) %>%
      uncount(probability)

然后您可以创建一个函数来根据您感兴趣的条件对数据进行子集化，拉出测量值，然后随机抽样这 10000 个测量值。

sample_groups <- function(group, metric, probs){
      probs %>%
            filter(group == group, metric == metric) %>%
            pull(measurement) %>%
            sample(., 1)
}

最后，使用 mapply 获取指标和每行分组以使测量变量。

data$measurement <- mapply(function(x,y) sample_groups(x, y, probs),
                           data$group, data$metric)

【讨论】：