RunAllModels.R

RunAllModels <- function(USE_THESE_FORMULAS = all_formulas,
                         MODEL_DATA = model_data,
                         DATA_DIMENSION = dim_name,
                         DATE_COLUMN = "date_ymd",
                         TARGET_COLUMN = "visits",
                         DEBUG = TRUE){
  
  if(DEBUG) message("RunAllModels: Function Initialized  \n")
  
  if(!is.list(USE_THESE_FORMULAS)){
    stop("RunAllModels: The input must be a list of character strings....please investigate!  \n")
  }
  
  if(!is.data.table(MODEL_DATA)){
    stop("RunAllModels: The input data is not a data table  \n")
  }
  
  FUNCTION_OUTPUT <- list()
  
  # each_formula = USE_THESE_FORMULAS[[1]]  
  for(each_formula in USE_THESE_FORMULAS){
    
    tryCatch({
      
        message("Executing Model: ", each_formula, "  \n")
        
        # if(!DO_PENALIZATION){ 
        
        MOD_FIT <- lm(each_formula, data = MODEL_DATA)
        
        MOD_RESULTS_DT <- data.table::setDT(broom::tidy(summary(MOD_FIT)))
        cols <- names(MOD_RESULTS_DT)[2:ncol(MOD_RESULTS_DT)]
        MOD_RESULTS_DT[ ,(cols) := round(.SD, 3), .SDcols = cols]
        MOD_RESULTS_DT[, mod_formula := each_formula]
        MOD_RESULTS_DT[, dimension_name := DATA_DIMENSION]
        # MOD_RESULTS_DT
        
        MODEL_EVAL_DT <- data.table(FULL_FORMULA = each_formula)
        MODEL_EVAL_DT[, c("TARGET", "PREDICTORS") := tstrsplit(FULL_FORMULA, "~", fixed=TRUE, fill="<NA>")]
        MODEL_EVAL_DT[, RSQUARED := summary(MOD_FIT)$r.squared]
        MODEL_EVAL_DT[, ADJ_RSQUARED := summary(MOD_FIT)$adj.r.squared]
        MODEL_EVAL_DT[, MSE := mean(MOD_FIT$residuals^2) ]
        MODEL_EVAL_DT[, RMSE := sqrt(mean(MOD_FIT$residuals^2)) ]
        MODEL_EVAL_DT[, DIMENSION_NAME := DATA_DIMENSION]
  
        
        PLT_DATA_NEW <- data.table(
            date_ymd = MODEL_DATA[[DATE_COLUMN]], 
            actuals = round(as.numeric(MODEL_DATA[[TARGET_COLUMN]], 0)),
            fittedvals = round(as.numeric(fitted(MOD_FIT), 0))
        )
          
        PLT_DATA_NEW[, mod_formula := each_formula]
        PLT_DATA_NEW[, dimension_name := DATA_DIMENSION]
  
        
        FUNCTION_OUTPUT[[each_formula]][["MODEL_FIT"]] <- MOD_FIT
        
        FUNCTION_OUTPUT[[each_formula]][["MODEL_RESULTS"]] <- MOD_RESULTS_DT
        
        FUNCTION_OUTPUT[[each_formula]][["MODEL_EVALUATION"]] <- MODEL_EVAL_DT
        
        FUNCTION_OUTPUT[[each_formula]][["ACTUALS_FITTED_DATA"]] <- PLT_DATA_NEW
      
      
    }, error = function(cond) {
      message(paste("RunAllModels", "eror", cond, sep = "  -  "))
    })
    
  }
  return(FUNCTION_OUTPUT)
}