.packageName <- "quantregForest"
"getnodes" <-
function(qrf,x){
  nodes <- matrix(nrow=nrow(x),ncol=qrf$ntree)
  nodes <- randomForest:::predict.randomForest(qrf,newdata=x,predict.all=TRUE)$individual  
  return(nodes)
}

"plot.quantregForest" <-
function(x, ...){

  quantiles <- c(0.05,0.5,0.95)
  quant <- predict(x,quantiles=quantiles)

  or <- order(quant[,2])
  n <- length(x$origObs)
  plot(quant[or,2],x$origObs[or],pch=20,xlab="predicted median values", ylab ="observed response",type="n",main="95 \% prediction intervals on out-of-bag data") 


  med <- quant[or,2]
  upp <- quant[or,3]
  low <- quant[or,1]
  ytrain <- x$origObs[or]
  
  dist <- mean(diff(sort(med)),trim=0.05)/3

  for (i in 1:n){
    polygon( c(med[i]-dist,med[i]+dist,med[i]+dist,med[i]-dist), c(upp[i],upp[i],low[i],low[i]) ,col=rgb(0.8,0.8,0.8) ,border=NA)
  }
  for (i in 1:n){
    lines(c(med[i]-dist,med[i]+dist) , c(upp[i],upp[i]) )
    lines(c(med[i]-dist,med[i]+dist) , c(low[i],low[i]) )
  }
  
  inpred <- (ytrain<= upp) & (ytrain>=low)
  for (i in  1:n) points(med[i],x$origObs[or[i]],col=as.numeric(inpred)[i]+2,pch=20)
  abline(c(0,1),col=rgb(0.5,0.5,0.5))

  legend(x=min(med),y=max(x$origObs), legend=c("inside prediction interval","outside predicition interval"),fill=c(3,2))
  
}
  
"predict.quantregForest" <-
function(object, newdata= NULL, quantiles= c(0.1,0.5,0.9), ... ) {

  ### Checking arguments
  if (!inherits(object, "quantregForest")) 
    stop("object not of class quantregForest")
  if(min(quantiles)<0 | max(quantiles)>1 )
    stop("quantiles must be in [0,1]")
  
  x <- newdata
  if(!is.null(x)){
    if (nrow(x) == 0) 
      stop("newdata has 0 rows")
    if (any(is.na(x))) 
      stop("missing values in newdata")
    keep <- 1:nrow(x)
    rn <- rownames(x)
    if (is.null(rn)) rn <- keep
  }

  if (is.data.frame(x)) {
    for(i in seq(along=ncol(x))) {
      if(is.ordered(x[[i]])) x[[i]] <- as.numeric(x[[i]])
    }
    cat.new <- sapply(x, function(x) if (is.factor(x) && !is.ordered(x)) 
                      length(levels(x)) else 1)
    if (length(cat.new) != length(object$forest$ncat))
      stop("Number of variables in newdata does not match the model.")
    if (!all(object$forest$ncat == cat.new)) 
      stop("Type of predictors in new data do not match that of the training data.")
  }

  if(!is.null(newdata)){
    vname <- if (is.null(dim(object$importance))) {
      names(object$importance)
    } else {
      rownames(object$importance)
    }
    
    if (any(colnames(x) != vname))
      stop("names of predictor variables do not match")
  }
  
  #### Out-of-bag prediction or not ?
    if(is.null(newdata)){
    origObs <- object$origObs
    nobs <- length(origObs)

    origNodes <- object$origNodes
    
    quant <- matrix(nrow=nobs,ncol=length(quantiles))
    ntree <- object$ntree

    normalise <- 0
    weightvec <- rep(0,nobs*nobs)
    counti <- rep(0,nobs)
    thres <- 5*.Machine$double.eps

    
    result <- .C("findweightsinbag",
                 as.double(as.vector(origNodes)),
                 as.integer(as.vector(object$inbag)),
                 weightvec=as.double(weightvec),
                 as.integer(nobs),
                 as.integer(ntree),
                 as.double(thres),
                 as.integer(counti),
                 as.integer(normalise),
                 DUP=FALSE,
                 PACKAGE="quantregForest")


    
    weights <- matrix(result$weightvec,nrow= nobs)

    ord <- order(origObs)
    origObs <- origObs[ord]
    weights <- weights[ord,]
    cumweights <- apply(weights,2,cumsum)
    cumweights <- sweep(cumweights,2,cumweights[nobs,],FUN="/")

    for (qc in 1:length(quantiles)){
      larg <- cumweights<quantiles[qc]
      wc <- apply(larg,2,sum)+1
      quant[,qc] <- origObs[wc]
    }
    
  }else{
    origObs <- object$origObs
    
    origNodes <- object$origNodes
    
    quant <- matrix(nrow=nrow(x),ncol=length(quantiles))
    nodes <- getnodes(object,x)
    ntree <- object$ntree

    nobs <- length(origObs)
    nnew <- nrow(x)
    normalise <- 0
    weightvec <- rep(0,nobs*nnew)
    counti <- rep(0,nobs)
    thres <- 5*.Machine$double.eps
    result <- .C("findweights",
                 as.double(as.vector(origNodes)),
                 as.double(as.vector(nodes)),
                 weightvec=as.double(weightvec),
                 as.integer(nobs),
                 as.integer(nnew),
                 as.integer(ntree),
                 as.double(thres),
                 as.integer(counti),
                 as.integer(normalise),
                 DUP=FALSE,
                 PACKAGE="quantregForest")
    
    weights <- matrix(result$weightvec,nrow= nobs)

    ord <- order(origObs)
    origObs <- origObs[ord]
    weights <- weights[ord,]
    cumweights <- apply(weights,2,cumsum)
    cumweights <- sweep(cumweights,2,cumweights[nobs,],FUN="/")

    for (qc in 1:length(quantiles)){
      larg <- cumweights<quantiles[qc]
      wc <- apply(larg,2,sum)+1
      quant[,qc] <- origObs[wc]
    }

  }
  colnames(quant) <- paste("quantile=",quantiles)
  return(quant)
  
}

"print.quantregForest" <-
function(x, ...) {
  cat("\nCall:\n", deparse(x$call), "\n\n")
  
  cat("                     Number of trees: ", x$ntree, "\n",sep="")
  cat("No. of variables tried at each split: ", x$mtry, "\n\n", sep="")
}

"quantregForest" <-
function(x,y, mtry= ceiling(ncol(x)/3)  , nodesize= 10, ntree= 1000){

  ## Some checks 
  if(! class(y) %in% c("numeric","integer") )
    stop(" y must be numeric ")
  
  if(is.null(nrow(x)) || is.null(ncol(x)))
    stop(" x contains no data ")
    
  if(length(unique(y))<=4)
    stop(" The response variable y contains less than 5 unique values! Quantile Regression assumes a continuous response variable. ")

  
  if(length(unique(y))<10)
    warning(" The response variable y contains less than 10 unique values! Quantile Regression assumes a continuous response variable.")

  if(mtry < 1 || mtry > ncol(x)){
    warning(" The value of mtry is too low or high! Has been reset to default value.")
    mtry <- max( floor(ncol(x)/3) ,1)
  }

  if( nrow(x) != length(y) )
    stop(" predictor variables and response variable must contain the same number of samples ")

  if (any(is.na(x))) stop("NA not permitted in predictors")
  if (any(is.na(y))) stop("NA not permitted in response")

  
  
  ## Check for categorial predictors with too many categories (copied from randomForest package)
   if (is.data.frame(x)) {
        ncat <- sapply(x, function(x) if(is.factor(x) && !is.ordered(x))
                       length(levels(x)) else 1)
      } else {
        ncat <- rep(1, p)
    }
    maxcat <- max(ncat)
    if (maxcat > 32)
        stop("Can not handle categorical predictors with more than 32 categories.")

  
  ## Note that crucial parts of the computation
  ## are only invoked by the predict method
  cl <- match.call()
  cl[[1]] <- as.name("quantregForest")

  qrf <- randomForest( x=x,y=y,keep.forest=TRUE, mtry=mtry, nodesize=nodesize, ntree=ntree, keep.inbag=TRUE )
  class(qrf) <- c("quantregForest","randomForest")

  qrf[["call"]] <- cl
  qrf[["origNodes"]] <- getnodes(qrf,x)
  qrf[["origObs"]] <- y

  
  return(qrf)
}

