Memoize async functions

memoise_async.R

library(digest)
library(promises)
library(cache)

# Given a list with items named `value` and `visible`, return `x$value` either
# visibly, or invisibly, depending on the value of `x$visible`.
valueWithVisible <- function(x) {
  if (x$visible) x$value else invisible(x$value)
}

# Memoise a function that returns a promise
memoise_p <- function(f, cache = cache_mem()) {
  function(...) {
    args <- list(...)
    key <- digest(args, algo = "spookyhash")
    res <- cache$get(key)
    
    # Case 1: cache hit
    if (!is.key_missing(res)) {
      if (res$error) {
        return(promise_reject(valueWithVisible(res)))
      }
      return(promise_resolve(valueWithVisible(res)))
    }
    
    # Case 2: cache miss
    p <- as.promise(f(...))
    p$then(function(value) {
        res <- withVisible(value)
        cache$set(key, list(
          value   = res$value,
          visible = res$visible,
          error   = FALSE
        ))
        valueWithVisible(res)
      })$
      catch(function(e) {
        cache$set(key, list(
          value   = e,
          visible = TRUE,
          error   = TRUE
        ))
        stop(e)
      })
  }
}


# Use memoise_p on a function
f <- memoise_p(function(x) {
  future::future({
    Sys.sleep(2)
    x
  })
})


start <- as.numeric(Sys.time())
f(1)$then(function(value) message(round(as.numeric(Sys.time()) - start, 2), " seconds: ", value))
#> 2.06 seconds: 1

start <- as.numeric(Sys.time())
f(1)$then(function(value) message(round(as.numeric(Sys.time()) - start, 2), " seconds: ", value))
#> 0.06 seconds: 1

start <- as.numeric(Sys.time())
f(2)$then(function(value) message(round(as.numeric(Sys.time()) - start, 2), " seconds: ", value))
#> 2.06 seconds: 2

start <- as.numeric(Sys.time())
f(2)$then(function(value) message(round(as.numeric(Sys.time()) - start, 2), " seconds: ", value))
#> 0.06 seconds: 2

start <- as.numeric(Sys.time())
f(1)$then(function(value) message(round(as.numeric(Sys.time()) - start, 2), " seconds: ", value))
#> 0.06 seconds: 1