################ Recherche d'un seuil de validité de l'approximation normale #####################


pmulOR=function(p, OR) {
	odds2p(p2odds(p)*OR)
}
nmulOR=function(n, N, OR) {
	if (N == Inf) {n*OR} else {N*pmulOR(n/N, OR)}
}


#x1=find.valid(64, OR=1.10)
find.valid=function(N, control=control0,OR=1.20,frame=2048,overlap=64,alpha.tol=0.025*1.5,smart=T,look=2,epsilon.conv=1e-5,worst.cover=F) {
	control$cifunc=NULL
	conf.level = getcontrol(control, "conf.level")
	upper.alpha = alpha.tol > (1-conf.level)/2
	if (!upper.alpha) {
		stop("Il n'est pas raisonnable d'analyer le risque de ce côté");
	}
	Npc=ifelse(N == Inf, getcontrol(control,"Npois"), N)
	precalc1 = precompute(N, c(list(cifunc=ciz, poisfunc=poisz, Npois=Npc), control))
	if (worst.cover & is.null(getcontrol(control, "cifuncref"))) {cifuncref=cic;} else {cifuncref=cicmidp}
	precalc2 = precompute(N, c(list(cifunc=cifuncref, Npois=Npc), control)) # poisfunc=poismjeffrey, 

	lowerFAIL = 2
	upperFAIL = min(floor(N/2), 1000)
	save=rep(NA,upperFAIL)

	alpha.tol = alpha.tol - epsilon.conv
	alpha.risk.at=function(n0) {
		n0=ceiling(n0)
		if (n0 <= 2) {n0=2}
		if (n0 >= N-2) {n0=N-2}
		if (n0 > floor(N/2)) {n0=floor(N/2)}
		
		if (!is.na(save[n0+1])) {return(save[n0+1])}
		
		control$precalc = rbind(
			precalc2[1 + 0:(n0-1)        ,,drop=F],
			precalc1[1 + (n0):(Npc-n0)   ,,drop=F],
			precalc2[1 + (Npc-n0+1):(Npc),,drop=F])

		if (worst.cover) {OR=(n0+12)/(n0+3)} # Pour la pire couverture on a besoin d'un voisinage minuscule pour trouver le pic
		if (smart) {
			qn=qnorm(0.5+conf.level/2)*sqrt(n0)
			lower=pmin(N-1, pmax(round(nmulOR(n0+qn, N, OR^-2)) - look, 1))
			upper=pmin(N-1, pmax(round(nmulOR(n0+qn, N, OR^4)) + look, 1))
		} else {lower=4;upper=upperFAIL-4}

		cover=couverture4P(start=lower, end=upper, N=N, control=control, frame=frame,OR=OR,overlap=overlap)
		if (upper.alpha) {
			if (!worst.cover) {
				alpha=max(c(cover$toolow, cover$toohigh))
			} else {
				alpha=max(c(cover$toolow.worst, cover$toohigh.worst))
			}
			dalpha = alpha - alpha.tol
		} else {
			dalpha = alpha.tol - min(c(cover$toolow, cover$toohigh))
		}

		save[n0+1] <<- dalpha
		dalpha
	}

	lower=lowerFAIL;upper=upperFAIL;
	if (alpha.risk.at(upper) > 0) {
		return(Inf);
	}
	if (alpha.risk.at(upper) < 0 & alpha.risk.at(lower) < 0) {
		return(0);
	}
	rt=uniroot.integer(lower=lower,upper=upper, alpha.risk.at)
	if (rt$f.root > epsilon.conv & alpha.risk.at(rt$root+1)<epsilon.conv) {
		return(ceiling(rt$root+1))
	}
	if (rt$f.root > 0.002) {
		return(NA)
	} else {
		return(ceiling(rt$root))
	}
}


table.valid=function(x, seuils, OR=1.2, worst.cover=F, control=control0) {
	conf.level=getcontrol(control, "conf.level")
	l=lapply(seuils, function(seuil) {
		v=sapply(x, function (N) {
			print(c(N,seuil))
			find.valid(N=N, OR=OR, alpha.tol=seuil, control=control, worst.cover=worst.cover)
		})
		df=data.frame(v=v)
		colnames(df)=paste0("Alpha unilat ", ifelse(seuil < (1-conf.level)/2, ">=", "<="), seuil)
		df
	})
	do.call(cbind, c(list(data.frame(N=x)),l));
}
### Helper functions for Wald validity
sk2=function(p,n) { # Skewness of a binomial distribution
	(1-2*p)/sqrt(n*p*(1-p))
}

sk2n=function(n,sk) { # Find x such as B(n, x/n) has the specified skewness
	mapply(function(n,sk) {
		uniroot.integer(lower=1, upper=(n-1), function (x) {
			if (n==Inf) {skx=1/sqrt(x);} else {skx=sk2(x/n,n)}
			skx - sk
		})$root
	}, n, sk)
}

complete.validity.table=function(OR,tbl,worst.cover,suffix="") {
	if (worst.cover) {
		mp=sapply(2:ncol(tbl), function(icol) {
			n = tbl[,1]
			xi = max(tbl[is.finite(tbl[,icol]),icol],na.rm=T)
			xi2 = ifelse(n==Inf,xi,ceiling(odds2p(xi/n)*n))
			ifelse(xi2 > n/2,Inf,xi2)
		})
		m=sapply(2:ncol(tbl), function(icol) {
			n = tbl[,1]
			xi = max(tbl[is.finite(tbl[,icol]),icol],na.rm=T)
			offset = ifelse(icol==2,6,ifelse(icol==3,1,0))
			xi2 = offset+ifelse(n==Inf, xi, ceiling(xi * (n / (2*xi+n)) ))
			#if (icol == 2) {xi2=ifelse(n<100,Inf,xi2)}
			ifelse(xi2 > n/2,Inf,xi2)
		})
	} else {
		m=sapply(2:ncol(tbl), function(icol) {
			n = tbl[,1]
			xi = tbl[,icol]
			skew = 1/sqrt(xi[n==Inf])
			xi2 = sk2n(n, rep(skew, length(n)))
			ifelse(xi2 > n/2,Inf,xi2)
		})
		mp=m
	}
	m2=sapply(2:ncol(tbl), function(icol) {
		gsub("Inf","Never",paste0(tbl[,icol], " (", m[,icol-1], ")"))
	})
	tblout=tbl;tblraw = tbl;tblapprox = tbl;
	tblout[,2:ncol(tblout)]=m2
	tblapprox[,2:ncol(tblout)]=m
	write.table(tblout, sep=";",dec=",",paste0("events-requiredOR",OR,ifelse(worst.cover, "worst","avg"),suffix,".csv"),row.names=F)
	list(tblout=tblout, tblraw=tblraw, tblapprox=tblapprox, tbldiff=cbind(tbl[,1],m - tbl[,2:ncol(tblout)]), tbldiffp=cbind(tbl[,1],mp - tbl[,2:ncol(tblout)]))
}
omitinf=function(v) {v[is.finite(v)]}

summarydiff=function(tbl,fcol=3) {
	tbl=as.vector(as.matrix(tbl[,fcol:ncol(tbl)]));summary(omitinf(tbl))
}

if (0) {
summarydiff(complete.validity.table(1.10,ltblc0$tblraw,worst.cover=T)$tbldiff,fcol=2);
summarydiff(complete.validity.table(1.10,ltblm0$tblraw,worst.cover=F)$tbldiff,fcol=2);
summarydiff(complete.validity.table(1.10,ltblc$tblraw,worst.cover=T)$tbldiff,fcol=2);
summarydiff(complete.validity.table(1.10,ltblm$tblraw,worst.cover=F)$tbldiff,fcol=2);
}

create.validity.table=function(OR=1.1,x=c(30,50,100,200,500,1000,Inf), seuils=c(0.030,0.035,0.0375,0.05), worst.cover=F,control=control0, suffix="") {
	if (!(Inf %in% x)) {x=c(x,Inf)}
	tbl=table.valid(
		x=x,
		seuils=seuils,
		OR=OR,
		worst.cover=worst.cover,
		control=control)
	complete.validity.table(OR,tbl,worst.cover,suffix=suffix)
}
#create.validity.table(1.30)
#create.validity.table(1.20)
#create.validity.table(1.10)
#create.validity.table(1.10,x=c(64,Inf),worst.cover=T,seuils=c(0.0375))

if (0) {
	x=round(30*1.1^(1:60))
	mixval=sapply(x, find.valid)
	ok=x<400
	plot(x=x[ok],y=mixval[ok])
	abline(c(7,0.10),col="blue")
}

