R/smooth.construct.rn.smooth.spec.R

In Faskally/rns: Functions to fit river network smoothers

#' River Network Smoothers in GAMs
#'
#' Description here.
#'
#' @param object a smooth specification object, usually generated by a term
#'   s(...,bs="cr",...), s(...,bs="cs",...) or s(...,bs="cc",...).
#' @param data a list containing just the data (including any by variable)
#'   required by this term, with names corresponding to object$term
#'   (and object$by). The by variable is the last element.
#' @param knots a list containing any knots supplied for basis setup — in same
#'   order and with same names as data. Can be NULL. See details.
#'
#' @details
#' The constructor is not normally called directly, but is rather used
#' internally by gam. To use for basis setup it is recommended to use
#' \link{smooth.construct2}.
#'
#' @return
#' An object of class "rn.smooth". In addition to the usual elements of a smooth
#' class documented under smooth.construct, this object will contain:
#'
#' xp
#' giving the knot locations used to generate the basis.
#'
#' @importFrom mgcv smooth.construct
#' @exportS3Method mgcv::smooth.construct rn.smooth.spec
smooth.construct.rn.smooth.spec <- function (object, data, knots)
{
  if (!is.null(object$id))
    stop("rn smoothers don't work with ids.")
  # set basis dimension
  if (object$bs.dim == -1) {
    object$X <- object$xt$X
  } else {
    if (object$bs.dim > ncol(object$xt$X) + 1) {
      warning("dimension of smoother too large for supplied X matrix, reducing to k = ", ncol(object$xt$X) + 1)
      object$bs.dim <- ncol(object$xt$X) + 1
    }
    object$X <- object$xt$X[,ncol(object$xt$X) - object$bs.dim:1 + 1]
  }
  object$bs.dim <- ncol(object$X)
  # get correct rows
  object$X <- object$X[data[[object$term]],]
  # set penalty matrix
  if (is.null(object$xt$S)) {
    object$S <- list(diag(object$bs.dim))
  } else {
    object$S <- list(object$xt$S)
  }

  # set smoother properties
  object$rank <- object$bs.dim
  object$null.space.dim <- 0
  object$C <- matrix(0, 0, ncol(object$X))
  object$side.constrain <- FALSE
  object$plot.me <- FALSE
  object$te.ok <- if (inherits(object, "tensor.smooth.spec")) 0 else 2
  object$random <- TRUE
  class(object) <- "rn.smooth"
  object
}