Custom R functions for validating and coercing.

utils-validate.R

# NOTE: Most of these are from my {vp2} project, which builds upon other past work.

.validate_path <- function(x, strict = TRUE, verbose = TRUE) {
  # stopifnot(length(x) == 1, is.character(x))
  file_exists <- file.exists(x)
  if(strict) {
    stopifnot(file_exists)
    return(invisible(TRUE))
  } else {
    if(verbose) {
      msg <- sprintf('The file %s does not exist.', x)
      message(msg)
      return(invisible(FALSE))
    }
  }
  invisible(TRUE)
}

.validate_paths <- function(x, ...) {
  res <- x %>% purrr::map_lgl(~.validate_path(...))
  stopifnot(all(res == TRUE))
  res
}

.validate_col <- function(.data, col) {
  stopifnot(is.character(col))
  stopifnot(length(col) == 1)
  stopifnot(length(intersect(colnames(.data), col)) == 1)
}

.validate_cols <- function(.data, cols) {
  stopifnot(is.character(cols))
  stopifnot(sum(cols %in% colnames(.data)) == length(cols))
}


.validate_col_out <- function(.data, col) {
  stopifnot(is.character(col))
  stopifnot(length(col) == 1)
  stopifnot(length(intersect(colnames(.data), col)) == 0)
}

.validate_data <- function(x) {
  stopifnot(is.data.frame(x))
}

.coerce_data <- function(x) {
  tibble::as_tibble(x)
}

.validate_coerce_data <- function(x) {
  .validate_data(x)
  .coerce_data(x)
}

.validate_chr <- function(x) {
  stopifnot(is.character(x))
  stopifnot(length(x) == 1)
}

.validate_rgx <- .validate_chr

.validate_dir <- function(x) {
  .validate_chr(x)
  # stopifnot(dir.exists(dir))
  stopifnot(fs::dir_exists(dir))
}

.coerce_col_type <- function(.data, col, f) {
  # .validate_col(.data, col)
  col_quo <- enquo(col)
  .data %>%
    mutate_at(vars(!!col_quo), list(f))
}

.coerce_value_type <- function(.data, ...) {
  .data %>% .coerce_col_type(col = value, ...)
}

coerce_col_numeric <- function(...) {
  .coerce_col_type(..., f = as.numeric)
}

coerce_col_integer <- function(...) {
  .coerce_col_type(..., f = as.integer)
}

coerce_value_numeric <- function(...) {
  .coerce_value_type(..., f = as.numeric)
}