R/mkDmat.R

In cirls: Constrained Iteratively Reweighted Least Squares

################################################################################
#
# Create a deriv matrix for shape-constrained splines with domain bounds
# Maybe export for "advanced" use?
#
################################################################################

mkDmat <- function(d, s, knots, ord, intercept, lower = -Inf, upper = Inf){

  #----- Create initial matrix

  # Create diff matrices for each derivative order (including "zero" deriv)
  alldm <- lapply(rev(seq_len(d)), dm, knots = knots, ord = ord)
  alldm <- c(alldm, list(diag(length(knots) - ord)))

  # Matrix multiply everything
  Cmat <- s * Reduce("%*%", alldm)

  #----- Remove rows with domain

  # Determine the constraints to be kept
  nk <- length(knots)
  upkn <- knots[(ord + 1):(nk - d)]
  lokn <- knots[(d + 1):(length(knots) - ord)]
  keep <- (upkn > lower) & (lokn < upper)

  # Remove from Cmat
  Cmat <- Cmat[keep,, drop = F]

  #----- Clean and return

  # Optionally remove intercept
  if (!intercept) Cmat <- Cmat[,-1, drop = F]

  # Return
  Cmat
}