R/utilities.R

Defines functions coalesce_dates prep_regex

#' @noRd
prep_regex <- function(x) {
  paste0("(", paste(formatC(x, width = 2, flag = "0"), collapse = "|"), ")")
}


#' @noRd
coalesce_dates <- function(x, y, prefer) {

  # use_x <- is.na(y) & !is.na(x) | (!is.na(x) & x == y)
  # use_y <- is.na(x) & !is.na(y)
  #
  # out <- as.Date(rep(NA_character_, length(x)))
  # out[use_x] <- x[use_x]
  # out[use_y] <- y[use_y]

  # for convenience, initially set output to x
  out <- x

  # swap in values from y where missing in x
  use_y <- is.na(x) & !is.na(y)
  out[use_y] <- y[use_y]

  # check for conflicts between x and y
  is_conflict <- !is.na(x) & !is.na(y) & x != y

  if (any(is_conflict)) {
    if (prefer == "latest") {

      today <- Sys.Date()

      diff_x <- as.integer(abs(today - x))
      diff_y <- as.integer(abs(today - y))

      swap_x <- is_conflict & diff_x < diff_y
      swap_y <- is_conflict & diff_y < diff_x

      out[swap_x] <- x[swap_x]
      out[swap_y] <- y[swap_y]

    } else if (prefer == "x") {
      out[is_conflict] <- x[is_conflict]
    } else if (prefer == "y") {
      out[is_conflict] <- y[is_conflict]
    }
  }

  return(out)
}
epicentre-msf/llutils documentation built on Nov. 9, 2020, 8:24 p.m.