R/no_adherence.R

In jmiahjones/lunch.time: Analyze Survey Data related to Eating Trends

#' Get Interval
#' @description Returns the beginning and end date of an input datetime vector.
#' @keywords internal
#' @param datetime_vector a date or datetime vector
#'
#' @return Returns a vector of length two, with the first entry being the start date
#' and the second being the end date.
get_interval <- function(datetime_vector) {
  sorted <- sort(datetime_vector)
  n <- length(datetime_vector)
  start <- sorted[1]
  end <- sorted[n]
  return(c(start, end))
}

#' Get Workdays
#' @description Returns a vector of the days of the week for the user's workday input.
#' @keywords internal
#' @param workday_key A string representing the key passed in by the user. May also
#' a vector, list, or any other class supporting %in% enumerating the desired days
#' in the work week. If the key is not recognized, a warning will be given and all days
#' will be used.
#'
#' @return A vector or the enumerable class provided by the user.
get_workdays <- function(workday_key) {
  if(length(workday_key) > 1) { # not a key at all-this is a vector of workdays
    workdays <- workday_key
  } else if(tolower(workday_key) == "monthrufri") {
    workdays <- c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday")
  } else { # as a fallback, use all days of the week
    workdays <- c("Monday", "Tuesday", "Wednesday", "Thursday",
                  "Friday", "Saturday", "Sunday")
    message = paste("Unknown workday parameter: ", workday_key,
                    ". Continuing with all days of the week in the",
                    "work week. See package docs for more details.",
                    sep="")
    warning(message)
  }
  return(workdays)
}

#' Return Dates of No Adherence
#' @description This function returns the days without adherence to the data collection
#' regimen for any potential missingness analysis. This is important in case there are high
#' levels of missingness in the collected data, which could be correlated with certain
#' covariates.
#' @param datetime_vector The vector of date or datetime values corresponding to
#' observation dates. This will likely be a column in the data frame parsed from
#' Google Sheets.
#' @param workdays Either the default supported string or a vector of days considered
#' for adherence. See the examples for alternative uses.
#' @param start_date optional, a POSIX date representing an alternative start date
#' @param end_date optional, a POSIX date representing an alternative end date
#'
#' @return The returned object will be a Date vector representing all workdays
#' not represented in the input vector. If no days were missed, this vector will have
#' length 0.
#' @export
#' @importFrom magrittr %>%
no_adherence <- function(datetime_vector, workdays="MonThruFri",
                         start_date=NULL, end_date=NULL) {
  # verify inputs
  if(!inherits(datetime_vector, "POSIXt")) {
    message = paste("Error: datetime_vector is not of class POSIXt.",
                    "Cannot compare dates of class:",
                    class(datetime_vector)
    )
    stop(message)
  }

  # transform start-end dates if necessary
  if(is.null(start_date) || is.null(end_date))
    interval <- datetime_vector %>% get_interval()
  if(is.null(start_date))
    start_date <- interval[1]
  if(is.null(end_date))
    end_date <- interval[2]
  stopifnot(inherits(start_date, "POSIXt"),
            inherits(end_date, "POSIXt"))

  workdays_vector <- get_workdays(workdays)

  # find all workdays in between the start and end dates
  start_date <- as.Date(start_date)
  end_date <- as.Date(end_date)
  date_seq <- seq(from=start_date, to=end_date, by=1 # for seq.Date, unit is days
  )
  days <- sapply(date_seq, weekdays)

  data.frame(date_missing=date_seq, day=days) %>%
    dplyr::filter(day %in% workdays_vector,
                  !(date_missing %in% as.Date(datetime_vector))) %>%
    dplyr::pull(date_missing) %>%
    return()
}