.packageName <- "MixThres"
`EMAlgo` <-
function(mdata,param,stop.crit)
{
  if (length(param) == 5)
    final <- list(logLike(mdata,one.comp(mdata,param)),matrix(1,nrow=length(mdata),ncol=1))
  else { 
        
      res.paramk <- list()
      tauk <- list()  
      old.eps <- 0
           
      for (k in 1:10000)
   {
           tauk[[k]] <- eStep(mdata,param)
           res <- m1Step(mdata,tauk[[k]],param)
          
          if (sum(is.na(res)) != 0)
                    {
              param <- NA
              final <- list(NA,NA)
              cat("Convergence problem (type1) \n")
              break
            }
          res.paramk[[k]] <- m2Step(res)
          res.param <- res.paramk[[k]]
          
          if (k<3){
          if ((max(abs(res.param-param)/param)>stop.crit) != 0){
           param <- res.param
          } else{
              taux <- tauk[[k]]
              param <- res.param
              final <- list(logLike(mdata,param),taux)
              cat("EM algorithm converged after ", k," iterations \n")
              break
          }
          }
          
          if (k>=3){
   
          a <- k-1  
             
          eps <- res.paramk[[a]]+1/(1/(res.paramk[[a-1]]-res.paramk[[a]])+1/(res.paramk[[a+1]]-res.paramk[[a]]))  
             
         if (is.na((max(abs(eps - old.eps)) <= stop.crit))) {
              param <- NA
              final <- list(NA,NA)
              ## type 2 : is.na((sum((eps-old.eps)^2)<=stop.crit))
              cat("Convergence problem (type2) \n")
              break
         }
         
         if (max(abs(eps - old.eps)) <= stop.crit) {
          taux <- eStep(mdata,eps)
          param <- eps
          final <- list(logLike(mdata,param),taux)
              cat("EM algorithm converged after ", a," iterations \n")
              break
         
          }
          old.eps <- eps
          param <- res.param
         }
 
        }
    
     if (k == 10000)
        {
          param <- NA
          final <- list(NA,NA)
          cat("Convergence problem (type3)\n")
          cat("Last parameters : ",matrix(res.param,ncol=5,byrow=TRUE),"\n")
        }
  }
  final
}

`MAPthreshold` <-
function(MixThres) 
  { 
    resSelect <- matrix(MixThres$ModelInfo$estimation,ncol=5,byrow=TRUE)   
    ordre <- order(resSelect[,1])
    groups <- apply(MixThres$Prob[,ordre],1,which.max)
    threshold <- min(MixThres$InputData[groups==max(groups)])
    threshold
  }

`eStep` <-
function(mdata,param)
  {
    taux <- matrix(0,nrow=length(mdata),ncol=length(param)/5)
    deno <- 0
    tmp0 <- sapply(1:(length(param)/5),FUN=function(g) apply(t(mdata),1,gfct,moy=param[5*(g-1)+1:5][1],sd=param[5*(g-1)+1:5][2],l=param[5*(g-1)+1:5][4],u=param[5*(g-1)+1:5][5]))
    tmp <- log(pmax(tmp0,1e-10))
    tmp2 <- sapply(1:(length(param)/5),FUN=function(g) param[5*(g-1)+1:5][3]*exp(tmp[,g]-rowMeans(tmp)))
    deno <- rowSums(tmp2)
    if (min(deno,na.rm=TRUE) == 0) {taux <- 1e-10 
    }else { 
     val <- tmp2/deno
     taux <- pmin(pmax(val,1e-10,na.rm=TRUE),(1-1e-10))
    
}
   
    invisible(taux)   
  }

`extract` <-
function(liste,j)
  {
    liste[[j]][[1]]
  }

`gfct` <-
function(x,moy,sdev,l,u)
  (dnorm(x,mean=moy,sd=sdev)*(x<=u)*(x>=l))/(pnorm(u,mean=moy,sd=sdev)-pnorm(l,mean=moy,sd=sdev))

`hist.MixThres` <-
function(x,...) {
    classes <- seq(min(x$InputData),max(x$InputData),length=50)
    param <- x$ModelInfo$estimation
    titre <- paste("selected model",length(param)/5,"gaussian component : t.left",round(param[4],2),"t.right",round(param[5],2))
    hist(x$InputData,proba=TRUE,breaks=classes,xlab="Intensity",main=titre,...)
    tmp <- numeric(length(classes))*0
    for (g in 1:(length(param)/5))
      {
        param.g <- param[seq(from=(5*(g-1))+1,by=1,length=5)]
        toto <- param.g[3]*apply(t(classes),1,gfct,moy=param.g[1],sd=param.g[2],l=param.g[4],u=param.g[5])
        tmp <- tmp+toto
        lines(classes,toto,col=g+1)
      }
    lines(classes,tmp)
    if (! is.null(x$Threshold)){
    abline(v=x$Threshold)
    }
  }

`hybridization` <-
function(x, leftT=c(TRUE,FALSE,TRUE,FALSE), rightT=c(TRUE,TRUE,FALSE,FALSE), stop.crit=1e-6,Kmax=5) 
  {
    
    if (length(rightT)!=length(leftT)) 
    {
          cat("Problem with arguments, please verify rightT and leftT \n")
          break
        }
    
    mdata =x[,2]
    
    i.compteur1 <- numeric(Kmax*length(rightT))*0 
    

    resCollec <- list()
        for (j in 1:length(rightT))
          {
           l <- min(mdata)*(leftT[j]==TRUE)+(-100)*(leftT[j]==FALSE)
           u <- max(mdata)*(rightT[j]==TRUE)+(100)*(rightT[j]==FALSE)
           cat("----------------------------------------------- \n")
           cat(" Truncatures :" , l, "and", u," \n")
            
           for (comp in 1:Kmax) 
              {
                param <- numeric()
                param[seq(4,by=5,length=comp)] <- l
                param[seq(5,by=5,length=comp)] <- u
                param[seq(3,by=5,length=comp)] <- 1/comp
                param[seq(2,by=5,length=comp)] <- sort(runif(comp,0.1,1))
                param[seq(1,by=5,length=comp)] <- seq(min(mdata),max(mdata),by=(max(mdata)-min(mdata))/(comp+1))[2:(2+comp-1)]+runif(comp,0,.5)#rajout na.rm=TRUE
                 modele <- (j-1)*5+comp
                resCollec[[modele]] <- EMAlgo(mdata,param,stop.crit)
                if (!is.na(resCollec[[modele]][[1]][1]))
                  {
                    cat("Number of components :",comp,"\n")
                    i.compteur1[modele] <- modele
                    cat("estimated parameters : \n")
                    resSelect <- matrix(resCollec[[modele]][[1]]$estimation,ncol=5,byrow=TRUE)[,1:3]
                    print(resSelect)
                    cat("log-likelihood :",resCollec[[modele]][[1]]$logLike,"\t BIC : ",resCollec[[modele]][[1]]$bic,"\n")
                    cat("\n")
                  }
              }
             
          }
          

        i.compteur1 <- sort(unique(i.compteur1))[-1]
        bic <- numeric()
        nb.comp <- numeric()
        for(i in i.compteur1){
        bic <- c(bic,extract(resCollec,i)$bic)
        nb.comp <- c(nb.comp,extract(resCollec,i)$nb.comp)
        }
        best <- i.compteur1[which.max(bic)]
        fic <- resCollec[[best]]
        j = ceiling(best/Kmax)
        l <- min(mdata)*(leftT[j]==TRUE)+(-100)*(leftT[j]==FALSE)
        u <- max(mdata)*(rightT[j]==TRUE)+(100)*(rightT[j]==FALSE)
        
        out <- list(GeneID=x[,1],InputData=x[,2],ModelInfo=fic[[1]],Prob=fic[[2]],Trunc=c(l,u),Bic=bic,NbComp=nb.comp)
        class(out) <- "MixThres"
        print(out)
        invisible(out)
        }

`logLike` <-
function(mdata,param)
{
  ncomp <- length(param)/5
  tmp <- sapply(1:ncomp,FUN=function(g) param[5*(g-1)+1:5][3]*apply(t(mdata),1,gfct,moy=param[5*(g-1)+1:5][1],sd=param[5*(g-1)+1:5][2],l=param[5*(g-1)+1:5][4],u=param[5*(g-1)+1:5][5]))
  logLike <- sum(log(rowSums(as.matrix(tmp))))
  nb.param <- (ncomp*3)-1
  aicCrit <- logLike-2*nb.param
  bicCrit <- logLike-nb.param*log(length(mdata))/2
  list(nb.comp=ncomp,estimation=param,logLikelihood=logLike,nb.param=nb.param,bic=bicCrit,aic=aicCrit)
 }

`loggfct` <-
function(x,moy,sdev,l,u)
  log((dnorm(x,mean=moy,sd=sdev)*(x<=u)*(x>=l))/(pnorm(u,mean=moy,sd=sdev)-pnorm(l,mean=moy,sd=sdev)))

`m1Step` <-
function(mdata,taux,param)
{
  g <- ncol(taux)
  res.param <- param
  p.tmp <- colSums(taux)
  moy1 <- apply(taux,2,FUN=function(x) x%*%mdata)/p.tmp
  sdev1 <- sqrt(sapply(1:g,FUN=function(x) taux[,x]%*%((mdata-moy1[x])^2))/p.tmp)
  res.param <- replace(res.param,list=c(rep((5*(1:g-1)+1),3)+rep(0:2,each=g)),values=c(moy1,sdev1,p.tmp/length(mdata)))
  res.param
}

`m2Step` <-
function(param)
{
  for (g in 1:(length(param)/5))
    {
      param.g <- param[seq(from=(5*(g-1))+1,by=1,length=5)]
      l <- param.g[4]
      u <- param.g[5]
      moy <- param.g[1]
      sdev <- param.g[2]
      variance <- sdev^2
      var.init <- pmin(pmax(variance,1e-6),1000)
      moy.init <- moy
      for (i in 1:1000)
        {
          rapport <- (dnorm(l,moy,sdev)-dnorm(u,mean=moy,sd=sdev))/(pnorm(u,mean=moy,sd=sdev)-pnorm(l,mean=moy,sd=sdev))
          m.iter <- moy+var.init*rapport
          a1.num <- (l-m.iter)*dnorm(l,moy,sdev)-(u-m.iter)*dnorm(u,moy,sdev)
          a1.deno <- pnorm(u,moy,sdev)-pnorm(l,moy,sdev)
          a1 <- a1.num/a1.deno
          s2.iter <- variance/(1+a1+var.init*(rapport)^2)
          if ((abs(m.iter-moy)/moy>1e-6) && (abs(s2.iter-var.init)/var.init>1e-6) )
                      {
              moy.init <- m.iter
              var.init <- s2.iter
            }
          else
            {
              param.g[1] <- m.iter
              param.g[2] <- sqrt(s2.iter)
              param[seq(from=(5*(g-1))+1,by=1,length=5)] <- param.g
              break
            }
       }
    }
  param
}

`one.comp` <-
function(mdata,param)
  {
    moy <- mean(mdata)
   
    sdev <- sd(mdata)
    if (param[4] == min(mdata) && param[5] == max(mdata)) 
      {
        param <- c(moy,sdev,1,param[4],param[5])
      }
    else
      {
        l <- param[4]
        u <- param[5]
        rapport <- (dnorm(l,moy,sdev)-dnorm(u,moy,sdev))/(pnorm(u,moy,sdev)-pnorm(l,moy,sdev))
        moy <- moy-rapport*sdev^2
        variance <- sdev^2*(1+((l-moy)*dnorm(l,moy,sdev)-(u-moy)*dnorm(u,moy,sdev)/(pnorm(u,moy,sdev)-pnorm(l,moy,sdev)))+(sdev*rapport)^2)
        sdev <- sqrt(variance)
        param <- c(moy,sdev,1,l,u)
    }
    param
  }

`plot.MixThres` <-
function(x,...){
        plot(x$InputData,x$Prob[,1],main=
        paste("Posterior probabilities according to the intensity signal"),
        col='red',pch=20,ylim=c(0,1),xlab="intensity signal",ylab="posterior probability",las=1,...)

        nbGroup <- ncol(x$Prob) 
        for (j in 2:nbGroup){
        points(x$InputData,x$Prob[,j],col=1+j, pch=20)
        leg.txt <- paste("component", 1:nbGroup, sep=" ")
        legend("bottomright", leg.txt, pch=20, col = 2:(nbGroup+1), bg = grey(0.9))
       }
       }

`print.MixThres` <-
function(x,...){
     
     nbComponent <- ncol(x$Prob)
        cat("\n The best mixture according to BIC is a mixture of ",nbComponent,x$Trunc[1]," and ",x$Trunc[2],"truncated gaussian","\n\n")
        res1 <- as.data.frame(cbind(x$InputData,x$Prob))
        names(res1)[-1] <- c(paste("group",1:(length(names(res1)[-1])),sep=""))
        resSelect <- as.data.frame(matrix(x$ModelInfo$estimation,ncol=5,byrow=TRUE)[,1:3])
        names(resSelect) <- c("mean","sd","probability")
        cat("parameters of selected model : \n")
        print(resSelect)
        cat("truncatures :",x$Trunc[1],"\t",x$Trunc[2])
        cat("\n")
        
     if (!(is.null(x$Threshold))){
     cat("threshold (crit = ",x$Crit,") :",x$Threshold,"\n")
     n <- length(x$InputData)
     #x$Hybrid <- 0*numeric(n)
#        if (x$Threshold!=0)
#          {
#            x$Hybrid <- 1*(x$InputData>=x$Threshold)
#          }            
     nb.hyb <- length(which(x$Hybrid==1))
        cat("Number of hybridized genes : ",nb.hyb,"/",n," - ", 
        round((nb.hyb/n)*100,2),"% \n")
     }   
        
     }

`threshold` <-
function(MixThres,crit=1e-04,fileGRAPH=NULL,fileOUT=NULL,sep="\t",...) 
  { 
    resSelect <- matrix(MixThres$ModelInfo$estimation,ncol=5,byrow=TRUE)
    MixThres$Crit <- crit
    mdata <- MixThres$InputData
  
    classes <- seq(min(mdata),max(mdata),length=50)
    nb.comp <- nrow(resSelect) 
    seuil.int <- numeric(nb.comp) 
    value <- matrix(0,ncol=length(classes),nrow=nb.comp) 
    resSelect <- resSelect[order(resSelect[,1]),]
    
    if (!is.null(fileGRAPH)){
    pdf(paste(fileGRAPH,".pdf",sep=""))
    hist(MixThres)
    dev.off()
    } ## end if(display) 
    
    taux <- eStep(classes,c(t(resSelect)))
    kstar <- apply(taux,1,which.max)
    donnee <- classes[kstar != max(kstar)]
    tau.reduit <- taux[kstar != max(kstar),]
    kstar <- apply(tau.reduit,1,which.max)
    if (max(kstar) == 1)
      {
        seuil.possible <- max(donnee)
      }
    else
      {
        i <- length(donnee)
        while (sum((tau.reduit[i,(1:(kstar[i]-1))]<=crit)) == (kstar[i]-1))
          {
            i <- i-1
          }
        seuil.possible <- donnee[i]
      }
    MixThres$Threshold <- seuil.possible
    MixThres$Hybrid <- 0*numeric(length(MixThres$InputData))
     if (MixThres$Threshold!=0)
    MixThres$Hybrid <- 1*(MixThres$InputData>=MixThres$Threshold)
    
    if (!is.null(fileOUT)){
    Proba <- MixThres$Prob
    colnames(Proba) <- paste("tau",1:ncol(Proba),sep="")
    fic <- data.frame(GeneID=MixThres$GeneID,Signal=MixThres$InputData,Proba,Index.Hybrid=MixThres$Hybrid)
    
    write.table(fic,paste(fileOUT,".txt",sep=""),row.names=FALSE,sep=sep,...)
    } 
    
    MixThres
    
    
  }

