Nothing
## -----------------------------------------------------------------------------
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)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.