R/helper_functions.R

In alexWhitworth/concord: Code for prediction of concord models

#' @title A modified version of ifelse
#' @description This function is a modified version of base::ifelse
#' @param cond A test condition
#' @param yes return values for true elements of \code{test}
#' @param no return values for false elements of \code{test}
#' @return a vector of the same length as \code{test} and data values from \code{yes} and \code{no}.
safe.ifelse <- function(cond,yes,no){
  class.y=class(yes)
  x=ifelse(cond,yes,no)
  class(x)=class.y; return(x)
}

#' Calculate number of months since origin
#' 
#' Calculates the  number of months since first an origin; default is first data point
num_mo <- function(date1) { 
  lt <- as.POSIXlt(as.Date(date1))
  return(lt$year*12 + lt$mon) 
} 

#' calc month difference between two num_mo objects
month_diff <- function(date1, date2) {num_mo(date2) - num_mo(date1)}

#' @title Encoding of holiday months
#' @description Physical models - Encodes specific months for \code{xmas} and \code{mf_day}. 
#' Also does a data interaction
phys_holidays <- function(dat) {
  dat$title_format2 <- interaction(dat$title, dat$format2)
  dat$mf_day <- ifelse(month(dat$date2) %in% c(5,6), TRUE, FALSE)
  dat$xmas   <- ifelse(month(dat$date2) %in% c(11,12), TRUE, FALSE)
  return(dat)
}

#' @title Encoding of holiday months
#' @description Digital models - Encodes specific months for \code{xmas} and \code{mf_day}. 
#' Also does a data interaction
digi_holidays <- function(dat) {
  dat$title_format2 <- interaction(dat$title, dat$format2)
  dat$mf_day <- ifelse(month(dat$date2) %in% c(5,6), TRUE, FALSE)
  dat$xmas   <- ifelse(month(dat$date2) %in% c(12,1), TRUE, FALSE)
  return(dat)
}