
############################################################################################
#### On va essayer de réimplementer les fonctions à partir des formules de l'article   #####
############################################################################################
comparecifunc=function(cifunc1, cifunc2, tol=1e-6, conf.level=0.95) {
	wrong = any(sapply(c(32,64,128,2048), function (n) {
		any(sapply(0:n, function (x) {
			ci1=cifunc1(x,n, conf.level)
			ci2=cifunc2(x,n,qnorm(0.5+conf.level/2), 1-conf.level)
			if (length(ci1) != length(ci2)) {ci1=ci1[1];ci2=ci2[1]}
			wrong = max(abs(ci1 - ci2)) > tol
			if (is.na(wrong)) {
				print(c(x,n))
			}
			if (wrong) {
				cat("Difference for : ", x, "/", n, "\n")
			}
			wrong
		}))
	}))
	!wrong
}

ciz2=function(x,n,kappa,alpha) {
	max(x/n - kappa*sqrt(x*(n-x)/n^3), 0)
}
comparecifunc(ciz,ciz2)

cimw2=function(x,n,kappa,alpha) {
	xstar = ifelse(n<=50,2,3)
	if (x >= 1 & x <= xstar) {
		1/(2*n)*qchisq(alpha,df=2*x)
	} else {
		(x+kappa^2/2 - kappa*sqrt(x*(n-x)/n + kappa^2/4))/(n+kappa^2)
	}
}
comparecifunc(cimw,cimw2)

ciasinbartlett2=function(x,n,kappa,alpha) {
	sin(max(0,asin(sqrt((x+1/2)/(n+1)))-kappa/(2*sqrt(n+1/2))) )^2
}
comparecifunc(ciasinbartlett,ciasinbartlett2)

cilogit2=function(x,n,kappa,alpha) {
	if (x > 0 & x < n) {
		expit( log(x/(n-x))-kappa*sqrt(n/(x*(n-x))) )
	} else if (x==n) {
		(alpha/2)^(1/n)
	} else if (x==0) {
		0
	}
}
comparecifunc(cilogit,cilogit2)

cilr_new=function(x,n,kappa,alpha) {
	if (x == n) {
		(alpha/2)^(1/n)
	} else {
		rt=function(q) {
			log(((x/(n*q))^x*((n-x)/(n*(1-q)))^(n-x))) - 1/2*kappa^2
		}
		if (x>0) {uniroot(rt,c(0,x/n),tol=1e-8/n)$root} else {0}
	}
}
comparecifunc(cilr1,cilr_new)

cimjeffrey2=function(x,n,kappa,alpha) {
	if (x>=2 & x < n) {qbeta(alpha/2, x+1/2,n-x+1/2)}
	else if (x == n) {(alpha/2)^(1/n)}
	else if (x<=1) {return(0)}
}
comparecifunc(cimjeffrey,cimjeffrey2)


### begin Blaker
bpval=function(q,x,n) {
	if (q>=x/n) {
		pmin(1, pbinom(x,n,q) + 1-pbinom(qbinom(1-pbinom(x,n,q),n,q),n,q))
	} else if (q<x/n) {
		bpval(1-q,n-x,n)
	}
}
bpval2=function(q,x,n) {
	if (q>=x/n) {
		pmin(n, x + n - qbinom(1-pbinom(x,n,q),n,q)) # Number of support values in Blaker's p-value
	} else if (q<x/n) {
		bpval2(1-q,n-x,n)
	}
}

blaker_nextdiscontL(x,n,pcp)
bpval2(pcp,x,n)
bpval2(pstar,x,n)
blaker_nextdiscontL=function(x,n,p) {
	target = bpval2(p,x,n) + 0.5
	test=function(q) {
		bpval2(q,x,n) - target
	}
	if (sign(test(p)) * sign(test(x/n)) >= 0) {return(x/n)}
	uniroot(test,c(p,x/n),tol=1e-8/n)$root
}

plotblaker=function(x,n,xlim=c(0,1),...) {
	ps = seq(xlim[1],xlim[2],1e-3/n)
	plot(x=ps,y=sapply(ps, function(p) {
		bpval(p,x,n)
	}),xlim=xlim,type="l",...)
	abline(h=0.05,lty="dashed")
}

blaker_ndL=function(x,n,kappa,alpha) {
	if (x==0) {return(0)}
	pcp = qbeta(alpha/2,x,n-x+1)
	pstar = blaker_nextdiscontL(x,n,pcp)
	bpvalstar=function(p) {
		if (p >= pstar) {Inf}
		else {bpval(p,x,n) - alpha}
	}
	#plotblaker(x,n,xlim=c(0.94,0.95),ylim=c(0.02,0.06))
	#abline(col="violet",v=pstar)
	uniroot(bpvalstar,c(pcp,pstar),tol=1e-8/n)$root
}
comparecifunc(ciblaker,blaker_ndL)
ciblaker(126,128)
blaker_ndL(126,128,1.96,0.05)

###end Blaker

cic2=function(x,n,kappa,alpha) {
	qbeta(alpha/2, x, n-x+1)
}
comparecifunc(cic,cic2)

cicmidp2=function(x,n,kappa,alpha) {
	if (x==0) {return(0)}
	test=function(q) {
		min(pbinom(x,n,q),1-pbinom(x-1,n,q))-1/2*dbinom(x,n,q) - alpha/2
	}
	uniroot(test, c(0, x/n), tol=1e-8/n)$root
}
comparecifunc(cicmidp,cicmidp2)

cit2=function(x,n,kappa,alpha) {
	p=x/n
	pmax(0, p-qt(1-alpha/2,n-1)*sqrt(p*(1-p)/(n-1)))
}
comparecifunc(cit,cit2)

cizc2=function(x,n,kappa,alpha) {
	p=x/n
	pmax(0,p-kappa*sqrt(p*(1-p)/n)-1/(2*n))
}
comparecifunc(cizc,cizc2)

ciwaldcentered2=function(x,n,kappa,alpha) {
	p=x/n
	ptilde=(x+1/2*kappa^2)/(n+kappa^2)
	pmin(x/n,pmax(0,ptilde - kappa*sqrt(p*(1-p)/n)))
}
comparecifunc(ciwaldcentered,ciwaldcentered2)

omega2=function(p,n) {
	(p-p^2)/n^3 -2*(p+(2*n-3)*p^2-2*(n-1)*p^3)/n^4 +(p+(6*n-7)*p^2+4*(n-1)*(n-3)*p^3-2*(n-1)*(2*n-3)*p^4)/n^5
}
citpan2=function(x,n,kappa,alpha) {
	p=x/n
	dfp=(2*(p*(1-p)/n)^2)/omega2(p,n) 
	pmax(0, p - qt(1-alpha/2, dfp)*sqrt(p*(1-p)/n))
}
citpan2(0,100,1.96,0.05)

# citpanGILLIBERTunbiased not yet tested

ciagresti2=function(x,n,kappa,alpha) {
	p=x/n
	ptilde=(x+1/2*kappa^2)/(n+kappa^2)
	pmax(0, ptilde - kappa*sqrt(ptilde*(1-ptilde)/(n+kappa^2)))
}
comparecifunc(ciagresti,ciagresti2)

citpanagresti2=function(x,n,kappa,alpha) {
	p=x/n
	ptilde=(x+1/2*kappa^2)/(n+kappa^2)
	dfptilde=(2*(ptilde*(1-ptilde)/(n+kappa^2))^2)/omega2(ptilde,n+kappa^2) 
	max(0,ptilde - qt(1-alpha/2, dfptilde)*sqrt(ptilde*(1-ptilde)/(n+kappa^2)))
}
comparecifunc(citpanagresti,citpanagresti2)


# citpanagrestiGILLIBERTunbiased not yet tested

ciw2=function(x,n,kappa,alpha) {
	(x+kappa^2/2-kappa*sqrt(x*(n-x)/n+kappa^2/4))/(n+kappa^2)
}
ciw2(10,10,kappa,alpha)
ciw2(1,10,kappa,alpha)

comparecifunc(ciw,ciw2)

ciwcc2=function(x,n,kappa,alpha) {
	p=x/n
	ifelse(x==0,0,1/(2*(n+kappa^2))*(2*x+kappa^2-1-kappa*sqrt(kappa^2-2-1/n+4*x/n*(n-x+1))))
}
comparecifunc(ciwcc,ciwcc2)
ciwcc2(0,2048,kappa,alpha)
ciwcc(0,2048)

ciasin2=function(x,n,kappa,alpha) {
	p=x/n
	if (x==0) {return(0)} else {sin(asin(sqrt(p))-kappa/(2*sqrt(n)))^2}
}
comparecifunc(ciasin,ciasin2)

ciasinanscombe2=function(x,n,kappa,alpha) {
	ifelse(x==0,0,sin(asin(sqrt((x+3/8)/(n+3/4)))-kappa/(2*sqrt(n+1/2)))^2)
}
comparecifunc(ciasinanscombe.pires,ciasinanscombe2)

ciasinfreeman2=function(x,n,kappa,alpha) {
	ifelse(x==0,0,sin(1/2*(asin(sqrt(x/(n+1)))+asin(sqrt((x+1)/(n+1)))-kappa/sqrt(n+1/2)))^2)
}
comparecifunc(ciasinfreeman,ciasinfreeman2)

la=function(p,n) {
	log((n*p+1/2)/(n*(1-p)+1/2))
}
lainv=function(t,n) {
	((n+1/2)*exp(t)-1/2)/(n*(1+exp(t)))
}

cilogitanscombe2=function(x,n,kappa,alpha) {
	pmax(0,lainv(la(x/n,n)-kappa*sqrt(((n+1)*(n+2))/(n*(x+1)*(n-x+1))),n))
}
comparecifunc(cilogitanscombe,cilogitanscombe2)

cirubin2=function(x,n,kappa,alpha) {
	ifelse(x==0,0,expit(la(x/n,n)-kappa*sqrt((n+1)/((x+1/2)*(n-x+1/2)))))
}
cirubin(1,100)
cirubin2(1,100,kappa,alpha)
comparecifunc(cilogitanscombe,cilogitanscombe2)

cijeffrey2=function(x,n,kappa,alpha) {
	ifelse(x==0,0,qbeta(alpha/2,x+1/2,n-x+1/2))
}
comparecifunc(cijeffrey,cijeffrey2)

cibayesunif2=function(x,n,kappa,alpha) {
	ifelse(x==0,0,qbeta(alpha/2,x+1,n-x+1))
}
comparecifunc(cibayesunif,cibayesunif2)

cibayeshpd2=function(x,n,kappa,alpha) {
	r = optimize(function(r) {
		qbeta(1-alpha + r, x+0.5, n-x+0.5) - qbeta(r, x+0.5, n-x+0.5)
	},c(0,alpha),tol=1e-8/n)$minimum
	ifelse(x==0, 0, qbeta(r, x+0.5, n-x+0.5))
}
#cibayeshpd2(3,100,kappa,alpha)
#cibayeshpd(3,100)
comparecifunc(cibayeshpd,cibayeshpd2)

cibootperc2=function(x,n,kappa,alpha) {
	c(qbinom(alpha/2,n,x/n)/n, qbinom(1-alpha/2,n,x/n)/n)
}
comparecifunc(cibootperc0,cibootperc2)

cibootbasic2=function(x,n,kappa,alpha) {
	c(pmax(0,(2*x-qbinom(1-alpha/2,n,x/n))/n),
	  pmin(1,(2*x-qbinom(alpha/2,n,x/n))/n))
}
comparecifunc(cibootbasic0,cibootbasic2)

cibootstud2=function(x,n,kappa,alpha) {
	if (pmin(x,n-x)<=4) {return(cic(x,n))}
	p=x/n
	l=1/n*qbinom(1-alpha/2,n,x/n)
	u=1/n*qbinom(alpha/2,n,x/n)
	lower = p-(l-p)*sqrt(p*(1-p)/(l*(1-l)))
	upper = p-(u-p)*sqrt(p*(1-p)/(u*(1-u)))
	c(lower, upper)
}
cibootstud(7,100)
cibootstud2(7,100,kappa,alpha)

comparecifunc(cibootstud,cibootstud2)

##BCa from formula
acc=function(x,n) {
	(n-2*x)/(6*sqrt(n*x*(n-x)))
}
bias=function(x,n,d) {
	qnorm(pbinom(x-1,n,x/n)+d/2*dbinom(x,n,x/n))
}
EF=function(q,n,x,d) {
	qbinom(pnorm(bias(x,n,d)+(bias(x,n,d)+qnorm(q))/(1-acc(x,n)*(bias(x,n,d)+qnorm(q)))),n,x/n)/n
}

cibootbca2=function(x,n,kappa,alpha) {
	if (x==0 | x==n) {return(cic(x,n,1-alpha))}
	c(EF(alpha/2, n, x, 0), EF(1-alpha/2, n, x, 0))
}
comparecifunc(cibootbca,cibootbca2)

cihall2=function(x,n,kappa,alpha) {
	p=x/n
	#delta = (kappa^2/3+1/6)*(1-2*p)/n
	delta = (1+2*kappa^2)*(1-2*p)/(6*n)
	pmax(0,ifelse(x==0,0,p+delta-kappa*sqrt(p*(1-p)/n)))
}
comparecifunc(cihall,cihall2)

cicai2=function(x,n,kappa,alpha) {
	p=x/n
	gamma1=-13/18*kappa^2-17/18
	gamma2=1/18*kappa^2+7/36
	eta=kappa^2/3+1/6
	#prh=(p+eta/n)/(1+2*eta/n)
	prh=(n*p+eta)/(n+2*eta)

	ci = pmax(0, prh-kappa/sqrt(n)*sqrt(p*(1-p)+(gamma1*p*(1-p)+gamma2)/n))
	if (x == 0) {ci[1]=0}
	if (x == n) {ci[2]=1}
	ci
}
comparecifunc(cicai,cicai2)

cikottliu2=function(x,n,kappa,alpha) {
	p=x/n
	delta = (1+2*kappa^2)*(1-2*p)/(6*n)
	pmax(0,p+delta-sqrt(kappa^2*p*(1-p)/(n-1)+delta^2))
}
comparecifunc(cikottliu,cikottliu2)

cisaifs2=function(x,n,kappa,alpha) {
	max(0,x/(n+1)-kappa*sqrt(x*(n+1-x)/(n*(n+1)^2)))
}
cisaifs2=function(x,n,kappa,alpha) {
	pp=x/(n+1)
	max(0,pp-kappa*sqrt(pp*(1-pp)/n))
}

comparecifunc(cisaifs,cisaifs2)

p=0.07;plot(density(rbinom(100000,20,p),bw=0.5));lines(type="h",x=0:20,y=dbinom(0:20,20,p))

ciprofileglm_logit2=function(x,n, kappa, alpha) {
	if (x == 0 | x==n) {return(cic(x,n))}
	expit(confint(glm(family=binomial, cbind(x,n-x)~1), conf=1-alpha))
}
comparecifunc(ciprofileglm_logit, ciprofileglm_logit2)

if (0) {
ciprofileglm_logit3=function(x,n, kappa, alpha) {
	if (x == 0 | x==n) {return(cic(x,n))}
	expit(confint(glm(family=binomial, cbind(x,n-x)~1), conf=1-alpha, control=glm.control(epsilon=1e-15)))
}
ciprofileglm_logit3(3,10)
cilr1(3,10)
}

ciprofileglm_poisson2=function(x,n, kappa, alpha) {
	if (x == 0 | x==n) {return(cic(x,n))}
	ci = exp(confint(glm(family=poisson, x~offset(log(n))), conf=1-alpha))
	if (ci[2] > 1) {ci[2]=1}
	ci
}

ciprofileglm_poisson(2048,2048)
ciprofileglm_poisson2(2048,2048)
comparecifunc(ciprofileglm_poisson, ciprofileglm_poisson2) # Des discordances minimes sont explicables par la condition 'start=log(x/n)' qui améliore les performances dans ciprofileglm_poisson

ciwaldglm_logit2=function(x,n,kappa,alpha) {
	if (x == 0 | x==n) {return(cic(x,n))}
	expit(confint.default(
	   glm(family=binomial,
	       cbind(x,n-x)~1), conf=1-alpha))
}

comparecifunc(ciwaldglm_logit, ciwaldglm_logit2, tol=1e-5) # Des discordances minimes sont explicables par la condition 'start=log(x/n)' qui améliore les performances dans ciprofileglm_poisson


ciwaldglm_logbinom2=function(x,n,kappa,alpha) {
	if (pmin(x,n-x) <= 0) {return(cic(x,n))}
	ci = exp(confint.default(
	   glm(family=binomial(log),
	       cbind(x,n-x)~1), conf=1-alpha))
	if (ci[2] > 1) {ci[2]=1}
	ci
}
comparecifunc(ciwaldglm_logbinom, ciwaldglm_logbinom2, tol=1e-5)


ciwaldglm_poisson2=function(x,n,kappa,alpha) {
	if (x == 0 | x==n) {return(cic(x,n))}
	ci = exp(confint.default(
	   glm(family=poisson,
	       x~offset(log(n))), conf=1-alpha))
	if (ci[2] > 1) {ci[2]=1}
	ci
}

comparecifunc(ciwaldglm_poisson, ciwaldglm_poisson2, tol=1e-5)  # Des discordances minimes sont explicables par la condition 'start=log(x/n)' qui améliore les performances dans ciprofileglm_poisson

#cipratt_upper

lprt=function(x,n,kappa,alpha) {
	#if (x == 0) {return(0)}
	1 - 1/(
		1+
		((n-x+1)/x)^2*
		(
			(81*x*(n-x+1)-9*n-8-3*kappa*sqrt(9*x*(n-x+1)*(9*n+5-kappa^2)+n+1))
			/(81*(n-x+1)^2-9*(n-x+1)*(2+kappa^2)+1)
		)^3
	)
}

ciprattmean2_lower=function(x,n,kappa,alpha) {
	if (x==0) {return(0)}
	(lprt(x,n,kappa,alpha)+lprt(min(n,x+1),n,kappa,alpha))/2
}
ciprattmean2=function(x,n,kappa,alpha) {
	c(ciprattmean2_lower(x,n,kappa,alpha), 1-ciprattmean2_lower(n-x,n,kappa,alpha))
}
ciprattmean2(0,10,qnorm(0.975),0.05)
ciprattmean2(1,10,qnorm(0.975),0.05)
cicmidp(1,10)
comparecifunc(ciprattmean, ciprattmean2)
