R/gen_splines.R

In hongqi0314/PRAuto.PMML: User defined functions to output a PMML file that is to be implemented in S1

#' B-spline basis generation
#'
#' Generate the B-spline basis
#'
#' @param x Vector of numerical attribute that is going to be transformed to splines/hats.
#' @param limits Vector of two float numbers indicating model fitting limits for x.
#' @param knots Vector of float numbers representing inner cutpoints of x.
#' @param missCode An integer indicating missing value, e.g. 0 or 999.
#' @param degree An integer indicating degree of the transformed splines.
#' @param name Character string used as the new field names for the transformed data.
#'
#' @return Data frame contains transformed splines. The returned data frame has
#'         'length(knots) + degree (+ 1 if there is an intercept)' columns.
#'
#' @export
#'
#' @examples
#' basisFICO <- gen_splines(x = Data_UsedPlat$FICO, limits = c(450, 900),
#'     knots = c(500, 525, 540, 575, 600, 670), degree = 3, missCode = 0, name = 'FICO')
gen_splines <- function(x, limits, knots, missCode = NA, degree = 1, intercept = TRUE, name) {
  xCap <- ifelse(
    x >= limits[1] & x <= limits[2],
    x,
    ifelse(
      x > limits[2], limits[2], limits[1]
    )
  )

  basis <- as.tibble(
    splines::bs(
      x = xCap, knots = knots, degree = degree,
      Boundary.knots = limits, intercept = intercept
    )
  )

  for (i in seq_along(basis)) {
    names(basis)[i] <- paste0('basis', name, '_', i)
  }

  if (!is.na(missCode)) {
    if (missCode < limits[1]) {
      basis[x == missCode, 1] <- 0
    } else if (missCode > limits[2]) {
      basis[x == missCode, ncol(basis)] <- 0
    }
  }

  return(basis)
}