Profile likelihood for 'balanced accuracy'

proflike.R

nnot<-100
ndis<-50
tpr<-0.9
fpr<-0.5



rr<-replicate(100,{
tpos <-rbinom(1,ndis,tpr)
fpos<-rbinom(1,nnot,fpr)
fneg <-ndis-tpos
tneg<-nnot-fpos
sens<-tpos/(tpos+fneg)
spec<-tneg/(tneg+fpos)

bla<-(sens+spec)/2

diff<-(sens-spec)/2

lldiff<-function(a,d){
	k<-length(a)
	se<-a+d
	sp<-a-d
	rval <-dbinom(tpos,ndis,se,log=TRUE)+dbinom(tneg,nnot,sp,log=TRUE)	
	rval[is.nan(rval)]<- -Inf
	rval
}

llprof<-function(a){
	limits<-c(-a, 1-a)
	optimise(function(d) -2*lldiff(a,d),limits)$objective
}


xrange<-seq(0.5,.99,length=100)
llprofcurve<-sapply(xrange, llprof)
devmin<-min(llprofcurve,na.rm=TRUE)
range(xrange[llprofcurve<=devmin+qchisq(.95,1)])
})