Specialized formats for big targets

DESCRIPTION

@@ -99,10 +99,12 @@ Suggests:
   curl (>= 2.7),
   datasets,
   downloader,
+  fst,
   future,
   ggplot2,
   ggraph,
   grDevices,
+  keras,
   knitr,
   lubridate,
   networkD3,

NEWS.md

@@ -8,6 +8,7 @@
 
 ## New features
 
+- Support specialized data storage via a decorated cache and `return_*()` functions (#971). This allows users to leverage faster ways to save and load targets, such as `write_fst()` for data frames and `save_model_hdf5()` for Keras models. It also improves memory because it prevents `storr` from making a serialized in-memory copy of large data objects.
 - Add `tidyselect` functionality for `...` in `progress()`, analogous to `loadd()`, `build_times()`, and `clean()`.
 - Support S3 for user-defined generics (#959). If the generic `do_stuff()` and the method `stuff.your_class()` are defined in `envir`, and if `do_stuff()` has a call to `UseMethod("stuff")`, then `drake`'s code analysis will detect `stuff.your_class()` as a dependency of `do_stuff()`.
 

R/build_times.R

@@ -45,6 +45,7 @@ build_times <- function(
   if (is.null(cache)) {
     return(weak_as_tibble(empty_times()))
   }
+  cache <- decorate_storr(cache)
   eval(parse(text = "require(methods, quietly = TRUE)")) # needed for lubridate
   targets <- c(as.character(match.call(expand.dots = FALSE)$...), list)
   if (requireNamespace("tidyselect", quietly = TRUE)) {

R/cache.R

@@ -85,6 +85,7 @@ readd <- function(
   if (is.null(cache)) {
     stop("cannot find drake cache.")
   }
+  cache <- decorate_storr(cache)
   if (!character_only) {
     target <- as.character(substitute(target))
   }
@@ -224,6 +225,7 @@ loadd <- function(
   if (is.null(cache)) {
     stop("cannot find drake cache.")
   }
+  cache <- decorate_storr(cache)
   if (is.null(namespace)) {
     namespace <- cache$default_namespace
   }
@@ -503,6 +505,7 @@ read_drake_seed <- function(
   if (is.null(cache)) {
     stop("cannot find drake cache.")
   }
+  cache <- decorate_storr(cache)
   if (cache$exists(key = "seed", namespace = "session")) {
     cache$get(key = "seed", namespace = "session")
   } else {
@@ -579,6 +582,7 @@ cached <- function(
   if (is.null(cache)) {
     return(character(0))
   }
+  cache <- decorate_storr(cache)
   if (is.null(namespace)) {
     namespace <- cache$default_namespace
   }
@@ -628,6 +632,9 @@ is_imported_cache <- Vectorize(function(target, cache) {
 #'   You can also supply your own `storr` cache to the `cache`
 #'   argument of `make()`. The `drake_cache()` function retrieves
 #'   this cache.
+#' @details `drake_cache()` actually returns a *decorated* `storr`,
+#'   an object that *contains* a `storr` (plus bells and whistles).
+#'   To get the *actual* inner `storr`, use `drake_cache()$storr`.
 #' @seealso [new_cache()], [drake_config()]
 #' @export
 #' @return A drake/storr cache in a folder called `.drake/`,
@@ -650,9 +657,12 @@ is_imported_cache <- Vectorize(function(target, cache) {
 #' load_mtcars_example() # Get the code with drake_example("mtcars").
 #' make(my_plan) # Run the project, build the targets.
 #' x <- drake_cache() # Now, there is a cache.
-#' y <- storr::storr_rds(".drake") # Equivalent.
+#' y <- storr::storr_rds(".drake") # Nearly equivalent.
 #' # List the objects readable from the cache with readd().
 #' x$list()
+#' # drake_cache() actually returns a *decorated* storr.
+#' # The *real* storr is inside.
+#' drake_cache()$storr
 #' }
 #' })
 #' }
@@ -732,8 +742,10 @@ find_cache <- function(
 #'   Use `storr` to customize your caches instead.
 #' @param hash_algorithm Name of a hash algorithm to use.
 #'   See the `algo` argument of the `digest` package for your options.
-#' @param short_hash_algo Deprecated on 2018-12-12. Use `hash_algorithm` instead.
-#' @param long_hash_algo Deprecated on 2018-12-12. Use `hash_algorithm` instead.
+#' @param short_hash_algo Deprecated on 2018-12-12.
+#'   Use `hash_algorithm` instead.
+#' @param long_hash_algo Deprecated on 2018-12-12.
+#'   Use `hash_algorithm` instead.
 #' @param ... other arguments to the cache constructor.
 #' @examples
 #' \dontrun{
@@ -772,6 +784,7 @@ new_cache <- function(
     mangle_key = FALSE,
     hash_algorithm = hash_algorithm
   )
+  cache <- decorate_storr(cache)
   writeLines(
     text = c("*", "!/.gitignore"),
     con = file.path(path, ".gitignore")
@@ -816,7 +829,7 @@ drake_fetch_rds <- function(path) {
   if (!file.exists(path)) {
     return(NULL)
   }
-  storr::storr_rds(path = path)
+  decorate_storr(storr::storr_rds(path = path))
 }
 
 cache_vers_stop <- function(cache){
@@ -905,6 +918,7 @@ drake_get_session_info <- function(
   if (is.null(cache)) {
     stop("No drake::make() session detected.")
   }
+  cache <- decorate_storr(cache)
   return(cache$get("sessionInfo", namespace = "session"))
 }
 
@@ -999,6 +1013,7 @@ drake_cache_log <- function(
       )
     )
   }
+  cache <- decorate_storr(cache)
   out <- lightly_parallelize(
     X = cache$list(),
     FUN = single_cache_log,
@@ -1091,6 +1106,7 @@ diagnose <- function(
   if (is.null(cache)) {
     return(character(0))
   }
+  cache <- decorate_storr(cache)
   if (!character_only) {
     target <- as.character(substitute(target))
   }
@@ -1248,6 +1264,7 @@ progress <- function(
   if (is.null(cache)) {
     return(weak_tibble(target = character(0), progress = character(0)))
   }
+  cache <- decorate_storr(cache)
   if (!is.null(no_imported_objects)) {
     warning(
       "Argument `no_imported_objects` of progress() is deprecated. ",

R/clean.R

@@ -100,6 +100,7 @@ clean <- function(
   if (is.null(cache)) {
     return(invisible())
   }
+  cache <- decorate_storr(cache)
   targets <- c(as.character(match.call(expand.dots = FALSE)$...), list)
   if (requireNamespace("tidyselect", quietly = TRUE)) {
     targets <- drake_tidyselect_cache(
@@ -260,6 +261,7 @@ drake_gc <- function(
 ) {
   deprecate_search(search)
   if (!is.null(cache)) {
+    cache <- decorate_storr(cache)
     cache$gc()
     rm_bad_cache_filenames(cache)
   }
@@ -333,6 +335,7 @@ rescue_cache <- function(
   if (is.null(cache)) {
     return(invisible())
   }
+  cache <- decorate_storr(cache)
   for (namespace in cache$list_namespaces()) {
     X <- cache$list(namespace = namespace)
     if (!is.null(targets)) {