R/errors.R

In crossmap: Apply Functions to All Combinations of List Elements

abort_if_not_df <- function(x) {
  non_data_frames <- which(purrr::map_lgl(x, ~ !inherits(., "data.frame")))
  length          <- length(non_data_frames)

  if (!length) {return()}

  non_data_frames <- non_data_frames[seq_len(min(length, 5))]

  call      <- sys.call(-1)
  fun       <- call[1]
  arguments <- as.list(call[-1][non_data_frames])
  types     <- purrr::map_chr(x[non_data_frames], ~ class(.)[[1]])
  problems  <- purrr::map2_chr(
    arguments, types,
    ~ cli::format_error("{.arg {.x}} is of class {.val {.y}}")
  )

  cli::cli_abort(
    c(
      "{.fun {fun}} inputs must be data frames or lists of data frames.",
      purrr::set_names(problems, "x"),
      if (length > 5) "... and {length - 5} more"
    )
  )
}

abort_if_not_formulas <- function(x) {
  x            <- rlang::flatten(x)
  non_formulas <- which(purrr::map_lgl(x, ~ !inherits(., "formula")))
  length       <- length(non_formulas)

  if (!length) {return()}

  non_formulas <- non_formulas[seq_len(min(length, 5))]

  call      <- sys.call(-1)
  arguments <- x[non_formulas]
  types     <- purrr::map_chr(x[non_formulas], ~ class(.)[[1]])
  problems  <- purrr::map2_chr(
    arguments, types,
    ~ cli::format_error("{.arg {.x}} is of class {.val {.y}}")
  )

  cli::cli_abort(
    c(
      "{.arg formulas} must all be of class {.val formula}.",
      purrr::set_names(problems, "x"),
      if (length > 5) "... and {length - 5} more"
    )
  )
}

warn_if_not_matrix <- function(.l) {
  if (length(.l) > 2) {
    call <- sys.call(-1)

    new_call      <- call
    new_call[[1]] <- rlang::sym(gsub("mat$", "arr", as.character(call[[1]])))

    cli::cli_warn(
      c(
        "!" = paste(
          "{.fun {call[1]}}",
          "returned an array because it has more than 2 dimensions."
        ),
        "*" = "Try {.code {format(new_call)}} to avoid this warning."
      )
    )
  }
}

require_furrr <- function() {
  rlang::check_installed("furrr",  "to use parallelized functions.")
  rlang::check_installed("future", "to use parallelized functions.")

  check_unparallelized(fn = format(sys.call(-1)[1]))
}

check_unparallelized <- function(fn) {
  plan    <- future::plan()
  base_fn <- gsub("future_", "", fn)

  if (future::availableCores() < 2) {
    cli::cli_inform(
      c(
        "!" = "{.fun {fn}} is not set up to run background processes.",
        "i" = "You can use {.fun {base_fn}} to avoid this warning.",
        "i" = "Check {.code help(plan, future)} for more details."
      )
    )
  } else if (
    "uniprocess" %in% class(plan) ||
    is.null(plan) ||
    ("multicore" %in% class(plan) && !future::supportsMulticore())
  ) {
    cli::cli_inform(
      c(
        "!" = "{.fun {fn}} is not set up to run background processes.",
        "*" = 'Try running {.code future::plan("multisession")}.',
        "i" = "Check {.code help(plan, future)} for more details."
      )
    )
  }
}