ldbinom=function (x, size, prob) 
{
    if (x == size & prob == 1) {return(0)}
    if (x == 0 & prob == 0) {return(0)}
    if (prob == 0 | prob == size) {return(-Inf)}
    lchoose(size, x) + x * log(prob) + (size - x) * log(1 - prob)
}

#teststernef0(348,3667, 0.0951)

#teststernef0(1368, 1373, 0.9967)
#teststerne(1368, 1373, 0.9967)
teststernef0=function(x,n,p,relErr=1+1e-9,discontX=NA,includeDiscontX=T) {
	if (x/n > p) {return(teststernef0(n-x,n,1-p,discontX=n-discontX,includeDiscontX=includeDiscontX))}
	p1=pbinom(x,n,p)
	d=ldbinom(x,n,p)
	
	if (p1 == 1 || p1 == 0) {return(p1)}
	if (!is.finite(d)) {
		return(p1)
	}
	ce = ceiling(n*p)
	if (d < ldbinom(n,n,p)) {
		if (!is.na(discontX) && discontX <= x && !includeDiscontX) {
			p1 = p1 - dbinom(discontX,n,p)
		}
		if (!is.na(discontX) && discontX > x && includeDiscontX) {
			p1 = p1 + dbinom(discontX,n,p)
		}
		return(p1)
	}
	epsilon = log(relErr)
	test=function (q) {
		ldbinom(round(q),n,p) - d
	}
	lower = floor(n*p+c(0:1))
	lower = lower[which.max(sapply(lower,test))]
	#lower = ifelse(test(floor(n*p)) < 0, floor(n*p)+1, floor(n*p))
	if (test(lower) < 0) {
		q=x
	} else {
		q=round(ssanv::uniroot.integer(test,lower=lower, upper=n, step.power=32)$root)
	}

	#q = pmax(qbinom(pmax(p1,1e-15),n,p, lower.tail=F), ce)
	while (ldbinom(q,n,p) <= d+epsilon & q > ce) {q=q-1}
	while (ldbinom(q,n,p) > d+epsilon & q < n) {q=q+1}
	if (q == x) {q=q+1}
	p2=pbinom(q-1,n,p,lower.tail=F)
	if (!is.na(discontX) && (discontX <= x | discontX >= q) && !includeDiscontX) {
		p1 = p1 - dbinom(discontX,n,p)
	}
	if (!is.na(discontX) && (discontX > x & discontX < q) && includeDiscontX) {
		p1 = p1 + dbinom(discontX,n,p)
	}
	p1+p2
}
#teststerne (1848,2048,0.8887271,relErr=1+1e-7,1792,F)
#teststernef0(1848,2048,0.8887271,relErr=1+1e-7,1792,F)
#x=1848;n=2048;p=0.8887271;relErr=1+1e-7;discontX=1792;includeDiscontX=F;

teststerne_slow=function(x,n,p,relErr=1+1e-9,discontX=NA,includeDiscontX=F) {
	probs = dbinom(0:n,n,p)
	accept = probs <= dbinom(x,n,p)*relErr
	if (!is.na(discontX)) {
		accept[1+discontX]=includeDiscontX
	}
	sum(probs[accept])
}

teststernef=function(x,n,p,relErr=1+1e-7,discontX=NA,includeDiscontX=F) {
	if (n < 800) {return(teststerne_slow(x,n,p,relErr,discontX,includeDiscontX))}
	return(teststernef0(x,n,p,relErr,discontX,includeDiscontX))

if (0) {
	p1 = teststernef0(x,n,p,relErr,discontX,includeDiscontX)
	p2 = teststerne  (x,n,p,relErr,discontX,includeDiscontX)
	if (is.null(p1) | is.null(p2)) {
		cat("Paramerr teststerne : ",x,n,p,"\n");
	}
	if (abs(p1 - p2)>1e-6) {
		cat("Incohérence teststerne : ",x,n,p,",",discontX,includeDiscontX, ":", p1,p2,"\n");
	}
	p2
}
}



if (0) {
	closestdbinom(3,1e7,0.20,F,tol=tol);
	x=3;n=1e7;p=0.20;below=F

	closestdbinom(100,2048,0.09356456,FALSE,tol=1e-9);
	closestdbinom(100,2048,0.5505,FALSE,tol=1e-9);
	system.time(replicate(1000,	closestdbinom(100,2048,0.09356456,FALSE,tol=1e-9)))
	system.time(replicate(1000,	closestdbinom(100,2048,0.090,FALSE,tol=1e-9)))
	system.time(replicate(1000,	closestdbinom0(100,2048,0.090,FALSE,tol=1e-9)))
	#closestdbinom(100,2048,4e-5,F,1e-9)
	#closestdbinom0(100,2048,4e-5,F,1e-9)
 dec0=0;dec1=2048;x=2045;n=2048;p=9.996055e-01;below=FALSE;tol= 4.882813e-08 ;relErr= 1.000005e+00
#closestdbinom(x,n,p,below,tol)
goodsterneL(2047-3,2047)
goodsterneL(2,2048)
sapply(0:2048, function(x) {print(x);goodsterne(x,2048)})

closestdbinom=closestdbinom0
goodsterne(10,2048)
closestdbinom=closestdbinom1
goodsterne(10,2048)

# x=2038; n=2048; p=0.997402596301594; below=FALSE; tol=4.8828125e-08; relErr=1.0000048828125;
}
library(ssanv)
if (0) {
closestdbinom=function(x,n,p,below,tol,relErr=1+tol*100) {
	v=c(closestdbinom0(x,n,p,below,tol,relErr),
	  closestdbinom1(x,n,p,below,tol,relErr))
	if (all(is.na(v))) {return(v[1])}
	if (anyNA(v)) {
		print(v)
		stop("x=",x,"; n=",n,"; p=",p,"; below=",below,"; tol=",tol,"; relErr=",relErr,"; attr(p,\"equalX\")=",attr(p,"equalX"),";");	}
	if (v[1] != v[2]) {
		print(v)
		stop("x=",x,"; n=",n,"; p=",p,"; below=",below,"; tol=",tol,"; relErr=",relErr,"; attr(p,\"equalX\")=",attr(p,"equalX"),";");
	}
	return(v[1])
}
}

closestdbinom=function(x,n,p,below,tol,relErr=1+tol*100) {
	if (p == 0) {return(0)}
	if (p == 1) {return(n)}

	if (below) {
		dec1 = pmax(0,floor(p*n)+1) # Plus grande valeur en cours de décroissance.
		dec0 = 0 # Plus petite valeur en cours de décroissance
	} else {
		dec0 = pmin(ceiling(p*n)-1,n) # Plus petite valeur en cours de croissance
		dec1 = n # Plus grande valeur en cours de croissance
	}

	hasX = !is.null(attr(p,"equalX")) && !is.na(attr(p,"equalX"))

	# On veut trouver x2 tel que lchoose(n,x2)+(log(p)*x2+log(1-p)*(n-x2)) ~= lchoose(n,x)+(log(p)*x+log(1-p)*(n-x))
	lpp = (log(p)-log(1-p))
	lnx = - lchoose(n,x) - lpp*x + ifelse(below,-1,1)*log(relErr)
	xtest = function(x2) {
		lchoose(n,x2) + lnx + lpp*x2
	}
	
	if (sign(xtest(dec0)) * sign(xtest(dec1)) > 0) {
		return (NA)
	}
	r = uniroot.integer(xtest,lower=dec0,upper=dec1,pos.side=below,step.power=32)$root
	if (hasX && r == attr(p,"equalX")) {
		r = r+1
		if (r>n) {return(NA)}
	}
	return(r)
}

if (0) {
closestdbinom(100,2048,0.03,TRUE,1e-9)
closestdbinom0(100,2048,0.03,TRUE,1e-9)
nextdiscont(100,2048,0.03,1e-9,plot=F)

pp=0.03008000
attr(pp,"equalX")=29
nextdiscont(100,2048,pp,1e-9,plot=F)

pp=0.05878400
attr(pp,"equalX")=141
nextdiscont(100,2048,pp,1e-9,plot=F)

pp=120/2048
nextdiscont(100,2048,pp,1e-9,plot=F)
}

if (0) {
closestdbinom0=function(x,n,p,below,tol,relErr=1+tol*100) {
	d = dbinom(x,n,p) # exp(lchoose(n,x)+(log(p)*x+log(1-p)*(n-x)))

	if (below) {
		dec1 = pmax(0,floor(p*n)+1) # Plus grande valeur en cours de décroissance.
		dec0 = 0 # Plus petite valeur en cours de décroissance
		seuil = d*relErr
	} else {
		dec0 = pmin(ceiling(p*n)-1,n) # Plus petite valeur en cours de croissance
		dec1 = n # Plus grande valeur en cours de croissance
		seuil = d/relErr
	}
	rng = pmin(d/2,1e-2)
	rng = qbinom(c(rng,1-rng),n,p) + c(-1,1)
	dec0 = pmax(pmax(dec0, rng[1]),0)
	dec1 = pmin(pmin(dec1, rng[2]),n)

	# On veut trouver x2 tel que lchoose(n,x2)+(log(p)*x2+log(1-p)*(n-x2)) ~= lchoose(n,x)+(log(p)*x+log(1-p)*(n-x))

	ddec = dbinom(dec0:dec1,n,p)
	ok = sign(ddec - seuil) != sign(d - seuil)
	if (!is.null(attr(p,"equalX")) && !is.na(attr(p,"equalX"))) {
		ok = ok & dec0:dec1 != attr(p,"equalX")
	}
	x1 = (dec0:dec1)[which(ok)[1]]
	#ddec - seuil
	x1
}
}

plotsternep=function(x,n,xlim=NULL,ylim=c(0,1),prec=1e-3,type="l",col="gray",xbreaks=20,ybreaks=20,ylab="p-value",xlab="Null hypothesis p",conf.level=0.95,add=F,test=teststernef,...) {
	if (!is.null(xlim)) {
		p=seq(xlim[1],xlim[2],prec*(xlim[2]-xlim[1]));
	} else {
		p=seq(0,1,prec/n);
	}
	y=sapply(p, function(p) {
		test(x,n,p)
	})
	if (add) {plott=lines} else {plott=plot}
	plott(p,y,type=type,xlab=xlab,ylab=ylab,col=col,xaxs="i",yaxs="i",xaxt="n",yaxt="n",las=1,bty="l",xlim=xlim,ylim=ylim,...)
	abline(col=col,h=1-conf.level,lty="dashed")
	axis(2,pretty(c(ylim[1],ylim[2]),ybreaks),las=1)
	axis(1,pretty(c(xlim[1],xlim[2]),xbreaks))
}



if (0) {
	nextdiscont(3,1e7,5e-7,prev=F,plot=F)
	x=3;n=1e7;tol=1e-5/n;prev=F;plot=F
}

#nextdiscont(3,20,0.01,plot=F);x=3;n=20;p=0.01
nextdiscont=function(x,n,p,tol=1e-5/n,prev=F,plot=F) {
	# Recherche la prochaine discontinuité de p-value dans la fonction ptheo->pvalue_sterne(x/n,ptheo)
	#if (p >= x/n) {
	#	stop("Not yet implemented");
	#}
	if (p==1) {
		pnext=1
		attr(pnext,"equalX")=NA
		attr(pnext,"pvalue1")=0
		attr(pnext,"pvalue2")=0
		return(pnext)
	}
	if (prev) {
		pnext = 1-nextdiscont(n-x,n,1-p,tol=tol,prev=F,plot=F)
		attr(pnext,"equalX")=n-attr(pnext,"equalX")
		if (plot) {
			abline(v=pnext,col="orange")
		}
		return(pnext)
	}
	d = dbinom(x,n,p)
	below=p < x/n;
	x1 = closestdbinom(x,n,p,below,tol=tol);
	if (p < x/n & is.na(x1)) {below=!below;x1=closestdbinom(x,n,p,below,tol=tol);}
	if (is.na(x1)) {
		pnext=1
		attr(pnext,"equalX")=NA
		attr(pnext,"pvalue1")=0
		attr(pnext,"pvalue2")=0
		if (plot) {abline(v=pnext,col="blue")}
		return(pnext)
	}
	# C'est dbinom(x1,n,p) qui va croiser bientôt dbinom(x,n,p) lorsque p va croître
	# choose(n,x1)/choose(n,x)*p^(x1-x)*(1-p)^(x-x1) - 1 = 0

	if (0) {
		rc = lchoose(n,x1)-lchoose(n,x)
		if (below) {lower=pmin(p,x/n);upper=pmax(p,x/n);} else {lower=p;upper=1;}
		pnext=uniroot(function(p) {
			rc + (x1-x)*log(p)+(x-x1)*log(1-p)
		},lower=lower,upper=upper,tol=tol)$root
	}
	pnext = 1/(1 + exp((lchoose(n, x) - lchoose(n, x1))/(x - x1)))

	if (x1 < x) {
		pvalue1 = pbinom(x1,n,pnext) + pbinom(x-1,n,pnext,lower.tail=F)
	} else {
		pvalue1 = pbinom(x1-1,n,pnext,lower.tail=F) + pbinom(x,n,pnext,lower.tail=T)
	}
	pvalue2 = pvalue1 - dbinom(x1,n,pnext)
	attr(pnext, "equalX")=x1
	attr(pnext, "pvalue1")=pvalue1
	attr(pnext, "pvalue2")=pvalue2
	pnext
}

if (0) {
x=100;n=2048
nd1=0.1/n;
v=NULL
while(nd1 < 1) {
	nd0<-nd1
	nd1<-nextdiscont(x,n,nd1,prev=F,plot=F)
	v <- c(v, nd1)
}
#sort(1/(1 + exp((lchoose(n, x) - lchoose(n, 0:n))/(x - x1))))

print(nd0)
x=100;n=2048;p=0.09356456
nextdiscont(x,n,p,prev=F,plot=F)
}

#1/(1 + exp((lchoose(n, x) - lchoose(n, 
#                x1))/(x - x1)))
#goodsterne(3,2048)*2048 # 0.8179204 8.8064084
#system.time(replicate(100, goodsterneL(2048-3,2048)))
#system.time(replicate(100, wrongsterneL(2048-3,2048)))

wrongsterneL=function(x,n,conf.level=0.95,tol=1e-3/n) {
	if (x==0) {return(0)}
	test = function(p) {
		teststernef(x,n,p) - (1-conf.level)
	}
	alpha = (1-conf.level)
	lower = qbeta(alpha/4, x, n-x+1)
	upper = qbeta(alpha, x, n-x+1)
	if (sign(test(lower)) * sign(test(upper)) >= 0) {
		lower=0; upper=x/n
	}
	uniroot(lower=lower, upper=upper, test,tol=tol)$root
}
#system.time(replicate(1000, wrongsterneL(2048-3,2048)))

#plot(sapply(seq(0,x/n,0.0001),test),type="l")
wrongsterne=function(x,n,conf.level=0.95,tol=1e-3/n) {
	c(wrongsterneL(x,n,conf.level,tol),
	1-wrongsterneL(n-x,n,conf.level,tol))
}

optimsterne=function(x,n,p1,p2,discontX, includeDiscontX, tol=1e-3/n) {
	test=function (p) {
		teststernef(x,n,p,discontX=discontX,includeDiscontX=includeDiscontX)
	}
	opt = optimize(f=test,lower=p1,upper=p2)
	# Parfois, la fonction est croissante et l'optimum est à p1, contrairement
	# à ce qu'optimize trouve
	tp1 = test(p1)
	if (opt$objective > tp1) {
		opt$minimum = p1
		opt$objective = tp1
	}
	opt
}
if (0) {
plotsternep(18,134,conf.level=0.94,xlim=c(0.08466,0.0848),ylim=c(0.03,0.07));abline(v=lower)
goodsterne(18,134,conf.level=0.95)
goodsterne(18,134,conf.level=0.94)
teststernef(18,134, 0.08474927)
cisterne_exactci(18,134,conf.level=0.94)
}

#nextdiscont(18,134,nextdiscont(18,134,0.085,prev=T)) # Bug de nextdiscont (contourné dans goodsterneL)
goodsterneL=function(x,n,conf.level=0.95,tol=1e-5/n) {
	if (x == 0) {return(0)}
	alpha = 1 - conf.level
	lower = wrongsterneL(x,n,conf.level=conf.level,tol=tol)
	# On est à un croisement de la ligne du risque alpha
	# Mais il peut y avoir plusieurs croisements selon Sterne !
	# On pourra remarquer qu'au plus il y a trois croisements
	# Et ces trois croisements sont situés dans le même intervalle entre deux discontinuités
	# Du coup, on a seulement un retour arrière à faire vers la discontinuité précédente
	nd1=nextdiscont(x,n,lower-0.01/n,prev=T,tol=tol,plot=F)
	nd2=nextdiscont(x,n,nd1  ,prev=F,tol=tol,plot=F)
	topleft  = teststernef(x,n,nd1,discontX=attr(nd1,"equalX"),includeDiscontX=T)
	if (topleft >= alpha) {
		return(nd1[1])
	}
	topright    = teststernef(x,n,nd2,discontX=attr(nd2,"equalX"),includeDiscontX=T)
	#if (topright < alpha & topright+100*tol>alpha) {topright=alpha}

	while (topright+100*tol < alpha & nd1 <= x/n) { # Il arrive que ça aille trop loin à gauche
		nd1 = nd2
		nd2 = nextdiscont(x,n,nd1  ,prev=F,tol=tol,plot=F)
		topleft = topright
		topright = teststernef(x,n,nd2,discontX=attr(nd2,"equalX"),includeDiscontX=T)
	}
	if (nd1 > x/n) {
		stop("Not in good hole")
	}

	bottomright = teststernef(x,n,nd2,discontX=attr(nd2,"equalX"),includeDiscontX=F)
	if (bottomright < alpha) {
		return(nd2[1])
	}
	if (nd1 == 0) {
		bottom=list(minimum=0,objective=0)
	} else {
		bottom   = optimsterne(x,n,nd1,nd2,discontX=attr(nd1,"equalX"),includeDiscontX=T,tol=tol)
	}
	#points(y=c(topleft, bottom$objective, topright), x=c(nd1,bottom$minimum,nd2))
	if (bottom$objective > alpha) {
		return(nd2[1])
	}
	upcross  = uniroot(lower=bottom$minimum, upper=nd2, function (p) {
		teststernef(x,n,p, discontX=attr(nd2,"equalX"), includeDiscontX=F) - alpha
	},tol=tol)$root
	#points(x=upcross$root,y=alpha)
	return(upcross)
}
goodsterneL3=function(x,n,conf.level=0.95,tol=1e-5/n) { # Like goodsterneL but finds the union of several intervals
	if (x == 0) {return(c(0,1))}
	alpha = 1 - conf.level
	lower = wrongsterneL(x,n,conf.level=conf.level,tol=tol)
	# On est à un croisement de la ligne du risque alpha
	# Mais il peut y avoir plusieurs croisements selon Sterne !
	# On pourra remarquer qu'au plus il y a trois croisements
	# Et ces trois croisements sont situés dans le même intervalle entre deux discontinuités
	# Du coup, on a seulement un retour arrière à faire vers la discontinuité précédente
	nd1=nextdiscont(x,n,lower-0.01/n,prev=T,tol=tol,plot=F)
	nd2=nextdiscont(x,n,nd1  ,prev=F,tol=tol,plot=F)
	topleft  = teststernef(x,n,nd1,discontX=attr(nd1,"equalX"),includeDiscontX=T)
	topright    = teststernef(x,n,nd2,discontX=attr(nd2,"equalX"),includeDiscontX=T)
	#if (topright < alpha & topright+100*tol>alpha) {topright=alpha}

	while (topright+100*tol < alpha & nd1 <= x/n) { # Il arrive que ça aille trop loin à gauche
		nd1 = nd2
		nd2 = nextdiscont(x,n,nd1  ,prev=F,tol=tol,plot=F)
		topleft = topright
		topright = teststernef(x,n,nd2,discontX=attr(nd2,"equalX"),includeDiscontX=T)
	}
	if (nd1 > x/n) {
		stop("Not in good hole")
	}

	bottomright = teststernef(x,n,nd2,discontX=attr(nd2,"equalX"),includeDiscontX=F)
	if (bottomright < alpha & topright < alpha) {
		nd1 = nd2
		nd2 = nextdiscont(x,n,nd1  ,prev=F,tol=tol,plot=F)
		topleft = topright
		topright = teststernef(x,n,nd2,discontX=attr(nd2,"equalX"),includeDiscontX=T)
		bottomright = teststernef(x,n,nd2,discontX=attr(nd2,"equalX"),includeDiscontX=F)
	}
	# We are in the hole where there may be one or more cut on the left
	if (topright < alpha) {
		stop("Not in good hole : topright < alpha")
	}

	if (nd1 == 0) {
		bottom=list(minimum=0,objective=0)
	} else {
		bottom   = optimsterne(x,n,nd1,nd2,discontX=attr(nd1,"equalX"),includeDiscontX=T,tol=tol)
	}
	if (bottom$objective >= alpha) {
		return(c(nd1,1)) # One cut only
	}

	if (topleft > alpha) {
		leftcross = uniroot(lower=nd1, upper=bottom$minimum, function (p) {
			teststernef(x,n,p, discontX=attr(nd1,"equalX"), includeDiscontX=T) - alpha
		},tol=tol)$root
	} else {
		leftcross=NA
	}

	if (bottomright < alpha) {
		rightcross = nd2
	} else {
		rightcross = uniroot(lower=bottom$minimum, upper=nd2, function (p) {
			teststernef(x,n,p, discontX=attr(nd2,"equalX"), includeDiscontX=F) - alpha
		},tol=tol)$root
	}
	if (is.na(leftcross)) {
		return(c(rightcross,1))
	} else {
		return(c(nd1, leftcross, rightcross, 1))
	}
}
goodsterne3=function(x,n,conf.level=0.95,tol=1e-4/n) { # Renvoie une matrice 2xN correspondant aux N intervalles disjoints de la région de confiance de Sterne
	low = goodsterneL3(x,n,conf.level,tol=tol)
	low = low[1:(length(low)-1)]
	upp = rev(1-goodsterneL3(n-x,n,conf.level,tol=tol))
	upp = upp[2:length(upp)]
	matrix(nrow=2, c(low, upp))
}

goodsterne=function(x,n,conf.level=0.95,tol=1e-4/n) {
	c(goodsterneL(x,n,conf.level,tol=tol),
	1-goodsterneL(n-x,n,conf.level,tol=tol))
}

testblaker=function(x,n,p) {
	if (p == 0) {return(1*(x==0))}
	if (p == 1) {return(1*(x==n))}
	if (x <= p*n) {
		lefttail=pbinom(x, size=n, prob=p)
		uplimit= qbinom(lefttail, lower.tail=F, size=n,prob=p)
		lefttail + pbinom(uplimit, size=n, prob=p, lower.tail=F)
	} else {
		return(testblaker(n-x,n,1-p));
		#righttail=pbinom(x-1, size=n, prob=p, lower.tail=F)
		#downlimit= qbinom(righttail, lower.tail=T, size=n,prob=p)
		#righttail + pbinom(downlimit-1, size=n, prob=p, lower.tail=T)
	}
}
testclopper=function(x,n,p) {
	pmin(1,2*pmin(pbinom(x, size=n, prob=p), 1-pbinom(x-1, size=n, prob=p, lower.tail=T)))
}
#plotsternep(300,1000,xlim=c(0.25,0.28),ylim=c(0.00,0.055))
#plotsternep(300,1000,xlim=c(0.2718,0.2726),ylim=c(0.045,0.055))
#plotsternep(0,100000,xlim=c(15e-05,16e-05),ylim=c(0,0.000001))
#plotsternep(0,100000,xlim=c(16e-05,17e-05),ylim=c(0,0.0000005))
# La hauteur d'une discontinuité en p-value passant de dessus à dessous alpha est minoré par alpha/n
# La baisse de p-value distale entre deux discontinuités est limitée

#nextdiscont(0,1000,1e-4,prev=F)
#nextdiscont(0,1000,5e-4,prev=F)

pvalued=function(x) {
	c(attr(x,"pvalue1"), attr(x,"pvalue2"))
}

nextdiscontDetail=function(x,n,p,tol=1e-5/n,narrow=F) { # Input: p must be above x/n
	nd1 = nextdiscont(x,n,p,prev=F)
	nd2 = nextdiscont(x,n,nd1,prev=F)
	os = optimsterne2(x,n,nd1,nd2,tol=tol)
	ndm = os$minimum
	attr(ndm,"pvaluem")=os$objective
	xepsilon=0.5/n
	ylim=range(sort(c(pvalued(nd1), pvalued(nd2)))[1:4])
	ylimc=range(sort(c(pvalued(nd1), pvalued(nd2)))[2:3])
	ylimc[1]=pmin(ylimc[1], attr(ndm,"pvaluem"))

	if (narrow) {ylim=mean(ylimc)+c(-1,1)*0.10*0.5*diff(ylim)}
	plot(1,xlim=c(nd1-xepsilon, nd2+xepsilon),ylim=ylim,type="n",xaxt="n");

	#abline(col="blue",h=ylimc)
	#abline(col="blue",v=c(nd1, nd2))
	abline(col="red",v=ndm)
	abline(col="red",h=attr(ndm,"pvaluem"))
	plotsternep(x,n,add=T,col="black",xlim=c(nd1-xepsilon, nd2+xepsilon),ylim=ylim);
	c(nd1,ndm,nd2)
}

optimsterne2=function(x,n,p1,p2, tol=1e-3/n) {
	test=function (p) {
		if (p < (p1+p2)/2) {
			discontX = attr(p1,"equalX")
			includeDiscontX = p1 < x/n #attr(p1,"pvalue1") < attr(p1,"pvalue2")
		} else {
			discontX = attr(p2,"equalX")
			includeDiscontX = p2 >= x/n #attr(p2,"pvalue1") >= attr(p2,"pvalue2")
		}
		teststernef(x,n,p,discontX=discontX,includeDiscontX=includeDiscontX)
	}
	tp1 = test(p1)
	tp2 = test(p2)
	test2=function (p) {
		if (p==p1) {return(tp1)}
		if (p==p2) {return(tp2)}
		return(test(p))
	}
	opt = optimize(f=test2,lower=as.vector(p1),upper=as.vector(p2))
	# Parfois, la fonction est monotone et l'optimum est à p1 ou p2, contrairement
	# à ce qu'optimize trouve
	if (opt$objective > tp1) {
		opt$minimum = p1
		opt$objective = tp1
	}
	if (opt$objective > tp2) {
		opt$minimum = p2
		opt$objective = tp2
	}
	opt
}


if (0) {
nextdiscontDetail(0,2000,1/2000)
nextdiscontDetail(1,20,2/20)
#abline(h=0.502,col="violet");abline(v=0.13823831,col="violet")
#goodsterne(1,20,conf.level=1-0.502)
nextdiscontDetail(1,2000,1.1/2000)
nextdiscontDetail(1,2000,2.1/2000)
nextdiscontDetail(1,2000,3.1/2000)
nextdiscontDetail(1,2000,4.1/2000)
nextdiscontDetail(1,2000,10.1/2000)
nextdiscontDetail(1,2000,100.1/2000)
nextdiscontDetail(0,2000,200.1/2000)
nextdiscontDetail(0,20000,300.1/20000)

nextdiscontDetail(3,2000,4/2000)
nextdiscontDetail(10,2000,11/2000)
}

if (0) {
# Poisson Sterne p-value discontinuities for x=0
n=10
y=min(which(dpois(1:(10*n),lambda=10) <= dpois(0,lambda=n)))
dpois(0,lambda=n)+1-sum(dpois(0:(y-1),lambda=n)) # Sterne Poisson p-value of comparison of oberved zero to theoretical n
1-sum(dpois(1:(y-1),lambda=n))
1-sum(dpois(1:(y-1),lambda=10.99))
}

if (0) {
nextdiscontDetail(40,100,30/100)
nextdiscontDetail(95,100,80/100)

gs3=function(x,n,alpha) {
	#abline(col="violet",v=goodsterneL3(x,n,conf.level=1-alpha))
	#abline(col="violet",h=alpha)
	m=goodsterne3(x,n,conf.level=1-alpha)
	segments(col="violet",y0=alpha,y1=alpha,x0=m[1,],x1=m[2,])
	m
}
x=9;n=10
nextdiscontDetail(x,n,6/10,narrow=T)
gs3(x,n,0.1005)
gs3(x,n,0.10)
gs3(x,n,0.105)
gs3(x,n,0.111)

x=9;n=10
nextdiscontDetail(x,n,7.5/10,narrow=T)
gs3(x,n,0.697)
gs3(x,n,0.699)
gs3(x,n,0.7015)
gs3(x,n,0.703)
gs3(x,n,0.705)
#goodsterneL(x,n,1-0.7015)
#goodsterneL3(x,n,1-0.7015)
x=9;n=10;conf.level=1-0.7015
matrix(nrow=2,goodsterne3(x,n,1-0.7015))

matrix(nrow=2,goodsterne3(x,n,0.95))


holesize=function(m) {
	v = as.vector(m)
	if (length(v)<=2) {return(0)}
	v = v[2:(length(v)-1)]
	m = matrix(nrow=2,v)
	sum(m[2,] - m[1,])
}

x=5;n=10
nextdiscontDetail(x,n,3/10,narrow=F)
v=sapply(0:2048, function(x) {
	ncol(goodsterne3(x,2048))
})
table(v) # Number of intervals with holes

getholes=function(n,conf.level=0.95) {
	v=sapply(0:n, function(x) {
		m = goodsterne3(x,n,conf.level)
		holesize(m) / diff(range(as.vector(m)))
	})
	table(v) # Intervals with holes
}
holes_loss=function(n,conf.level=0.95) {
	v=sapply(0:n, function(x) {
		m = goodsterne3(x,n,conf.level)
		dr = diff(range(as.vector(m)))
		(dr+holesize(m)) / dr
	})
	exp(mean(log(v))) # Geometric mean of loss due to holes
}
getholes(64)
getholes(128)
getholes(174)
getholes(1024)
nextdiscontDetail(0,20,0.1,narrow=F)
gs3(0,20,0.10)

hashole=sapply(c(0.90,0.95,0.99), function (clevel) {
	sapply(1:100, function (n) {print(n);length(getholes(n,clevel))>1})
})
holeloss=sapply(c(0.90,0.95,0.99), function (clevel) {
	sapply(1:100, function (n) {print(n);holes_loss(n,clevel)})
})
mean(as.vector(hashole))
colMeans(hashole)
exp(colMeans(log(holeloss)))-1 # Relative loss of length due to holes
plot(holeloss[,1],type="l")
plot(holeloss[,2],type="l")
plot(holeloss[,3],type="l")
}
