.packageName <- "BGcom"
"Tmc" <-
function(repl,output.ratio,dir,data){
    if(output.ratio$pvalue==FALSE){
    data=1-data
    }

    lists = ncol(data)
    l=length(output.ratio$DECommon)
    Tmax = max(output.ratio$ratios,na.rm=TRUE)
    Tmax.null = rep(NA,repl)
    ratios.null = matrix(NA,l,repl)
    sample = matrix(NA,dim(data)[1],lists)
    
    sample[,1] <- data[,1]
    for(k in 1:repl){
    int = c()
    L=matrix(0,l,lists)
    data1 = matrix(NA,dim(data)[1],lists)
    data1[,1] <- data[,1]

    	for(j in 2:lists){
    		sample[,j] = sample(data[,j])
		data1[,j] = sample[,j]
		}
    
    threshold = output.ratio$q
    for(i in 1:l){
  		temp = data1<=threshold[i]
		for(j in 1:lists){
		L[i,j] <- sum(temp[,j])
		temp[temp[,j]==FALSE,j]<-0
		temp[temp[,j]==TRUE,j]<-1
		}
		int[i] <- sum(apply(temp,1,sum)==lists)	
			}



expected = apply(L,1,prod)/(dim(data)[1])^(lists-1)
observed = int
ratios = matrix(0,l,1)

for(i in 1:l){
    ratios[i,1] <- observed[i]/expected[i]
    }
ratios.null[,k] <- ratios
ratios <- ratios[threshold>0]
Tmax.null[k] = max(ratios)
}

ID=seq(1,repl)
p=length(ID[Tmax.null>=Tmax])
pvalue<- p/repl

postscript(paste("Pvalue","_",output.ratio$name,".ps"))
hist(Tmax.null,main="",xlab="T",ylab="",xaxt="n",cex.main=0.9,xlim=c(min(Tmax.null),max(c(Tmax,max(Tmax.null)))),yaxt="n",cex.axis=0.9)
axis(1,at = seq(min(Tmax.null),max(c(Tmax,max(Tmax.null))),5),labels = round(seq(min(Tmax.null),max(c(Tmax,max(Tmax.null))),5),0))
legend(x=Tmax/2,y=dim(data)[1]/100,legend=paste("P value =",pvalue),bty="n",cex=0.9)
abline(v=Tmax,lty=2)
dev.off()
return(pvalue=pvalue)
}

"baymod" <-
function(data,output.ratio,repl,dir){
if(output.ratio$pvalue==FALSE){
data=1-data;
}

#Number of lists
lists = dim(data)[2]

#Calculate all the needed quantities 
ID=seq(1,dim(data)[1])
l=length(output.ratio$DECommon)

#Design
design = designMatrix(lists)
row.names(design)<-seq(1,dim(design)[1])
threshold = output.ratio$q
O = matrix(0,l,(nrow(design)-1))

    for(i in 1:l){
    temp = matrix(0,dim(data)[1],lists)
		for(j in 1:lists){
			for(r in 1:dim(data)[1]){
				if(data[r,j]<=threshold[i]) {temp[r,j] = 1}
				}
			}
xx=designCount(temp,design)
O[i,] <- xx
}

#Dirichlet prior
prior.p=matrix(0.001,l,(nrow(design)-1))
post.p=matrix(NA,l,(nrow(design)-1))

p=array(NA,dim=c(l,(nrow(design)-1),repl))
p.s = array(NA,dim=c(l,(nrow(design)-1),repl)) 
marginal.p=array(NA,dim=c(l,lists,repl))
ratio = matrix(NA,l,repl)

for(i in 1:l){
	for(j in 1:(nrow(design)-1)){
    post.p[i,j] <- O[i,j] + prior.p[i,j]

    for(k in 1:repl){   
            p.s[i,j,k] <- rgamma(1,post.p[i,j],1)}
		}
	for(j in 1:(nrow(design)-1)){
			for(k in 1:repl){   
				p[i,j,k] <- p.s[i,j,k]/dim(data)[1]
					}
			}  

		for(j in 1:lists){
			for(k in 1:repl){
        		marginal.p[i,j,k] <- sum(p[i,(as.numeric(row.names(design[design[,j]==1,]))-1),k])
				}
		}

		for(k in 1:repl){
        ratio[i,k] <- p[i,(nrow(design)-1),k] / prod(marginal.p[i,,k])

			}
        	}
#########################################
#CI for ratio
quantile = matrix(NA,l,3)
for(i in 1:l){
    quantile[i,1] <- quantile(ratio[i,],0.05,na.rm=TRUE)
    quantile[i,2] <- quantile(ratio[i,],0.5,na.rm=TRUE)
    quantile[i,3] <- quantile(ratio[i,],0.95,na.rm=TRUE)
}

lim1<-matrix(0,l,2)
for (i in 1:l) {
lim1[i,1]<-quantile[i,1]
lim1[i,2]<-quantile[i,3]}
y1<-seq(1:l)
y1<-matrix(y1,l,2)
Rmax = max(quantile[round(quantile[,1],2)>1,2])
qmax = output.ratio$q[quantile[,2]==Rmax]

    if(length(output.ratio$q[quantile[round(quantile[,1],2)>1,2]>=2])>0){
	q2 = max(output.ratio$q[quantile[,2]>=2])
	R2 = quantile[output.ratio$q==q2,2]
     
	ps.options(horizontal=FALSE)
	setwd(dir)
	postscript(paste("bayCI","_",output.ratio$name,".ps"))
	plot(y1,lim1,xlab="P value",ylab="R",main="",pch="_",axes=TRUE,yaxt="n",xaxt="n",
	ylim=c(0,(max(quantile[1:l,3],na.rm=TRUE)+1*sd(quantile[1:l,3],na.rm=TRUE))),
	lwd=0.2)
	for (i in 1:l) lines(y1[i,],lim1[i,], lty=3,lwd=1.7)
    	axis(2, at = c(0,0.5,1,1.5,R2,Rmax), labels = c(0,0.5,1,1.5,expression(R[2]),expression(R[max])), tick = TRUE,cex.axis=0.9)
 	if(output.ratio$pvalue==TRUE){   
	axis(1, at = c((qmax*100),(q2*100),seq(((q2*100)+10),100,20)), labels = c(expression(q[max]),expression(q[2]),seq((q2+0.1),1,0.2)), tick=TRUE,cex=0.9)
	}
 		if(output.ratio$pvalue==FALSE){   
		axis(1, at = c((qmax*100),(q2*100),seq(((q2*100)+10),100,20)), labels = c(expression(q[max]),expression(q[2]),1-seq((q2+0.1),1,0.2)), tick=TRUE,cex=0.9)
		}
		axis(4, at = c(1,R2,Rmax),labels = c(dim(data)[1],output.ratio$DECommon[output.ratio$q==q2],output.ratio$DECommon[output.ratio$q==qmax]),tick=TRUE,cex=0.9)
		abline(h=1,col="black", lwd=1.5)
		points(y1[,1],quantile[1:l,2],col="red",cex=0.5)
		dev.off()
	}

    if(length(output.ratio$q[quantile[round(quantile[,1],2)>1,2]>=2])==0){

	ps.options(horizontal=FALSE)
	setwd(dir)
	postscript(paste("bayCI","_",output.ratio$name,".ps"))
	plot(y1,lim1,xlab="P value",ylab="R",main="",pch="_",axes=TRUE,yaxt="n",xaxt="n",
	ylim=c(0,(max(quantile[1:l,3],na.rm=TRUE)+1*sd(quantile[1:l,3],na.rm=TRUE))),
	lwd=0.2)
	for (i in 1:l) lines(y1[i,],lim1[i,], lty=3,lwd=1.7)
    	axis(2, at = c(seq(0,(Rmax-0.5),0.5),Rmax), labels = c(seq(0,(Rmax-0.5),0.5),expression(R[max])), tick = TRUE,cex.axis=0.9)
 	if(output.ratio$pvalue==TRUE){   
	axis(1, at = c((qmax*100),seq(((qmax*100)+10),100,20)), labels = c(expression(q[max]),seq((qmax+0.1),1,0.2)), tick=TRUE,cex=0.9)
	}
 		if(output.ratio$pvalue==FALSE){   
		axis(1, at = c((qmax*100),seq(((qmax*100)+10),100,20)), labels = c(expression(q[max]),1-seq((qmax+0.1),1,0.2)), tick=TRUE,cex=0.9)
		}
		axis(4, at = c(1,Rmax),labels = c(dim(data)[1],output.ratio$DECommon[output.ratio$q==qmax]),tick=TRUE,cex=0.9)
		abline(h=1,col="black", lwd=1.5)
		points(y1[,1],quantile[1:l,2],col="red",cex=0.5)
		dev.off()
	}


return(quantile=quantile)
}
"createTable" <-
function(dir,output.ratio,output.bay,name){
if(output.ratio$pvalue==TRUE){
matrix.results =  cbind(output.ratio$q,round(output.bay,3),output.ratio$DECommon,output.ratio$DE)
lists = dim(output.ratio$DE)[2]
namesDE = paste("O",seq(1,lists),rep("+",lists))
names.matrix = c("q","LowCI","MedCI","HighCI","O11",namesDE)
dimnames(matrix.results)[[2]]<-names.matrix
}
if(output.ratio$pvalue==FALSE){
matrix.results =  cbind(1-output.ratio$q,round(output.bay,3),output.ratio$DECommon,output.ratio$DE)
lists = dim(output.ratio$DE)[2]
namesDE = paste("O",seq(1,lists),rep("+",lists))
names.matrix = c("q","LowCI","MedCI","HighCI","O11",namesDE)
dimnames(matrix.results)[[2]]<-names.matrix
}

#Decision rules:
#1) Maximum for CI not including 1
max.R = max(matrix.results[round(round(matrix.results[,2],2),1)>1,3])
maximum = matrix.results[matrix.results[,3]==max.R,]


if(length(matrix.results[matrix.results[round(matrix.results[,2],2)>1,3]>=2,1])>0){
#2) Rule 2
R2 = max(matrix.results[round(round(matrix.results[,3],2),3)>=2 & round(round(matrix.results[,2],2),1)>1 ,1])
rule2 = matrix.results[matrix.results[,1]==R2,]

setwd(dir)
write.csv(matrix.results,paste(name,".csv"),row.names=FALSE)
return(list(maximum=maximum,rule2=rule2))
	}

if(length(matrix.results[matrix.results[round(matrix.results[,2],2)>1,3]>=2,1])==0){
#2) Rule 2
setwd(dir)
write.csv(matrix.results,paste(name,".csv"),row.names=FALSE)
return(maximum=maximum)
	}

}
"designCount" <- function(array,design) {

sum1intersects <- function(c1,c2) return(all(c1 == c2))
res <- vector(mode="numeric",length=(nrow(design)-1))

for(i in 2:nrow(design)){
res[i-1] <- sum(apply(array,1,sum1intersects,design[i,]))
}
return(res)
}



"designMatrix" <- function(lists){

rows = 2^(lists)
ncycles = rows
x = matrix(0,rows,lists)

for (k in 1:lists){   
	settings = c(0,1)   
	ncycles = ncycles/2   
	nreps = rows/(2*ncycles)   

	settings = matrix(rep(settings,nreps),nreps,length(settings),byrow=TRUE)
	settings = as.vector(settings) #impila in un vettore settings, una colonna sotto l'altra
	settings = matrix(rep(settings,ncycles),length(settings),ncycles)

	x[,lists-k+1] = as.vector(settings)	
	}
return(x)
}
"extractGenes" <-
function(output.ratio,output.bay,gene.names,data,q=NULL){
if(output.ratio$pvalue==FALSE){
data = 1 - data
}

lists = dim(data)[2]
#Decision rules:
#1) Maximum for CI not including 1
max.R = max(output.bay[round(round(output.bay[,1],2),1)>1,2])
threshold.max = output.ratio$q[output.bay[,2]==max.R]

#Table
temp = matrix(0,dim(data)[1],lists)
for(i in 1:dim(data)[1]){
		for(j in 1:lists){
			if(data[i,j]<= threshold.max){temp[i,j]<-1}
		}
}

table.max <- data[apply(temp,1,sum)==lists,]
names.max <- gene.names[apply(temp,1,sum)==lists]

if(output.ratio$pvalue==FALSE){
table.max <- data.frame(Names=names.max,RankingStat = 1- table.max)
}

if(output.ratio$pvalue==TRUE){
table.max <- data.frame(Names=names.max,RankingStat = table.max)
}

if(length(output.ratio$q[output.bay[round(output.bay[,1],2)>1,2]>=2])>0){

#2) Rule 2
threshold.2 = max(output.ratio$q[round(round(output.bay[,2],2),3)>=2 & round(round(output.bay[,1],2),1)>1])

#Table
temp = matrix(0,dim(data)[1],lists)
for(i in 1:dim(data)[1]){
		for(j in 1:lists){
			if(data[i,j]<= threshold.2){temp[i,j]<-1}
		}
}

table.2 <- data[apply(temp,1,sum)==lists,]
names.2 <- gene.names[apply(temp,1,sum)==lists]

if(output.ratio$pvalue==FALSE){
table.2 <- data.frame(Names=names.2,RankingStat = 1-table.2)
}

if(output.ratio$pvalue==TRUE){
table.2 <- data.frame(Names=names.2,RankingStat = table.2)
	}


if(is.null(q))
{return(list(max = table.max,rule2 = table.2))}

if(!is.null(q)){
l = length(q)
table.q = list()
	for(r in 1:l){

temp = matrix(0,dim(data)[1],lists)
for(i in 1:dim(data)[1]){
		for(j in 1:lists){
			if(data[i,j]<= q[r]){temp[i,j]<-1}
				}
			}

table.q[[r]] <- data[apply(temp,1,sum)==lists,]
names.q <- gene.names[apply(temp,1,sum)==lists]
if(output.ratio$pvalue==FALSE){
	table.q[[r]] <- data.frame(Names=names.q,RankingStat = 1-table.q[[r]])
	}

if(output.ratio$pvalue==TRUE){
	table.q[[r]] <- data.frame(Names=names.q,RankingStat = table.q[[r]])
	}

names(table.q)[[r]] <- paste("q=",q[r])	
			}
		}
return(list(max = table.max,rule2 = table.2, User = table.q))
	}


if(length(output.ratio$q[output.bay[round(output.bay[,1],2)>1,2]>=2])==0){


if(is.null(q))
{return(list(max = table.max))}

if(!is.null(q)){
l = length(q)
table.q = list()
	for(r in 1:l){

temp = matrix(0,dim(data)[1],lists)
for(i in 1:dim(data)[1]){
		for(j in 1:lists){
			if(data[i,j]<= q[r]){temp[i,j]<-1}
				}
			}

table.q[[r]] <- data[apply(temp,1,sum)==lists,]
names.q <- gene.names[apply(temp,1,sum)==lists]
if(output.ratio$pvalue==FALSE){
	table.q[[r]] <- data.frame(Names=names.q,RankingStat = 1-table.q[[r]])
	}

if(output.ratio$pvalue==TRUE){
	table.q[[r]] <- data.frame(Names=names.q,RankingStat = table.q[[r]])
	}

names(table.q)[[r]] <- paste("q=",q[r])	
				}
			}
return(list(max = table.max,User = table.q))
	}

}

ratio <-
function(dir,data,interval=0.01,name,pvalue){
#Define how many lists for the comparison
lists = ncol(data)

if(pvalue==TRUE){
data=data;
}
if(pvalue==FALSE){
data=1-data;
}

ID=seq(1,dim(data)[1])
l=length(seq(0,1,interval))
threshold = seq(0,1,interval)
int=c()
L=matrix(0,l,lists)

    for(i in 1:l){
				temp = data<=threshold[i]
		for(j in 1:lists){
		L[i,j] <- sum(temp[,j])
		temp[temp[,j]==FALSE,j]<-0
		temp[temp[,j]==TRUE,j]<-1
		}
		int[i] <- sum(apply(temp,1,sum)==lists)	
			}

#Calculate the ratio for the number of observed genes/number of expected ones
expected = apply(L,1,prod)/(dim(data)[1])^(lists-1)
ratios = matrix(0,l,1)

for(i in 1:l){
    ratios[i,1] <- int[i]/expected[i]
    }

    #Plot
    ratios=ratios[int>0]
    thresh.ratios=threshold[int>0]
    L = L[int>0,] 
    int=int[int>0]

    if(length(thresh.ratios[ratios>=2])>0){
    q2 = max(thresh.ratios[ratios>=2])
    T2 = ratios[thresh.ratios==q2]
    Tmax = max(ratios)
    qmax = thresh.ratios[ratios==Tmax]
    ps.options(paper="a4",horizontal=TRUE)
    setwd(dir)
    ps.options(horizontal=FALSE)
    postscript(paste("Ratio","_",name,".ps"))
    plot(thresh.ratios,ratios,type="l",
    ylab= "T",xlab="P value",main="",yaxt="n",xaxt="n",cex.main=0.7,cex.axis=1.2,ylim=c(0,(max(ratios,na.rm=TRUE)+sd(ratios,na.rm=TRUE))))
    axis(2, at = c(0,0.5,1,1.5,T2,Tmax), labels = c(0,0.5,1,1.5,expression(T[2]),expression(T[max])), tick = TRUE,cex.axis=0.9)
    if(pvalue==TRUE){
    axis(1, at = c(qmax,q2,seq((q2+0.1),1,0.2)), labels = c(expression(q[max]),expression(q[2]),seq((q2+0.1),1,0.2)), tick=TRUE,cex=0.9)
    }
    
    if(pvalue==FALSE){
    axis(1, at = c(qmax,q2,seq((q2+0.1),1,0.2)), labels = c(expression(q[max]),expression(q[2]),1- seq((q2+0.1),1,0.2)), tick=TRUE,cex=0.9)
    }
    axis(4, at = c(1,T2,Tmax),labels = c(dim(data)[1],int[thresh.ratios==q2],int[thresh.ratios==qmax]),tick=TRUE,cex=0.9)
    dev.off()
	}
	
    if(length(thresh.ratios[ratios>=2])==0){
    Tmax = max(ratios)
    qmax = thresh.ratios[ratios==Tmax]
    ps.options(paper="a4",horizontal=TRUE)
    setwd(dir)
    ps.options(horizontal=FALSE)
    postscript(paste("Ratio","_",name,".ps"))
    plot(thresh.ratios,ratios,type="l",
    ylab= "T",xlab="P value",main="",yaxt="n",xaxt="n",cex.main=0.7,cex.axis=1.2,ylim=c(0,(max(ratios,na.rm=TRUE)+sd(ratios,na.rm=TRUE))))
    axis(2, at = c(0,0.5,1,1.5,Tmax), labels = c(0,0.5,1,1.5,expression(T[max])), tick = TRUE,cex.axis=0.9)
    if(pvalue==TRUE){
    axis(1, at = c(qmax,seq((qmax+0.1),1,0.2)), labels = c(expression(q[max]),seq((qmax+0.1),1,0.2)), tick=TRUE,cex=0.9)
    }
    
    if(pvalue==FALSE){
    axis(1, at = c(qmax,seq((qmax+0.1),1,0.2)), labels = c(expression(q[max]),1- seq((qmax+0.1),1,0.2)), tick=TRUE,cex=0.9)
    }
    axis(4, at = c(1,Tmax),labels = c(dim(data)[1],int[thresh.ratios==qmax]),tick=TRUE,cex=0.9)
    dev.off() 
	}

    return(list(DE = L, ratios=ratios,q=thresh.ratios,DECommon = int,interval=interval,name=name,pvalue=pvalue))

}
"simulation" <-
function(n,GammaA,GammaB,epsilonM=0, epsilonSD=1, r1,r2,DEfirst,DEsecond,DEcommon){

T1=c()
T2=c()
delta=rgamma(n,GammaA,1/GammaB)
epsilon1=rnorm(n,epsilonM,epsilonSD)
epsilon2=rnorm(n,epsilonM,epsilonSD)
names=c()
#Group 1 : DE in common
for(i in 1: DEcommon){
x=rbinom(1,1,0.5)
if(x==1) {
    T1[i] <- delta[i] + epsilon1[i]*r1;
    T2[i] <- delta[i] + epsilon2[i]*r2
}
if(x==0) {T1[i] <- -delta[i] - epsilon1[i]*r1;
    T2[i] <- -delta[i] - epsilon2[i]*r2}

names[i] <- "DEcommon"
}

#Group 2 : DE in the first experiment
for(i in (DEcommon+1):(DEfirst)){
x=rbinom(1,1,0.5)
if(x==1){
T1[i] <- delta[i] + epsilon1[i]*r1
}
if(x==0){T1[i] <- -delta[i] - epsilon1[i]*r1}
T2[i] <- epsilon2[i]*r2
names[i] <- "DEfirst"
}

#Group 3 : DE in the second experiment
for(i in (DEfirst+1):(DEfirst+DEsecond-DEcommon)){
x=rbinom(1,1,0.5)
T1[i] <- epsilon1[i]*r1
if(x==1){
T2[i] <- delta[i] + epsilon2[i]*r2
}
if(x==0){T2[i] <- -delta[i] - epsilon2[i]*r2}
names[i] <- "DEsecond"

}

#Group 4 : Not DE in Both experiments
for(i in (DEfirst+DEsecond-DEcommon+1):(n)){
T1[i] <- epsilon1[i]*r1
T2[i] <- epsilon2[i]*r2
names[i] <- "Null"
}


##############################################
#Assign the Pvalues

Pval1 = c()
Pval2 = c()

for(i in 1:n){
Pval1[i] <- 2*pnorm(-abs(T1[i]/r1))
Pval2[i] <- 2*pnorm(-abs(T2[i]/r2))
#Pval1[i] <- 1-pnorm(T1[i]/r1)
#Pval2[i] <- 1-pnorm(T2[i]/r2)
}

##############################################
return(list(names=names,T1=T1,T2=T2,Pval=cbind(Pval1,Pval2)))
}

"simulation.indep" <-
function(n,GammaA=2,GammaB=2,epsilonM=0, epsilonSD=1, r1,r2,DEfirst,DEsecond){

T1=c()
T2=c()
delta=rgamma(n,shape=GammaA,scale=GammaB)
epsilon1=rnorm(n,epsilonM,epsilonSD)
epsilon2=rnorm(n,epsilonM,epsilonSD)
names=c()
#Group 1 : DE in the first experiment
for(i in (1):(DEfirst)){
x=rbinom(1,1,0.5)
if(x==1){T1[i] <- delta[i] + epsilon1[i]*r1}
if(x==0){T1[i] <- -delta[i] - epsilon1[i]*r1}
T2[i] <- epsilon2[i]*r2
names[i] <- "DEfirst"
}

#Group 2 : DE in the second experiment
for(i in (DEfirst+1):(DEfirst+DEsecond)){
x=rbinom(1,1,0.5)
T1[i] <- epsilon1[i]*r1
if(x==1){T2[i] <- delta[i] + epsilon2[i]*r2}
if(x==0){T2[i] <- -delta[i] - epsilon2[i]*r2}
names[i] <- "DEsecond"

}

#Group 3 : Not DE in Both experiments
for(i in (DEfirst+DEsecond+1):(n)){
T1[i] <- epsilon1[i]*r1
T2[i] <- epsilon2[i]*r2
names[i] <- "Null"
}


##############################################
#Assign the Pvalues

Pval1 = c()
Pval2 = c()

for(i in 1:n){
Pval1[i] <- 2*pnorm(-abs(T1[i]/r1))
Pval2[i] <- 2*pnorm(-abs(T2[i]/r2))
}

##############################################
return(list(names=names,T1=T1,T2=T2,Pval=cbind(Pval1,Pval2)))
}

