Как сделать выборку без замены в группах в R

Question

У меня есть фрейм данных, который содержит переменную 'year' со значениями от 1 до 100000, повторяющимися несколько раз. У меня есть еще один кадр данных с 1000 «суммами потерь» со связанной вероятностью для каждой потери. Я хотел бы объединить суммы убытков с фреймом данных года путем выборки из таблицы сумм потерь. Я хочу произвести выборку без замены на каждом уровне переменной года, например, на каждом уровне переменной года суммы потерь должны быть уникальными.

Воспроизводимый пример ниже, где я могу получить его только для выборки без замены по всей набор данных 'year', а не только в пределах различных уровней переменной года, как требуется. Есть ли способ сделать это (в идеале без использования циклов, так как мне нужен код для быстрого запуска)

#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)

Answer 1

Я использовал разделение, чтобы разбить данные за год на группы в списке. Затем запустив (слегка исправленную) функцию sample_from_lookup для каждого элемента списка, используя map. Измененный код ниже.

#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)

Answer 2

Согласно вашему описанию, возможно, вы можете попробовать replicate в вашем sample_from_lookup, то есть

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

В этом случае вам необходимо установить размер 1 для вашей функции sample ,