R/apply_models.R

In PatrickEslick/MixedModelLoads: Mixed Model Loads

#' Apply a model equation to a time series
#'
#' @param model_equation the model equation to apply see \code{modelEquation}
#' @param time_series the time series to use the model with. This should have headings
#' corresponding the variables in \code{model_equation}. Otherwise, a vector of NAs will
#' be returned with a warning
#' @param flow a vector of flow values, if calculating load. Otherwise leave as default NA
#' @param retransformation a function used to retransform the model calculations before
#' using them to calculate the load
#' @param bias_correction_factor the bias correction factor to multiply model calculations
#' by after retransforming the model, if applicable
#' @param conversion_factor any conversion factor to multiply the model calculated values
#'
#' @return a vector of model calculations, the same length as the number of rows in
#' \code{time_series}. NAs will be returned for any missing data points or if the
#' model variables are not present in the time series.
#'
#' @export
#'

apply_model <- function(model_equation, time_series,
                        flow = NULL,
                        retransformation = NULL,
                        bias_correction_factor = 1,
                        conversion_factor = 1) {

  if(!(all(model_equation@variables %in% names(time_series)))) {
    warning("Not all model coefficients found in time series")
    return(rep(NA, nrow(time_series)))
  }
  model <- rep(0, nrow(time_series))
  for(i in 1:length(model_equation@coefficients)) {
    model <- model +
      time_series[,model_equation@variables[i]] * model_equation@coefficients[i]
  }
  model <- model + model_equation@intercept
  if(!is.null(retransformation)) {
    if(class(retransformation) != "function")
      error("retransformation should be a function")
    model <- retransformation(model)
  }
  model <- model * bias_correction_factor
  if(!is.null(flow)) {
    if(length(flow) != nrow(time_series))
      stop("flow should be the same length as the number of rows in the time series")
    model <- model * flow
  }
  model <- model * conversion_factor

  return(model)

}