inst/doc/external.R

In storr: Simple Key Value Stores

## -----------------------------------------------------------------------------
fetch_hook_gh_description <- function(key, namespace) {
  if (!isTRUE(unname(capabilities("libcurl")))) {
    stop("This vignette requires libcurl support in R to run")
  }
  fmt <- "https://raw.githubusercontent.com/%s/master/DESCRIPTION"
  path <- tempfile("gh_description_")
  on.exit(file.remove(path))
  code <- download.file(sprintf(fmt, key), path, mode = "wb")
  if (code != 0L) {
    stop("Error downloading file")
  }
  as.list(read.dcf(path)[1, ])
}

## -----------------------------------------------------------------------------
st <- storr::storr_external(storr::driver_environment(),
                            fetch_hook_gh_description)

## -----------------------------------------------------------------------------
st$list()

## -----------------------------------------------------------------------------
d <- st$get("richfitz/storr")

## -----------------------------------------------------------------------------
identical(st$get("richfitz/storr"), d)

## -----------------------------------------------------------------------------
st$list()

## -----------------------------------------------------------------------------
tryCatch(st$get("richfitz/no_such_repo"),
         KeyErrorExternal = function(e)
           message(sprintf("** Repository %s not found", e$key)))

## -----------------------------------------------------------------------------
st_rds <- st$export(storr::storr_rds(tempfile(), mangle_key = TRUE))
st_rds$list()
st_rds$get("richfitz/storr")$Version

## -----------------------------------------------------------------------------
st_rds$destroy()

## -----------------------------------------------------------------------------
f <- function(a, b) {
  message(sprintf("Computing f(%.3f, %.3f)", a, b))
  ## ...expensive computation here...
  list(a, b)
}

## -----------------------------------------------------------------------------
pars <- data.frame(id = as.character(1:10), a = runif(10), b = runif(10),
                   stringsAsFactors = FALSE)

## -----------------------------------------------------------------------------
hook <- function(key, namespace) {
  p <- pars[match(key, pars$id), -1]
  f(p$a, p$b)
}

st <- storr::storr_external(storr::driver_environment(), hook)

## -----------------------------------------------------------------------------
x <- st$get("1")

## -----------------------------------------------------------------------------
identical(st$get("1"), x)

## -----------------------------------------------------------------------------
st <- storr::storr_environment()
st$set("experiment1", pars, namespace = "parameters")
st$set("experiment1", f, namespace = "functions")

hook2 <- function(key, namespace) {
  f <- st$get(namespace, namespace = "functions")
  pars <- st$get(namespace, namespace = "parameters")
  p <- pars[match(key, pars$id), -1]
  f(p$a, p$b)
}

st_use <- storr::storr_external(st$driver, hook2)

x1 <- st_use$get("1", "experiment1")
x2 <- st_use$get("1", "experiment1")

## -----------------------------------------------------------------------------
memoise <- function(f, driver = storr::driver_environment()) {
  force(f)
  st <- storr::storr(driver)
  function(...) {
    ## NOTE: also digesting the inputs as a key here (in addition to
    ## storr's usual digesting of values)
    key <- digest::digest(list(...))
    tryCatch(
      st$get(key),
      KeyError = function(e) {
        ans <- f(...)
        st$set(key, ans)
        ans
      })
  }
}

## -----------------------------------------------------------------------------
f <- function(x) {
  message("computing...")
  x * 2
}

## -----------------------------------------------------------------------------
g <- memoise(f)

## -----------------------------------------------------------------------------
g(1)

## -----------------------------------------------------------------------------
g(1)