.packageName <- "LogitBoost"
## CLASSIFICATION: V-FOLD CROSS VALIDATION WITH LOGITBOOST AND GENE SELECTION
crossval <- function(x, y, v=length(y), mfinal = 100, presel = 0,
                     estimate = 0, verbose = FALSE)
  {
    ## Number of classes
    K    <-  nlevels(as.factor(y))
    
    ## Checking the input and warning messages
    if (nrow(x)!=length(y)) stop("x and y must have equally many observation")
    if (v>length(y))        stop("set v for v-fold c.v. appropriately!")
    if (v<2)                stop("set v for v-fold c.v. appropriately!")
    if (K < 2)              stop("y must have at least two different levels")
    if (K > 10)          warning("more than 10 classes; is `y' categorical?")

    ## Calling the binary or the multiclass version
    if (K==2){output <- cv.binary(x, y, v, mfinal, presel, estimate, verbose)}
    if (K>2) {output <- cv.multic(x, y, v, mfinal, presel, estimate, verbose)}

    ## Output
    output
  }

## FOR BINARY PROBLEMS
cv.binary <- function(x, y, v, mfinal, presel, estimate, verbose)
  {    
    ## Number of samples and genes
    nsamples  <- length(y)
    ngenes    <- dim(x)[2]

    ## Defining the output variable
    ptest                     <- matrix(0, nsamples, mfinal)
    if (estimate>0) {likeli   <- matrix(0, nsamples, mfinal)}
    
    ## Predictions with LogitBoost
    for (i in 1:v)
      {
        test         <- v*(0:floor(nsamples/v))+i
        test         <- test[test<nsamples+1]
        lern         <- (1:nsamples)[-test]  
        xlearn       <- x[lern, ]
        ylearn       <- y[lern]
        xtest        <- x[test,,drop = FALSE]
        output       <- logitboost(xlearn, ylearn, xtest, mfinal, presel,
                                   estimate, verbose)
        ptest[test,] <- output$probs
        if(estimate>0) {likeli[test,]   <- output$loglikeli}
        if(verbose)    {print(paste("This was run number", i, "of", v))}
      }

    ## Output
    out   <- list(probs = ptest)
    if (estimate>0) {out   <- list(probs = ptest, loglikeli = likeli)}
    out
  }


## FOR MULTICLASS PROBLEMS
cv.multic <- function(x, y, v, mfinal, presel, estimate, verbose)
  {
    ## Number of samples, genes and classes
    nsamples  <- length(y)
    ngenes    <- dim(x)[2]
    K         <- nlevels(as.factor(y))

    ## Defining the output variable
    ptest                     <- array(0, c(nsamples, mfinal, K))
    if (estimate>0) {likeli   <- array(0, c(nsamples, mfinal, K))}
    
    ## Cross validation
    for (i in 1:v)
      {
        test      <- v*(0:floor(nsamples/v))+i
        test      <- test[test<nsamples+1]
        learn     <- (1:nsamples)[-test]
        xlearn    <- x[learn, ]
        ylearn    <- y[learn]
        xtest     <- x[test, , drop=FALSE]
        for (k in 0:(K-1))
          {
            output             <- logitboost(xlearn, (ylearn==k)*1, xtest,
                                  mfinal, presel, estimate, verbose)
            ptest[test,,(k+1)] <- output$probs
            if(estimate>0) {likeli[test,,(k+1)] <- output$loglikeli}
          }
        if(verbose) {print(paste("This was run number", i, "of", v))}
      }

    ## Output
    out <- list(probs=ptest)
    if (estimate>0) {out <- list(probs=ptest, loglikeli=likeli)}
    out
  }
logitboost <- function(xlearn, ylearn, xtest, mfinal, presel = 0,
                       estimate = 0, verbose = FALSE)
  {
    ## The binary version, always used if called from crossval()
    if (nlevels(as.factor(ylearn))==2)
      {      
        ## Feature Preselection
        if (presel > 0)
          {
            s       <- apply(xlearn, 2, score, ylearn)
            quality <- apply(rbind(s,-s+(sum(ylearn==0)*sum(ylearn==1))),2,max)
            genes   <- rev(order(quality))[1:presel]
            xlearn  <- xlearn[, genes]
            xtest   <- xtest[ , genes, drop = FALSE]
          }

        ## Estimation of the stopping parameter
        if (estimate>0)
          {
            if (verbose) {print("Stopping Parameter Estimation")}
            likeli       <- numeric(mfinal)
            probabs      <- crossval(xlearn, ylearn, estimate, mfinal)$probs
            for (k in 1:mfinal)
              {
                a          <- pmax(log(probabs[,k]),   -1e36)
                b          <- pmax(log(1-probabs[,k]), -1e36)
                likeli[k]  <- (ylearn%*%a)+((1-ylearn)%*%b)
              }
          }

        ## Length of training and test data
        learn    <- dim(xlearn)[1]         
        test     <- dim(xtest)[1]

        ## Initialization
        Flearn   <- numeric(learn)             
        Ftest    <- numeric(test)              
        flearn   <- numeric(learn)             
        ftest    <- numeric(test)              
        z        <- numeric(learn)             
        w        <- numeric(learn)             
        plearn   <- rep(1/2, learn)
        ptest    <- matrix(0, test, mfinal)

        ## Boosting Iterations
        if (verbose) { print("Boosting Iterations") }
        for (m in 1:mfinal)
          {
            ## Computation of working response and weights
            w      <- pmax(plearn*(1-plearn), 1e-24)
            z      <- (ylearn-plearn)/w

            ## Setting the arguments for rpart
            cntrl  <- rpart.control(maxdepth=1, minsplit=learn-1, maxcompete=0,
                                    maxsurrogate=0, cp=0, xval=0)

            ## Fitting the tree
            xx     <- xlearn
            fit    <- rpart(z~xx, weights = w/mean(w), control = cntrl)
            flearn <- predict(fit)
            xx     <- xtest
            ftest  <- predict(fit, newdata = data.frame(xx))

            ## Updating and probabilities
            Flearn    <- Flearn + (1/2)*flearn
            Ftest     <- Ftest  + (1/2)*ftest
            plearn    <- 1/(1+exp((-2)*Flearn))
            ptest[,m] <- 1/(1+exp((-2)*Ftest))
          }

        ## Output
        output   <- list(probs = ptest)
        if (estimate>0){output <- list(probs = ptest,loglikeli = matrix(likeli,
                                       nr = test, nc = mfinal, byrow = TRUE))}
      }

    ## The multiclass version, only used if logitboost() is called directly
    if (nlevels(as.factor(ylearn))>2)
      {
        ## Preliminaries
        K      <- nlevels(as.factor(ylearn))
        likeli <- array(0, c(dim(xtest)[1], mfinal, K))
        ptest  <- array(0, c(dim(xtest)[1], mfinal, K))

        ## Looping over the K classes
        for (k in 0:(K-1))
          {
            ## Defining the response
            yyl <- as.numeric(ylearn==k)
            
            ## Feature Preselection
            if (presel > 0)
              {
                s       <- apply(xlearn, 2, score, yyl)
                quality <- apply(rbind(s,-s+(sum(yyl==0)*sum(yyl==1))),2,max)
                genes   <- rev(order(quality))[1:presel]
                xxl     <- xlearn[, genes]
                xxt     <- xtest[ , genes, drop = FALSE]
              }
            else {  ## VC guesswork -- dies with no xxl found if no presel
                s <- apply(xlearn, 2, score, yyl)
                quality <- apply(rbind(s, -s + (sum(yyl == 0) *
                  sum(yyl == 1))), 2, max)
                genes <- rev(order(quality))[1:length(quality)]
                xxl <- xlearn[, genes]
                xxt <- xtest[, genes, drop = FALSE]
            }


            ## Estimation of the stopping parameter
            if (estimate>0)
              {
                if (verbose) {print("Stopping Parameter Estimation")}
                probabs      <- crossval(xxl, yyl, estimate, mfinal)$probs
                for (i in 1:mfinal)
                  {
                    a                 <- pmax(log(probabs[,i]),   -1e36)
                    b                 <- pmax(log(1-probabs[,i]), -1e36)
                    for (q in 1:dim(xtest)[1])
                      {
                        likeli[q,i,(k+1)] <- (yyl%*%a)+((1-yyl)%*%b)
                      }
                  }
              }

            ## Length of training and test data
            learn    <- dim(xxl)[1]         
            test     <- dim(xxt)[1]

            ## Initialization
            Flearn   <- numeric(learn)             
            Ftest    <- numeric(test)              
            flearn   <- numeric(learn)             
            ftest    <- numeric(test)              
            z        <- numeric(learn)             
            w        <- numeric(learn)             
            plearn   <- rep(1/2, learn)

            ## Boosting Iterations
            if (verbose) { print("Boosting Iterations") }
            for (m in 1:mfinal)
              {
                ## Computation of working response and weights
                w      <- pmax(plearn*(1-plearn), 1e-24)
                z      <- (yyl-plearn)/w

                ## Setting the arguments for rpart
                cntrl  <- rpart.control(maxdepth=1, minsplit=learn-1, xval=0,
                                        maxcompete=0, cp=0, maxsurrogate=0, )

                ## Fitting the tree
                xx     <- xxl
                fit    <- rpart(z~xx, weights = w/mean(w), control = cntrl)
                flearn <- predict(fit)
                xx     <- xxt
                ftest  <- predict(fit, newdata = data.frame(xx))

                ## Updating and probabilities
                Flearn          <- Flearn + (1/2)*flearn
                Ftest           <- Ftest  + (1/2)*ftest
                plearn          <- 1/(1+exp((-2)*Flearn))
                ptest[,m,(k+1)] <- 1/(1+exp((-2)*Ftest))
              }
          }
             
        ## Output
        output   <- list(probs = ptest)
        if (estimate>0){output <- list(probs=ptest,loglikeli=likeli)}
      }
    
    ## Final output
    class(output) <- "logitboost" # VJC
    attr(output,"call") <- match.call() #VJC
    output
  }





print.logitboost <- function(x) {
	cat("logitboost result; call was\n")
	print(attr(x,"call"))
	cat("dims of result:")
	print(dim(x$probs))
}
score <- function(x, resp)
  {
    .C("R_score", as.double(x), as.integer(resp), as.integer(length(x)),
       re=double(1))$re
  }
summarize <- function(boost.out, resp, mout=100, grafik=TRUE)
  {
    ## Binary version
    if ((K <- nlevels(as.factor(resp)))==2)
      {
        mcra <- apply(((boost.out$probs>0.5)*1)!=resp, 2, mean)
        mini <- which.min(mcra)
        mcrs <- round(min(mcra), 4)
        print(paste("Minimal mcr:  ",mcrs, "achieved after",
                    mini, "boosting step(s)"))
        mcrf <- round(mean(((boost.out$probs[,mout]>0.5)*1)!=resp),4)
        print(paste("Fixed mcr:    ",mcrf,"achieved after", mout,
                    "boosting step(s)"))
        if (length(boost.out)==2)
          {
            c.likeli     <- numeric(length(resp))
            m.likeli     <- apply(boost.out$loglikeli, 1, which.max)
            for (i in 1:length(resp))
              {
                classification <- ((boost.out$probs>0.5)*1)
                c.likeli[i]    <- classification[i, m.likeli[i]]
              }            
            mcrl  <- round(mean((c.likeli!=resp)),4)
            print(paste("Estimated mcr:", mcrl, "achieved after",
                  round(mean(m.likeli),2), "boosting step(s)"))
          }
        if (grafik)
          {
            xax <- "Boosting steps"
            yax <- "Error rate"
            ttl <- "LogitBoost"
            plot(mcra, xlab=xax, ylab=yax, main=ttl, type="l")
          }
      }
    
    ## Multiclass version
    if ((K <- nlevels(as.factor(resp)))>2)
      {
        clas <- apply(boost.out$probs, c(1,2), which.max)-1
        mcra <- apply(clas!=resp, 2, mean)
        mini <- which.min(mcra)
        mcrs <- round(min(mcra), 4)
        print(paste("Minimal mcr:  ",mcrs, "achieved after",
                    mini, "boosting step(s)"))
        mcrf <- round(mean(clas[,mout]!=resp),4)
        print(paste("Fixed mcr:    ",mcrf, "achieved after", mout,
                    "boosting step(s)"))
        if (length(boost.out)==2)
          {
            stops <- apply(boost.out$loglikeli,c(1,3),which.max)
            fprob <- matrix(0, length(resp), K)
            for (j in 1:K)
              {
                for (i in 1:length(resp))
                  {
                    fprob[i,j] <- boost.out$probs[i,stops[i,j],j]
                  }
              }
            class <- apply(fprob, 1, which.max)-1
            mcrl  <- round(mean(class!=resp),4)
            mlik  <- numeric(length(resp))
            for (i in 1:length(resp))
              {
                mlik[i] <- stops[i,class[i]+1]
              }
            mlik  <- stops[,class+1]
            print(paste("Estimated mcr:", mcrl, "achieved after",
                        round(mean(mlik),2), "boosting step(s)"))
          }
        if (grafik)
          {
            xax <- "Boosting steps"
            yax <- "Error rate"
            ttl <- "LogitBoost"
            plot(mcra, xlab=xax, ylab=yax, main=ttl, type="l")
          }
      }
  }

require(rpart)
.First.lib <- function(lib, pkg) library.dynam("LogitBoost", pkg, lib)
