R/linearregutils.R

In alteryx/AlteryxPredictive: Utility functions used by the predictive tools in Alteryx

#' Process Linear Regression Inputs
#'
#' These two functions take `inputs` and `config` and return the model object
#' along with other elements essential to create the reports and plots
#'
#' @param inputs input data streams to the tool
#' @param config configuration passed to the tool
#' @rdname processLinear
#' @export
processLinearOSR <- function(inputs, config){
  the.data = inputs$the.data
  var_names <- getNamesFromOrdered(names(inputs$the.data), config$`Use Weight`)
  the.formula <- if (config$`Omit Constant`){
    makeFormula(c("-1", var_names$x), var_names$y)
  } else {
    makeFormula(var_names$x, var_names$y)
  }
  # Create a call list
  theCall_l <- list(as.name('lm'))
  theCall_l$formula <- the.formula
  theCall_l$data <- as.name("the.data")
  if (config$`Use Weight`) {
    theCall_l$weights <- as.name(var_names$w)
  }
  theCall_c <- as.call(theCall_l)
  the.model <- eval(theCall_c)
  the.model
}

#' @inheritParams processLinearOSR
#' @rdname processLinear
#' @export
processLinearXDF <- function(inputs, config){
  temp.dir <- textInput('%Engine.TempFilePath%', tempdir())
  xdf.path = inputs$XDFInfo$xdf_path
  var_names <- getNamesFromOrdered(names(inputs$the.data), config$`Use Weight`)
  the.formula = if (config$`Omit Constant`){
    makeFormula(c("-1", var_names$x), var_names$y)
  } else {
    makeFormula(var_names$x, var_names$y)
  }
  the.model <- RevoScaleR::rxLinMod(the.formula, xdf.path, pweights = var_names$w,
    covCoef = TRUE, dropFirst = TRUE)

  # Add the level labels for factor predictors to use in model scoring, and
  # determine if the smearing estimator adjustment should be calculated for
  # scoring option value.
  the.model$xlevels <- getXdfLevels(makeFormula(var_names$x, ""), xdf.path)
  sum.info <- RevoScaleR::rxSummary(makeFormula(var_names$y, ""), xdf.path)
  # See if it is possible that the maximum target value is consistent with the
  # use of a natural log transformation, and construct the smearing adjust if
  # it is.
  if (sum.info$sDataFrame[1,5] <= 709) {
    resids.path <- file.path(temp.dir, paste0(ceiling(100000*runif(1)), '.xdf'))
    RevoScaleR::rxPredict(the.model, data = xdf.path, outData = resids.path,
      computeResiduals = TRUE, predVarNames = "Pred", residVarNames = "Resid")
    resids.df <- RevoScaleR::rxReadXdf(file = resids.path)
    smear <- RevoScaleR::rxSummary(~ Resid, data = resids.path,
      transforms = list(Resid = exp(Resid)))
    the.model$smearing.adj <- smear$sDataFrame[1,2]
  }
  return(the.model)
}

#' Create Reports
#'
#' If the ANOVA table is requested then create it and add its results to the
#' key-value table. Its creation will be surpressed if the car package isn't
#' present, or if the input is an XDF file.
#'
#' @param the.model model object
#' @param config configuration passed to the tool
#' @export
#' @rdname createReportLinear
createReportLinearOSR <- function(the.model, config){
  lm.out <- Alteryx.ReportLM(the.model)
  lm.out <- rbind(c("Model_Name", config$`Model Name`), lm.out)
  lm.out <- rbind(lm.out, Alteryx.ReportAnova(the.model))
  lm.out
}

#' @inheritParams createReportLinearOSR
#' @export
#' @rdname createReportLinear
createReportLinearXDF <- function(the.model, config){
  AlteryxMessage2(
    XMSG(
      in.targetString_sc = "Creation of the Analysis of Variance table was surpressed due to the use of an XDF file."
    ),
    iType = 2,
    iPriority = 3
  )
  lm.out <- AlteryxReportRx(the.model)
  lm.out <- rbind(c("Model_Name", config$`Model Name`), lm.out)
  lm.out
}

#' Create Plots
#'
#' Prepare the basic regression diagnostic plots if it is requested
#' and their isn't the combination of singularities and the use of
#' sampling weights.
#'
#' @param the.model model object
#' @export
createPlotOutputsLinearOSR <- function(the.model){
  par(mfrow=c(2, 2), mar=c(5, 4, 2, 2) + 0.1)
  plot(the.model)
}

#' Plots in XDF
#'
#' @export
createPlotOutputsLinearXDF <- function(){
  noDiagnosticPlot(
    XMSG(
      in.targetString_sc = "The diagnostic plot is not available for XDF based models."
    )
  )
}