如何在 R 中的组内进行抽样而不进行替换答案

【问题标题】：How to sample without replacement within groups in R如何在 R 中的组内进行抽样而不进行替换
【发布时间】：2020-02-20 12:18:08
【问题描述】：

我有一个数据框，其中包含一个“年份”变量，其值在 1 到 100000 之间重复多次。我有另一个数据框，其中包含 1000 个“损失金额”，每个损失都有一个相关的概率。我想通过从损失金额表中抽样将损失金额合并到年份数据框中。我想在年份变量的每个级别内进行抽样而不进行替换，例如在年度变量的每个级别内，损失金额应该是唯一的。

下面的可重现示例，我只能在整个“年份”数据集中而不是根据需要在年份变量的不同级别内对其进行采样而不进行替换。有没有办法做到这一点（最好不使用循环，因为我需要代码快速运行）

#mean frequency
freq <- 100
years <- 100000

#create data frame with number of losses in each year
num_losses <- rpois(years, freq)
year <- tibble(index=1:length(num_losses), num=num_losses)
year <- map2(year$index, year$num, function(x, y) rep(x, y)) %>% unlist() %>% tibble(year = .)

#lookup table with loss amounts
lookup <- tibble(prob = runif(1000, 0, 1), amount = rgamma(1000, shape = 1.688, scale = 700000)) %>%
  mutate(total_prob = cumsum(prob)/sum(prob),
         pdf = total_prob - lag(total_prob),
         pdf = ifelse(is.na(pdf), total_prob, pdf))


#add on amounts to year table by sampling from lookup table
sample_from_lookup <- function(number){
  amount <- sample(lookup$amount, number, replace = FALSE, prob = lookup$pdf) 
}

amounts <- sample_from_lookup(nrow(year))
year <- tibble(year = year$year, amount = amounts)

【问题讨论】：

标签： r dplyr

【解决方案1】：

根据您的描述，也许您可以在sample_from_lookup 中尝试replicate，即，

sample_from_lookup <- function(number){
  amount <- replicate(number,
                      sample(lookup$amount, 
                             1, 
                             replace = FALSE, 
                             prob = lookup$pdf))
}

在这种情况下，您需要将大小 1 设置为您的 sample 函数。

【讨论】：

谢谢。运行需要很长时间，所以我也发布了自己的解决方案。

【解决方案2】：

我最终使用 split 将“年份”数据分成列表中的组。然后使用 map 对列表的每个元素运行（略微修改）sample_from_lookup 函数。修改代码如下。

#mean frequency
freq <- 5
years <- 100

#create data frame with number of losses in each year
num_losses <- rpois(years, freq)
year <- tibble(index=1:length(num_losses), num=num_losses)
year <- map2(year$index, year$num, function(x, y) rep(x, y)) %>% unlist() %>% tibble(year = .)
year_split = split(year, year$year)

#lookup table
lookup <- tibble(prob = runif(1000, 0, 1), amount = rgamma(1000, shape = 1.688, scale = 700000)) %>%
  mutate(total_prob = cumsum(prob)/sum(prob),
         pdf = total_prob - lag(total_prob),
         pdf = ifelse(is.na(pdf), total_prob, pdf))


#add on amounts to year table by sampling from lookup table
sample_from_lookup <- function(x){
  number = NROW(x)
  amount <- sample(lookup$amount, number, replace = FALSE, prob = lookup$pdf) 
}


amounts <- map(year_split, sample_from_lookup) %>% unlist() %>% tibble(amount = .)
year <- tibble(year = year$year, amount = amounts$amount)

【讨论】：