1 Problem

We want to be able to select \(n\), the sample size, from a universe of Bernoulli trials with probability of success equal to \(\theta \in [0,1])\). For instance, consider a random sample \(x_1,\ldots,x_n\) from vodka bottles from a very large shipment intercepted by the police regarding potential contamination by methanol. Notationally, we would say that \[ x_1,\ldots,x_n \ \ \mbox{are iid} \ \ Bernoulli(\theta), \] or that \(Pr(x_i=1)=\theta\) and \(Pr(x_i=0)=1-\theta\).

2 Frequentist approach

As you probably have learned in an intro class on stats or probability, a \(100(1-\alpha)\%\) (approximate) confidence interval for \(\theta\) is given by \[ {\widehat \theta} \pm Z_{1-\alpha/2}\left[\theta(1-\theta)/n\right]^{1/2} \] where \({\widehat \theta}=(x_1+x_2+\cdots+x_n)/n\) and \(Z_{1-\alpha/2}\) is the \(100(1-\alpha/2)\%\) percentile of the standard normal distribution. If \(\alpha=0.05\), then \(Z_{1-\alpha/2}=1.959964\) (or simple the usual 1.96, or even 2!).

Therefore, the error has size \[ E = Z_{1-\alpha/2}\left[\theta(1-\theta)/n\right]^{1/2}. \] Since \(\theta(1-\theta)\) is always smaller than \(0.25\) (show it!), then \[ E \leq Z_{1-\alpha/2}0.5/\sqrt{n}. \] When \(\alpha=0.05\), then \(E \leq 1/\sqrt{n}\) and, consequently \(n \geq 1/E^2\). Suppose one wants the error to be at most \(E=0.01\), then \(n \geq 10,000\), while when \(E=0.05\), then \(n \geq 400\).

2.1 Selecting the sample size

For a given confidence level \(1-\alpha\), error size \(E\), it is easy to see that \[ n \geq \frac{Z_{1-\alpha/2}^2\theta(1-\theta)}{E^2}. \]

alpha  = 0.05
E      = 0.05
Z      = qnorm(1-alpha/2)
theta  = seq(0.01,0.2,length=100)
n      = Z^2*theta*(1-theta)/E^2

plot(theta,n,xlab="True proportion",ylab="Selected sample size")

3 Bayesian approach

Suppose that we do have some prior information about \(\theta\), represented here by a Beta distribution with parameters \(a\) and \(b\), ie. \(\theta \sim Beta(a,b)\). For instance, when \(b=15\) and \(a=b/9=1.67\), it is easy to see that \[ E(\theta)=0.1 \ \ \ \mbox{and} \ \ \ Pr(0.01 \leq \theta \leq 0.278) = 0.95. \] The 2008 Bayesian Analysis paper Bayesian Sample Size Determination for Binomial Proportions, by M’Lan, Joseph and Wolfson (Volume 3, Number 2, pp. 269–296, DOI:10.1214/08-BA310), offers various schemes to select the optimal sample size. From the paper’s abstract we collected the following part:

This paper presents several new results on Bayesian sample size determination for estimating binomial proportions, and provides a comprehensive comparative overview of the subject. We investigate the binomial sample size problem using generalized versions of the Average Length and Average Coverage Criteria, the Median Length and Median Coverage Criteria, as well as the Worst Outcome Criterion and its modified version.

For illustration, we use their result from Theorem 1, which uses the Average Length Criterion (ALC). to derive an approximate sample size formula, for when \(a>1\) and \(b>1\): \[ n = \frac{4Z_{1-\alpha/2}^2}{l^2}\left[\frac{B(a+1/2,b+1/2)}{B(a,b)}\right]^2-(a+b), \] where \(l\) is the length of the highest posterior density (HPD) interval.

alpha = 0.05
Z = qnorm(1-alpha/2)
b = 15
a = b/9
l = 2*E
n1 = 4*Z^2/(l^2)*(beta(a+1/2,b+1/2)/beta(a,b))^2-(a+b)

theta = seq(0,0.5,length=1000)
plot(theta,dbeta(theta,a,b),xlab="Proportion",type="l",ylab="Density")
abline(v=qbeta(0.025,a,b),lty=2)
abline(v=qbeta(0.975,a,b),lty=2)
abline(v=a/(a+b),lty=2)
title(paste("n=",round(n1),sep=""))

3.1 Varying the scale parameter \(b\)

Let us now see the behavior of \(n\) when \(b\), which is a scale parameter, varies.

alpha = 0.05
Z = qnorm(1-alpha/2)
b = seq(2,120,length=100)
a = b/9
l = 2*E
n11 = 4*Z^2/(l^2)*(beta(a+1/2,b+1/2)/beta(a,b))^2-(a+b)

par(mfrow=c(1,2))
plot(b,qbeta(0.025,a,b),type="l",ylim=c(0,1),ylab="95% prior credibility interval")
lines(b,qbeta(0.975,a,b))
abline(h=a/(a+b),lty=2)
abline(v=b[n11==max(n11)],lty=2)

plot(b,n11,type="l",ylim=c(0,100),ylab="Sample size")
abline(h=0,lty=2)
abline(v=b[n11==max(n11)],lty=2)

3.2 Highly informative prior

When your prior is highly informative, say \(\theta \sim Beta(120/9,120)\), whose prior mean is \(0.1\), the prior standard deviation is \(0.026\) and the prior 95% credibility interval is \((0.055,0.156)\), then you will only need a sample of size \(n=2\).

thetas = seq(0,0.5,length=1000)
plot(thetas,dbeta(thetas,120/9,120),type="l",xlab="Proportion",ylab="Prior density",lwd=2)
lines(thetas,dbeta(thetas,15/9,15),col=2,lwd=2)
legend("topright",legend=c("n=2","n=101"),bty="n",lwd=2,col=1:2)

LS0tCnRpdGxlOiAiQmVybm91bGxpIHRyaWFscyIKc3VidGl0bGU6ICJTYW1wbGUgc2l6ZSBzZWxlY3Rpb24iCmF1dGhvcjogIkhlZGliZXJ0IEZyZWl0YXMgTG9wZXMiCmRhdGU6ICIxMC8xMC8yMDI1IgpvdXRwdXQ6CiAgaHRtbF9kb2N1bWVudDoKICAgIHRvYzogdHJ1ZQogICAgdG9jX2RlcHRoOiAzCiAgICB0b2NfY29sbGFwc2VkOiB0cnVlCiAgICBjb2RlX2Rvd25sb2FkOiB5ZXMKICAgIG51bWJlcl9zZWN0aW9uczogdHJ1ZQotLS0KCmBgYHtyIHNldHVwLCBpbmNsdWRlPUZBTFNFfQprbml0cjo6b3B0c19jaHVuayRzZXQoZWNobyA9IFRSVUUpCmBgYAoKIyBQcm9ibGVtCldlIHdhbnQgdG8gYmUgYWJsZSB0byBzZWxlY3QgJG4kLCB0aGUgc2FtcGxlIHNpemUsIGZyb20gYSB1bml2ZXJzZSBvZiBCZXJub3VsbGkgdHJpYWxzIHdpdGggcHJvYmFiaWxpdHkgb2Ygc3VjY2VzcyBlcXVhbCB0byAkXHRoZXRhIFxpbiBbMCwxXSkkLiBGb3IgaW5zdGFuY2UsIGNvbnNpZGVyIGEgcmFuZG9tIHNhbXBsZSAkeF8xLFxsZG90cyx4X24kIGZyb20gdm9ka2EgYm90dGxlcyBmcm9tIGEgdmVyeSBsYXJnZSBzaGlwbWVudCBpbnRlcmNlcHRlZCBieSB0aGUgcG9saWNlIHJlZ2FyZGluZyBwb3RlbnRpYWwgY29udGFtaW5hdGlvbiBieSBtZXRoYW5vbC4gIE5vdGF0aW9uYWxseSwgd2Ugd291bGQgc2F5IHRoYXQgCiQkCnhfMSxcbGRvdHMseF9uIFwgXCBcbWJveHthcmUgaWlkfSBcIFwgQmVybm91bGxpKFx0aGV0YSksCiQkCm9yIHRoYXQgJFByKHhfaT0xKT1cdGhldGEkIGFuZCAkUHIoeF9pPTApPTEtXHRoZXRhJC4gIAoKIyBGcmVxdWVudGlzdCBhcHByb2FjaApBcyB5b3UgcHJvYmFibHkgaGF2ZSBsZWFybmVkIGluIGFuIGludHJvIGNsYXNzIG9uIHN0YXRzIG9yIHByb2JhYmlsaXR5LCBhICQxMDAoMS1cYWxwaGEpXCUkIChhcHByb3hpbWF0ZSkgY29uZmlkZW5jZSBpbnRlcnZhbCBmb3IgJFx0aGV0YSQgaXMgZ2l2ZW4gYnkKJCQKe1x3aWRlaGF0IFx0aGV0YX0gXHBtIFpfezEtXGFscGhhLzJ9XGxlZnRbXHRoZXRhKDEtXHRoZXRhKS9uXHJpZ2h0XV57MS8yfQokJAp3aGVyZSAke1x3aWRlaGF0IFx0aGV0YX09KHhfMSt4XzIrXGNkb3RzK3hfbikvbiQgYW5kICRaX3sxLVxhbHBoYS8yfSQgaXMgdGhlICQxMDAoMS1cYWxwaGEvMilcJSQgcGVyY2VudGlsZSBvZiB0aGUgc3RhbmRhcmQgbm9ybWFsIGRpc3RyaWJ1dGlvbi4gIElmICRcYWxwaGE9MC4wNSQsIHRoZW4gJFpfezEtXGFscGhhLzJ9PTEuOTU5OTY0JCAob3Igc2ltcGxlIHRoZSB1c3VhbCAxLjk2LCBvciBldmVuIDIhKS4gIAoKVGhlcmVmb3JlLCB0aGUgZXJyb3IgaGFzIHNpemUKJCQKRSA9IFpfezEtXGFscGhhLzJ9XGxlZnRbXHRoZXRhKDEtXHRoZXRhKS9uXHJpZ2h0XV57MS8yfS4KJCQKU2luY2UgJFx0aGV0YSgxLVx0aGV0YSkkIGlzIGFsd2F5cyBzbWFsbGVyIHRoYW4gJDAuMjUkIChzaG93IGl0ISksIHRoZW4gCiQkCkUgXGxlcSBaX3sxLVxhbHBoYS8yfTAuNS9cc3FydHtufS4KJCQKV2hlbiAkXGFscGhhPTAuMDUkLCB0aGVuICRFIFxsZXEgMS9cc3FydHtufSQgYW5kLCBjb25zZXF1ZW50bHkgJG4gXGdlcSAxL0VeMiQuICBTdXBwb3NlIG9uZSB3YW50cyB0aGUgZXJyb3IgdG8gYmUgYXQgbW9zdCAkRT0wLjAxJCwgdGhlbiAkbiBcZ2VxIDEwLDAwMCQsIHdoaWxlIHdoZW4gJEU9MC4wNSQsIHRoZW4gJG4gXGdlcSA0MDAkLgoKIyMgU2VsZWN0aW5nIHRoZSBzYW1wbGUgc2l6ZQpGb3IgYSBnaXZlbiBjb25maWRlbmNlIGxldmVsICQxLVxhbHBoYSQsIGVycm9yIHNpemUgJEUkLCBpdCBpcyBlYXN5IHRvIHNlZSB0aGF0IAokJApuIFxnZXEgXGZyYWN7Wl97MS1cYWxwaGEvMn1eMlx0aGV0YSgxLVx0aGV0YSl9e0VeMn0uCiQkCgpgYGB7ciBmaWcuYWxpZ249J2NlbnRlcicsIGZpZy53aWR0aD01LCBmaWcuaGVpZ2h0PTV9CmFscGhhICA9IDAuMDUKRSAgICAgID0gMC4wNQpaICAgICAgPSBxbm9ybSgxLWFscGhhLzIpCnRoZXRhICA9IHNlcSgwLjAxLDAuMixsZW5ndGg9MTAwKQpuICAgICAgPSBaXjIqdGhldGEqKDEtdGhldGEpL0VeMgoKcGxvdCh0aGV0YSxuLHhsYWI9IlRydWUgcHJvcG9ydGlvbiIseWxhYj0iU2VsZWN0ZWQgc2FtcGxlIHNpemUiKQpgYGAKCiMgQmF5ZXNpYW4gYXBwcm9hY2gKU3VwcG9zZSB0aGF0IHdlIGRvIGhhdmUgc29tZSBwcmlvciBpbmZvcm1hdGlvbiBhYm91dCAkXHRoZXRhJCwgcmVwcmVzZW50ZWQgaGVyZSBieSBhIEJldGEgZGlzdHJpYnV0aW9uIHdpdGggcGFyYW1ldGVycyAkYSQgYW5kICRiJCwgaWUuICRcdGhldGEgXHNpbSBCZXRhKGEsYikkLiAgRm9yIGluc3RhbmNlLCB3aGVuICRiPTE1JCBhbmQgJGE9Yi85PTEuNjckLCBpdCBpcyBlYXN5IHRvIHNlZSB0aGF0IAokJApFKFx0aGV0YSk9MC4xIFwgXCBcIFxtYm94e2FuZH0gXCBcIFwgUHIoMC4wMSBcbGVxIFx0aGV0YSBcbGVxIDAuMjc4KSA9IDAuOTUuCiQkClRoZSAyMDA4ICoqQmF5ZXNpYW4gQW5hbHlzaXMqKiBwYXBlciAqQmF5ZXNpYW4gU2FtcGxlIFNpemUgRGV0ZXJtaW5hdGlvbiBmb3IgQmlub21pYWwgUHJvcG9ydGlvbnMqLCBieSBN4oCZTGFuLCBKb3NlcGggYW5kIFdvbGZzb24gKFZvbHVtZSAzLCBOdW1iZXIgMiwgcHAuIDI2OS0tMjk2LCBET0k6MTAuMTIxNC8wOC1CQTMxMCksIG9mZmVycyB2YXJpb3VzIHNjaGVtZXMgdG8gc2VsZWN0IHRoZSBvcHRpbWFsIHNhbXBsZSBzaXplLiAgRnJvbSB0aGUgcGFwZXIncyBhYnN0cmFjdCB3ZSBjb2xsZWN0ZWQgdGhlIGZvbGxvd2luZyBwYXJ0OgoKCipUaGlzIHBhcGVyIHByZXNlbnRzIHNldmVyYWwgbmV3IHJlc3VsdHMgb24gQmF5ZXNpYW4gc2FtcGxlIHNpemUgZGV0ZXJtaW5hdGlvbiBmb3IgZXN0aW1hdGluZyBiaW5vbWlhbCBwcm9wb3J0aW9ucywgYW5kIHByb3ZpZGVzIGEgY29tcHJlaGVuc2l2ZSBjb21wYXJhdGl2ZSBvdmVydmlldyBvZiB0aGUgc3ViamVjdC4gV2UgaW52ZXN0aWdhdGUgdGhlIGJpbm9taWFsIHNhbXBsZSBzaXplIHByb2JsZW0gdXNpbmcgZ2VuZXJhbGl6ZWQgdmVyc2lvbnMgb2YgdGhlIEF2ZXJhZ2UgTGVuZ3RoIGFuZCBBdmVyYWdlIENvdmVyYWdlIENyaXRlcmlhLCB0aGUgTWVkaWFuIExlbmd0aCBhbmQgTWVkaWFuIENvdmVyYWdlIENyaXRlcmlhLCBhcyB3ZWxsIGFzIHRoZSBXb3JzdCBPdXRjb21lIENyaXRlcmlvbiBhbmQgaXRzIG1vZGlmaWVkIHZlcnNpb24uKgoKRm9yIGlsbHVzdHJhdGlvbiwgd2UgdXNlIHRoZWlyIHJlc3VsdCBmcm9tIFRoZW9yZW0gMSwgd2hpY2ggdXNlcyB0aGUgQXZlcmFnZSBMZW5ndGggQ3JpdGVyaW9uIChBTEMpLiB0byBkZXJpdmUgYW4gYXBwcm94aW1hdGUgc2FtcGxlIHNpemUgZm9ybXVsYSwgZm9yIHdoZW4gJGE+MSQgYW5kICRiPjEkOgokJApuID0gXGZyYWN7NFpfezEtXGFscGhhLzJ9XjJ9e2xeMn1cbGVmdFtcZnJhY3tCKGErMS8yLGIrMS8yKX17QihhLGIpfVxyaWdodF1eMi0oYStiKSwKJCQKd2hlcmUgJGwkIGlzIHRoZSBsZW5ndGggb2YgdGhlIGhpZ2hlc3QgcG9zdGVyaW9yIGRlbnNpdHkgKEhQRCkgaW50ZXJ2YWwuCgpgYGB7ciBmaWcuYWxpZ249J2NlbnRlcicsIGZpZy53aWR0aD01LCBmaWcuaGVpZ2h0PTV9CmFscGhhID0gMC4wNQpaID0gcW5vcm0oMS1hbHBoYS8yKQpiID0gMTUKYSA9IGIvOQpsID0gMipFCm4xID0gNCpaXjIvKGxeMikqKGJldGEoYSsxLzIsYisxLzIpL2JldGEoYSxiKSleMi0oYStiKQoKdGhldGEgPSBzZXEoMCwwLjUsbGVuZ3RoPTEwMDApCnBsb3QodGhldGEsZGJldGEodGhldGEsYSxiKSx4bGFiPSJQcm9wb3J0aW9uIix0eXBlPSJsIix5bGFiPSJEZW5zaXR5IikKYWJsaW5lKHY9cWJldGEoMC4wMjUsYSxiKSxsdHk9MikKYWJsaW5lKHY9cWJldGEoMC45NzUsYSxiKSxsdHk9MikKYWJsaW5lKHY9YS8oYStiKSxsdHk9MikKdGl0bGUocGFzdGUoIm49Iixyb3VuZChuMSksc2VwPSIiKSkKYGBgCgojIyBWYXJ5aW5nIHRoZSBzY2FsZSBwYXJhbWV0ZXIgJGIkCkxldCB1cyBub3cgc2VlIHRoZSBiZWhhdmlvciBvZiAkbiQgd2hlbiAkYiQsIHdoaWNoIGlzIGEgc2NhbGUgcGFyYW1ldGVyLCB2YXJpZXMuCgpgYGB7ciBmaWcuYWxpZ249J2NlbnRlcicsIGZpZy53aWR0aD0xMCwgZmlnLmhlaWdodD01fQphbHBoYSA9IDAuMDUKWiA9IHFub3JtKDEtYWxwaGEvMikKYiA9IHNlcSgyLDEyMCxsZW5ndGg9MTAwKQphID0gYi85CmwgPSAyKkUKbjExID0gNCpaXjIvKGxeMikqKGJldGEoYSsxLzIsYisxLzIpL2JldGEoYSxiKSleMi0oYStiKQoKcGFyKG1mcm93PWMoMSwyKSkKcGxvdChiLHFiZXRhKDAuMDI1LGEsYiksdHlwZT0ibCIseWxpbT1jKDAsMSkseWxhYj0iOTUlIHByaW9yIGNyZWRpYmlsaXR5IGludGVydmFsIikKbGluZXMoYixxYmV0YSgwLjk3NSxhLGIpKQphYmxpbmUoaD1hLyhhK2IpLGx0eT0yKQphYmxpbmUodj1iW24xMT09bWF4KG4xMSldLGx0eT0yKQoKcGxvdChiLG4xMSx0eXBlPSJsIix5bGltPWMoMCwxMDApLHlsYWI9IlNhbXBsZSBzaXplIikKYWJsaW5lKGg9MCxsdHk9MikKYWJsaW5lKHY9YltuMTE9PW1heChuMTEpXSxsdHk9MikKYGBgCgojIyBIaWdobHkgaW5mb3JtYXRpdmUgcHJpb3IKV2hlbiB5b3VyIHByaW9yIGlzIGhpZ2hseSBpbmZvcm1hdGl2ZSwgc2F5ICRcdGhldGEgXHNpbSBCZXRhKDEyMC85LDEyMCkkLCB3aG9zZSBwcmlvciBtZWFuIGlzICQwLjEkLCB0aGUgcHJpb3Igc3RhbmRhcmQgZGV2aWF0aW9uIGlzICQwLjAyNiQgYW5kIHRoZSBwcmlvciA5NVwlIGNyZWRpYmlsaXR5IGludGVydmFsIGlzICQoMC4wNTUsMC4xNTYpJCwgdGhlbiB5b3Ugd2lsbCBvbmx5IG5lZWQgYSBzYW1wbGUgb2Ygc2l6ZSAkbj0yJC4KCmBgYHtyIGZpZy5hbGlnbj0nY2VudGVyJywgZmlnLndpZHRoPTUsIGZpZy5oZWlnaHQ9NX0KdGhldGFzID0gc2VxKDAsMC41LGxlbmd0aD0xMDAwKQpwbG90KHRoZXRhcyxkYmV0YSh0aGV0YXMsMTIwLzksMTIwKSx0eXBlPSJsIix4bGFiPSJQcm9wb3J0aW9uIix5bGFiPSJQcmlvciBkZW5zaXR5Iixsd2Q9MikKbGluZXModGhldGFzLGRiZXRhKHRoZXRhcywxNS85LDE1KSxjb2w9Mixsd2Q9MikKbGVnZW5kKCJ0b3ByaWdodCIsbGVnZW5kPWMoIm49MiIsIm49MTAxIiksYnR5PSJuIixsd2Q9Mixjb2w9MToyKQpgYGAKCgoK