## This function provides for a complete S3 implementation of
## regression splines with categorical factors using two approaches,
## (i) kernel smoothing, and (ii) indicator function bases. Both
## additive and tensor product bases are supported (default is
## additive, but also see the option basis="auto" that computes both
## and uses that with the smallest cross-validation
## score). Cross-validation (leave-one-out, generalized, and the AIC_c
## method of Hurvich, Simonoff, and Tsai (1998, JRSS B)) can be used
## to select (i) the degree and number of knots (`segments'+1) of the
## basis spline for each continuous predictor, (ii) bandwidth for each
## ordinal/nominal predictor, or (iii) whether or not to include each
## ordinal/nominal predictor's indicator basis. S3 methods include
## fitted, predict, residuals, plot and so forth.

## 2010 (C) Jeffrey S. Racine (racinej@mcmaster.ca).

crs <- function(...) UseMethod("crs")

.crs_default_selector_args <- function() {
  c("cv",
    "cv.df.min",
    "cv.func",
    "cv.threshold",
    "degree.max",
    "degree.min",
    "display.nomad.progress",
    "initial.mesh.size.integer",
    "initial.mesh.size.real",
    "lambda.discrete",
    "lambda.discrete.num",
    "max.bb.eval",
    "min.mesh.size.integer",
    "min.mesh.size.real",
    "min.frame.size.integer",
    "min.frame.size.real",
    "nmulti",
    "opts",
    "random.seed",
    "restarts",
    "segments.max",
    "segments.min",
    "singular.ok")
}

.crs_default_should_select <- function(xz,
                                       kernel,
                                       degree,
                                       segments,
                                       include,
                                       lambda,
                                       dots) {
  xz.df <- as.data.frame(xz)
  dot.names <- names(dots)

  has.numeric <- any(vapply(xz.df, is.numeric, logical(1L)))
  has.categorical <- any(vapply(xz.df, is.factor, logical(1L)))
  has.selector.args <- !is.null(dot.names) &&
    any(nzchar(dot.names) & dot.names %in% .crs_default_selector_args())

  missing.continuous.spec <- has.numeric && (is.null(degree) || is.null(segments))
  missing.categorical.spec <- has.categorical &&
    if (kernel) is.null(lambda) else is.null(include)

  has.selector.args || missing.continuous.spec || missing.categorical.spec
}

.crs_default_delegate <- function(xz,
                                  y,
                                  basis,
                                  complexity,
                                  data.return,
                                  degree,
                                  deriv,
                                  display.nomad.progress,
                                  display.warnings,
                                  include,
                                  kernel,
                                  knots,
                                  lambda,
                                  model.return,
                                  prune,
                                  tau,
                                  weights,
                                  dots) {
  xz.df <- as.data.frame(xz)
  response.name <- make.unique(c(".crs_response", names(xz.df)))[1L]
  data <- xz.df
  data[[response.name]] <- y

  args <- c(
    list(
      formula = reformulate(names(xz.df), response = response.name),
      basis = basis,
      complexity = complexity,
      data = data,
      data.return = data.return,
      degree = degree,
      deriv = deriv,
      display.nomad.progress = display.nomad.progress,
      display.warnings = display.warnings,
      include = include,
      kernel = kernel,
      knots = knots,
      lambda = lambda,
      model.return = model.return,
      prune = prune,
      tau = tau,
      weights = weights
    ),
    dots
  )

  do.call(crs.formula, args)
}

## This function computes the fit and returns the fit, degree
## (vector), segments (vector), and include (vector) for categorical
## predictors. Note that degree of zero and include of zero drop the
## variable from the resulting fit.

crsEst <- function(xz,
                   y,
                   basis=c("auto","additive","tensor","glp"),
                   complexity=c("degree-knots","degree","knots"),
                   data.return=FALSE,
                   degree=NULL,
                   deriv=0,
                   display.nomad.progress=TRUE,
                   display.warnings=TRUE,
                   include=NULL,
                   kernel=TRUE,
                   knots=c("quantiles","uniform","auto"),
                   lambda=NULL,
                   model.return=FALSE,
                   prune=FALSE,
                   prune.index=NULL,
                   segments=NULL,
                   tau=NULL,
                   weights=NULL) {

  ## Take data frame xz and parse into factors (z) and numeric (x).

  complexity <- match.arg(complexity)
  knots <- match.arg(knots)
  basis <- match.arg(basis)

  if(!kernel) {
    xztmp <- splitFrame(xz)
  } else {
    xztmp <- splitFrame(xz,factor.to.numeric=TRUE)
  }
  x <- xztmp$x
  xnames <- xztmp$xnames
  num.x <- xztmp$num.x
  z <- xztmp$z
  znames <- xztmp$znames
  num.z <- xztmp$num.z
  is.ordered.z <- xztmp$is.ordered.z
  ## The default is kernel==TRUE - this will throw an error with no
  ## categorical predictors so first check
  if(is.null(num.z) && isTRUE(kernel)) kernel <- FALSE
  rm(xztmp)
  if(is.null(z)) {
    include <- NULL
  }

  y <- as.numeric(y)

  ## If weights are provided and there are NA values in the data, we
  ## need only those weights corresponding to the complete cases

  if(!is.null(weights))
    weights <- na.omit(data.frame(xz,y,weights))$weights

  if(!kernel) {

    model <- preditFactorSpline(x=x,
                                y=y,
                                z=z,
                                K=cbind(degree,segments),
                                I=include,
                                knots=knots,
                                basis=basis,
                                prune=prune,
                                tau=tau,
                                weights=weights)

    prune.index <- model$prune.index

    if(deriv > 0) {

      deriv.mat <- xz ## copy for dimension only
      deriv.mat.lwr <- deriv.mat
      deriv.mat.upr <- deriv.mat
      l <- 1 ## num.z
      m <- 1 ## num.x
      for(i in seq_len(ncol(xz))) {
        if(!is.factor(xz[,i])) {
          if(deriv <= degree[m]) {
            tmp <- derivFactorSpline(x=x,
                                     y=y,
                                     z=z,
                                     K=cbind(degree,segments),
                                     I=include,
                                     knots=knots,
                                     basis=basis,
                                     deriv.index=m,
                                     deriv=deriv,
                                     prune.index=prune.index,
                                     tau=tau,
                                     weights=weights)
          } else {
            tmp <- matrix(0,length(y),3)
          }
          deriv.mat[,i] <- tmp[,1]
          deriv.mat.lwr[,i] <- tmp[,2]
          deriv.mat.upr[,i] <- tmp[,3]
          rm(tmp)
          m <- m + 1
        } else {
          ztmp <- z
          ztmp[,l] <- factor(rep(levels(xz[,i])[1],NROW(xz)),levels=levels(xz[,i]),ordered=is.ordered(xz[,i]))

          zpred <- preditFactorSpline(x=x,
                                      y=y,
                                      z=z,
                                      K=cbind(degree,segments),
                                      I=include,
                                      knots=knots,
                                      basis=basis,
                                      prune=prune,
                                      prune.index=prune.index,
                                      tau=tau,
                                      weights=weights)$fitted.values

          zpred.base <- preditFactorSpline(x=x,
                                           y=y,
                                           z=z,
                                           K=cbind(degree,segments),
                                           I=include,
                                           xeval=x,
                                           zeval=ztmp,
                                           knots=knots,
                                           basis=basis,
                                           prune=prune,
                                           prune.index=prune.index,
                                           tau=tau,
                                           weights=weights)$fitted.values

          deriv.mat[,i] <- zpred[,1]-zpred.base[,1]
          deriv.mat.lwr[,i] <- deriv.mat[,i] - qnorm(0.975)*sqrt(zpred[,4]^2+zpred.base[,4]^2)
          deriv.mat.upr[,i] <- deriv.mat[,i] + qnorm(0.975)*sqrt(zpred[,4]^2+zpred.base[,4]^2)

          l <- l + 1
        }
      }

    } else {
      deriv.mat <- NULL
      deriv.mat.lwr <- NULL
      deriv.mat.upr <- NULL
    }

  } else {

    model <- predictKernelSpline(x=x,
                                 y=y,
                                 z=z,
                                 K=cbind(degree,segments),
                                 lambda=lambda,
                                 is.ordered.z=is.ordered.z,
                                 knots=knots,
                                 basis=basis,
                                 model.return=model.return,
                                 tau=tau,
                                 weights=weights)

    prune.index <- NULL

    if(deriv > 0) {

      deriv.mat <- xz ## copy for dimension only
      deriv.mat.lwr <- deriv.mat
      deriv.mat.upr <- deriv.mat
      l <- 1 ## num.z
      m <- 1 ## num.x
      for(i in seq_len(ncol(xz))) {
        if(!is.factor(xz[,i])) {
          if(deriv <= degree[m]) {
            tmp <- derivKernelSpline(x=x,
                                     y=y,
                                     z=z,
                                     K=cbind(degree,segments),
                                     lambda=lambda,
                                     is.ordered.z=is.ordered.z,
                                     knots=knots,
                                     basis=basis,
                                     deriv.index=m,
                                     deriv=deriv,
                                     tau=tau,
                                     weights=weights)
          } else {
            tmp <- matrix(0,length(y),3)
          }
          deriv.mat[,i] <- tmp[,1]
          deriv.mat.lwr[,i] <- tmp[,2]
          deriv.mat.upr[,i] <- tmp[,3]
          rm(tmp)
          m <- m + 1
        } else {

          ztmp <- z
          ztmp[,l] <- rep(sort(unique(z[,l]))[1],NROW(z))

          zpred <- predictKernelSpline(x=x,
                                       y=y,
                                       z=z,
                                       K=cbind(degree,segments),
                                       lambda=lambda,
                                       is.ordered.z=is.ordered.z,
                                       knots=knots,
                                       basis=basis,
                                       model.return=model.return,
                                       tau=tau,
                                       weights=weights)$fitted.values

          zpred.base <- predictKernelSpline(x=x,
                                            y=y,
                                            z=z,
                                            K=cbind(degree,segments),
                                            lambda=lambda,
                                            is.ordered.z=is.ordered.z,
                                            xeval=x,
                                            zeval=ztmp,
                                            knots=knots,
                                            basis=basis,
                                            model.return=model.return,
                                            tau=tau,
                                            weights=weights)$fitted.values

          deriv.mat[,i] <- zpred[,1]-zpred.base[,1]
          deriv.mat.lwr[,i] <- deriv.mat[,i] - qnorm(0.975)*sqrt(zpred[,4]^2+zpred.base[,4]^2)
          deriv.mat.upr[,i] <- deriv.mat[,i] + qnorm(0.975)*sqrt(zpred[,4]^2+zpred.base[,4]^2)

          l <- l + 1
        }
      }

    } else {
      deriv.mat <- NULL
      deriv.mat.lwr <- NULL
      deriv.mat.upr <- NULL
    }

  }

  if(!data.return) {
    x <- NULL
    z <- NULL
  }

  if(is.null(tau)) {
    fitted.values <- model$fitted.values[,1]
    lwr <- model$fitted.values[,2]
    upr <- model$fitted.values[,3]
  } else {
    fitted.values <- model$fitted.values[,1]
    lwr <- NULL
    upr <- NULL
  }

  return(list(fitted.values=fitted.values,
              lwr=lwr,
              upr=upr,
              df.residual=model$df.residual,
              K=cbind(degree,segments),
              degree=degree,
              segments=segments,
              complexity=complexity,
              knots=knots,
              include=include,
              lambda=lambda,
              kernel=kernel,
              basis=basis,
              num.x=num.x,
              num.z=num.z,
              is.ordered.z=is.ordered.z,
              xnames=xnames,
              znames=znames,
              deriv=deriv,
              deriv.mat=deriv.mat,
              deriv.mat.lwr=deriv.mat.lwr,
              deriv.mat.upr=deriv.mat.upr,
              model.lm=model$model,
              hatvalues=model$hatvalues,
              nobs=length(y),
              k=model$rank,
              x=x,
              z=z,
              prune=prune,
              prune.index=prune.index,
              P.hat=model$P.hat,
              tau=tau,
              weights=weights))

}

## Default method - this function takes the minimum arguments (data,
## degree of spline with one element for each column of xz having
## continuous data (presumed default is all xz continuous)).

crs.default <- function(xz,
                        y,
                        basis=c("auto","additive","tensor","glp"),
                        complexity=c("degree-knots","degree","knots"),
                        data.return=FALSE,
                        degree=NULL,
                        deriv=0,
                        display.nomad.progress=TRUE,
                        display.warnings=TRUE,
                        include=NULL,
                        kernel=TRUE,
                        knots=c("quantiles","uniform","auto"),
                        lambda=NULL,
                        model.return=FALSE,
                        prune=FALSE,
                        segments=NULL,
                        tau=NULL,
                        weights=NULL,
                        ...) {
  dots <- list(...)

  if (.crs_default_should_select(xz = xz,
                                 kernel = kernel,
                                 degree = degree,
                                 segments = segments,
                                 include = include,
                                 lambda = lambda,
                                 dots = dots)) {
    est <- .crs_default_delegate(xz = xz,
                                 y = y,
                                 basis = basis,
                                 complexity = complexity,
                                 data.return = data.return,
                                 degree = degree,
                                 deriv = deriv,
                                 display.nomad.progress = display.nomad.progress,
                                 display.warnings = display.warnings,
                                 include = include,
                                 kernel = kernel,
                                 knots = knots,
                                 lambda = lambda,
                                 model.return = model.return,
                                 prune = prune,
                                 tau = tau,
                                 weights = weights,
                                 dots = dots)
    est$call <- match.call(expand.dots = FALSE)
    return(est)
  }

  complexity <- match.arg(complexity)
  knots <- match.arg(knots)
  basis <- match.arg(basis)

  ## Does the following properly belong here or crsEst?

  est <- crsEst(xz=xz,
                y=y,
                degree=degree,
                segments=segments,
                include=include,
                kernel=kernel,
                lambda=lambda,
                complexity=complexity,
                knots=knots,
                basis=basis,
                deriv=deriv,
                data.return=data.return,
                prune=prune,
                model.return=model.return,
                tau=tau,
                weights=weights,
                display.warnings=display.warnings,
                display.nomad.progress=display.nomad.progress)

  ## Add results to estimated object.

  est$residuals <- y - est$fitted.values
  est$r.squared <- RSQfunc(y,est$fitted.values,weights)
  est$call <- match.call()
  class(est) <- "crs"

  ## Return object of type crs

  return(est)

}

## Here we define the formula and split y (always first column of the
## model frame) from xz (the remaining continuous and
## ordinal/nominal).  nomad/exhaustive search and nmulti controls multiple initial
## points. When nmulti==0, snomadRSolve is used; otherwise
## smultinomadRSolve is used. See ?snomadr
## Jun 4,  2011
##1) degree.max (we have removed  basis.maxdim)
##2) segments.max (we have removed  basis.maxdim)
##3) degree.min (currently 0)
##4) segments.min (currently 1)

crs.formula <- function(formula,
                        basis=c("auto","additive","tensor","glp"),
                        complexity=c("degree-knots","degree","knots"),
                        cv=c("nomad","exhaustive","none"),
                        cv.df.min=1,
                        cv.func=c("cv.ls","cv.gcv","cv.aic"),
                        cv.threshold=1000,
                        data=list(),
                        data.return=FALSE,
                        degree=NULL,
                        degree.max=10,
                        degree.min=0,
                        deriv=0,
                        display.nomad.progress=TRUE,
                        display.warnings=TRUE,
                        include=NULL,
                        initial.mesh.size.integer="1",
                        initial.mesh.size.real="r1.0e-01",
                        kernel=TRUE,
                        knots=c("quantiles","uniform","auto"),
                        lambda=NULL,
                        lambda.discrete=FALSE,
                        lambda.discrete.num=100,
                        max.bb.eval=140,
                        min.mesh.size.integer=1,
                        min.mesh.size.real=paste(sqrt(.Machine$double.eps)),
                        min.frame.size.integer=1,
                        min.frame.size.real=1,
                        model.return=FALSE,
                        nmulti=5,
                        opts=list(),
                        prune=FALSE,
                        random.seed=42,
                        restarts=0,
                        segments=NULL,
                        segments.max=10,
                        segments.min=1,
                        singular.ok=FALSE,
                        tau=NULL,
                        weights=NULL,
                        ...) {

  ptm.start <- proc.time()
  cv <- match.arg(cv)
  cv.func <- match.arg(cv.func)
  complexity <- match.arg(complexity)
  knots <- match.arg(knots)
  basis <- match.arg(basis)

  #  if(!is.null(tau)) {
  #    if(!require(quantreg)) stop(" Error: you must first install the quantreg package")
  #  }

  mf <- model.frame(formula=formula, data=data)
  mt <- attr(mf, "terms")
  y <- model.response(mf)
  xz <- mf[, attr(attr(mf, "terms"),"term.labels"), drop = FALSE]

  ## Set DISPLAY_DEGREE to 0 if crs.messages=FALSE and DISPLAY_DEGREE
  ## is not provided

  if(!isTRUE(getOption("crs.messages")) && is.null(opts[["DISPLAY_DEGREE"]])) opts$"DISPLAY_DEGREE"=0

  ## If a weights vector is provided and there exists missing data
  ## then the weight vector must be parsed to contain weights
  ## corresponding to the non-missing observations only.

  rows.omit <- as.vector(attr(mf,"na.action"))
  if(!is.null(weights) && !is.null(rows.omit))
    weights <- weights[-rows.omit]

  if(!kernel) {
    xztmp <- splitFrame(xz)
  } else {
    xztmp <- splitFrame(xz,factor.to.numeric=TRUE)
  }
  x <- xztmp$x
  xnames <- xztmp$xnames
  num.x <- xztmp$num.x
  z <- xztmp$z
  znames <- xztmp$znames
  num.z <- xztmp$num.z
  is.ordered.z <- xztmp$is.ordered.z
  ## The default is kernel==TRUE - this will throw an error with no
  ## categorical predictors so first check
  if(is.null(num.z) && isTRUE(kernel)) kernel <- FALSE
  rm(xztmp)
  if(is.null(z)) {
    include <- NULL
  }

  ## Check for dynamic cv and if number of combinations is not overly
  ## large use exhaustive search

  if(cv=="nomad" && is.null(num.z) && ((degree.max-degree.min)*(segments.max-segments.min))**num.x <= cv.threshold) {
    if(display.warnings) warning(" Dynamically changing search from nomad to exhaustive (if unwanted set cv.threshold to 0)")
    cv <- "exhaustive"
  }

  ## If no degree nor include nor lambda, return cubic spline
  ## (identity bases) or non-smooth model (kernel).

  if(cv.df.min < 1 || cv.df.min > length(y)-1) stop(" cv.df.min must be a positive integer less than n")
  if(!is.null(degree)&&length(degree)!=num.x) stop(" degree vector must be the same length as x")
  if(!is.null(segments)&&length(segments)!=num.x) stop(" segments vector must be the same length as x")
  if(degree.max > 100) stop(paste(" degree.max (",degree.max,") exceeds reasonable value (",100,")",sep=""))
  if(lambda.discrete && (lambda.discrete.num < 1)) stop(" lambda.discrete.num must be a positive integer")

  if(cv=="none"){

    ## When no cross-validation is selected and no defaults are set
    ## for various parameters, we set them to ad hoc defaults and warn
    ## the user to this effect.

    if(is.null(degree) && !is.null(x)) {
      if(display.warnings) warning(paste(" cv=\"none\" selected but no degree provided, using degree=rep(3,num.x): you might consider other degree settings",sep=""),immediate.=TRUE)
      degree <- rep(3,num.x)
    }
    if(is.null(segments) && !is.null(x)) {
      if(display.warnings) warning(paste(" cv=\"none\" selected but no segments provided, using segments=rep(1,num.x): you might consider other segment settings",sep=""),immediate.=TRUE)
      segments <- rep(1,num.x)
    }
    if(is.null(include) && !is.null(z) && !kernel) {
      if(display.warnings) warning(paste(" cv=\"none\" selected but no inclusion for factors indicated, using include=rep(1,num.z): you might consider other include settings",sep=""),immediate.=TRUE)
      include <- rep(1,num.z)
    }
    if(is.null(lambda) && !is.null(z) && kernel) {
      if(display.warnings) warning(paste(" cv=\"none\" selected but no bandwidths for factors indicated, using lambda=rep(0,num.z): you might consider other lambda settings",sep=""),immediate.=TRUE)
      lambda <- rep(0,num.z)
    }

    ## With one continuous predictor all bases are identical, so
    ## simply set the basis to additive and be done (no warning
    ## necessary)

    if(basis == "auto" && num.x == 1) basis <- "additive"

    if(basis == "auto" && num.x > 1) {
      if(display.warnings) warning(paste(" cv=\"none\" selected, basis=\"auto\" changed to basis=\"additive\": you might consider basis=\"tensor\" etc.",sep=""),immediate.=TRUE)
      basis <- "additive"
    }

    if(knots == "auto" && num.x > 1) {
      if(display.warnings) warning(paste(" cv=\"none\" selected, knots=\"auto\" changed to knots=\"quantiles\": you might consider knots=\"uniform\" etc.",sep=""),immediate.=TRUE)
      knots <- "quantiles"
    }

  }

  if(isTRUE(kernel) && isTRUE(prune)) {
    if(display.warnings) warning(" pruning cannot coexist with categorical kernel smoothing (pruning ignored)")
  }
  if(!is.null(tau) && isTRUE(prune)) stop(" pruning is not supported for quantile regression splines")

  ## Check for cv="nomad" and complexity="degree-knots" but
  ## degree.min==degree.max or segments==segments.max

  if((cv=="nomad" && complexity=="degree-knots") && (segments.min==segments.max)) stop("NOMAD search selected with complexity degree-knots but segments.min and segments.max are equal")
  if((cv=="nomad" && complexity=="degree-knots") && (degree.min==degree.max)) stop("NOMAD search selected with complexity degree-knots but degree.min and degree.max are equal")

  ## Check for proper derivative

  if(deriv < 0) stop("derivative order must be a non-negative integer")

  ## Check for logical singular.ok

  if(!is.logical(singular.ok)) stop("singular.ok must be logical (TRUE/FALSE)")

  cv.min <- NULL
  cv.maxPenalty <- resolve_cv_maxPenalty(NULL, y, weights = weights, cv.func = cv.func)

  if(!kernel) {

    ## indicator bases and B-spline bases cross-validation

    if(cv=="nomad") {

      cv.return <- frscvNOMAD(xz=xz,
                               y=y,
                               degree.max=degree.max,
                               segments.max=segments.max,
                               degree.min=degree.min,
                               segments.min=segments.min,
                               cv.df.min=cv.df.min,
                               complexity=complexity,
                               knots=knots,
                               basis=basis,
                               cv.func=cv.func,
                               degree=degree,
                               segments=segments,
                               nmulti=nmulti,
                               weights=weights,
                               singular.ok=singular.ok,
                               display.nomad.progress=display.nomad.progress,
                               display.warnings=display.warnings)

      cv.min <- cv.return$cv.objc
      degree <- cv.return$degree
      segments <- cv.return$segments
      include <- cv.return$I
      basis <- cv.return$basis
      knots <- cv.return$knots
      if(isTRUE(all.equal(cv.min, cv.maxPenalty))) stop(" Search failed: restart with larger nmulti or smaller degree.max  (or degree if provided)")
    }  else if(cv=="exhaustive") {

      cv.return <- frscv(xz=xz,
                          y=y,
                          degree.max=degree.max,
                          segments.max=segments.max,
                          degree.min=degree.min,
                          segments.min=segments.min,
                          complexity=complexity,
                          knots=knots,
                          basis=basis,
                          cv.func=cv.func,
                          degree=degree,
                          segments=segments,
                          tau=tau,
                          weights=weights,
                          singular.ok=singular.ok,
                          display.warnings=display.warnings)

      cv.min <- cv.return$cv.objc
      degree <- cv.return$degree
      segments <- cv.return$segments
      include <- cv.return$I
      basis <- cv.return$basis
      knots <- cv.return$knots
      if(isTRUE(all.equal(cv.min, cv.maxPenalty))) stop(" Search failed: restart with smaller degree.max")
    }

  } else {

    ## kernel smooth and B-spline bases cross-validation

    if(cv=="nomad") {

      cv.return <- krscvNOMAD(xz=xz,
                               y=y,
                               degree.max=degree.max,
                               segments.max=segments.max,
                               degree.min=degree.min,
                               segments.min=segments.min,
                               cv.df.min=cv.df.min,
                               complexity=complexity,
                               knots=knots,
                               basis=basis,
                               cv.func=cv.func,
                               degree=degree,
                               segments=segments,
                               lambda=lambda,
                               lambda.discrete=lambda.discrete,
                               lambda.discrete.num=lambda.discrete.num,
                               random.seed=random.seed,
                               max.bb.eval=max.bb.eval,
                               initial.mesh.size.real=initial.mesh.size.real,
                               initial.mesh.size.integer=initial.mesh.size.integer,
                               min.mesh.size.real=min.mesh.size.real,
                               min.mesh.size.integer=min.mesh.size.integer,
                               min.frame.size.real=min.frame.size.real,
                               min.frame.size.integer=min.frame.size.integer,
                               nmulti=nmulti,
                               tau=tau,
                               weights=weights,
                               singular.ok=singular.ok,
                               display.nomad.progress=display.nomad.progress,
                               display.warnings=display.warnings)

      cv.min <- cv.return$cv.objc
      degree <- cv.return$degree
      segments <- cv.return$segments
      include <- cv.return$I
      lambda <- cv.return$lambda
      basis <- cv.return$basis
      knots <- cv.return$knots
      if(isTRUE(all.equal(cv.min, cv.maxPenalty))) stop(" Search failed: restart with larger nmulti or smaller degree.max")

    } else if(cv=="exhaustive") {

      cv.return <- krscv(xz=xz,
                          y=y,
                          degree.max=degree.max,
                          segments.max=segments.max,
                          degree.min=degree.min,
                          segments.min=segments.min,
                          complexity=complexity,
                          knots=knots,
                          basis=basis,
                          cv.func=cv.func,
                          degree=degree,
                          segments=segments,
                          restarts=restarts,
                          tau=tau,
                          weights=weights,
                          singular.ok=singular.ok,
                          display.warnings=display.warnings)

      cv.min <- cv.return$cv.objc
      degree <- cv.return$degree
      segments <- cv.return$segments
      include <- cv.return$I
      lambda <- cv.return$lambda
      basis <- cv.return$basis
      knots <- cv.return$knots
      if(isTRUE(all.equal(cv.min, cv.maxPenalty))) stop(" Search failed: restart with smaller degree.max")

    }

  }

  est <- crs.default(xz=xz,
                      y=y,
                      degree=degree,
                      segments=segments,
                      include=include,
                      kernel=kernel,
                      lambda=lambda,
                      complexity=complexity,
                      knots=knots,
                      basis=basis,
                      deriv=deriv,
                      data.return=data.return,
                      prune=prune,
                      model.return=model.return,
                      tau=tau,
                      weights=weights,
                      display.warnings=display.warnings,
                      ...)


  est$cv.score <- cv.min
  est$call <- match.call()
  est$formula <- formula
  est$terms <- mt
  est$xlevels <- .getXlevels(mt, mf)
  est$xz <- xz
  est$y <- y
  est$prune <- prune
  est$cv.min <- cv.min
  est$cv <- cv
  est$restarts <- restarts
  est$ptm <- proc.time() - ptm.start
  est$nmulti <- nmulti

  return(est)

}

## Method for predicting given a new data frame.

predict.crs <- function(object,
                        newdata=NULL,
                        deriv=0,
                        ...) {

  if(is.null(newdata)) {

    ## If no new data provided, return sample fit.
    fitted.values <- fitted(object)
    deriv.mat <- object$deriv.mat

    lwr <- NULL
    upr <- NULL
    deriv.mat.lwr <- NULL
    deriv.mat.upr <- NULL

  } else{

    ## Get training data from object (xz and y) and parse into factors
    ## and numeric.

    basis <- object$basis
    deriv <- object$deriv
    prune <- object$prune
    prune.index <- object$prune.index
    tau <- object$tau
    weights <- object$weights

    xz <- object$xz
    y <- object$y

    ## Divide into factors and numeric

    if(!object$kernel) {
      xztmp <- splitFrame(xz)
    } else {
      xztmp <- splitFrame(xz,factor.to.numeric=TRUE)
    }
    x <- xztmp$x
    z <- xztmp$z
    is.ordered.z <- xztmp$is.ordered.z
    rm(xztmp)

    ## Get evaluation data (newdata) and divide into factors and
    ## numeric.

    Terms <- delete.response(terms(object))
    newdata <- model.frame(Terms,newdata,xlev=object$xlevels)

    if(!object$kernel) {
      xztmp <- splitFrame(data.frame(newdata))
    } else {
      xztmp <- splitFrame(data.frame(newdata),factor.to.numeric=TRUE)
    }
    xeval <- xztmp$x
    zeval <- xztmp$z
    is.ordered.z <- xztmp$is.ordered.z
    rm(xztmp)

    ## Compute the predicted values.

    if(!object$kernel) {

      ## Get degree vector and include vector.

      complexity <- object$complexity
      knots <- object$knots
      K <- object$K
      degree <- object$degree
      segments <- object$segments
      include <- object$include

      tmp <- preditFactorSpline(x=x,
                                y=y,
                                z=z,
                                K=K,
                                I=include,
                                xeval=xeval,
                                zeval=zeval,
                                basis=basis,
                                knots=knots,
                                prune=prune,
                                prune.index=prune.index,
                                tau=tau,
                                weights=weights)$fitted.values

      fitted.values <- tmp[,1]
      lwr <- tmp[,2]
      upr <- tmp[,3]
      rm(tmp)

      if(deriv > 0) {

        deriv.mat <- matrix(NA,nrow=NROW(newdata),ncol=NCOL(newdata))
        deriv.mat.lwr <- deriv.mat
        deriv.mat.upr <- deriv.mat
        l <- 1 ## num.z
        m <- 1 ## num.x
        for(i in seq_len(ncol(newdata))) {
          if(!is.factor(newdata[,i])) {
            if(deriv <= degree[m]) {
              tmp <- derivFactorSpline(x=x,
                                       y=y,
                                       z=z,
                                       K=K,
                                       I=include,
                                       xeval=xeval,
                                       zeval=zeval,
                                       knots=knots,
                                       basis=basis,
                                       deriv.index=m,
                                       deriv=deriv,
                                       prune.index=prune.index,
                                       tau=tau,
                                       weights=weights)
            } else {
              tmp <- matrix(0,nrow(xeval),3)
            }
            deriv.mat[,i] <- tmp[,1]
            deriv.mat.lwr[,i] <- tmp[,2]
            deriv.mat.upr[,i] <- tmp[,3]
            rm(tmp)
            m <- m + 1
          } else {
            zevaltmp <- zeval
            zevaltmp[,l] <- factor(rep(levels(newdata[,i])[1],NROW(newdata)),levels=levels(newdata[,i]),ordered=is.ordered(newdata[,i]))
            zpred <- preditFactorSpline(x=x,
                                        y=y,
                                        z=z,
                                        K=K,
                                        I=include,
                                        xeval=xeval,
                                        zeval=zeval,
                                        knots=knots,
                                        basis=basis,
                                        prune=prune,
                                        prune.index=prune.index,
                                        tau=tau,
                                        weights=weights)$fitted.values

            zpred.base <- preditFactorSpline(x=x,
                                             y=y,
                                             z=z,
                                             K=K,
                                             I=include,
                                             xeval=xeval,
                                             zeval=zevaltmp,
                                             knots=knots,
                                             basis=basis,
                                             prune=prune,
                                             prune.index=prune.index,
                                             tau=tau,
                                             weights=weights)$fitted.values

            deriv.mat[,i] <- zpred[,1]-zpred.base[,1]
            deriv.mat.lwr[,i] <- deriv.mat[,i] - qnorm(0.975)*sqrt(zpred[,4]^2+zpred.base[,4]^2)
            deriv.mat.upr[,i] <- deriv.mat[,i] + qnorm(0.975)*sqrt(zpred[,4]^2+zpred.base[,4]^2)

            l <- l + 1
          }
        }

      } else {
        deriv.mat <- NULL
        deriv.mat.lwr <- NULL
        deriv.mat.upr <- NULL
      }

    } else {

      ## Get degree vector and lambda vector

      complexity <- object$complexity
      knots <- object$knots
      K <- object$K
      segments <- object$segments
      degree <- object$degree
      lambda <- object$lambda

      is.ordered.z <- object$is.ordered.z

      z <- as.matrix(z)
      zeval <- as.matrix(zeval)

      tmp <- predictKernelSpline(x=x,
                                 y=y,
                                 z=z,
                                 K=K,
                                 lambda=lambda,
                                 is.ordered.z=is.ordered.z,
                                 xeval=xeval,
                                 zeval=zeval,
                                 knots=knots,
                                 basis=basis,
                                 tau=tau,
                                 weights=weights)$fitted.values

      fitted.values <- tmp[,1]
      lwr <- tmp[,2]
      upr <- tmp[,3]
      rm(tmp)

      if(deriv > 0) {

        deriv.mat <- matrix(NA,nrow=NROW(newdata),ncol=NCOL(newdata))
        deriv.mat.lwr <- deriv.mat
        deriv.mat.upr <- deriv.mat
        l <- 1 ## num.z
        m <- 1 ## num.x
        for(i in seq_len(ncol(newdata))) {
          if(!is.factor(newdata[,i])) {
            if(deriv <= degree[m]) {
              tmp <- derivKernelSpline(x=x,
                                       y=y,
                                       z=z,
                                       K=K,
                                       lambda=lambda,
                                       is.ordered.z=is.ordered.z,
                                       xeval=xeval,
                                       zeval=zeval,
                                       knots=knots,
                                       basis=basis,
                                       deriv.index=m,
                                       deriv=deriv,
                                       tau=tau,
                                       weights=weights)
            } else {
              tmp <- matrix(0,nrow(xeval),3)
            }
            deriv.mat[,i] <- tmp[,1]
            deriv.mat.lwr[,i] <- tmp[,2]
            deriv.mat.upr[,i] <- tmp[,3]
            rm(tmp)
            m <- m + 1
          } else {
            zevaltmp <- zeval
            zevaltmp[,l] <- rep(sort(unique(zeval[,l]))[1],NROW(zeval))

            zpred <- predictKernelSpline(x=x,
                                         y=y,
                                         z=z,
                                         K=K,
                                         lambda=lambda,
                                         is.ordered.z=is.ordered.z,
                                         xeval=xeval,
                                         zeval=zeval,
                                         knots=knots,
                                         basis=basis,
                                         tau=tau,
                                         weights=weights)$fitted.values

            zpred.base <- predictKernelSpline(x=x,
                                              y=y,
                                              z=z,
                                              K=K,
                                              lambda=lambda,
                                              is.ordered.z=is.ordered.z,
                                              xeval=xeval,
                                              zeval=zevaltmp,
                                              knots=knots,
                                              basis=basis,
                                              tau=tau,
                                              weights=weights)$fitted.values

            deriv.mat[,i] <- zpred[,1]-zpred.base[,1]
            deriv.mat.lwr[,i] <- deriv.mat[,i] - qnorm(0.975)*sqrt(zpred[,4]^2+zpred.base[,4]^2)
            deriv.mat.upr[,i] <- deriv.mat[,i] + qnorm(0.975)*sqrt(zpred[,4]^2+zpred.base[,4]^2)

            l <- l + 1
          }
        }

      } else {
        deriv.mat <- NULL
        deriv.mat.lwr <- NULL
        deriv.mat.upr <- NULL
      }

    }

  }

  ## Return the predicted values.

  attr(fitted.values, "lwr") <- lwr
  attr(fitted.values, "upr") <- upr
  attr(fitted.values, "deriv.mat") <- deriv.mat
  attr(fitted.values, "deriv.mat.lwr") <- deriv.mat.lwr
  attr(fitted.values, "deriv.mat.upr") <- deriv.mat.upr

  return(fitted.values)

}

## Basic print method.

print.crs <- function(x,
                      ...) {

  cat("Call:\n")
  print(x$call)

}

## print.summary is different from print.

summary.crs <- function(object,
                        sigtest=FALSE,
                        ...) {

  cat("Call:\n")
  print(object$call)
  if(!object$kernel) {
    if(is.null(object$tau))
      cat("\nIndicator Bases/B-spline Bases Regression Spline\n",sep="")
    else
      cat("\nIndicator Bases/B-spline Bases Quantile Regression Spline\n",sep="")
  } else {
    if(is.null(object$tau))
      cat("\nKernel Weighting/B-spline Bases Regression Spline\n",sep="")
    else
      cat("\nKernel Weighting/B-spline Bases Quantile Regression Spline\n",sep="")
  }
  if(!is.null(object$tau)) cat(paste("\nQuantile estimated: tau = ",format(object$tau),sep=""),sep="")
  if(object$num.x==1){
    cat(paste("\nThere is ",format(object$num.x), " continuous predictor",sep=""),sep="")
  } else {
    cat(paste("\nThere are ",format(object$num.x), " continuous predictors",sep=""),sep="")
  }
  if(!is.null(object$num.z)) if(object$num.z==1) {
    cat(paste("\nThere is ",format(object$num.z), " categorical predictor",sep=""),sep="")
  }  else {
    cat(paste("\nThere are ",format(object$num.z), " categorical predictors",sep=""),sep="")
  }
  for(j in seq_len(object$num.x))
    cat(paste("\nSpline degree/number of segments for ",format(object$xnames[j]),": ",format(object$degree[j]),"/",format(object$segments[j]),sep=""),sep="")
  if(!is.null(object$include)) for(j in seq_along(object$include))
    cat(paste("\nInclusion indicator for ",format(object$znames[j]),": ",format(object$include[j]),sep=""),sep="")
  if(!is.null(object$lambda)) for(j in seq_along(object$lambda))
    cat(paste("\nBandwidth for ",format(object$znames[j]),": ",format(object$lambda[j]),sep=""),sep="")
  cat(paste("\nModel complexity proxy: ", format(object$complexity), sep=""))
  cat(paste("\nKnot type: ", format(object$knots), sep=""))
  if(object$num.x > 1) cat(paste("\nBasis type: ",format(object$basis),sep=""))
  if(!object$kernel) cat(paste("\nPruning of final model: ",format(if(object$prune) "TRUE" else "FALSE"),sep=""))
  cat(paste("\nTraining observations: ", format(object$nobs), sep=""))
  if(is.null(object$tau)) cat(paste("\nRank of model frame: ", format(object$k), sep=""))
  cat(paste("\nTrace of smoother matrix: ", format(round(sum(object$hatvalues))), sep=""))

  if(is.null(object$weights)) {
    if(is.null(object$tau)) cat(paste("\n\nResidual standard error: ", format(sqrt(sum(object$residuals^2)/object$df.residual),digits=4)," on ", format(object$df.residual)," degrees of freedom",sep=""))
    adjusted.r.squared <- 1-(1-object$r.squared)*(length(object$fitted.values)-1)/object$df.residual
    if(is.null(object$tau)) cat(paste("\nMultiple R-squared: ", format(object$r.squared,digits=4),",   Adjusted R-squared: ",format(adjusted.r.squared,digits=4), sep=""))
    df1 <- round(sum(object$hatvalues))-1
    df2 <- (object$nobs-round(sum(object$hatvalues)))
    F <- (df2/df1)*(sum((object$y-mean(object$y))^2)-sum(residuals(object)^2))/sum(residuals(object)^2)
    if(is.null(object$tau)) cat(paste("\nF-statistic: ", format(F,digits=4), " on ", df1, " and ", df2, " DF, p-value: ", format.pval(pf(F,df1=df1,df2=df2,lower.tail=FALSE),digits=4), sep=""))
    if(!is.null(object$cv.score)) cat(paste("\n\nCross-validation score: ", format(object$cv.score,digits=8), sep=""))
  } else {
    if(is.null(object$tau)) cat(paste("\n\nResidual standard error (weighted): ", format(sqrt(sum((object$residuals^2)*object$weights)/object$df.residual),digits=4)," on ", format(object$df.residual)," degrees of freedom",sep=""))
    adjusted.r.squared <- 1-(1-object$r.squared)*(length(object$fitted.values)-1)/object$df.residual
    if(is.null(object$tau)) cat(paste("\nMultiple R-squared (weighted): ", format(object$r.squared,digits=4),",   Adjusted R-squared (weighted): ",format(adjusted.r.squared,digits=4), sep=""))
    df1 <- round(sum(object$hatvalues))-1
    df2 <- (object$nobs-round(sum(object$hatvalues)))
    F <- (df2/df1)*(sum((object$y-mean(object$y))^2*object$weights)-sum(residuals(object)^2*object$weights))/sum(residuals(object)^2*object$weights)
    if(is.null(object$tau)) cat(paste("\nF-statistic (weighted): ", format(F,digits=4), " on ", df1, " and ", df2, " DF, p-value: ", format.pval(pf(F,df1=df1,df2=df2,lower.tail=FALSE),digits=4), sep=""))
    if(!is.null(object$cv.score)) cat(paste("\n\nCross-validation score (weighted): ", format(object$cv.score,digits=8), sep=""))
  }

  if(object$cv != "none") cat(paste("\nNumber of multistarts: ", format(object$nmulti), sep=""))

  if(sigtest && !object$kernel) {
    cat("\n\nPredictor significance test:\n")
    crs.sigtest(object)
  }

  cat(paste("\nEstimation time: ", formatC(object$ptm[1],digits=1,format="f"), " seconds",sep=""))

  cat("\n\n")

}

.crs.SCSrank <- function(x, conf.level = 0.95, alternative = "two.sided") {
  alternative <- match.arg(alternative, choices = c("two.sided", "less", "greater"))
  DataMatrix <- x
  N <- nrow(DataMatrix)
  k <- round(conf.level * N, 0)
  RankDat <- apply(DataMatrix, 2, rank)
  switch(alternative,
         "two.sided" = {
           W1 <- apply(RankDat, 1, max)
           W2 <- N + 1 - apply(RankDat, 1, min)
           Wmat <- cbind(W1, W2)
           w <- apply(Wmat, 1, max)
           tstar <- round(sort(w)[k], 0)
           SCI <- function(x) {
             sortx <- sort(x)
             cbind(sortx[N + 1 - tstar], sortx[tstar])
           }
           SCS <- t(apply(DataMatrix, 2, SCI))
         },
         "less" = {
           W1 <- apply(RankDat, 1, max)
           tstar <- round(sort(W1)[k], 0)
           SCI <- function(x) {
             sortx <- sort(x)
             cbind(-Inf, sortx[tstar])
           }
           SCS <- t(apply(DataMatrix, 2, SCI))
         },
         "greater" = {
           W2 <- N + 1 - apply(RankDat, 1, min)
           tstar <- round(sort(W2)[k], 0)
           SCI <- function(x) {
             sortx <- sort(x)
             cbind(sortx[N + 1 - tstar], Inf)
           }
           SCS <- t(apply(DataMatrix, 2, SCI))
         })
  colnames(SCS) <- c("lower", "upper")
  list(conf.int = SCS)
}

.crs.bootstrap.bounds <- function(boot.t, alpha, band.type, center) {
  neval <- ncol(boot.t)
  if (band.type == "standard") {
    z <- qnorm(1 - alpha/2)
    se <- sqrt(diag(cov(boot.t)))
    return(cbind(center - z * se, center + z * se))
  }
  if (band.type == "pointwise") {
    return(t(apply(boot.t, 2, quantile, probs = c(alpha/2, 1 - alpha/2))))
  }
  if (band.type == "bonferroni") {
    return(t(apply(boot.t, 2, quantile, probs = c(alpha/(2 * neval), 1 - alpha/(2 * neval)))))
  }
  if (band.type == "simultaneous") {
    return(.crs.SCSrank(boot.t, conf.level = 1 - alpha)$conf.int)
  }
  if (band.type == "all") {
    return(list(
      pointwise = .crs.bootstrap.bounds(boot.t, alpha, "pointwise", center),
      simultaneous = .crs.bootstrap.bounds(boot.t, alpha, "simultaneous", center),
      bonferroni = .crs.bootstrap.bounds(boot.t, alpha, "bonferroni", center)
    ))
  }
  stop("'band.type' must be one of standard, pointwise, bonferroni, simultaneous, all")
}

.crs.draw.all <- function(x, all.bounds, add.legend = TRUE, legend.loc = "topleft") {
  cols <- c(pointwise = "red", simultaneous = "green3", bonferroni = "blue")
  for (bn in c("pointwise", "simultaneous", "bonferroni")) {
    lines(x, all.bounds[[bn]][,1], lty = 2, col = cols[bn])
    lines(x, all.bounds[[bn]][,2], lty = 2, col = cols[bn])
  }
  if (add.legend) {
    legend(legend.loc,
           legend = c("Pointwise", "Simultaneous", "Bonferroni"),
           lty = 2, col = c("red", "green3", "blue"), lwd = 2, bty = "n")
  }
}

.crs.bootstrap.matrix <- function(object,
                                  newdata,
                                  deriv = 0,
                                  deriv.index = 1,
                                  boot.num = 99,
                                  display.warnings = TRUE,
                                  display.nomad.progress = TRUE,
                                  progress.target = NULL) {
  n <- nrow(object$xz)
  prep.activity <- NULL
  if (isTRUE(display.nomad.progress)) {
    prep.activity <- .crs_plot_activity_begin(
      .crs_plot_bootstrap_stage_label(
        stage = "Preparing plot bootstrap",
        target_label = progress.target
      )
    )
    on.exit(.crs_plot_activity_end(prep.activity), add = TRUE)
  }
  pred0 <- predict(object, newdata = newdata, deriv = deriv)
  center <- if (deriv > 0) attr(pred0, "deriv.mat")[,deriv.index] else as.numeric(pred0)
  boot.mat <- matrix(NA_real_, nrow = boot.num, ncol = nrow(newdata))
  progress <- NULL

  if (!is.null(prep.activity)) {
    .crs_plot_activity_end(prep.activity)
    prep.activity <- NULL
  }

  if (isTRUE(display.nomad.progress)) {
    progress <- .crs_plot_stage_progress_begin(
      total = boot.num,
      label = .crs_plot_bootstrap_stage_label(
        stage = "Plot bootstrap",
        target_label = progress.target
      )
    )
    on.exit(.crs_plot_progress_end(progress), add = TRUE)
  }

  for (b in seq_len(boot.num)) {
    idx <- sample.int(n, size = n, replace = TRUE)
    fit.b <- crs.default(
      xz = object$xz[idx,,drop=FALSE],
      y = object$y[idx],
      basis = object$basis,
      complexity = object$complexity,
      degree = object$degree,
      include = object$include,
      kernel = object$kernel,
      knots = object$knots,
      lambda = object$lambda,
      prune = object$prune,
      segments = object$segments,
      tau = object$tau,
      weights = if (is.null(object$weights)) NULL else object$weights[idx],
      display.warnings = display.warnings,
      display.nomad.progress = FALSE
    )
    fit.b$xz <- object$xz[idx,,drop=FALSE]
    fit.b$y <- object$y[idx]
    if (!is.null(object$terms)) fit.b$terms <- object$terms
    if (!is.null(object$xlevels)) fit.b$xlevels <- object$xlevels
    pred.b <- predict(fit.b, newdata = newdata, deriv = deriv)
    boot.mat[b,] <- if (deriv > 0) attr(pred.b, "deriv.mat")[,deriv.index] else as.numeric(pred.b)
    progress <- .crs_plot_progress_tick(progress, done = b, force = (b == 1L))
  }
  list(center = center, boot.mat = boot.mat)
}

plot.crs <- function(x,
                     mean=FALSE,
                     deriv=0,
                     ci=FALSE,
                     plot.errors.method = c("asymptotic","bootstrap"),
                     plot.errors.boot.num = 99,
                     plot.errors.type = c("standard","pointwise","bonferroni","simultaneous","all"),
                     plot.errors.alpha = 0.05,
                     num.eval=100,
                     caption=list("Residuals vs Fitted",
                                  "Normal Q-Q Plot",
                                  "Scale-Location",
                                  "Cook's Distance"),
                     xtrim = 0.0,
                     xq = 0.5,
                     plot.behavior = c("plot","plot-data","data"),
                     common.scale=TRUE,
                     persp.rgl=FALSE,
                     display.warnings=TRUE,
                     display.nomad.progress=TRUE,
                     ...) {

  plot.behavior <- match.arg(plot.behavior)
  plot.errors.method <- match.arg(plot.errors.method)
  plot.errors.type <- match.arg(plot.errors.type)

  if (ci && plot.errors.method == "asymptotic" && plot.errors.type != "standard") {
    if (display.warnings) warning("asymptotic CI supports only standard type; switching plot.errors.type='standard'")
    plot.errors.type <- "standard"
  }
  if (ci && deriv > 0 && plot.errors.method == "bootstrap") {
    if (display.warnings) warning("bootstrap CI for derivatives is not yet supported in plot.crs; switching to asymptotic")
    plot.errors.method <- "asymptotic"
    plot.errors.type <- "standard"
  }

  object <- x

  progress.status <- .crs_progress_status_begin(
    enabled = display.nomad.progress,
    surface = "plot"
  )
  on.exit(.crs_progress_status_clear(progress.status), add = TRUE)
  set_status <- function(msg = NULL) {
    if (is.null(msg)) return(.crs_progress_status_clear(progress.status))
    .crs_progress_status_update(progress.status, msg)
  }
  set_status()

  xq <- double(ncol(object$xz)) + xq

  ## Check for proper derivative

  if(deriv < 0) stop("derivative order must be a non-negative integer")

  ## Default - basic residual plots

  if(!mean && !deriv) {

    par(mfrow=c(2,2))

    ## Residuals versus fitted

    set_status("Working...")

    plot(fitted(object),
         residuals(object),
         xlab="Fitted Values",
         ylab="Residuals",
         main=caption[[1]],
         ...)

    ## QQ plot

    set_status("Working...")

    std.res <- residuals(object)/sqrt(mean(residuals(object)^2))

    qqnorm(std.res,
           main=caption[[2]])

    qqline(std.res)

    ## Standardized versus fitted

    set_status("Working...")

    plot(fitted(object),
         sqrt(abs(residuals(object,"pearson"))),
         xlab="Fitted Values",
         ylab=as.expression(substitute(sqrt(abs(YL)), list(YL = as.name("Standardized Residuals")))),
         main=caption[[3]],
         ...)

    ## Cook's distance \frac{\hat\epsilon_t^2
    ## h_{tt}}{\hat\sigma^2(1-h_{tt})^2k}. Note that this is not
    ## computed for kernel method (what is df.residual when there are
    ## multiple models, etc.?)


    if(!object$kernel) {

      set_status("Working...")

      sigmasq <- sum(residuals(object)^2)/object$df.residual
      cook <- (residuals(object)^2*object$hatvalues)/(sigmasq*(1-object$hatvalues)^2*object$k)
      plot(cook,
           type = "h",
           main=caption[[4]],
           xlab = "Observation Number",
           ylab = "Cook's Distance",
           ...)

    }

    set_status()

  }

  ## Mean

  if(mean) {

    ## Information required to compute predictions

    basis <- object$basis
    prune <- object$prune
    prune.index <- object$prune.index

    xz <- object$xz
    y <- object$y

    ## Divide into factors and numeric

    if(!object$kernel) {
      xztmp <- splitFrame(xz)
    } else {
      xztmp <- splitFrame(xz,factor.to.numeric=TRUE)
    }
    x <- xztmp$x
    z <- xztmp$z
    is.ordered.z <- xztmp$is.ordered.z
    rm(xztmp)

    ## Get degree vector and lambda vector

    complexity <- object$complexity
    knots <- object$knots
    K <- object$K
    degree <- object$degree
    segments <- object$segments
    include <- object$include
    lambda <- object$lambda
    is.ordered.z <- object$is.ordered.z
    tau <- object$tau
    weights <- object$weights

    ## End information required to compute predictions

    if(!persp.rgl) {

      mg <- list()

      for(i in seq_len(NCOL(object$xz))) {

        if(!is.factor(object$xz[,i])) {
          newdata <- matrix(NA,nrow=num.eval,ncol=NCOL(object$xz))
          neval <- num.eval
        } else {
          newdata <- matrix(NA,nrow=length(levels(object$xz[,i])),ncol=NCOL(object$xz))
          neval <- length(levels(object$xz[,i]))
        }

        newdata <- data.frame(newdata)

        if(!is.factor(object$xz[,i])) {
          xlim <- trim.quantiles(object$xz[,i],xtrim)
          newdata[,i] <- seq(xlim[1],xlim[2],length=neval)
        } else {
          newdata[,i] <- factor(levels(object$xz[,i]),levels=levels(object$xz[,i]),ordered=is.ordered(object$xz[,i]))
        }

        for(j in (seq_len(NCOL(object$xz)))[-i]) {
          if(!is.factor(object$xz[,j])) {
            newdata[,j] <- rep(uocquantile(object$xz[,j],prob=xq[j]),neval)
          } else {
            newdata[,j] <- factor(rep(uocquantile(object$xz[,j],prob=xq[j]),neval),levels=levels(object$xz[,j]),ordered=is.ordered(object$xz[,j]))
          }
        }

        newdata <- data.frame(newdata)
        names(newdata) <- names(object$xz)

        if(!object$kernel) {
          xztmp <- splitFrame(data.frame(newdata))
        } else {
          xztmp <- splitFrame(data.frame(newdata),factor.to.numeric=TRUE)
        }
        xeval <- xztmp$x
        zeval <- xztmp$z
        is.ordered.z <- xztmp$is.ordered.z
        rm(xztmp)

        ## Compute the predicted values.

        set_status(.crs_plot_bootstrap_stage_label(
          stage = "Evaluating plot surface",
          target_label = .crs_plot_regression_bootstrap_target_label(
            object = object,
            slice.index = i,
            gradients = FALSE
          )
        ))

        if(!object$kernel) {

          tmp <- preditFactorSpline(x=x,
                                    y=y,
                                    z=z,
                                    K=K,
                                    I=include,
                                    xeval=xeval,
                                    zeval=zeval,
                                    basis=basis,
                                    knots=knots,
                                    prune=prune,
                                    prune.index=prune.index,
                                    tau=tau,
                                    weights=weights,
                                    display.warnings=display.warnings)$fitted.values

          fitted.values <- tmp[,1]
          lwr <- tmp[,2]
          upr <- tmp[,3]
          rm(tmp)

        } else {

          z <- as.matrix(z)
          zeval <- as.matrix(zeval)

          tmp <- predictKernelSpline(x=x,
                                     y=y,
                                     z=z,
                                     K=K,
                                     lambda=lambda,
                                     is.ordered.z=is.ordered.z,
                                     xeval=xeval,
                                     zeval=zeval,
                                     knots=knots,
                                     basis=basis,
                                     tau=tau,
                                     weights=weights,
                                     display.warnings=display.warnings)$fitted.values

          fitted.values <- tmp[,1]
          lwr <- tmp[,2]
          upr <- tmp[,3]
          rm(tmp)

        }

        if(!ci) {

          mg[[i]] <- data.frame(newdata[,i],fitted.values)
          names(mg[[i]]) <- c(names(newdata)[i],"mean")

        } else {
          if (plot.errors.method == "bootstrap") {
            target.label <- .crs_plot_regression_bootstrap_target_label(
              object = object,
              slice.index = i,
              gradients = FALSE
            )
            set_status()
            boot <- .crs.bootstrap.matrix(object = object,
                                         newdata = newdata,
                                         deriv = 0,
                                         deriv.index = i,
                                         boot.num = plot.errors.boot.num,
                                         display.warnings = display.warnings,
                                         display.nomad.progress = display.nomad.progress,
                                         progress.target = target.label)
            set_status(.crs_plot_bootstrap_stage_label(
              stage = sprintf("Constructing bootstrap %s bands", plot.errors.type),
              target_label = target.label
            ))
            if (plot.errors.type == "all") {
              all.bounds <- .crs.bootstrap.bounds(boot$boot.mat, plot.errors.alpha, "all", boot$center)
              mg[[i]] <- data.frame(newdata[,i], boot$center,
                                    all.bounds$pointwise[,1], all.bounds$pointwise[,2],
                                    all.bounds$simultaneous[,1], all.bounds$simultaneous[,2],
                                    all.bounds$bonferroni[,1], all.bounds$bonferroni[,2])
              names(mg[[i]]) <- c(names(newdata)[i],"mean","lwr","upr","lwr.sim","upr.sim","lwr.bonf","upr.bonf")
            } else {
              bounds <- .crs.bootstrap.bounds(boot$boot.mat, plot.errors.alpha, plot.errors.type, boot$center)
              mg[[i]] <- data.frame(newdata[,i], boot$center, bounds)
              names(mg[[i]]) <- c(names(newdata)[i],"mean","lwr","upr")
            }
          } else {
            mg[[i]] <- data.frame(newdata[,i],fitted.values,lwr,upr)
            names(mg[[i]]) <- c(names(newdata)[i],"mean","lwr","upr")
          }
        }

        set_status()

      }

      if(common.scale) {
        min.mg <- Inf
        max.mg <- -Inf
        for(i in seq_along(mg)) {
          if (ci && plot.errors.type == "all") {
            min.mg <- min(min.mg, min(mg[[i]][,c("lwr","lwr.sim","lwr.bonf")]))
            max.mg <- max(max.mg, max(mg[[i]][,c("upr","upr.sim","upr.bonf")]))
          } else {
            min.mg <- min(min.mg,min(mg[[i]][,-1]))
            max.mg <- max(max.mg,max(mg[[i]][,-1]))
          }
        }
        ylim <- c(min.mg,max.mg)
      } else {
        ylim <- NULL
      }

      if(plot.behavior!="data") {

        if(!is.null(object$num.z)||(object$num.x>1)) par(mfrow=n2mfrow(NCOL(object$xz)))

        for(i in seq_len(NCOL(object$xz))) {

          if(!ci) {
            plot(mg[[i]][,1],mg[[i]][,2],
                 xlab=names(newdata)[i],
                 ylab=if(is.null(tau)) "Conditional Mean" else paste("Conditional Quantile (tau = ",format(tau),")",sep=""),
                 ylim=ylim,
                 type="l",
                 ...)

          } else {
            if(!common.scale) {
              if (plot.errors.type == "all") {
                ylim <- c(min(mg[[i]][,c("lwr","lwr.sim","lwr.bonf")]), max(mg[[i]][,c("upr","upr.sim","upr.bonf")]))
              } else {
                ylim <- c(min(mg[[i]][,-1]),max(mg[[i]][,-1]))
              }
            }
            plot(mg[[i]][,1],mg[[i]][,2],
                 xlab=names(newdata)[i],
                 ylab=if(is.null(tau)) "Conditional Mean" else paste("Conditional Quantile (tau = ",format(tau),")",sep=""),
                 ylim=ylim,
                 type="l",
                 ...)
            if (plot.errors.type == "all") {
              all.bounds <- list(
                pointwise = cbind(mg[[i]][,"lwr"], mg[[i]][,"upr"]),
                simultaneous = cbind(mg[[i]][,"lwr.sim"], mg[[i]][,"upr.sim"]),
                bonferroni = cbind(mg[[i]][,"lwr.bonf"], mg[[i]][,"upr.bonf"])
              )
              .crs.draw.all(mg[[i]][,1], all.bounds, add.legend = TRUE)
            } else {
              ## Need to overlay for proper plotting of factor errorbars
              par(new=TRUE)
              plot(mg[[i]][,1],mg[[i]][,3],
                   xlab="",
                   ylab="",
                   ylim=ylim,
                   type="l",
                   axes=FALSE,
                   lty=2,
                   col=2,
                   ...)
              par(new=TRUE)
              plot(mg[[i]][,1],mg[[i]][,4],
                   xlab="",
                   ylab="",
                   ylim=ylim,
                   type="l",
                   axes=FALSE,
                   lty=2,
                   col=2,
                   ...)
            }
          }

        }

      }

    } else {


      if(!is.null(object$num.z)) stop(" Error: persp3d is for continuous predictors only")
      if(object$num.x != 2) stop(" Error: persp3d is for cases involving two continuous predictors only")

      newdata <- matrix(NA,nrow=num.eval,ncol=2)
      newdata <- data.frame(newdata)

      xlim <- trim.quantiles(object$xz[,1],xtrim)
      ylim <- trim.quantiles(object$xz[,2],xtrim)

      x1.seq <- seq(xlim[1],xlim[2],length=num.eval)
      x2.seq <- seq(ylim[1],ylim[2],length=num.eval)

      x.grid <- expand.grid(x1.seq,x2.seq)
      newdata <- data.frame(x.grid[,1],x.grid[,2])
      names(newdata) <- names(object$xz)

      z <- matrix(predict(object,newdata=newdata),num.eval,num.eval)

      mg <- list()

      mg[[1]] <- data.frame(newdata,z)

      if(plot.behavior!="data") {

        num.colors <- 1000
        colorlut <- topo.colors(num.colors)
        col <- colorlut[ (num.colors-1)*(z-min(z))/(max(z)-min(z)) + 1 ]

        if(requireNamespace("rgl", quietly = TRUE)) {

          rgl::open3d()

          rgl::par3d(windowRect=c(900,100,900+640,100+640))
          rgl::view3d(theta = 0, phi = -70, fov = 80)

          rgl::persp3d(x=x1.seq,y=x2.seq,z=z,
                       xlab=names(object$xz)[1],ylab=names(object$xz)[2],zlab="Y",
                       ticktype="detailed",
                       border="red",
                       color=col,
                       alpha=.7,
                       back="lines",
                       main=if(is.null(tau)) "Conditional Mean" else paste("Conditional Quantile (tau = ",format(tau),")",sep=""))

          rgl::grid3d(c("x", "y+", "z"))

          rgl::play3d(rgl::spin3d(axis=c(0,0,1), rpm=5), duration=15)

        } else {

          if(display.warnings) warning("rgl not installed, option persp.rgl ignored")

        }

      }

    }

    if(plot.behavior!="plot") {
      set_status()
      if(!persp.rgl) par(mfrow=c(1,1))
      return(mg)
    }

  }

  ## deriv

  if(deriv > 0) {

    ## Information required to compute predictions

    basis <- object$basis
    prune <- object$prune
    prune.index <- object$prune.index

    xz <- object$xz
    y <- object$y

    ## Divide into factors and numeric

    if(!object$kernel) {
      xztmp <- splitFrame(xz)
    } else {
      xztmp <- splitFrame(xz,factor.to.numeric=TRUE)
    }
    x <- xztmp$x
    z <- xztmp$z
    is.ordered.z <- xztmp$is.ordered.z
    rm(xztmp)

    ## Get degree vector and lambda vector

    complexity <- object$complexity
    knots <- object$knots
    K <- object$K
    degree <- object$degree
    segments <- object$segments
    include <- object$include
    lambda <- object$lambda
    is.ordered.z <- object$is.ordered.z
    tau <- object$tau
    weights <- object$weights

    ## End information required to compute predictions

    if(deriv > 0) {

      rg <- list()
      m <- 0
      i.numeric <- 0

      for(i in seq_len(NCOL(object$xz))) {

        if(!is.factor(object$xz[,i])) {
          i.numeric <- i.numeric + 1
          newdata <- matrix(NA,nrow=num.eval,ncol=NCOL(object$xz))
          neval <- num.eval
          m <- m + 1
        } else {
          newdata <- matrix(NA,nrow=length(levels(object$xz[,i])),ncol=NCOL(object$xz))
          neval <- length(levels(object$xz[,i]))
        }

        newdata <- data.frame(newdata)
        newdata.base <- data.frame(newdata)

        if(!is.factor(object$xz[,i])) {
          xlim <- trim.quantiles(object$xz[,i],xtrim)
          newdata[,i] <- seq(xlim[1],xlim[2],length=neval)
        } else {
          newdata[,i] <- factor(levels(object$xz[,i]),levels=levels(object$xz[,i]),ordered=is.ordered(object$xz[,i]))
          newdata.base[,i] <- factor(rep(levels(object$xz[,i])[1],neval),levels=levels(object$xz[,i]),ordered=is.ordered(object$xz[,i]))
        }

        for(j in (seq_len(NCOL(object$xz)))[-i]) {
          if(!is.factor(object$xz[,j])) {
            newdata[,j] <- rep(uocquantile(object$xz[,j],prob=xq[j]),neval)
            newdata.base[,j] <- rep(uocquantile(object$xz[,j],prob=xq[j]),neval)
          } else {
            newdata[,j] <- factor(rep(uocquantile(object$xz[,j],prob=xq[j]),neval),levels=levels(object$xz[,j]),ordered=is.ordered(object$xz[,j]))
            newdata.base[,j] <- factor(rep(uocquantile(object$xz[,j],prob=xq[j]),neval),levels=levels(object$xz[,j]),ordered=is.ordered(object$xz[,j]))
          }
        }

        newdata <- data.frame(newdata)
        names(newdata) <- names(object$xz)
        newdata.base <- data.frame(newdata.base)
        names(newdata.base) <- names(object$xz)

        if(!object$kernel) {
          xztmp <- splitFrame(data.frame(newdata))
        } else {
          xztmp <- splitFrame(data.frame(newdata),factor.to.numeric=TRUE)
        }
        xeval <- xztmp$x
        zeval <- xztmp$z
        is.ordered.z <- xztmp$is.ordered.z
        rm(xztmp)

        if(!object$kernel) {
          xztmp <- splitFrame(data.frame(newdata.base))
        } else {
          xztmp <- splitFrame(data.frame(newdata.base),factor.to.numeric=TRUE)
        }
        xeval.base <- xztmp$x
        zeval.base <- xztmp$z
        is.ordered.z <- xztmp$is.ordered.z
        rm(xztmp)

        ## Compute the predicted values.

        set_status(.crs_plot_bootstrap_stage_label(
          stage = "Evaluating plot surface",
          target_label = .crs_plot_regression_bootstrap_target_label(
            object = object,
            slice.index = i,
            gradients = TRUE
          )
        ))

        if(!object$kernel) {

          if(!is.factor(newdata[,i])) {
            if(deriv <= degree[i.numeric]) {
              tmp <- derivFactorSpline(x=x,
                                       y=y,
                                       z=z,
                                       K=K,
                                       I=include,
                                       xeval=xeval,
                                       zeval=zeval,
                                       knots=knots,
                                       basis=basis,
                                       deriv.index=m,
                                       deriv=deriv,
                                       prune.index=prune.index,
                                       tau=tau,
                                       weights=weights)
            } else {
              tmp <- matrix(0,nrow(newdata),3)
            }
            deriv.est <- tmp[,1]
            deriv.lwr <- tmp[,2]
            deriv.upr <- tmp[,3]
            rm(tmp)
          } else {
            zpred <- preditFactorSpline(x=x,
                                        y=y,
                                        z=z,
                                        K=K,
                                        I=include,
                                        xeval=xeval,
                                        zeval=zeval,
                                        knots=knots,
                                        basis=basis,
                                        prune=prune,
                                        prune.index=prune.index,
                                        tau=tau,
                                        weights=weights)$fitted.values

            zpred.base <- preditFactorSpline(x=x,
                                             y=y,
                                             z=z,
                                             K=K,
                                             I=include,
                                             xeval=xeval.base,
                                             zeval=zeval.base,
                                             knots=knots,
                                             basis=basis,
                                             prune=prune,
                                             prune.index=prune.index,
                                             tau=tau,
                                             weights=weights)$fitted.values

            deriv.est <- zpred[,1]-zpred.base[,1]
            deriv.lwr <- deriv.est - qnorm(0.975)*sqrt(zpred[,4]^2+zpred.base[,4]^2)
            deriv.upr <- deriv.est + qnorm(0.975)*sqrt(zpred[,4]^2+zpred.base[,4]^2)

          }

        } else {

          if(!is.factor(newdata[,i])) {
            if(deriv <= degree[i.numeric]) {
              tmp <- derivKernelSpline(x=x,
                                       y=y,
                                       z=z,
                                       K=K,
                                       lambda=lambda,
                                       is.ordered.z=is.ordered.z,
                                       xeval=xeval,
                                       zeval=zeval,
                                       knots=knots,
                                       basis=basis,
                                       deriv.index=m,
                                       deriv=deriv,
                                       tau=tau,
                                       weights=weights)

            } else {
              tmp <- matrix(0,nrow(newdata),3)
            }
            deriv.est <- tmp[,1]
            deriv.lwr <- tmp[,2]
            deriv.upr <- tmp[,3]
            rm(tmp)
          } else {
            zpred <- predictKernelSpline(x=x,
                                         y=y,
                                         z=z,
                                         K=K,
                                         lambda=lambda,
                                         is.ordered.z=is.ordered.z,
                                         xeval=xeval,
                                         zeval=zeval,
                                         knots=knots,
                                         basis=basis,
                                         tau=tau,
                                         weights=weights)$fitted.values

            zpred.base <- predictKernelSpline(x=x,
                                              y=y,
                                              z=z,
                                              K=K,
                                              lambda=lambda,
                                              is.ordered.z=is.ordered.z,
                                              xeval=xeval.base,
                                              zeval=zeval.base,
                                              knots=knots,
                                              basis=basis,
                                              tau=tau,
                                              weights=weights)$fitted.values

            deriv.est <- zpred[,1]-zpred.base[,1]
            deriv.lwr <- deriv.est - qnorm(0.975)*sqrt(zpred[,4]^2+zpred.base[,4]^2)
            deriv.upr <- deriv.est + qnorm(0.975)*sqrt(zpred[,4]^2+zpred.base[,4]^2)

          }

        }

        if(!ci) {

          rg[[i]] <- data.frame(newdata[,i],deriv.est)
          names(rg[[i]]) <- c(names(newdata)[i],"deriv")

        } else {
          if (plot.errors.method == "bootstrap" && !is.factor(newdata[,i])) {
            target.label <- .crs_plot_regression_bootstrap_target_label(
              object = object,
              slice.index = i,
              gradients = TRUE
            )
            set_status()
            boot <- .crs.bootstrap.matrix(object = object,
                                         newdata = newdata,
                                         deriv = deriv,
                                         deriv.index = i,
                                         boot.num = plot.errors.boot.num,
                                         display.warnings = display.warnings,
                                         display.nomad.progress = display.nomad.progress,
                                         progress.target = target.label)
            set_status(.crs_plot_bootstrap_stage_label(
              stage = sprintf("Constructing bootstrap %s bands", plot.errors.type),
              target_label = target.label
            ))
            if (plot.errors.type == "all") {
              all.bounds <- .crs.bootstrap.bounds(boot$boot.mat, plot.errors.alpha, "all", boot$center)
              rg[[i]] <- data.frame(newdata[,i], boot$center,
                                    all.bounds$pointwise[,1], all.bounds$pointwise[,2],
                                    all.bounds$simultaneous[,1], all.bounds$simultaneous[,2],
                                    all.bounds$bonferroni[,1], all.bounds$bonferroni[,2])
              names(rg[[i]]) <- c(names(newdata)[i],"deriv","lwr","upr","lwr.sim","upr.sim","lwr.bonf","upr.bonf")
            } else {
              bounds <- .crs.bootstrap.bounds(boot$boot.mat, plot.errors.alpha, plot.errors.type, boot$center)
              rg[[i]] <- data.frame(newdata[,i], boot$center, bounds)
              names(rg[[i]]) <- c(names(newdata)[i],"deriv","lwr","upr")
            }
          } else {
            if (plot.errors.method == "bootstrap" && is.factor(newdata[,i]) &&
                plot.errors.type == "all" && display.warnings) {
              warning("bootstrap-all for factor derivatives currently reuses standard bounds for this slice")
            }
            if (plot.errors.type == "all") {
              rg[[i]] <- data.frame(newdata[,i], deriv.est,
                                    deriv.lwr, deriv.upr,
                                    deriv.lwr, deriv.upr,
                                    deriv.lwr, deriv.upr)
              names(rg[[i]]) <- c(names(newdata)[i],"deriv","lwr","upr","lwr.sim","upr.sim","lwr.bonf","upr.bonf")
            } else {
              rg[[i]] <- data.frame(newdata[,i], deriv.est, deriv.lwr, deriv.upr)
              names(rg[[i]]) <- c(names(newdata)[i],"deriv","lwr","upr")
            }
          }

        }

        set_status()

      }

    }

    if(deriv > 0) {

      if(common.scale) {
        min.rg <- Inf
        max.rg <- -Inf
        for(i in seq_along(rg)) {
          if (ci && plot.errors.type == "all") {
            min.rg <- min(min.rg, min(rg[[i]][,c("lwr","lwr.sim","lwr.bonf")]))
            max.rg <- max(max.rg, max(rg[[i]][,c("upr","upr.sim","upr.bonf")]))
          } else {
            min.rg <- min(min.rg,min(rg[[i]][,-1]))
            max.rg <- max(max.rg,max(rg[[i]][,-1]))
          }
        }
        ylim <- c(min.rg,max.rg)
      } else {
        ylim <- NULL
      }

      if(plot.behavior!="data") {

        if(!is.null(object$num.z)||(object$num.x>1)) par(mfrow=n2mfrow(NCOL(object$xz)))

        for(i in seq_len(NCOL(object$xz))) {

          if(!ci) {
            plot(rg[[i]][,1],rg[[i]][,2],
                 xlab=names(newdata)[i],
                 ylab=if(!is.factor(newdata[,i])) paste("Order", deriv,"Derivative") else "Difference in Levels",
                 ylim=ylim,
                 type="l",
                 ...)

          } else {
            if(!common.scale) {
              if (plot.errors.type == "all") {
                ylim <- c(min(rg[[i]][,c("lwr","lwr.sim","lwr.bonf")]), max(rg[[i]][,c("upr","upr.sim","upr.bonf")]))
              } else {
                ylim <- c(min(rg[[i]][,-1]),max(rg[[i]][,-1]))
              }
            }
            plot(rg[[i]][,1],rg[[i]][,2],
                 xlab=names(newdata)[i],
                 ylab=if(!is.factor(newdata[,i])) paste("Order", deriv,"Derivative") else "Difference in Levels",
                 ylim=ylim,
                 type="l",
                 ...)
            if (plot.errors.type == "all") {
              all.bounds <- list(
                pointwise = cbind(rg[[i]][,"lwr"], rg[[i]][,"upr"]),
                simultaneous = cbind(rg[[i]][,"lwr.sim"], rg[[i]][,"upr.sim"]),
                bonferroni = cbind(rg[[i]][,"lwr.bonf"], rg[[i]][,"upr.bonf"])
              )
              .crs.draw.all(rg[[i]][,1], all.bounds, add.legend = TRUE)
            } else {
              ## Need to overlay for proper plotting of factor errorbars
              par(new=TRUE)
              plot(rg[[i]][,1],rg[[i]][,3],
                   xlab="",
                   ylab="",
                   ylim=ylim,
                   type="l",
                   axes=FALSE,
                   lty=2,
                   col=2,
                   ...)
              par(new=TRUE)
              plot(rg[[i]][,1],rg[[i]][,4],
                   xlab="",
                   ylab="",
                   ylim=ylim,
                   type="l",
                   axes=FALSE,
                   lty=2,
                   col=2,
                   ...)
            }
          }

        }

      }

      if(plot.behavior!="plot") {
        set_status()
        par(mfrow=c(1,1))
        return(rg)
      }

    }

  }

  ## Reset par to 1,1 (can be modified above)

  set_status()

}

crs.sigtest <- function(object,...) {

  ## This function for the asymptotic significance test can be
  ## airlifted in trivially... trace of the smoother matrix etc. will
  ## deliver correct F stat etc. Left for future 9/1/11 since we have
  ## crssigtest function...

  if(object$kernel) stop(" sigtest is currently available only when kernel=FALSE")

  resolve.call.data <- function(obj) {
    data.expr <- obj$call$data
    if (is.null(data.expr)) {
      return(list())
    }

    env.candidates <- list(
      attr(obj$terms, ".Environment"),
      environment(obj$formula),
      parent.frame()
    )

    for (env in env.candidates) {
      if (!is.environment(env)) {
        next
      }
      data.val <- try(.crs_eval_call(data.expr, env), silent = TRUE)
      if (!inherits(data.val, "try-error")) {
        return(data.val)
      }
    }

    stop("unable to resolve data from fitted call; refit with explicit `data=` in scope")
  }

  model.data <- resolve.call.data(object)
  sg <- list()

  ## Conduct the significance test in order variable by variable

  j.num.x <- 1
  j.num.z <- 1

  for(i in seq_len(NCOL(object$xz))) {

    if(!is.factor(object$xz[,i])) {
      degree <- object$degree
      degree[j.num.x] <- 0
      model.res <- crs(object$formula,cv="none",degree=degree,include=object$include,basis=object$basis,prune=object$prune,data=model.data)
      sg[[i]] <- anova(model.res$model.lm,object$model.lm)
      j.num.x <- j.num.x + 1
    } else {
      include <- object$include
      include[j.num.z] <- 0
      model.res <- crs(object$formula,cv="none",degree=object$degree,include=include,basis=object$basis,prune=object$prune,data=model.data)
      sg[[i]] <- anova(model.res$model.lm,object$model.lm)
      j.num.z <- j.num.z + 1
    }

    cat(paste("Predictor ", format(names(object$xz)[i]), ": Df = ", sg[[i]]$Df[2], ", F = ", format(sg[[i]]$F[2],digits=4), ", Pr(>F) = ", format(sg[[i]][[6]][2],digits=4), "\n", sep=""))

  }

}
