R/combine.R

In alexWhitworth/concord: Code for prediction of concord models

#' @title Combined Prediction and Actual - Physical
#' @param pred A \code{data.frame} of predicted results
#' @param act A \code{data.frame} of actual results
combine_phys <- function(pred, act) {
  if ("geography" %in% names(act)) {
    act <- act[, c("geography", "date2", "dt_scale", "albumid", "title", "format2",
                   "title_format2", "physical")]
  } else {
    act <- act[, c("date2", "dt_scale", "albumid", "title", "format2",
                   "title_format2", "physical")]
  }
  out <- merge(pred, act, all.x= TRUE, all.y= FALSE)
  out$anomalie <- ifelse(out[,dim(out)[2]] < out$l | 
                         out[,dim(out)[2]] > out$u, TRUE, FALSE)
  return(out)
}

#' @title Combined Prediction and Actual - Digital
#' @param pred A \code{data.frame} of predicted results
#' @param act A \code{data.frame} of actual results
combine_digi <- function(pred, act) {
  if ("geography" %in% names(act)) {
    act <- act[, c("geography", "date2", "dt_scale", "albumid", "title", "format2",
                   "title_format2", "digital")]
  } else {
    act <- act[, c("date2", "dt_scale", "albumid", "title", "format2",
                   "title_format2", "digital")]
  }
  out <- merge(pred, act, all.x= TRUE, all.y= FALSE)
  out$anomalie <- ifelse(out[,dim(out)[2]] < out$l | 
                           out[,dim(out)[2]] > out$u, TRUE, FALSE)
  return(out)
}

#' @title Combined Prediction and Actual - Stream
#' @param pred A \code{data.frame} of predicted results
#' @param act A \code{data.frame} of actual results
combine_stream <- function(pred, act) {
  if ("geography" %in% names(act)) {
    act <- act[, c("geography", "date2", "dt_scale", "albumid", "title", "format2",
                   "title_format2", "streaming")]
  } else {
    act <- act[, c("date2", "dt_scale", "albumid", "title", "format2",
                   "title_format2", "streaming")]
  }
  out <- merge(pred, act, all.x= TRUE, all.y= FALSE)
  out$anomalie <- ifelse(out[,dim(out)[2]] < out$l | 
                           out[,dim(out)[2]] > out$u, TRUE, FALSE)
  return(out)
}

#' @title Combined Prediction and Actual Results
#' @description This function takes a list of predicted results and a list of
#' actual results, appropriately combines them, and returns the results
#' @param pred_list A \code{list} of predicted results from \code{create_pred()}
#' @param act_list A \code{list} of actual results from the database.
#' @param geography A character scalar. In: \code{c("usa", "can", "jap", "lt", "uk", "ger", "fra", "cmg", "iEUR")}.
#' @return A list of combined prediction and actual results.
#' @export
combine_pred_act <- function(pred_list, act_list, geography) {
  results <- list()
  if (!(geography %in% c("iEUR", "cmg", "fra"))) {
    results[[1]] <- combine_digi(pred_list$d, act_list$d)
    results[[2]] <- combine_phys(pred_list$p, act_list$p)
    results[[3]] <- combine_stream(pred_list$d, act_list$d)
    names(results) <- names(pred_list)
    return(results)
  } else if (geography == "cmg") {
    results[[1]] <- combine_phys(pred_list$p, act_list$p)
    return(results)
  } else if (geography == "iEUR") {
    results[[1]] <- combine_digi(pred_list$d, act_list$d)
    results[[2]] <- combine_stream(pred_list$s, act_list$s)
    names(results) <- names(pred_list)
    return(results)
  } else if (geography == "fra") {
    results[[1]] <- combine_digi(pred_list$d, act_list$d)
    results[[2]] <- combine_phys(pred_list$p, act_list$p)
    names(results) <- names(pred_list)
    return(results)
  }
}