R/persistently.R

In ijlyttle/warrenr: A persistently verb for purrr

#' Capture side effects.
#'
#' These functions wrap functions so that instead of generating side effects
#' through printed output, messages, warnings, and errors, they return enhanced
#' output. They are all adverbs because they modify the action of a verb (a
#' function).
#'
#' @param .f A function, formula, or atomic vector. See [purrr::map()]
#' @param quiet Hide errors (`TRUE`, the default), or display them
#'   as they occur?
#' @param max_attempts Positive integer. `persistent` functions will try
#'   to run this many times before giving up.
#' @param wait_seconds Positive number. Base multiplier for time in seconds to
#'   wait between attempts. The time increases exponentially, with a wait time
#'   randomly chosen from a uniform distribution between `0` and
#'   `wait_seconds * 2 ^ (i - 1)` seconds, between the `i`th and
#'   `i + 1`th attempts.
#'
#' @seealso [httr::RETRY()] is a special case of [persistently()]
#' @return wrapped function uses a default value (`otherwise`)
#'   whenever an error occurs max_attempts times.
#' @export
#' @examples
#'
#' # persistently() makes a function repeatedly try to work
#'
#' risky_runif <- function(lo = 0, hi = 1) {
#'   y <- stats::runif(1, lo, hi)
#'   if(y < 0.9) {
#'     stop(y, " is too small")
#'   }
#'   y
#' }
#'
#' persistent_risky_runif <- persistently(
#'   risky_runif, quiet = FALSE, wait_seconds = 0.01)
#'
#' \dontrun{
#'   set.seed(1)
#'   persistent_risky_runif()
#'   set.seed(3)
#'   persistent_risky_runif()
#' }
#'
#'
#' @export
#'
persistently <- function(.f, quiet = TRUE, max_attempts = 5,
                         wait_seconds = 0.1) {

  .f <- purrr::as_mapper(.f)

  force(quiet)
  force(max_attempts)
  force(wait_seconds)

  function(...) {
    for (i in seq_len(max_attempts)) {
      answer <- purrr:::capture_error(.f(...), quiet = quiet)
      if (is.null(answer$error)) {
        return(answer$result)
      }
      if (wait_seconds > 0) {
        actual_wait_seconds <- stats::runif(1, 0, wait_seconds * 2 ^ (i - 1))
        if (!quiet) {
          message(sprintf("Retrying in %.3g seconds.", actual_wait_seconds))
        }
        Sys.sleep(actual_wait_seconds)
      }
    }
    if (!quiet) {
      msg <- sprintf(
        "%s failed after %d tries",
        deparse(match.call()),
        max_attempts
      )
      message(msg)
    }
    stop(answer$error)
  }
}