Nothing
#' @title History and provenance
#' `r lifecycle::badge("stable")`
#' @description See the history and provenance of your targets:
#' what you ran, when you ran it, the function arguments
#' you used, and how to get old data back.
#' @details [drake_history()] returns a data frame with the following columns.
#'
#' - `target`: the name of the target.
#' - `current`: logical, whether the row describes the data
#' actually assigned to the target name in the cache,
#' e.g. what you get with `loadd(target)` and `readd(target)`.
#' Does **NOT** tell you if the target is up to date.
#' - `built`: when the target's value was stored in the cache.
#' This is the true creation date of the target's value,
#' not the recovery date from `make(recover = TRUE)`.
#' - `exists`: logical, whether the target's historical value
#' still exists in the cache. Garbage collection via
#' (`clean(garbage_collection = TRUE)` and `drake_cache()$gc()`)
#' remove these historical values, but `clean()` under the default
#' settings does not.
#' - `hash`: fingerprint of the target's historical value in the cache.
#' If the value still exists, you can read it with
#' `drake_cache()$get_value(hash)`.
#' - `command`: the [drake_plan()] command executed to build the target.
#' - `seed`: random number generator seed.
#' - `runtime`: the time it took to execute the [drake_plan()] command.
#' Does not include overhead due to `drake`'s processing.
#'
#' If `analyze` is `TRUE`, various other columns are included to show
#' the explicitly-named length-1 arguments to function calls in the commands.
#' See the "Provenance" section for more details.
#'
#' @section Provenance:
#' If `analyze` is `TRUE`, `drake`
#' scans your [drake_plan()] commands
#' for function arguments and mentions them in the history.
#' A function argument shows up if and only if:
#' 1. It has length 1. \cr
#' 2. It is atomic, i.e. a base type: logical, integer,
#' real, complex, character, or raw. \cr
#' 3. It is explicitly named in the function call,
#' For example, `x` is detected as `1` in
#' `fn(list(x = 1))` but not `f(list(1))`.
#' The exceptions are [file_out()], [file_in()],
#' and [knitr_in()]. For example, `filename` is detected
#' as `"my_file.csv"` in
#' `process_data(filename = file_in("my_file.csv"))`.
#' NB: in `process_data(filename = file_in("a", "b"))`
#' `filename` is not detected because the value must be atomic. \cr
#' @export
#' @return A data frame of target history.
#' @inheritParams drake_config
#' @param analyze Logical, whether to analyze [drake_plan()]
#' commands for arguments to function calls.
#' Could be slow because this requires parsing and analyzing
#' lots of R code.
#' @param verbose Deprecated on 2019-09-11.
#' @examples
#' \dontrun{
#' isolate_example("contain side-effects", {
#' if (requireNamespace("knitr", quietly = TRUE)) {
#' # First, let's iterate on a drake workflow.
#' load_mtcars_example()
#' make(my_plan, history = TRUE, verbose = 0L)
#' # Naturally, we'll make updates to our targets along the way.
#' reg2 <- function(d) {
#' d$x2 <- d$x ^ 3
#' lm(y ~ x2, data = d)
#' }
#' Sys.sleep(0.01)
#' make(my_plan, history = TRUE, verbose = 0L)
#' # The history is a data frame about all the recorded runs of your targets.
#' out <- drake_history(analyze = TRUE)
#' print(out)
#' # Let's use the history to recover the oldest version
#' # of our regression2_small target.
#' oldest_reg2_small <- max(which(out$target == "regression2_small"))
#' hash_oldest_reg2_small <- out[oldest_reg2_small, ]$hash
#' cache <- drake_cache()
#' cache$get_value(hash_oldest_reg2_small)
#' # If you run clean(), drake can still find all the targets.
#' clean(small)
#' drake_history()
#' # But if you run clean() with garbage collection,
#' # older versions of your targets may be gone.
#' clean(large, garbage_collection = TRUE)
#' drake_history()
#' invisible()
#' }
#' })
#' }
drake_history <- function(
cache = NULL,
history = NULL,
analyze = TRUE,
verbose = NULL
) {
deprecate_verbose(verbose)
if (is.null(cache)) {
cache <- drake_cache()
}
if (is.null(cache)) {
stop("cannot find drake cache.")
}
cache <- decorate_storr(cache)
cache$set_history(history)
if (is.null(cache$history)) {
stop0("no history. Call make(history = TRUE) next time.")
}
from_txtq <- cache$history$list()
from_cache <- lapply(from_txtq$message, history_from_cache, cache = cache)
from_cache <- do.call(drake_bind_rows, from_cache)
if (!nrow(from_txtq)) {
stop0("no history. Call make(history = TRUE) next time.")
}
out <- merge(
x = from_txtq,
y = from_cache,
by = "message",
all.x = TRUE
)
out <- weak_tibble(
target = out$title,
built = out$time,
hash = out$hash,
exists = out$exists,
command = out$command,
runtime = out$runtime,
seed = out$seed
)
out <- out[order(out$target, out$built), ]
current_hash <- vapply(
X = out$target,
FUN = cache$safe_get_hash,
FUN.VALUE = character(1),
namespace = cache$default_namespace
)
out$current <- out$hash == current_hash
out$current[is.na(out$current)] <- FALSE
cols <- c(
"target",
"current",
"built",
"exists",
"hash",
"command",
"seed",
"runtime"
)
out <- out[, cols]
if (analyze) {
args <- lapply(out$command, history_find_args)
args <- do.call(drake_bind_rows, args)
out <- cbind(out, args)
}
out$DRAKE_HISTORY_NA_ <- NULL
weak_as_tibble(out)
}
history_from_cache <- function(meta_hash, cache) {
if (!cache$exists_object(meta_hash)) {
return(
data.frame(
message = meta_hash,
built = NA_character_,
hash = NA_character_,
exists = NA,
command = NA_character_,
runtime = NA,
seed = NA_integer_,
stringsAsFactors = FALSE
)
)
}
meta <- cache$get_value(meta_hash)
out <- data.frame(hash = meta$hash, stringsAsFactors = FALSE)
out$exists <- cache$exists_object(meta$hash)
out$command <- meta$command
out$runtime <- meta$time_command$elapsed
out$seed <- meta$seed
out$message <- meta_hash
out
}
history_find_args <- function(command) {
command <- parse(text = command)[[1]]
ht <- ht_new()
history_walk_args(command, ht)
out <- as.data.frame(as.list(ht), stringsAsFactors = FALSE)
if (!nrow(out)) {
out <- data.frame(DRAKE_HISTORY_NA_ = NA, stringsAsFactors = FALSE)
}
out
}
history_walk_args <- function(expr, ht) {
if (!length(expr)) {
return()
}
if (is.call(expr)) {
for (name in Filter(nzchar, names(expr))) {
history_analyze_value(name = name, value = expr[[name]], ht = ht)
}
}
if (is.recursive(expr)) {
lapply(expr, history_walk_args, ht = ht)
}
}
history_analyze_value <- function(name, value, ht) {
if (is.call(value)) {
fn <- safe_deparse(value[[1]], backtick = FALSE)
if (fn %in% c(file_fns, no_deps_fns)) {
value <- eval(value)
}
}
if (is.atomic(value) && length(value) == 1) {
ht_set(ht = ht, x = name, value = value)
}
}
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.