Размер выборки, необходимый для оценки вероятности «успеха» в испытании Бернулли

Предположим, игра предлагает событие, которое по завершении либо дает вознаграждение, либо ничего не дает. Точный механизм определения того, дается ли вознаграждение, неизвестен, но я предполагаю, что используется генератор случайных чисел, и если результат больше некоторого жестко заданного значения, вы получаете вознаграждение.

Если я хочу в основном провести обратный инжиниринг, какое значение программисты использовали для определения того, как часто дается вознаграждение (оценивается в 15–30%), как рассчитать количество нужных мне выборок?

Я начал с раздела «Оценка истинной вероятности» здесь: Checking_whether_a_coin_is_fair , но я не уверен, что иду по правильному пути. Я получил результаты ~ 1000 образцов, необходимых для максимальной ошибки 3% при 95% достоверности.

В конечном итоге вот что я пытаюсь решить:

• Событие № 1 дает награду 1.0R, X% времени
• Событие № 2 дает вознаграждение 1.4R, Y% времени

Я хотел бы оценить X & Y достаточно точно, чтобы определить, какое событие более эффективно. Большие размеры выборки - проблема, так как я могу получить только 1 образец каждые 20 минут, самое большее.

Я знаю, что это менее изящно, но я должен был смоделировать это. Я не только построил довольно простую симуляцию, но и не изящен и медленно запускается. Это достаточно хорошо, хотя. Одно из преимуществ заключается в том, что, пока некоторые из основ верны, мне сообщат, когда упадет элегантный подход.

Размер выборки будет варьироваться в зависимости от жестко заданного значения.

Итак, вот код:

#main code
#want 95% CI to be no more than 3% from prevalence
#expect prevalence around 15% to 30%
#think sample size is ~1000

my_prev <- seq(from=0.15, to=0.30, by = 0.002)

samp_sizes <- seq(from=400, to=800, by = 1)
samp_sizes

N_loops <- 2000

store <- matrix(0,
                nrow = length(my_prev)*length(samp_sizes),
                ncol = 3)
count <- 1

#for each prevalence
for (i in 1:length(my_prev)){

     #for each sample size
     for(j in 1:length(samp_sizes)){

          temp <- 0

          for(k in 1:N_loops){

               #draw samples
               y <- rbinom(n = samp_sizes[j],
                           size = 1,
                           prob = my_prev[i])

               #compute prevalence, store
               temp[k] <- mean(y)

          }

          #compute 5% and 95% of temp
          width <-  diff(quantile(x = temp,probs = c(0.05,0.95)))

          #store samp_size, prevalence, and CI half-width
          store[count,1] <- my_prev[i]
          store[count,2] <- samp_sizes[j]
          store[count,3] <- width[[1]]

          count <- count+1
     }

}


store2 <- numeric(length(my_prev))

#go through store
for(i in 1:length(my_prev)){
     #for each prevalence
     #find first CI half-width below 3%
     #store samp_size

     idx_p <- which(store[,1]==my_prev[i],arr.ind = T)
     idx_p

     temp <- store[idx_p,]
     temp

     idx_2 <- which(temp[,3] <= 0.03*2, arr.ind = T)
     idx_2

     temp2 <- temp[idx_2,]
     temp2

     if (length(temp2[,3])>1){
     idx_3 <- which(temp2[,3]==max(temp2[,3]),arr.ind = T)
     store2[i] <- temp2[idx_3[1],2]
     } else {
          store2[i] <- temp2[2]
     }


}


#plot it
plot(x=my_prev,y=store2,
     xlab = "prevalence", ylab = "sample size")
lines(smooth.spline(x=my_prev,y=store2),col="Red")
grid()

$\pm$

Начиная с 50%, «несколько меньше наблюдений», похоже, требуется, как предположил Къетил.

Я думаю, что вы можете получить приличную оценку распространенности до 400 выборок и скорректировать свою стратегию выборки по мере необходимости. Я не думаю, что в середине должна быть пробежка, и поэтому вы можете увеличить N_loops до 10e3 и уменьшить «by» в «my_prev» до 0,001.

$X$$Y$