R/pred_backbone.R

In alexWhitworth/concord: Code for prediction of concord models

#' @title Create backbone of data elements for prediction
#' @description Loads the baseline data and creates the backbone \code{data.frame}.
#' @param geography Character scalar. In: \code{c("usa", "can", "ccr", "jap", "lt", "uk", "ger", "fra", "cmg", "iEUR")}.
#' @param revtype One of \code{c("physical", "digital", "streaming")}.
#' @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 \code{"2012-01-01"} unless models are refreshed.
#' @return A \code{data.frame} as specified by parameter inputs.
#' @export
create_pred_backbone <- function(geography, revtype, begMonth, endMonth, dt_center= "2012-01-01") {
  require(lubridate)  
  # load baseline data for specified geography and revtype
  load("\\\\cmgfs/users/alewit/2014 Projects/2015-05 IMPLEMENT/data/D00_baselineData.Rdata")
  b_dat <- get(geography, envir= baseline)
  b_dat <- get(revtype, b_dat)
  
  # remove NAs from tier -- not for CCR
  if (geography != "ccr") {
    if (revtype == "physical") {
      b_dat <- b_dat[!is.na(b_dat$p_tier),]
    } else {
      b_dat <- b_dat[!is.na(b_dat$d_tier),]
    }
  }
  
  # create vector of dates and attach to baseline data
  begMonth <- as.POSIXct(strptime(begMonth, format= "%Y-%m-%d"))
  endMonth <- as.POSIXct(strptime(endMonth, format= "%Y-%m-%d"))
  n_months <- month_diff(date1= begMonth, date2= endMonth)
  date2    <- begMonth %m+% months(0:n_months)
  dt_scale <- num_mo(date2) - num_mo(as.Date(dt_center, format= "%Y-%m-%d"))
  
  b_dat2 <- data.frame(cbind(b_dat, dt_scale= dt_scale[1]), date2= date2[1])
  for (i in 2:length(dt_scale)) {
    b_dat2 <- data.frame(rbind(b_dat2, cbind(b_dat, dt_scale= dt_scale[i], date2= date2[i])))
  }
  
  # add xmas / mf_day to data
  if (revtype == "physical") {
    b_dat2$mf_day <- ifelse((b_dat2$dt_scale %% 12) %in% c(4,5), TRUE, FALSE)   # may / june
    b_dat2$xmas   <- ifelse((b_dat2$dt_scale %% 12) %in% c(10,11), TRUE, FALSE) # nov / dec
  } else {
    b_dat2$mf_day <- ifelse((b_dat2$dt_scale %% 12) %in% c(4,5), TRUE, FALSE)   # may / june
    b_dat2$xmas   <- ifelse((b_dat2$dt_scale %% 12) %in% c(11, 0), TRUE, FALSE) # dec / jan
  } 
  # add years_since_rel
  b_dat2$yr_since_rel <- round(month_diff(b_dat2$rel_mo, b_dat2$date2) / 12, 2)
  b_dat2$yr_since_rel <- ifelse(b_dat2$yr_since_rel > 60, 60, 
                                ifelse(is.na(b_dat2$yr_since_rel), 60, b_dat2$yr_since_rel))
  
  return(b_dat2)
}