
cinamesen0=list(
	ciz="Wald",
	cizc="Wald with cc",
	ciwaldcentered="Recentered Wald", # doi:10.1214/aos/1015362189 Brown et al 2002
	ciwaldcenteredcc="Recentered Wald with cc", # Pires and Amado 2008 (comparison of twenty methods)
	ciagresti="Agresti-Coull",

	ciz_clopper1="Wald, CP if k=0",
	cit_clopper1="Student t with n-1 df, CP if k=0",
	citpan_clopper1="Pan 2002 Wald t interval, CP if k=0",
	citpanagresti ="Pan 2002 add4 t interval",
	citpanGILLIBERTunbiased="Kurto-match t, CP if k<=3",
	citpanagrestiGILLIBERTunbiased="Add4 kurto-match t, CP if k<=5",

	cilogit="Modified Wald logit",
	cilogitanscombe="Anscombe Logit",
	cirubin="Rubin logit+0.5",
	ciasin="Arc-sine",
	ciasinbartlett="Bartlett Arc-sine",
	ciasinanscombe.pires="Anscombe Arc-sine",
	ciasinanscombecc="Anscombe Arc-sine with cc",

	cilr="Likelihood ratio",
	cilr1="Modified likelihood ratio",
	ciw="Wilson",
	cimw="Modified Wilson",

	ciwcc="Wilson with cc",
	cimjeffrey="Modified equal-tailed Jeffreys",
	cibayesunif="Equal-tailed, uniform prior",
	cibayeshpd="Shortest, Jeffreys prior",
	cijeffrey="Equal-tailed Jeffreys",
	cibootperc="Percentile bootstrap, CP if k=0",
	cibootbasic="Basic bootstrap, CP if k=0",
	cibootstud="Studentized bootstrap, CP if k <= 4",
	cibootbca="BCa bootstrap, CP if k=0",
	cibootbcaD="Modified BCa bootstrap, CP if k=0",
	cic="Clopper-Pearson",
	cicmidp="Clopper-Pearson mid-P",
	cisterne="Sterne",
	ciblaker="Blaker",
#	ciclaw1956,
	ciprofileglm_logit="LR logit GLM, CP if k=0",
	ciprofileglm_poisson="LR Poisson GLM, CP if k=0",

	ciwaldglm_logit="Wald logit GLM, CP if k=0",
	ciwaldglm_logbinom="Wald log binomial GLM, CP if k=0",
	ciwaldglm_poisson="Wald Poisson GLM, CP if k=0",

	ciasinfreeman="Freeman-Tukey Arc-Sine",
	cihall="Hall 1982",
	cicai="Cai 2005",
	cikottliu="Kott-Liu",

	cischillingdoi="Schilling-Doi",
	ciwang2014="Wang 2014",
	cisaifs="Borkowf SAIFS", # Borkowf 2006
	cizielinski="Zielinski",
	cicaikrish="Combined Cai-Krishnamoorthy",
	ciblythstill="Blyth-Still-Casella",
	cibootsmoothbca="Smoothed BCa bootstrap, CP if k=0",
	ciexactscore="Exact score",
	ciexactlr="Exact likelihood ratio",

	ciprattmean="Mean Pratt (Vollset 1993)",
	# Redundant (not presented)
	cimolenaar="Molenaar 1973",
	cipratt="Pratt 1968",
	cimolenaar_alt="Blyth 1986 eq C"
)

cinamesfr0=list(
	ciz="Wald",
	cizc="Wald avec cc",
	ciwaldcentered="Wald recentré", # doi:10.1214/aos/1015362189 Brown et al 2002
	ciwaldcenteredcc="Wald recentré avec cc", # Pires and Amado 2008 (comparison of twenty methods)
	ciagresti="Agresti-Coull",
	
	ciz_clopper1="Wald, CP si k=0",
	cit_clopper1="t de Student à n-1 ddl, CP si k=0",
	citpan_clopper1="t selon Pan 2002, CP si k=0",
	citpanagresti ="t add4 selon Pan 2002",
	citpanGILLIBERTunbiased="t à kurto égal, CP si k<=3",
	citpanagrestiGILLIBERTunbiased="t add4 à kurto égal, CP si k<=5",

	cilogit="Logit-normal modifié",
	cilogitanscombe="Logit d'Anscombe",
	cirubin="Logit+0,5 de Rubin",
	ciasin="Arc-sinus",
	ciasinbartlett="Arc-sinus de Barlett 1936",
	ciasinanscombe.pires="Anscombe Arc-sinus 1948",
	ciasinanscombecc="Arc-sinus d'Anscombe avec cc",

	cilr="Rapp. vraisemblance",
	cilr1="Rapp. vraisemblance modifié",
	ciw="Wilson 1927",
	cimw="Wilson 1927 mod. Brown 2001",

	ciwcc="Wilson avec cc",
	cimjeffrey="Jeffreys équilibré mod. Brown",
	cibayesunif="Prior uniforme, équilibré",
	cibayeshpd="Jeffreys à densité maximale",
	cijeffrey="Jeffreys équilibré",
	cibootperc="Boot. percentile, CP si k=0",
	cibootbasic="Boot. basique, CP si k=0",
	cibootstud="Boot. studentisé, CP si k <= 4",
	cibootbca="Boot. BCa, CP si k=0",
	cibootbcaD="Boot. BCa modif, CP si k=0",
	cic="Clopper-Pearson",
	cicmidp="Clopper-Pearson mid-P",
	cisterne="Sterne 1954",

	ciblaker="Blaker 2000",
#	ciclaw1956,
	ciprofileglm_logit="RV GLM logit, CP si k=0",
	ciprofileglm_poisson="RV GLM Poisson, CP si k=0",

	ciwaldglm_logit="Wald GLM logit, CP si k=0",
	ciwaldglm_logbinom="Wald GLM log binom, CP si k=0",
	ciwaldglm_poisson="Wald GLM Poisson, CP si k=0",

	ciasinfreeman="Arc-Sinus de Freeman-Tukey",
	cihall="Hall 1982",
	cicai="Cai 2005",
	cikottliu="Kott-Liu 2009",

	cischillingdoi="Schilling-Doi",
	ciwang2014="Wang 2014",
	cisaifs="SAIFS de Borkowf 2006", # Borkowf 2006
	cizielinski="Zielinski 2009",
	cicaikrish="Cai-Krishnamoorthy combiné 2005",
	ciblythstill="Blyth-Still-Casella",
	cibootsmoothbca="Boot. BCa lissé, CP si k=0",
	ciexactscore="Score exact",
	ciexactlr="Rapp. vraisemblance exact",

	ciprattmean="Pratt moyen (Vollset 1993)",
	# Redundant
	cimolenaar="Molenaar 1973",
	cipratt="Pratt 1968",
	cimolenaar_alt="Blyth 1986 eq C"
)
# NB : GLM Wald probit redundant with GLM Wald logit
# All profile likelihood binomial GLM CI are equivalent

if (is_french) {cinames0=cinamesfr0} else {cinames0=cinamesen0}

ci01=function(ci) {
	if (is.vector(ci)) {
		ci[1]=pmax(ci[1],0)
		ci[2]=pmin(ci[2],1)
	} else {
		ci[,1]=pmax(ci[,1],0)
		ci[,2]=pmin(ci[,2],1)
	}
	ci
}


qbinpois=function(p, size, prob, lower.tail=T) {
	if (size == Inf) {qpois(p, lambda=prob, lower.tail=lower.tail)}
	else {qbinom(p, size=size, prob=prob, lower.tail=lower.tail)}
}
dbinpois=function(x, size, prob) {
	if (size == Inf) {dpois(x, lambda=prob)}
	else {dbinom(x, size=size, prob=prob)}
}
pbinpois=function(p, size, prob, lower.tail=T) {
	if (size == Inf) {ppois(p, lambda=prob, lower.tail=lower.tail)}
	else {pbinom(p, size=size, prob=prob, lower.tail=lower.tail)}
}


memorize=function(cifunc) {
	l = list()
	function(x,n,conf.level=0.95,...) {
		key = paste(x,n,conf.level,...)
		if (!is.null(l[[key]])) {
			return(l[[key]])
		}
		ci = cifunc(x,n,conf.level,...)
		l[[key]] <<- ci
		ci
	}
}
memorize2=function(cifunc) {
	cifuncm=memorize(cifunc)
	function(x,n,conf.level=0.95,...) {
		if (n < 1e15 && 2*x > n) {
			rev(1-cifuncm(n-x,n,conf.level=conf.level,...))
		} else {
			cifuncm(x,n,conf.level=conf.level,...)
		}
	}
}
alternativeci_seuil=function(seuil, cisafe, ciloose) {
	function(x,n,conf.level=0.95) {
		if (x < seuil | n-x < seuil) {
			cisafe(x,n,conf.level)
		} else {
			ciloose(x,n,conf.level)
		}
	}
}
memorize_cset=function(cisetfunc) { # For procedures computing confidence interval sets
	l=list()
	function(x,n,conf.level=0.95) {
		key = paste(n, conf.level)
		if (is.null(l[[key]])) {
			l[[key]] <<- as.matrix(cisetfunc(n,conf.level))
		}
		(l[[key]])[x+1,]
	}
}

cischillingdoi=memorize_cset(function(n,conf.level=0.95) {
	cat("  Computing Schilling-Doi confidence set for n =",n," and conf.level =",conf.level,"\n");
	m=LCO.CI2(n,conf.level)[,2:3]
	cat("  Computed Schilling-Doi confidence set for n =",n," and conf.level =",conf.level,"\n");
	m
})


ciwang2014=memorize_cset(function(n,conf.level=0.95) {
	fname = paste0("precalc/wang_", n, "_variable_CI", 100*conf.level, ".csv")
	if (file.exists(fname)) {
		return(read.csv(fname, sep=";",dec=","))
	}
	cat("  Computing Wang confidence set for n =",n," and conf.level =",conf.level,"\n");
	m=wang2017(n,alpha=1-conf.level,rprec=c(1e-2,0.1))
	cat("  Computed Wang confidence set for n =",n," and conf.level =",conf.level,"\n");
	m
})
ciblythstill=memorize_cset(function(n,conf.level=0.95) {
	fname = paste0("precalc/blyth_still_", n, "_CI", 100*conf.level, ".csv")
	if (file.exists(fname)) {
		return(read.csv(fname, sep=";",dec="."))
	} else {
		stop("Blyth-Still interval has not been precomputed for n=",n," and conf.level=",conf.level);
	}
})

glm_ci=function(cimethod=confint, family=poisson(log), seuil_cic=0) {
	memorize(function(x,n,conf.level=0.95) {
		if (n == 1e15) {n = 1e6;imul=1e6/1e15} else {imul=1}
		if (x == 0 | x == n) {return(cic(x,n)*imul)}
		if (pmin(x,n-x) <= seuil_cic) {return(cic(x,n)*imul)}
		if (family$family == "binomial") {form = cbind(x,n-x)~1} else {form=x~1+offset(log(n))}
		mod = try(glm(family=family, formula=form, start=log(x/n)))
		if ("try-error" %in% class(mod)) {
			stop("glm_ci glm error for family=", family$family, " link=", family$link, " x=", x, " n=", n);
		}
		ci = try(cimethod(level = conf.level, mod))
		if ("try-error" %in% class(ci)) {
			stop("glm_ci confint error for family=", family$family, " link=", family$link, " x=", x, " n=", n);
		}
		ci01(family$linkinv(ci))*imul
	})
}
cisterne=memorize(function(x,n,conf.level=0.95) {
	if (n==1e15) {n=1e7;imul=1e7/1e15} else {imul=1}
	goodsterne(x,n,conf.level)*imul
})

ciblaker=memorize(function(x,n,conf.level=0.95) {
	#exactci::binom.exact(c(x,n-x),tsmethod="blaker")$conf.int
	if (n == 1e15) {
		binom.blaker.limits(x,n*1e-7,level=conf.level)*1e-7
	} else {
		binom.blaker.limits(x,n,level=conf.level)
	}
})

ciprofileglm_poisson=glm_ci()
ciprofileglm_logit   =glm_ci(cimethod=confint        ,family=binomial(logit))

ciwaldglm_poisson=glm_ci(cimethod=confint.default)
ciwaldglm_logbinom=glm_ci(cimethod=confint.default,family=binomial(log))
ciwaldglm_logit=glm_ci(cimethod=confint.default,family=binomial(logit))

cisterne_exactci=function(x,n,conf.level) {
	ci=exactci::binom.exact(x,n,conf.level=conf.level,tsmethod="minlike")$conf.int
	c(mean(attr(ci, "conf.limit.prec")$lower),
	  mean(attr(ci, "conf.limit.prec")$upper))
}

p2odds=function(p) {p/(1-p)}
odds2p=function(p) {p/(1+p)}
logit=function(p) {log(p2odds(p))}
expit=function(p) {odds2p(exp(p))}

### Zielinski 2009 doi:10.1080/03610910903391270

cizielinski=memorize(function(x,n,conf.level=0.95,tol=1e-6) {
	q=conf.level
	Lower=function(n,x,q) {qbeta(q,x,n-x+1)}
	Upper=function(n,x,q) {qbeta(q,x+1,n-x)}
	rr = optimize(f=function(r) {
		Upper(n,x,q+r)-Lower(n,x,r)
	},lower=0, upper=1-q, tol=tol/n)$minimum
	ci = c(Lower(n,x,rr), Upper(n,x,q+rr))
	if (x == 1 & n>=3 ) {ci[1]=0}
	if (x == n-1 & n>=3 ) {ci[2]=1}
	ci
})

cibayeshpd=memorize(function(x,n,conf.level=0.95) {
	q=conf.level
	Lower=function(n,x,q) {qbeta(q,x+0.5,n-x+0.5)}
	Upper=function(n,x,q) {qbeta(q,x+0.5,n-x+0.5)}
	rr = optimize(f=function(r) {
		Upper(n,x,q+r)-Lower(n,x,r)
	},lower=0, upper=1-q, tol=1e-6/n)$minimum
	ci = c(Lower(n,x,rr), Upper(n,x,q+rr))
	if (x==0) {ci[1]=0}
	if (x==n) {ci[2]=1}
	return(ci)
})

ciz=function(n,N,conf.level=0.95) { # Wald method
		p=n/N
		ci01(p + qnorm(0.5+c(-conf.level,conf.level)/2)*sqrt(p*(1-p)/N))
}
ciwaldcentered=function(x,n,conf.level=0.95) { # Wald method re-centered on the same center as Wilson
	z=qnorm(0.5+conf.level/2)
	center = (x+0.5*z^2)/(n+z^2)
	p=x/n
	ci = center + c(-z,z)*sqrt(p*(1-p)/n)
	if (x == 0) {ci[1]=0}
	if (x == n) {ci[2]=1}
	ci01(ci)
}


ciwaldcenteredcc=function(x,n,conf.level=0.95) { # Wald+cc method re-centered on the same center as Wilson
	z=qnorm(0.5+conf.level/2)
	center = (x+0.5*z^2)/(n+z^2)
	ci=ci01(center + c(-z,+z)*sqrt(x*(n-x)/n^3))
	ci[1]=pmin(ci[1], x/n)
	ci[2]=pmax(ci[2], x/n)
	ci
}

cic=function(x,n,conf.level=0.95) { # Clopper-Pearson method, fast
	quantiles=0.5+c(-conf.level,+conf.level)/2
	c(qbeta(quantiles[1], x, n-x+1), qbeta(quantiles[2], x+1, n-x))
}


cpmidpvalueb=function(x,n,p) {
	if (n*p > x) {
		pval=pbinom(x,n,p)
	} else {
		pval=pbinom(x-1,n,p,lower.tail=F)
	}
	pmin(1,2 * pval - dbinom(x,n,p))
}
cpmidpvaluep=function(x,p) {
	if (p > x) {
		pval=ppois(x,p)
	} else {
		pval=ppois(x-1,p,lower.tail=F)
	}
	pmin(1,2 * pval - dpois(x,p))
}

# Poisson confidence intervals are binomial confidence intervals with infinite denominator
cpmidpvalue=function(x,n,p) {
	if (n==Inf) {cpmidpvaluep(x,p)} else {cpmidpvalueb(x,n,p)}
}

cicmidpl=function(x,n,conf.level=0.95) {
	if (x == 0) {return(0)}
	denom = ifelse(n==Inf,1,n)
	tol = 1e-6/denom

	uniroot(lower=0, upper=x/denom, function (p) {
		cpmidpvalue(x,n,p) - (1-conf.level)
	},tol=tol)$root
}

cicmidpu=function(x,n,conf.level=0.95) {
	denom = ifelse(n==Inf,1,n)
	if (x == n) {return(1)}
	tol = 1e-6/denom
	upper = qbinpois(0.5+conf.level/2, n, pmin(x+100,n)/denom)/denom

	uniroot(lower=x/denom, upper=upper, function (p) {
		cpmidpvalue(x,n,p) - (1-conf.level)
	},tol=tol)$root
}

cicmidp=memorize2(function(x,n,conf.level=0.95) {
	d=F
	if (n==1e15) {n=Inf;d=T}
	ci = c(cicmidpl(x,n,conf.level), cicmidpu(x,n,conf.level))
	if (d) {ci=ci*1e-15}
	ci
})

ciw=function(x,n,conf.level=0.95) { # Wilson's score method
	p=x/n
	z=qnorm(0.50+conf.level/2)
	var=4*n*p*(1-p)+z^2
	num = p+1/(2*n)*z^2 + c(-1,+1)*1/(2*n)*z*sqrt(var)
	num / (1+z^2/n)
}

cimw=function(x,n,conf.level=0.95) { # Modified Wilson
	if (n<=50) {seuil = 2} else {seuil = 3}
	ci = ciw(x,n,conf.level)
	if (x <= seuil & x>=1) {
		ci[1] = 0.5*qchisq(df=2*x, 1-conf.level)/n
	}
	if (n-x <= seuil & n-x>=1) {
		ci[2] = 1 - 0.5*qchisq(df=2*(n-x), 1-conf.level)/n
	}
	ci
}
ciwcc=function(x,n,conf.level=0.95) { # Wilson's score + continuity correction
	z = qnorm(0.5+conf.level/2)
	p = x/n
	# Formula of Newcombe 1998 (comparison of seven methods)
	cilower = (2*n*p+z^2-1-z*(sqrt(z^2-2-1/n+4*p*(n*(1-p)+1) )))
	ciupper = (2*n*p+z^2+1+z*(sqrt(z^2+2-1/n+4*p*(n*(1-p)-1) )))
	ci = c(cilower, ciupper)
	ci = ci/(2*(n+z^2))
	ci[1]=pmax(ci[1],0)
	ci[2]=pmin(ci[2],1)
	if (x==0) {ci[1]=0}
	if (x==n) {ci[2]=1}
	ci
}

cit=function(x,n,conf.level=0.95) {
	p=x/n
	ci01(p + qt(0.5+c(-conf.level,conf.level)/2, df=n-1)*sqrt(p*(1-p)/(n-1)))
}

dfpan2002=function(x,n) {
	# Lorsque p est petit et n assez grand, le degré de liberté est environ égal à 2*x
	if (x == 0 | x==n) {return(0)}
	p=x/n
	var=p*(1-p)/n
	omega = (p-p^2)/n^3 +
			(p+(6*n-7)*p^2+4*(n-1)*(n-3)*p^3-2*(n-1)*(2*n-3)*p^4)/n^5 -
			2*(p+(2*n-3)*p^2-2*(n-1)*p^3)/n^4
	df = 2*var^2/omega
	df
}


binomstud=function(p,prob,size,unbiased=F) {
	(p - prob)/sqrt(p*(1-p)/(size-unbiased))
}
kurtstudbinom=function(x0,n,add4=0) { # kurtosis excess of studentized binom distribution. add4 is the number of successes and failures to add
	# Note : Le fait d'utiliser la variance biaisée (divisée par n) ou non biaisée (divisée par n-1)
	# Ne change pas le kurtosis (multiplication par une constante)
	n=round(n)
	prob=x0/n
	x=pmax(1,pmin(n-1, qbinom(c(1e-6, 1-1e-6), prob=prob,size=n)))
	x=x[1]:x[2]
	d=dbinom(x, prob=prob, size=n)
	x=x+add4
	n=n+2*add4
	y=binomstud(x/n,(x0+add4)/n,n);
	y = y - sum(y*d)
	sum(d*y^4)/(sum(d*y^2)^2) - 3
	
}
kdf=function(x0,n,add4=0) { # Get degree of freedom (André GILLIBERT) of student t distro for a binomial distro
	4+1/(kurtstudbinom(x0,n,add4=add4)/6)
}

# Appendix 1, explanation about Pan 2002 erronous kurtosis

citpan=function(x,n,conf.level=0.95) {
	# Comparison of twenty intervals, method of Pan 2002 for Wald-t equation 2.8 page 176
	if (x == 0 | x == n) {return(c(0,1))}
	p=x/n
	ci01(p + qt(0.5+c(-conf.level, conf.level)/2, df=dfpan2002(x,n))*sqrt(p*(1-p)/n))
}
citpanGILLIBERTunbiased=memorize(function(x,n,conf.level=0.95) {
	# Comparison of twenty intervals, method of Pan 2002 for Wald-t equation 2.8 page 176. FIXED by Gillibert !
	if (x <= 3 | n - x <= 3) {return(cic(x,n))}
	p=x/n
	p + qt(0.5+c(-conf.level, conf.level)/2, df=kdf(x,n))*sqrt(p*(1-p)/(n-1))
})

citpanagresti=function(x,n,conf.level=0.95) {
	add2=0.5*qnorm(0.5+conf.level/2)^2
	citpan(x+add2, n+2*add2, conf.level)
}

citpanagrestiGILLIBERTunbiased=function(x,n,conf.level=0.95) {
	if (x <= 5 | n - x <= 5) {return(cic(x,n))}
	add4 = 0.5*qnorm(0.5+conf.level/2)^2
	df = kdf(x,n,add4=add4)
	x = x+add4; n=n+2*add4;
	p = x/n
	p + qt(0.5+c(-conf.level, conf.level)/2, df=df)*sqrt(p*(1-p)/(n-1))
}

citpan_clopper1=alternativeci_seuil(1,cic,citpan)
cit_clopper1=alternativeci_seuil(1,cic,cit)
ciz_clopper1=alternativeci_seuil(1,cic,ciz)


ciasin=function(x,n,conf.level=0.95) { # Méthode de l'Arc Sinus
	#if (x==0 | x==n) {return(cic(x,n))}
	ci = sin(asin(sqrt(x/n))+qnorm(0.5+c(-conf.level,conf.level)/2)/(2*sqrt(n)))^2
	if (x == 0) {ci[1]=0}
	if (x == n) {ci[2]=1}
	ci
}

# Anscombe transform for binomial distribution
asinanscombe2=function(x,n,c=3/8,cdenom=c*2) {
	asin(sqrt((x+c)/(n+cdenom)))*sqrt(n+0.5)
}

# Reciprocal of Anscombe transform
asinanscombe2.inv=function(t,n,c=0) {
	t=t/sqrt(n+0.5)
	(sin(t)^2*(n+2*c)-c)/n
}

# Yu Guan 2009 (doi:10.1016/j.spl.2009.04.010)
cistick=function(ci,x,n) {
	# Ensures that confidence interval contains point estimate when x=0 or x=n
	if (is.matrix(ci)) {
		ci[,1] = (x!=0)*ci[,1]
		ci[,2] = ifelse(x==n,1,ci[,2])
	} else {
		ci[1] = (x!=0)*ci[1]
		ci[2] = ifelse(x==n,1,ci[2])
	}
	ci
}

asinci=function(x,n,conf.level=0.95,c=1/2,cdenom=c*2,crev=0) {
	SE = sqrt(1/4) # Anscombe eq 3.4 works for any constant c
	ci1=asinanscombe2.inv(asinanscombe2(x,n,c=c,cdenom=cdenom)+qnorm(0.5-conf.level/2)*SE,n,c=crev)
	ci2=asinanscombe2.inv(asinanscombe2(x,n,c=c,cdenom=cdenom)+qnorm(0.5+conf.level/2)*SE,n,c=crev)
	if (length(ci1) == 1) {ci=c(ci1,ci2)} else {ci=cbind(ci1,ci2)}
	ci=cistick(ci01(ci),x,n)
	ci
}
ciasinbartlett=function(x,n,conf.level=0.95, drop=T) { # Méthode de l'Arc Sinus selon Bartlett (constante +1/2) doi:10.2307/2983678. Optimisé pour l'exécution parallèle
	kappa=qnorm(0.5+conf.level/2)/(2*sqrt(n+0.5))
	lcl=sin(pmax(0,asin(sqrt((x+0.5)/(n+1)))-kappa))^2
	ucl=sin(pmin(pi/2,asin(sqrt((x+0.5)/(n+1)))+kappa))^2
	ci=cbind(lcl,ucl)
	if (nrow(ci) == 1 & drop) {
		ci=ci[1,]
	}
	ci
}

ciasinanscombe.pires=function(x,n,conf.level=0.95) { # Méthode de l'Arc Sinus Anscombe selon Matuszwski 1985 doi:10.1016/0167-9473(85)90067-2
	asinci(x,n,conf.level,3/8)
}
ciasinanscombecc=function(x,n,conf.level=0.95) { # Méthode de l'Arc Sinus modifié par Anscombe + correction de continuité de Pires 2008
	#if (x==0 | x==n) {return(cic(x,n))}

	corr=c(-0.5,+0.5)
	if (x == 0) {corr[1]=0}
	if (x == n) {corr[2]=0}
	ci = sin(asin(sqrt((x+corr+3/8)/(n+3/4)))+qnorm(0.5+c(-conf.level,conf.level)/2)/(2*sqrt(n+0.5)))^2 # Anscombe (1948) improperly described by Brown and DasGupta 2001, equation 11 (he missed the +0.5 in 2*sqrt(n+0.5))
	if (x == 0) {ci[1]=0}
	if (x == n) {ci[2]=1}
	ci
}

ciasinfreeman=function(x,n,conf.level=0.95) { # Méthode de l'Arc Sinus selon Freeman & Tukey 1950
	t = asin(sqrt(x/(n+1)))+asin(sqrt((x+1)/(n+1)))
	ci = qnorm(0.5+c(-conf.level,conf.level)/2)
	var = 1/(n+0.5)
	ci = sin( (t + ci*sqrt(var)) / 2)^2
	if (x == 0) {ci[1]=0}
	if (x == n) {ci[2]=1}
	ci01(ci)
}


cihall=function(x,n,conf.level=0.95) { # Hall 1982 with n as the denominator (rather than n-1 in Kott-Liu)
	z=qnorm(0.5+conf.level/2)
	p = x/n
	ci = p + (z^2/3+1/6)*(1-2*p)/n + c(-z, z)*sqrt(p*(1-p)/n)
	if (x == 0) {ci[1]=0}
	if (x == n) {ci[2]=1}
	ci01(ci)
}
cicai=function(x,n,conf.level=0.95) {
	z=qnorm(0.5+conf.level/2)
	p=x/n
	eta = z^2/3 + 1/6
	pr=(p+eta/n) / (1+2*eta/n)
	gamma1=-13/18*z^2-17/18
	gamma2=1/18*z^2 + 7/36
	var = p*(1-p)+(gamma1*p*(1-p)+gamma2)/n
	ci = ci01(pr + c(-z,z)/sqrt(n)*sqrt(var))
	if (x == 0) {ci[1]=0}
	if (x == n) {ci[2]=1}
	ci
}	
cikottliu=function(x,n,conf.level=0.95) {
	z=qnorm(0.5+conf.level/2)
	p = x/n
	delta = (z^2/3+1/6)*(1-2*p)/n
	ci = p + delta + c(-1, 1)*sqrt(z^2*p*(1-p)/(n-1) + delta^2)
	if (x == 0) {ci[1]=0}
	if (x == n) {ci[2]=1}
	ci01(ci)
}

# Exact (strictly conservative) score test (p=theoretical proportion, x=numerator, n=denominator)
exacttestscore=function(x,n,p) {
	l1 = floor(n*(p - abs(x/n - p)))
	l2 = ceiling(n*(p + abs(x/n - p)))
	pmin(1, pbinom(l1,n,p)+1-pbinom(l2-1,n,p))
}

Molenaar_upper=function(x,n,conf.level=0.95) {
	if (x==n) {return(1)}
	xi = qnorm(0.5+conf.level/2);
	psi = (xi^2+2)/3
	omega = (7-xi^2)/18;
	( x + psi + xi*sqrt((x+1-omega)*(n-x-omega)/(n+11*omega-4))) / (n+2*psi-1)
}
Molenaar_alt_upper=function(x,n,conf.level=0.95) { # Blyth 1986 equation (C) doi:10.1080/01621459.1986.10478343
	if (x==n) {return(1)}
	kappa=qnorm(0.5+conf.level/2)
	kappa2=kappa^2
	(x*(1+(1-kappa2)/(3*n)) + (2+kappa2)/3 + (1-kappa2)/(6*n) +
	kappa*
	sqrt(
		(x+1)*(n-x)/n*(1+(7-kappa2)/(18*n))
		-(n+1)*(7-kappa2)/(18*n)
	)) / (n+(2+kappa2)/3)
}
cimolenaar=function(x,n,conf.level=0.95) {
	ci01(c(1-Molenaar_upper(n-x,n,conf.level), Molenaar_upper(x,n,conf.level)))
}
cimolenaar_alt=function(x,n,conf.level=0.95) {
	ci01(c(1-Molenaar_alt_upper(n-x,n,conf.level), Molenaar_alt_upper(x,n,conf.level)))
}

cipratt_upper=function(x,n,conf.level=0.95) { # Got from Blyth 1986 doi:10.1080/01621459.1986.10478343
	if (x<0) {x=0}
	if (x==n) {return(1)}
	kappa = qnorm(0.5+conf.level/2)
	1/(1+((x+1)/(n-x))^2*(
		(81*(x+1)*(n-x)-9*n-8
		  -3*kappa*sqrt(9*(x+1)*(n-x)*(9*n+5-kappa^2)+n+1)
		 )
		 /(81*(x+1)^2-9*(x+1)*(2+kappa^2)+1)
	)^3)
}
cipratt=function(x,n,conf.level=0.95) {
	c(1-cipratt_upper(n-x,n,conf.level), cipratt_upper(x,n,conf.level))
}


# See Reed 2007 doi:10.22237/jmasm/1177992840
ciprattmean_upper=function(x,n,conf.level=0.95) {
	if (x==n) {return(1)}
	(cipratt_upper(x,n,conf.level=conf.level)+cipratt_upper(x-1,n,conf.level=conf.level))/2
}
ciprattmean=function(x,n,conf.level=0.95) {
	c(1-ciprattmean_upper(n-x,n,conf.level), ciprattmean_upper(x,n,conf.level))
}


exactcptest=function(x,n,p) { # Exact Clopper-Pearson test (returns p-value)
	2*pmin(0.5,pbinom(x,n,p),pbinom(x-1,n,p,lower.tail=F))
}

krishcombtest=function(x,n,p) {
	pmin(exacttestscore(x,n,p), exactcptest(x,n,p)) # Combined test Cai-Krishnamoorthy doi:10.1016/j.csda.2004.03.008
}

# Test inversion algorithm for non-monotonous P-value functions.
# Useful for (i) Exact score test (ii) Cai-Krishnamoorthy (iii) Exact likelihood ratio test
# p01func is a conservative interval, larger than the one computed
stepalgoci_lower=function(pptest,p01func,fpostest=NULL) {
	function(x,n,conf.level=0.95,prec=1e-3/n) {
		margin = 4 # Number of prec steps due to imprecision
		if (x == 0) {return(0)}
		alpha = 1-conf.level
		p01=p01func(x,n,alpha)
		p0 = pmax(0,p01[1]-prec)
		p1 = pmin(1,p01[2]+prec)
		test=function(p) {pptest(x,n,p) - alpha}
		if (sign(test(p1) * test(p0))<0) { # Seek a zero
			p1 = uniroot(test,c(p0,p1),tol=1e-8/n)$root+prec
		}
		ps = seq(p0,p1+margin*prec,prec)
		if (!is.null(fpostest)) {
			pok = fpostest(x, n, ps, alpha) # numeric(0) if no negative test on this interval, otherwise, get the first test above alpha
		} else {
			pok = ps[which(test(ps) > 0)]
		}
		if (length(pok)>=1) {
			interval = pmax(0,pmin(1,c(pok[1] - margin*prec, pok[1] + margin*prec)))
			if (sign(test(interval[1])) * sign(test(interval[2])) < 0) {
				r = uniroot(test, interval,tol=1e-8/n)$root - 1e-8/n
				return(r)
			} else {
				# On est sur une pointe (convexité)
				r = optimize(test, interval, maximum=T)$maximum
				return(r)
			}
		}
		p0 = 0
		p1 = 1
		while(p0 <= p1) {
			if (test(p0) >= 0) {
				return (p0)
			}
			p0 = p0 + prec
		}
	}
}
stepalgoci=function(pptest,p01func,fpostest=NULL) {
	cilower=stepalgoci_lower(pptest,p01func,fpostest=fpostest)
	memorize2(function(x,n,conf.level=0.95,prec=1e-3/n) {
		c(cilower(x,n,conf.level,prec), 1-cilower(n-x,n,conf.level,prec))
	})
}

cicaikrish=stepalgoci(krishcombtest, function(x,n,alpha) {
	c(qbeta(alpha/2, x, n-x+1), qbeta(alpha, x, n-x+1))
})

p01clopper_large=function(x,n,alpha) {
	c(qbeta(alpha/4, x, n-x+1), qbeta(alpha, x, n-x+1))
}
ciexactscore=stepalgoci(exacttestscore, p01clopper_large)

GLLR=function(x,n,p) {
	#log(dbinom(x,n,x/n)/dbinom(x,n,p))
	ldbinom(x,n,x/n) - ldbinom(x,n,p)
}

cut0.integer=function(test,iv,def1,def2,pos.side=T) {
	st1=sign(test(iv[1]))
	st2=sign(test(iv[2]))
	if (st1 < 0 & st2 < 0) {
		return(def2)
	} else if (st1 >= 0 & st2 >= 0) {
		return(def1)
	} else {
		uniroot.integer(test,iv,pos.side=pos.side,step.power=32)$root
	}
}

exacttestlr1=function(x,n,p,ref=NA) {
	if (p==0) {
		return (1*(x==0))
	}
	if (p==1) {
		return (1*(x==n))
	}
	if (n*p == x) {return(1)}
	ll = GLLR(x,n,p)
	test=function(x0) {
		#if (x0 < 0 | x0 > n) {return(Inf)}
		GLLR(x0,n,p) - ll
	}
	lowup=F
	if (!is.na(ref) & !is.null(attr(ref,"lower"))) {
		lower = attr(ref,"lower")
		upper = attr(ref,"upper")
		lowup = (!is.na(lower) && !is.na(upper)
			&& test(lower) >= 0
			&& test(lower+1) < 0
			&& test(upper-1) < 0
			&& test(upper) >= 0);
	}
	if (!lowup) {
		lower = cut0.integer(test,c(0,floor(n*p)),floor(n*p),-1)
		upper = cut0.integer(test,c(floor(n*p)+1,n),floor(n*p)+1,n+1)
	}

	p = pbinom(lower,n,p) + pbinom(upper-1,n,p,lower.tail=F)
	if (lower >= 0 & upper <= n) {
		attr(p, "lowerX")=lower
		attr(p, "upperX")=upper
	}
	attr(p, "newcalc")=!lowup
	p
}
exacttestlr=function(x,n,pp) {
	r = NA
	l = NULL
	l2 = NULL
	vapply(pp, function(p) {
		r <<- exacttestlr1(x,n,p,ref=r)
		r
	},1.0)
}
exactfpostest_lr=function(x,n,pp,alpha) {
	r = NA
	for(p in pp) {
		r = exacttestlr1(x,n,p,ref=r)
		if (r >= alpha) {
			return(p)
		}
	}
	return(numeric(0))
}
ciexactlr=stepalgoci(exacttestlr, p01clopper_large, exactfpostest_lr)



### Normal approximation intervals
ciagresti=function(x,n,conf.level=0.95) {
	add2=0.5*qnorm(0.5+conf.level/2)^2
	ciz(x+add2, n+2*add2, conf.level)
}
cisaifs=function(x,n,conf.level=0.95) { # méthode de Craig B. Borkowf 2006
	p1=x/(n+1)
	p2=(x+1)/(n+1)
	z=qnorm(0.5+conf.level/2)
	ci01(c(p1-z*sqrt(p1*(1-p1)/n), p2+z*sqrt(p2*(1-p2)/n)))
}
cisaifs2=function(x,n,conf.level=0.95) { # méthode de Craig B. Borkowf 2006
	p1=x/(n+1)
	p2=(x+1)/(n+1)
	z=qnorm(0.5+conf.level/2)
	(c(p1-z*sqrt(p1*(1-p1)/n), p2+z*sqrt(p2*(1-p2)/n)))
}

ptest=function(x,n,conf.level=0.95) { # Ça utilise la méthode de Wilson !
	prop.test(x,n,conf.level=conf.level,correct=F)$conf.int
}
cizc=function(x,n,conf.level=0.95) { # Z-test avec correction de continuité
	ci01(ciz(x,n,conf.level)+c(-0.5,+0.5)/n)
}

cijeffrey=function(x,n,conf.level=0.95,drop=T,a=0.5) { # equal-tailed Jeffreys prior interval
	# Intervalle de Jeffrey
	# Paramètre x=nombre d'événements
	# Paramètre n=taille de l'échantillon

	quantiles=0.5+c(-conf.level,+conf.level)/2
	cil=ifelse(x==0,0,qbeta(quantiles[1], x+a, n-x+a))
	ciu=ifelse(x==n,1,qbeta(quantiles[2], x+a, n-x+a))
	ci=cbind(cil,ciu)
	if (nrow(ci)==1 && drop) {ci[1,]} else {ci}
}

cibayesunif=function(x,n,conf.level=0.95,drop=T) {
	cijeffrey(x,n,conf.level,drop=drop,a=1)
}
cimjeffrey=function(x,n,conf.level=0.95,drop=T) {
	# Intervalle de Jeffrey Modifié
	# Paramètre x=nombre d'événements
	# Paramètre n=taille de l'échantillon

	ci=cijeffrey(x,n,conf.level,drop=F)
	ci[x==0, 2] = 1-((1-conf.level)/2)^(1/n)
	ci[x==n, 1] = ((1-conf.level)/2)^(1/n)
	ci[x==1, 1] = 0
	ci[x==n-1, 2] = 1
	if (nrow(ci)==1 && drop) {ci[1,]} else {ci}
}



cilogit=function(x,n,conf.level=0.95) {
	if (x == 0 | x==n) {return(cic(x,n))}
	quantiles=0.5+c(-conf.level,+conf.level)/2
	lambda=log(x/(n-x)) # logit(p)
	lambda=lambda+qnorm(quantiles)*sqrt(n/(x*(n-x)))
	exp(lambda)/(1+exp(lambda))
}



#######
logitanscombe=function(x,n) {
	log((x+0.5)/(n-x+0.5))
}
logitanscombe.inv=function(lambda,n) {
	# log((x+0.5)/(n-x+0.5)) = lambda
	# (x+0.5)/(n-x+0.5) = exp(lambda)
	# el=exp(lambda)
	# (x+0.5) = el*n - el*x + 0.5*el
	# (1 + el)*x = el*n + 0.5*el - 0.5
	# x = (el*(n+0.5) - 0.5)/(1+el)
	# ci = exp(lambda)/(1+exp(lambda))
	(exp(lambda)*(n+0.5)-0.5)/(1+exp(lambda))/n
}
logitanscombe.inv(logitanscombe(3,10),10)
logitanscombe.inv(logitanscombe(2.7,10),10)

cilogitanscombe=function(x,n,conf.level=0.95) { # Intervalle logit Anscombe
	#if (x == 0 | x == n) {return(cic(x,n,conf.level))}
	quantiles=0.5+c(-conf.level,+conf.level)/2
	lambda=logitanscombe(x,n)
	var=(n+1)*(n+2)/(n*(x+1)*(n-x+1))
	lambda=lambda+qnorm(quantiles)*sqrt(var)
	ci = logitanscombe.inv(lambda, n)
	ci01(ci)
}


# bug report 1 : binom::binom.profile(1,30,bayes=F) has a different lower bound than binom::binom.profile(1,30,bayes=F,del=0.1)
# Moreover, likelihood ratio test is possible for zero events (contrary to what is said in documentation)

cilr0=function(x,n,conf.level=0.95,clopper=F) { # Likelihood-ratio test inversion
	ll=function(p) {x*log(p) + (n-x)*log(1-p)} # log-likelihood (choose() removed as it's a constant)
	
	if ((x==0 | x==n) & clopper) {return(cic(x,n,conf.level))}
	if (x==0 | x==n) {bl=0} else {bl = ll(x/n)}
	z=qnorm(0.5+conf.level/2)
	lambda=function(p0) {
		-2*(ll(p0) - bl) - z^2
	}
	if (x != 0) {cilower=uniroot(lower=0, upper=min(n-0.001,x)/n, lambda,tol=1e-12/n)$root} else {cilower=0}
	if (x != n) {ciupper=uniroot(lower=max(0.001,x)/n, upper=1, lambda,tol=1e-12/n)$root} else {ciupper=1}
	c(cilower, ciupper)
}

cilr=memorize(cilr0)
cilr1=memorize(function (x,n,conf.level=0.95) {cilr0(x,n,conf.level,clopper=T)})

cirubin=function(x,n,conf.level=0.95) { # Rubin & Schenker 1987
	ci = cilogit(x+0.5,n+1,conf.level)
	if (x == 0) {ci[1]=0}
	if (x == n) {ci[2]=1}
	ci
}


cibootperc0=function(x,n,conf.level=0.95) {
	qbinom(size=n,prob=x/n, 0.5+c(-conf.level,conf.level)/2)/n
}
cibootperc=function(x,n,conf.level=0.95) {
	if (x == 0 | n-x==0) {return(cic(x,n,conf.level))}
	cibootperc0(x,n,conf.level)
}

cibootbasic0=function(x,n,conf.level=0.95) {
	ci01((2*x-qbinom(size=n,prob=x/n, 0.5+c(conf.level,-conf.level)/2))/n)
}

cibootbasic=function(x,n,conf.level=0.95) {
	if (x == 0 | n-x==0) {return(cic(x,n,conf.level))}
	cibootbasic0(x,n,conf.level)
}
cibootstud=function(x,n,conf.level=0.95) {
	if (x <= 4 | n-x<=4) {return(cic(x,n,conf.level))}
	p0=x/n

	l=qbinom(size=n,prob=p0, 0.5+c(conf.level)/2)/n
	u=qbinom(size=n,prob=p0, 0.5-c(conf.level)/2)/n
	l=p0-(l-p0)*sqrt(p0*(1-p0)/(l*(1-l)))
	u=p0-(u-p0)*sqrt(p0*(1-p0)/(u*(1-u)))
	c(l,u)
}

cibootbca=function(x,n,conf.level=0.95,discrete=F) {
	# x=nombre d'événements
	# n=taille de l'échantillon
	# discrete=TRUE pour utiliser la variante du BCa améliorée pour les distribution de bootstrap discrètes
	# et discrete=FALSE pour utiliser le BCa standard tel que décrit par Efron en 1987 et utilisé par le paquet boot

	if (x == 0 | n-x==0) {return(cic(x,n,conf.level))} # Utiliser Clopper-Pearson pour 0% et 100%
	# Repose sur Efron 1987 Better bootstrap Confidence Intervals
	p=x/n # Proba estimée
	skew=(1-2*p)/sqrt(p*(1-p)) # Estimation de la skewness de la var de Bernoulli
	z0 = qnorm(pbinom(x-1,prob=p,size=n) + discrete*0.5*dbinom(x,prob=p,size=n)) # Eq 3.2 + eq 4.1 + amélioration si discrete=TRUE
	a = 1/(6*sqrt(n))*skew; # Accélération selon une variante d'Eq 4.4 appliquée à la moyenne (formule de mon mémoire)
	z = qnorm(0.5+c(-conf.level,conf.level)/2) # -1.96 , +1.96 si conf.level=0.95
	adjp = pnorm(z0 + (z0+z) / (1-a*(z0+z))) # Eq 3.14 -> quantiles ajustés
	qbinom(adjp, prob=p,size=n)/n # On renvoie l'IC95 BCa
}

cibootbcaD=function(x,n,conf.level=0.95) {
	cibootbca(x,n,conf.level,discrete=T)
}

bca=function(t0,v,a,conf.level=0.95) {
	# Repose sur Efron 1987 Better bootstrap Confidence Intervals
	n=length(v)
	z0 = qnorm(mean(v < t0))
	z = qnorm(0.5+c(-conf.level,conf.level)/2) # -1.96 , +1.96 si conf.level=0.95
	adjp = pnorm(z0 + (z0+z) / (1-a*(z0+z))) # Eq 3.14 -> quantiles ajustés
	boot:::norm.inter(v,adjp)[,2]
}


cibootsmoothbca=memorize2(function(x,n,conf.level=0.95,R=20000,smooth=0.5) {
	if (x==0 | x==n) {return(cic(x,n))}
	p=x/n
	t = (rbinom(R,n,p) + rnorm(R)*smooth)/n
	a=(1-2*p)/(6*sqrt(n*p*(1-p)))
	ci01(bca(p, t, a, conf.level=conf.level))
})
control0=list(conf.level=0.95, cifunc=cic, right=F, Npois=4000, overlap=16, frame=512, OR=1.20, unif=F, hotepsilon=1e-3, conditionnalStep=0.1)

getcontrol=function(control, name) {
	if (!is.null(control[[name]])) {
		return(control[[name]]);
	}
	control0[[name]]
}
poisz=function(x, conf.level=0.95, drop=F) {
	quantiles = qnorm(0.5+c(-conf.level, conf.level)/2)
	sx=sqrt(x)
	ci = cbind(x + quantiles[1]*sx, x + quantiles[2]*sx)
	if (nrow(ci)==1 && drop) {ci[1,]} else {ci}
}


##############################################################################
#########             END OF INTERVAL DEFINITIONS                    #########
##############################################################################
