rm(list=ls())
setwd("C:/Users/andre.gillibert/Desktop/Falissard/ztest/")
library(ggplot2)
library(cowplot)
library(exactci)
library(binom)
library("BlakerCI")
library(e1071)
library("extrafont")
library(DescTools)
library(boot)
library(exactci)

is_french=FALSE

#library(PropCIs)
source("sterne10.R")
source("wang2014.R")
source("schilling-doi.R")
source("ci_implementations10.R")
source("width_and_coverage10.R")
source("draw_figures10.R")
source("Wald_validity10.R")
en_environment()

####### Confidence intervals ########

# Not implemented:
# Crow 56, Kabaila-Byrne 2001
# Lecoutre-Poitevineau 2016, Reiczigel 2003
#

##################### Fonctions de tracé de courbes #####################

########## Define sets of confidence intervales for Article and Appendix figures ################

groups_appendix4=list(
	appendix1 = c("ciz","cizc","ciwaldcentered","ciwaldcenteredcc",
	  "ciz_clopper1", "cit_clopper1", "citpan_clopper1","citpanGILLIBERTunbiased",
	  "ciagresti","citpanagresti", "citpanagrestiGILLIBERTunbiased", "cisaifs"
	),
	appendix2 = c("cihall","cicai", "cikottliu","ciasin", "ciasinbartlett",
		"ciasinanscombe.pires","ciasinanscombecc","ciasinfreeman",
		"ciw", "cimw", "ciwcc",
		"cijeffrey","cimjeffrey","cibayesunif","cibayeshpd"
	),
	appendix3=c("cilogit","cilogitanscombe","cirubin", "ciprofileglm_logit","cilr", "cilr1",
		  "ciprofileglm_poisson", "ciwaldglm_logit", "ciwaldglm_logbinom", "ciwaldglm_poisson"
	),
	appendix4  =c("cibootperc","cibootbasic","cibootstud","cibootbca","cibootsmoothbca",
               "cibootbcaD", "cisterne", "cic", "cicmidp",
		   "ciblaker","cischillingdoi","ciwang2014", "cizielinski",
		   "ciblythstill","cicaikrish","ciexactscore","ciexactlr","ciprattmean")
)

groups_appendix=list(
	bappend1 = unlist(groups_appendix4[1:2]),
	bappend2 = unlist(groups_appendix4[3:4])
)

if (any(duplicated(unlist(groups_appendix)))) {
	stop("Duplicate in Appendix list")
}

groups_article=list(
	article=c(
		"ciz", "cimw", "ciasinbartlett",
		"cilogit", "cilr1", "cimjeffrey",
		"ciblaker", "cic", "cicmidp"
	)
)

if (any(duplicated(unlist(groups_article)))) {
	stop("Duplicate in Article list")
}

#groups_soutenance=list(soutenance=c("ciz","cic","cicmidp", "cisterne"))

control0$OR=1.20

groups=c(groups_article, groups_appendix)

if (length(setdiff(unlist(groups),  names(cinames0)) )) {
	stop("Undefined intervals: ", paste(setdiff(unlist(groups),  names(cinames0)), collapse=" "))
}

#################################################################################
####################            Heavy computation  ##############################
####################    computing all figures data ##############################
#################################################################################

df0a=NULL
df0b=NULL
system.time(df0a<<-canondf(computedf3(N=Inf, end=64, cinames=cinames0[unlist(groups_article)])))
system.time(df0b<<-canondf(computedf3(N=c(32,64,2048), end=64)))
df0<<-rbind(df0a, df0b)
df0$ORs=control0$OR
df3Cinf=canondf(computedf3C(N=Inf,end=32,cinames=cinames0[unlist(groups_article)]),compute_width=T)

system.time(df3C<<-rbind(
	df3Cinf,
	canondf(computedf3C(N=c(32,64,2048),end=64),compute_width=T)
))

system.time(df_appendix1_fig1<<-canondf(computedf3(N=c(32,64,2048), end=64, cinames=cinames0[unlist(groups_article)], OR=1.10 )))
df_appendix1_fig1$ORs=1.10
system.time(df_appendix1_fig2<<-canondf(computedf3(N=c(32,64,2048), end=64, cinames=cinames0[unlist(groups_article)], OR=1.05 )))
df_appendix1_fig2$ORs=1.05

system.time(df_appendix1_fig3<<-canondf(computedf3(N=c(32,64,2048), end=64, cinames=cinames0[unlist(groups_article)], OR=1.20, conf.level=0.90 )))
df_appendix1_fig3$ORs=1.20

df4N0=couverture4N(n=seq(0,32,0.1),c(32,64,2048),OR=1.20,control=list(cifunc="ciasinbartlett", frame=256))
df4N0$interval = "ciasinbartlett"
df4N=canondf(df4N0,compute_width=F)
df4N$alphappp=df4N$alpha
df4N$conf.level=0.95
df4N$SRs=1.20

df5N0=couverture4N(n=seq(0,32,0.1),c(32,64,2048),OR=1.05,control=list(cifunc="ciasinbartlett", frame=256))
df5N0$interval = "ciasinbartlett"
df5N=canondf(df5N0,compute_width=F)
df5N$alphappp=df5N$alpha
df5N$conf.level=0.95
df5N$SRs=1.05

##############################################################################
#################### End of heavy computation ################################
##############################################################################


###############################################
########### draw all figures ! ################
###############################################


plotgroups(groups_article, subset(df0, is.finite(N)), subset(df3C, N==2048)) # Main article figures
plotgroups(groups_article, subset(df0, N %in% c(2048,Inf)), subset(df3C, N == Inf), suffix=".inf", draw_cond_alpha=T, draw_local_width=F) # Appendix 1: Poisson
plotgroups(groups_article, df_appendix1_fig1, NULL, suffix=".or110", draw_cond_alpha=F, draw_local_width=F) # Appendix 1, sensitivity: less variable proportion (figure A1)
plotgroups(groups_article, df_appendix1_fig2, NULL, suffix=".or105", draw_cond_alpha=F, draw_local_width=F) # Appendix 1, sensitivity: event less variable proportion (figure A2)
plotgroups(groups_article, df_appendix1_fig3, NULL, suffix=".or120_conf90", conf.level=0.90, draw_local_width=F, draw_cond_alpha=F) # Appendix 1, sensitivity, confidence level=0.90, figure A3

# Appendix : other confidence interval estimators !
plotgroups(groups_appendix, subset(df0, is.finite(N)), subset(df3C, N==2048), conditional_xend=10)

#plotgroups(groups_soutenance, subset(df0, is.finite(N)), subset(df3C, N==2048), width=7, height=0.8*7)


dirfile0(paste0("plotOther/variableN"),width=9,height=5)
cat("Going to plot average Alpha for variable N SRs=1.20\n")
print(plotLR2(df4N, "ciasinbartlett", start=0, end=32,ylim=c(0,0.06),xstep=2,step=0.005,nrow=1,ncol=1, yvar="alphappp"))
dev.off()

dirfile0(paste0("plotOther/variableN.srs105"),width=9,height=5)
cat("Going to plot average Alpha for variable N SRs=1.05\n")
print(plotLR2(df5N, "ciasinbartlett", start=0, end=32,ylim=c(0,0.06),xstep=2,step=0.005,nrow=1,ncol=1, yvar="alphappp"))
dev.off()

#################### end of figures drawing ! #######################

##############################################################################################################################
###########################   validity thresholds for Wald's confidence interval estimator (Appendix 1) ######################
##############################################################################################################################

ltblc0=create.validity.table(1.10,x=c(round(32*1.10^(0:60)),Inf),seuils=c(0.030,0.035,0.0375,0.050),worst.cover=T)
ltblm0=create.validity.table(1.10,x=c(round(32*1.10^(0:60)),Inf),seuils=c(0.030,0.035,0.0375,0.050),worst.cover=F)

ltblmB=create.validity.table(1.10,x=c(round(32*2^(0:6)),Inf),seuils=c(0.030,0.035,0.0375,0.050),control=list(cifuncref=ciasinbartlett),suffix="asinbartlett")
ltblmW=create.validity.table(1.10,x=c(round(32*2^(0:6)),Inf),seuils=c(0.030,0.035,0.0375,0.050),control=list(cifuncref=ciw),suffix="wilson")
ltblm=create.validity.table(1.10,x=c(round(32*2^(0:6)),Inf),seuils=c(0.030,0.035,0.0375,0.050))
ltblc=create.validity.table(1.10,x=c(round(32*2^(0:6)),Inf),seuils=c(0.030,0.035,0.0375,0.050),worst.cover=T)
#ltblcB=create.validity.table(1.10,x=c(round(32*2^(0:6)),Inf),seuils=c(0.030,0.035,0.0375,0.050),worst.cover=F,control=list(cifuncref=ciasinbartlett),suffix="asinbartlett")

worst.cover=F;write.table(ltblm$tblout, sep=";",dec=",",paste0("events-requiredOR",OR,ifelse(worst.cover, "worst","avg"),".csv"),row.names=F)
worst.cover=T;write.table(ltblc$tblout, sep=";",dec=",",paste0("events-requiredOR",OR,ifelse(worst.cover, "worst","avg"),".csv"),row.names=F)

####################################################################
################# Basic test of strict nestedness ##################
####################################################################
nestedness=function(ciname,lvl1=0.95, lvl2=0.94) {
	NS=F
	cifunc=get(ciname)
	for(N in 10:128) {
	v=(1:(N-1))[sapply(1:(N-1), function (x) {
		cifunc(x,N,conf.level=lvl1)[1] >= cifunc(x,N,conf.level=lvl2)[1]
	})]
	if (length(v) > 0) {
		cat(ciname, " is not strictly nested for x=", v[1], " and n=", N, "\n")
		ci95 = cifunc(v[1],N,conf.level=lvl1)
		ci94 = cifunc(v[1],N,conf.level=lvl2)
		print(ci95)
		print(ci94)
		if (abs(ci95[1] - ci94[1])>1e-8) {return("not nested")}
		if (abs(ci95[1] - ci94[1])<1e-8) {NS=T}
	}
	}
	return(ifelse(NS,"non-strict","Yes"))
}
intervals=#setdiff(names(cinames0)[names(cinames0) %in% unlist(groups_appendix)], "ciblythstill")
intervals=setdiff(unique(c(unlist(groups_appendix), unlist(groups_article))), "ciblythstill")
ok = sapply(intervals, nestedness)

write.table(t(t(ok)), "tables/strict-nestedness.csv", sep=";")

