Wielkość próby potrzebna do oszacowania prawdopodobieństwa „sukcesu” w próbie Bernoulliego

Załóżmy, że gra oferuje wydarzenie, które po zakończeniu daje nagrodę lub nic. Dokładny mechanizm określania, czy nagroda jest przyznawana, jest nieznany, ale zakładam, że zastosowano generator liczb losowych, a jeśli wynik jest większy niż pewna zakodowana wartość, otrzymasz nagrodę.

Jeśli chcę w zasadzie dokonać inżynierii wstecznej, jaką wartość zastosowali programiści w celu ustalenia, jak często przyznawana jest nagroda (szacunkowo 15–30%), jak obliczyć liczbę potrzebnych próbek?

Zacząłem od sekcji „Estimator prawdziwego prawdopodobieństwa” tutaj: Checking_whether_a_coin_is_fair , ale nie jestem pewien, czy idę właściwą ścieżką. Otrzymywałem wyniki ~ 1000 próbek potrzebne dla maksymalnego błędu 3% przy 95% pewności.

Ostatecznie oto, co próbuję rozwiązać:

• Event nr 1 daje nagrodę 1.0R, X% czasu
• Event nr 2 daje nagrodę 1.4R, Y% czasu

Chciałbym oszacować X i Y wystarczająco dokładnie, aby ustalić, które zdarzenie jest bardziej wydajne. Duże rozmiary próbek stanowią problem, ponieważ mogę uzyskać tylko 1 próbkę co najwyżej 20 minut.

Wiem, że jest mniej elegancki, ale musiałem to zasymulować. Nie tylko zbudowałem dość prostą symulację, ale jest ona nieelegancka i wolno działa. Ale to wystarczy. Jedną z zalet jest to, że dopóki niektóre podstawy są prawidłowe, powie mi, kiedy upadnie eleganckie podejście.

Wielkość próbki będzie się zmieniać w zależności od wartości zakodowanej na stałe.

Oto kod:

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

Z dala od 50%, jak sugeruje kjetil, wydaje się, że wymagane są „nieco mniej obserwacji”.

Myślę, że można uzyskać przyzwoity szacunek rozpowszechnienia przed 400 próbkami i dostosować strategię pobierania próbek w miarę upływu czasu. Nie sądzę, że powinien być impuls na środku, więc możesz podbić N_loops do 10e3 i podnieść „przez” w „my_prev” do 0,001.

$X$$Y$