Использование sapply для выборки с заранее определенной вероятностью

Question

Я использую функцию sample с предопределенной вероятностью.

Я создал этот код, и он работал нормально. Тем не менее, нет никакого способа проверить, правильно ли я выполнил свою работу. Кто-нибудь проверит мою работу и оценит ее?

df <- structure(list(A=c("A","B","C","D","E","F","G"),
                     probs=c(0.2,0.4,0.6,0.8,0.3,0.7,0.9)),
                Names = c("name","probs"), class = "data.frame", row.names = c(1:7))

df$pred<-sapply(df$probs,function(x) sample(c("Yes","No"),1,prob=c(x,1-x),replace=TRUE))

В df, probs - это предопределенная вероятность сказать "yes". Я использовал sapply с каждым probs и применил sample функцию.

Answer 1

Способ проверить это - увеличить размер выборки и проверить пропорцию.

n <- 1e6
set.seed(123)
sapply(df$probs,function(x) 
          table(sample(c("Yes","No"),n,prob=c(x,1-x),replace=TRUE))/n)


#       [,1]     [,2]    [,3]     [,4]     [,5]     [,6]     [,7]
#No  0.80006 0.599886 0.40003 0.200072 0.699906 0.299314 0.100044
#Yes 0.19994 0.400114 0.59997 0.799928 0.300094 0.700686 0.899956

Поскольку мы можем видеть, что все значения "Yes" почти такие же, как df$probs, мы можем сказать, что то, что мы имеем, является правильным.

Answer 2

другой вариант с использованием "purrr"

library(purrr)
sample_fun <- function(probs){
  sample(c("Yes", "No"), size = 10^6, prob = c(probs, 1 - probs ), replace = T)
}

map(df$probs, ~ sample_fun(.x)) %>% 
  map_dbl( ~ mean(.x == "Yes")) %>% 
  purrr::set_names(df$A)