.packageName <- "howmany"
"find.beta" <-
function(m,alpha)
  {  
    quant.ecd <- -log(0.5*log(1/(1-alpha))) 
    c.n <- 2*log(log(m))+0.5*log(log(log(m)))-0.5*log(4*pi)
    b.n <- sqrt(2*log(log(m)))
    beta <- 1/sqrt(m)*(quant.ecd+c.n)/b.n 
  }

"get.boundingfunction.dependent" <-
function(X,Y,alpha,test,alternative,at=(1:1000)/1000,n.permutation=round(20/alpha))
  {
    
    m <- ncol(X)
    n <- nrow(X) 
     
    cat(" ... ", n.permutation," permutations\n ")
    Testall <- matrix(rep(0,m*n.permutation),nrow=n.permutation)
    Quantile <- matrix(rep(0,m*n.permutation),nrow=n.permutation)

    for (perm in 1:n.permutation)
      { 
        if(round(perm/50)==perm/50) cat( perm, "  ")
        Ynew <- Y[sample(1:n,n)]
        for (p in 1:m){
          Testall[perm,p] <- test(X[Ynew==0,p],X[Ynew==1,p],alternative=alternative)$p.value
        }
      }
    cat("  \n")
    Quantile <- Testall
    for (p in 1:m) Quantile[,p] <- sample(Quantile[,p],m)
    for (perm in 1:n.permutation) Quantile[perm,] <- sort(Quantile[perm,])
    for (p in 1:m) Quantile[,p] <- sort(Quantile[,p])
    
    quanbeta <- 1
    too.high <- 1

  
    while(too.high)
      {
        quanbeta <- quanbeta+1
        
        boundingjump <- rep(0,m)
        boundingjump <- Quantile[quanbeta,]
        
        count <- 0
        for (perm in 1:n.permutation)
          {
            count <- count  +  min(1,   sum(Testall[perm,]<boundingjump)  )
          }
        
        if(count>alpha*n.permutation)
          {
            too.high <- 0
            quanbeta <- quanbeta-1
            boundingjump <- Quantile[quanbeta,]
          }
      }

    boundingfunction <- numeric(length(at))
    for (i in 1:length(at))
      {
        boundingfunction[i] <- sum(boundingjump<=at[i])
      }
       
    return(boundingfunction)
        
  }

"get.boundingfunction.independent" <-
function(m,alpha,at=(1:1000)/1000,method="asymptotic")
  {
    if(method!="asymptotic") stop(paste("Method ", method, " not available"))
    beta <- find.beta(m,alpha)

    if( max(at)>1 | min(at)<0 ) stop( "bounding-function can only be evaluated within [0,1]")
    if(length(at)<1) stop(" bounding-function must be evaluated at least at one point ")
    
    boundingfunction <-   m*(  at + beta*sqrt(at*(1-at))  ) 
    return(boundingfunction)
        
  }

"howmany" <-
function(pvalues,alpha=0.05,cutoff=0.05/length(pvalues))
  {
    
    m <- length(pvalues)
    ord <- order(pvalues)
    pvalues <- pvalues[ord]

    howmany <- list()
    howmany$order <- ord
    howmany$pvalues <- pvalues
    howmany$alpha <- alpha
  
    ##cutoff
    pvalues[pvalues<cutoff] <- cutoff

    ##calculate bounding function
    boundingfunction <- get.boundingfunction.independent(m,alpha,pvalues)

    ##compute the lower bound for the number of correct rejections
    lowerbound <- numeric(m)
    cummax <- 0
    for (p in 1:m){

      cummax <- max(cummax,floor((p-floor(boundingfunction[p]))/max(0.2,(1-pvalues[p]))))
      lowerbound[p] <- cummax
    }

    ##give back the result
    howmany$boundingfunction <- boundingfunction
    howmany$lowerbound <- lowerbound
    class(howmany) <- "howmany"
    
    return(howmany)
  }

"howmany_dependent" <-
function(X,Y,alpha=0.05,test=wilcox.test,alternative="two.sided",n.permutation=round(20/alpha))
  {

    if(length(dim(X))!=2) stop(" dimension of X must have length 2\n ")
    if(nrow(X)!=length(Y)) stop(" number of rows of X must match length of Y\n ")
    ##check binary class variable Y
    if(is.factor(Y)) Y <- as.numeric(Y)
    if(length(unique(Y))!=2) stop(" Y must have binary values\n ")
    valY <- unique(Y)
    Ynew <- numeric(length(Y))
    Ynew[Y==min(valY)] <- 0
    Ynew[Y==max(valY)] <- 1
    Y <- Ynew
    
    if(ncol(X)<2) stop( " number of columns of X must exceed 1\n " )
        
    m <- ncol(X)
    n <- nrow(X)

    ##calculate original p-values
    pvalues <- numeric(m)
    for (p in 1:m){
      pvalues[p] <- test(X[Y==0,p],X[Y==1,p],alternative=alternative)$p.value
    }

    ##order p-values
    ord <- order(pvalues)
    pvalues <- pvalues[ord]

    ##compute bounding function
    boundingfunction <- get.boundingfunction.dependent(X,Y,alpha,test,alternative,at=pvalues,n.permutation=max(100,n.permutation))

    ##compute lower bound for the number of correct rejections
    lowerbound <- numeric(m)
    cummax <- 0
    for (p in 1:m){
      cummax <- max(cummax,(p-floor(boundingfunction[p])))
      lowerbound[p] <- cummax
    }

    ##give back result
    howmany <- list()
    howmany$order <- ord
    howmany$pvalues <- pvalues
    howmany$alpha <- alpha
    howmany$boundingfunction <- boundingfunction
    howmany$lowerbound <- lowerbound
    class(howmany) <- "howmany"
    return(howmany)
  }

"lowerbound" <-
function(object)
  {
    if(class(object)!="howmany") stop("lowerbound requires object of class 'howmany'")
    return(object$lowerbound)
  }

"plot.howmany" <-
function(x,...)
  {
    m <- length(x$pvalues)
    par(mfrow=c(2,2))
    plot(x$pvalues,1:m,main="distribution of  p-values",type="l",xlab="p",ylab="number of rejected hypotheses")
    lines(x$pvalues,x$boundingfunction,lty=3)
    lines(c(0,1),c(0,m),lty=2)

    plot(x$pvalues,(1:m)-x$pvalues*m,type="l",main="excess p-values",xlab="p",ylab="excess p-values")
    abline(h=0,lty=2)
    lines(x$pvalues,x$boundingfunction-x$pvalues*m,lty=3)

    
    plot(1:m,x$lowerbound,xlab="number of rejected hypotheses",ylab="number of correct rejections",type="l",main="correct rejections\n (simultaneous lower bound)")
    
    plot(1:m,x$lowerbound/(1:m),xlab="number of rejected hypotheses",ylab="proportion of correct rejections",type="l",main="proportion of correct rejections\n (simultaneous lower bound)")

  }

"print.howmany" <-
function(x,...)
  {
    summary(x)   
  }

"summary.howmany" <-
function(object,...)
  {
    m <- length(object$pvalues)
    lower <- max(object$lowerbound)
    maxabs <- which.max(object$lowerbound)
    switch(min(3,lower+1),
           {
         
             cat("\n Multiple testing of ",m," hypotheses. \n \n At confidence level ",1-object$alpha, ", no evidence for false null hypotheses was found.\n \n ",sep="")
           },
           {
             cat("\n Multiple testing of ",m," hypotheses. \n \n At confidence level ",1-object$alpha, ", there is at least ", lower," correct rejection, \n among the first ", maxabs  ," rejections. \n \n ",sep="")
             
           },
           {
             cat("\n Multiple testing of ",m," hypotheses. \n \n At confidence level ",1-object$alpha, ", there are at least ", lower," correct rejections \n (all among the first ", maxabs  ," rejections). \n \n ",sep="")
             proportion <- object$lowerbound/(1:m)
             maxprop <- max((1:m)[proportion==max(proportion)])
             if( maxprop>0 &  (object$lowerbound[maxprop]/maxprop)>1.2* (lower/maxabs)  )
               {
                 if(maxprop>1)
                   {
                     cat("Furthermore, at confidence level ",1-object$alpha, ", there are at least ",object$lowerbound[maxprop] ," correct rejections among the first ", maxprop," rejections. \n \n ",sep="")
                   }else{
                     cat("At confidence level ",1-object$alpha, ", the first rejection is furthermore correct. \n \n ",sep="")
                   } 
               }
           }
           )
    cat("\n")
  }

