TestPackage: Sandbox for Testing Package Stuff

#' @name bootstrap
#'
#' @title Associated S3 methods for bootCase from car.
#'
#' @description Provides S3 methods to construct non-parametric bootstrap confidence intervals, hypothesis tests, and plots of the parameter estimates for \code{\link[car]{bootCase}} objects from the \pkg{car} package.
#'
#' @details \code{confint} finds the two quantiles that have the (1-\code{conf.level})/2 proportion of bootstrapped parameter estimates below and above.  This is an approximate 100\code{conf.level}\% confidence interval.
#'
#' \code{predict} applies a user-supplied function to each row of \code{object} and then finds the median and the two quantiles that have the proportion (1-\code{conf.level})/2 of the bootstrapped predictions below and above.  The median is returned as the predicted value and the quantiles are returned as an approximate 100\code{conf.level}\% confidence interval for that prediction.
#'
#' In \code{htest} the \dQuote{direction} of the alternative hypothesis is identified by a string in the \code{alt=} argument.  The strings may be \code{"less"} for a \dQuote{less than} alternative, \code{"greater"} for a \dQuote{greater than} alternative, or \code{"two.sided"} for a \dQuote{not equals} alternative (the DEFAULT).  In the one-tailed alternatives the p-value is the proportion of bootstrapped parameter estimates in \code{object$coefboot} that are extreme of the null hypothesized parameter value in \code{bo}.  In the two-tailed alternative the p-value is twice the smallest of the proportion of bootstrapped parameter estimates above or below the null hypothesized parameter value in \code{bo}.
#'
#' @aliases confint.bootCase htest.bootCase hist.bootCase plot.bootCase predict.bootCase
#'
#' @param object A \code{bootCase} object.
#' @param parm A number or string that indicates which column of \code{object} contains the parameter estimates to use for the confidence interval or hypothesis test.
#' @param conf.level A level of confidence as a proportion.
#' @param level Same as \code{conf.level}.
#' @param plot A logical that indicates whether a plot should be constructed.  If \code{confint} then a histogram of the \code{parm} parameters from the bootstrap samples with error bars that illustrate the bootstrapped confidence intervals will be constructed.  If code{htest} then a histogram of the \code{parm} parameters with a vertical line illustrating the \code{bo} value will be constructed.
#' @param err.col A single numeric or character that identifies the color for the error bars on the plot.
#' @param err.lwd A single numeric that identifies the line width for the error bars on the plot.
#' @param rows A single numeric that contains the number of rows to use on the graphic.
#' @param cols A single numeric that contains the number of columns to use on the graphic.
#' @param \dots Additional items to send to functions.
#'
#' @return If \code{object} is a matrix, then \code{confint} returns a matrix with as many rows as columns (i.e., parameter estimates) in \code{object} and two columns of the quantiles that correspond to the approximate confidence interval.  If \code{object} is a vector, then \code{confint} returns a vector with the two quantiles that correspond to the approximate confidence interval.
#'
#' @author Derek H. Ogle, \email{dogle@@northland.edu}
#'
#' @seealso \code{\link[car]{bootCase}} in \pkg{car}.
#'
#' @references S. Weisberg (2005). \emph{Applied Linear Regression}, third edition.  New York: Wiley, Chapters 4 and 11.
#'
#' @keywords htest
#'
#' @examples
#' data(Ecoli)
#' fnx <- function(days,B1,B2,B3) B1/(1+exp(B2+B3*days))
#' nl1 <- nls(cells~fnx(days,B1,B2,B3),data=Ecoli,start=list(B1=6,B2=7.2,B3=-1.45))
#' if (require(car)) bc <- bootCase(nl1,B=99)
#' if (require(car)) confint(bc,parm=1)
#'
#' @rdname bootCase
#' @export
confint.bootCase <- function(object,parm=NULL,level=conf.level,conf.level=0.95,plot=FALSE,
                             err.col="black",err.lwd=2,rows=NULL,cols=NULL,...) {
  iCIBoot(object,parm,conf.level,plot,err.col,err.lwd,rows,cols,...)
}

##############################################################
## INTERNAL FUNCTIONS
##############################################################
## ===========================================================
## Confindence intervals from bootstrapped results
##   should work for bootCase and nlsboot results
## ===========================================================
iCIBoot <- function(object,parm,conf.level,plot,err.col,err.lwd,rows,cols,...) {
  #### internal function to find CIs
  cl <- function(x) quantile(x,c((1-conf.level)/2,1-(1-conf.level)/2))
  #### end internal function
  #### Main function
  ## Perform some checks on parm
  # if parm=NULL then set to all paramaters
  if (is.null(parm)) parm <- colnames(object)
  else {
    if (is.numeric(parm)) {
      # check numeric parm
      if (max(parm)>ncol(object)) stop("Number in 'parm' exceeds number of columns.",call.=FALSE)
      if (min(parm)<=0) stop("Number in 'parm' must be positive.",call.=FALSE)
    } else {
      # check named parm
      if (!all(parm %in% colnames(object))) stop("Name in 'parm' does not exist in object.",call.=FALSE)
    }
  }
  ## Reduce object to have only the parm columns in it
  object <- object[,parm]
  ## Compute CIs for each column, but handle differently if vector or matrix
  if (is.null(dim(object))) {
    # A vector, then only one parameter
    res <- cl(object)
    names(res) <- iCILabel(conf.level)
  } else {
    res <- t(apply(object,2,cl))
    colnames(res) <- iCILabel(conf.level)
    rownames(res) <- colnames(object)
  }
  ## Return CI result
  res
}

iCILabel <- function(conf.level,digits=1) paste(paste(round(100*conf.level,digits),"%",sep=""),c("LCI","UCI"))