R/utils.R

In mrc-ide/dust: Iterate Multiple Realisations of Stochastic Models

`%||%` <- function(a, b) { # nolint
  if (is.null(a)) b else a
}


hash_file <- function(path, short = TRUE) {
  hash <- unname(tools::md5sum(path))
  if (short) {
    hash <- substr(hash, 1, 8)
  }
  hash
}


dust_file <- function(path) {
  system.file(path, package = "dust", mustWork = TRUE)
}


read_lines <- function(path) {
  paste(readLines(path), collapse = "\n")
}


assert_file_exists <- function(path, name = "File") {
  if (!file.exists(path)) {
    stop(sprintf("%s '%s' does not exist", name, path))
  }
}


assert_is <- function(x, what, name = deparse(substitute(x))) {
  if (!inherits(x, what)) {
    stop(sprintf("'%s' must be a %s", name, paste(what, collapse = " / ")),
         call. = FALSE)
  }
}


is_directory <- function(path) {
  file.info(path)$isdir
}


set_names <- function(x, nms) {
  names(x) <- nms
  x
}


vcapply <- function(x, fun, ...) {
  vapply(x, fun, character(1), ...)
}


is_call <- function(x, name) {
  is.call(x) && identical(deparse(x[[1]]), name)
}


dust_header <- function(comment) {
  sprintf("%s Generated by dust (version %s) - do not edit",
          comment, utils::packageVersion("dust"))
}


squote <- function(x) {
  sprintf("'%s'", x)
}


is_integer_like <- function(x) {
  length(x) == 1 && !is.na(x) &&
    (is.integer(x) || (is.numeric(x) && isTRUE(all.equal(x, round(x)))))
}


writelines_if_changed <- function(text, path) {
  skip <- file.exists(path) && same_content(path, text)
  if (!skip) {
    writeLines(text, path)
  }
}


same_content <- function(path, text) {
  identical(read_lines(path), paste(as.character(text), collapse = "\n"))
}


drop_roxygen <- function(text) {
  if (any(grepl("\n", text, fixed = TRUE))) {
    text <- unlist(strsplit(text, "\n"))
  }
  text[!grepl("^\\s*#+'", text)]
}


drop_internal_comments <- function(text) {
  if (any(grepl("\n", text, fixed = TRUE))) {
    text <- unlist(strsplit(text, "\n"))
  }
  text[!grepl("^\\s*(###|///)", text)]
}


simple_cache <- R6::R6Class(
  "simple_cache",
  cloneable = FALSE,
  private = list(
    contents = list()
  ),
  public = list(
    set = function(key, value, skip) {
      if (!skip) {
        private$contents[[key]] <- value
      }
    },

    get = function(key, skip) {
      if (skip) {
        NULL
      } else {
        private$contents[[key]]
      }
    },

    has_key = function(key, skip) {
      !skip && key %in% names(private$contents)
    }
  ))