R/utils.R

In gaborcsardi/installlite: Perform 'pkgdepends' Package Installation Plans

is_string <- function(x) {
  is.character(x) && length(x) == 1 && !is.na(x)
}

is_count <- function(x, min = 0L)  {
  is.numeric(x) && length(x) == 1 && !is.na(x) &&
    as.integer(x) == x && x >= min
}

is.named <- function(x) {
  !is.null(names(x)) && all(names(x) != "")
}

set_envvar <- function(envs) {
  if (length(envs) == 0) return()

  stopifnot(is.named(envs))

  old <- Sys.getenv(names(envs), names = TRUE, unset = NA)
  set <- !is.na(envs)

  both_set <- set & !is.na(old)

  if (any(set))  do.call("Sys.setenv", as.list(envs[set]))
  if (any(!set)) Sys.unsetenv(names(envs)[!set])

  invisible(old)
}

with_envvar <- function(new, code) {
  old <- set_envvar(new)
  on.exit(set_envvar(old))
  force(code)
}

na_difftime <- function() as.difftime(NA_real_, units = "secs")

map_chr <- function(.x, .f, ...) {
  vapply(.x, .f, character(1), ...)
}

map_lgl <- function(.x, .f, ...) {
  vapply(.x, .f, logical(1), ...)
}

map_int <- function(.x, .f, ...) {
  vapply(.x, .f, integer(1), ...)
}

unlist_chr <- function(x) {
  ux <- unlist(x)
  y <- as.character(ux)
  if (!is.null(names(ux))) names(y) <- names(ux)
  y
}

mkdirp <- function (dir, msg = NULL) {
  s <- map_lgl(dir, dir.create, recursive = TRUE, showWarnings = FALSE)
  invisible(s)
}

rep_list <- function (n, expr) {
  lapply(integer(n), eval.parent(substitute(function(...) expr)))
}

get_num_cores <- function() {
  n <- tryCatch(
    suppressWarnings(as.integer(getOption("Ncpus", NA_integer_))),
    error = function(e) NA_integer_)

  if (length(n) != 1 || is.na(n)) {
    n <- tryCatch(
      asNamespace("parallel")$detectCores(),
      error = function(e) NA_integer_)
  }

  if (is.na(n))
    n <- 1L

  n
}

set_options <- function(new_options) {
  do.call(options, as.list(new_options))
}

with_options <- function(new, code) {
  old <- set_options(new_options = new)
  on.exit(set_options(old))
  force(code)
}

is_windows <- function() {
  .Platform$OS.type == "windows"
}

is_macos <- function() {
  Sys.info()["sysname"] == "Darwin"
}