#This first part is based Stephanie Kovalchik’s beta.prior code http://skoval.bol.ucla.edu/beta.prior.R

beta.given.region.mode < - function(lowerq,upperq,region,mode,min=2,max=10000,drawplot=FALSE)
{
mode.check <- function(lowerq,upperq,mode) {
if(!(mode > lowerq & mode stop("Mode must be between lower and upperq")
}
}

region.check=function(region) {
if(!(region >= 0 & region<=1 )) {
stop(“Region must be between 0 and 1″)
}
}

abcheck <- function(a,b) {
if(a<1 || b<1 ) {
stop(“a or b was less than 1″)
}
}

mode.check(lowerq,upperq,mode)
region.check(region)

#This function will be zeroed when the difference in the pbetas equals the region size
f <- function(n) {
a <- 1 + mode*(-2+n)
b <- -1-mode*(-2+n)+n
pbeta(upperq,a,b)-pbeta(lowerq,a,b)-region
}

#This uniroot thing calls f with every n from 2 to 1000 until it finds the n that causes the inner region to hit a certain number.
n <- uniroot(f,interval=c(min,max))$root
a <- 1 + mode*(-2+n)
b <- -1-mode*(-2+n)+n

abcheck(a,b)
theta <- c(a,b)
cat(a,b,”\n”)
return(theta)
}

####This is the part that needs work, especially the super-lame pause function!

pause_x = function (x) {
sofar=0
while (sofar sofar=sofar+system.time(for (i in 1:100000) {})[3]
}
}

for (i in seq(.29,.71,.01))
{
theta=beta.given.region.mode(lowerq=.2,upperq=.8,region=.99,mode=i,min=2,max=10000,drawplot=FALSE)

numslots=20
breaks=seq(0,1,1/numslots)
cumVals=pbeta(breaks,theta[1],theta[2])
barHeights=cumVals[1:numslots+1]-cumVals[1:numslots]
par(mfrow=c(4,1),mai=c(.3,.3,.2,.1))
barplot(barHeights,ylim=c(0,.5),main=”User’s Distribution of Belief”,col=”blue”)
denom=barHeights%*%barHeights
barplot(barHeights/denom^.5,ylim=c(0,1),main=”Payoff with Spherical Scoring Rule”,col=”green”)
barplot(2*barHeights-denom,ylim=c(-.5,.6),main=”Payoff with Quadratic Scoring Rule”,col=”green”)
barplot(log(barHeights),ylim=c(-12,1),main=”Payoff with Log Scoring Rule”,xpd=FALSE,col=”green”)
pause_x(.1)
}

One thing I think about is the following. Suppose research suggests (which it kind of does) that when you ask people for a 95% confidence interval, you get a very reasonable 50% confidence interval. If this is a pretty consistent finding a researcher might finally admit, ok, though it’s not the statistical definition, for whatever reason 95% confidence interval is “human” for 50% confidence interval. In this case, when eliciting a 95% confidence interval, perhaps the right thing to do in consulting settings is treat it as a 50% CI. I reckon that in the simulation above, if I treated the endpoints of the 95% CI as the endpoints of a 50% CI, there’d be very few cases in which 0% probability would be assigned to a cell.

On the other hand, to quote you, this is “teaching” them to not learn the true meaning of a 95% CI, which can’t be a good thing.

Of course, what you’re teaching them is to never assign a 0 probability to anything; the cost of assigning a tiny probability > 0, even if they truly believe the probability is 0, is like a minuscule insurance payment, and if people are at all risk averse, you’ll have convinced them to misstate their true beliefs, albeit in a tiny way – unless, of course, you believe that what constitutes a “true belief” is your willingness to risk everything for it – a logically consistent position, but a psychological implausible one.