R/create_pred.R

In alexWhitworth/concord: Code for prediction of concord models

#' @title Wrapper function for predictions
#' @description This function takes a inputs for geography and timelines and does 
#' three main things: (1) It loads the baseline data. (2) It loads the current prediction models. (3) It creates
#' predictions for the specified geography and timelines. Accomplished via other function calls.
#' @param geography Character scalar. In: c("usa", "can", "jap", "lt", "uk", "ger", "fra", "cmg", "iEUR")
#' @param begMonth The beginning month for which to create a dataset from. Format= "YYYY-MM-DD"
#' @param endMonth The ending month for which to create a dataset from. Format= "YYYY-MM-DD"
#' @param dt_center The centering date. Should be "2012-01-01" unless models are refreshed.
#' @return A \code{list} with two elements, each of which are \code{list}s. Firstly, a \code{list} of the geography's
#' baseline data. Second, a \code{list} of predictions for each model
#' @export
create_pred <- function(geography, begMonth, endMonth, dt_center= "2012-01-01") {
  ## 01. load / create data for predictions
  dat <- new.env()
  if (geography != "iEUR") {
    assign("p", envir= dat,
           create_pred_backbone(geography= geography, revtype= "physical", begMonth= begMonth, 
                                endMonth= endMonth, dt_center= dt_center))
  }
  if (geography != "cmg") {
    assign("d", envir= dat, 
           create_pred_backbone(geography= geography, revtype= "digital", begMonth= begMonth, 
                                endMonth= endMonth, dt_center= dt_center))
    if (geography != "fra") {
      assign("s", envir= dat,
             create_pred_backbone(geography= geography, revtype= "streaming", begMonth= begMonth, 
                                  endMonth= endMonth, dt_center= dt_center))
    }
  }
  
  ## 02. load models, extract for specific geography
  load("\\\\cmgfs/users/alewit/2014 Projects/2015-05 IMPLEMENT/data/M_models.Rdata")
  mod_nm <- paste(geography, "mod", sep= "_")
  mods <- get(mod_nm, envir= models)
  
  ## 03. do predictions --- specific by geography
  pred_out <- geog_predictions(geography= geography, dat= dat, mods= mods)
  
  ### 04. merge and return
  if (geography == "ccr") {
    dat$p <- merge(dat$p, pred_out$p)
    dat$d <- merge(dat$d, pred_out$d)
    dat$s <- merge(dat$s, pred_out$s)
    return(data= as.list(dat))
  }
  else if (geography != "iEUR") {
    dat$p <- merge(dat$p, do.call("rbind", pred_out$p)); dat$p$d_tier <- NULL
  } 
  if (geography != "cmg") {
    dat$d <- merge(dat$d, do.call("rbind", pred_out$d)); dat$d$p_tier <- NULL
    if (geography != "fra") {
      dat$s <- merge(dat$s, do.call("rbind", pred_out$s)); dat$d$p_tier <- NULL
    }
  }
  
  
  return(data= as.list(dat))
}