diff --git a/DESCRIPTION b/DESCRIPTION index 5706c7f58..adb80a01d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -57,6 +57,7 @@ Suggests: keras (>= 2.2.5.0), knitr (>= 1.30), rmarkdown (>= 2.4), + pkgload (>= 1.1.0), qs (>= 0.23.2), rstudioapi (>= 0.11), testthat (>= 3.0.0), diff --git a/NAMESPACE b/NAMESPACE index 7461bfb06..8a0ac0f50 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,6 +3,8 @@ S3method(hash_object,"function") S3method(hash_object,character) S3method(hash_object,default) +S3method(imports_init,default) +S3method(imports_init,tar_imports) S3method(pipeline_validate,default) S3method(pipeline_validate,tar_pipeline) S3method(pipeline_validate_lite,default) diff --git a/NEWS.md b/NEWS.md index 37d396a59..e8dc544ad 100644 --- a/NEWS.md +++ b/NEWS.md @@ -16,6 +16,7 @@ * Add new dynamic branching patterns `head()`, `tail()`, and `sample()` to provide functionality equivalent to `drake`'s `max_expand` (#56). * Add a new `tar_pattern()` function to emulate dynamic branching outside a pipeline. * Add a new `level_separation` argument to `tar_visnetwork()` and `tar_glimpse()` to control the aspect ratio (#226). +* Track functions from multiple packages with the `imports` argument to `tar_option_set()` (#239). ## Enhancements diff --git a/R/class_active.R b/R/class_active.R index 34c313431..5f873edce 100644 --- a/R/class_active.R +++ b/R/class_active.R @@ -24,7 +24,7 @@ active_class <- R6::R6Class( ensure_meta = function() { self$meta$validate() self$meta$database$preprocess(write = TRUE) - self$meta$record_imports(self$pipeline$envir, self$pipeline) + self$meta$record_imports(self$pipeline$imports, self$pipeline) self$meta$restrict_records(self$pipeline) }, produce_exports = function(envir) { @@ -50,7 +50,7 @@ active_class <- R6::R6Class( process_target = function(name) { target <- pipeline_get_target(self$pipeline, name) target_debug(target) - target_update_depend(target, meta) + target_update_depend(target, self$pipeline, self$meta) trn( target_should_run(target, self$meta), self$run_target(name), diff --git a/R/class_branch.R b/R/class_branch.R index 8208bfe29..75ba91d6f 100644 --- a/R/class_branch.R +++ b/R/class_branch.R @@ -63,7 +63,7 @@ target_get_type.tar_branch <- function(target) { } #' @export -target_produce_record.tar_branch <- function(target, meta) { +target_produce_record.tar_branch <- function(target, pipeline, meta) { file <- target$store$file record_init( name = target_get_name(target), diff --git a/R/class_builder.R b/R/class_builder.R index 5e2106f75..55d32a730 100644 --- a/R/class_builder.R +++ b/R/class_builder.R @@ -20,12 +20,12 @@ builder_new <- function( } #' @export -target_update_depend.tar_builder <- function(target, meta) { +target_update_depend.tar_builder <- function(target, pipeline, meta) { depends <- meta$depends memory_set_object( depends, target_get_name(target), - meta$produce_depend(target) + meta$produce_depend(target, pipeline) ) } @@ -116,7 +116,7 @@ builder_conclude <- function(target, pipeline, scheduler, meta) { builder_ensure_object(target, "main") builder_wait_correct_hash(target) target_ensure_buds(target, pipeline, scheduler) - meta$insert_record(target_produce_record(target, meta)) + meta$insert_record(target_produce_record(target, pipeline, meta)) target_patternview_meta(target, pipeline, meta) pipeline_register_loaded(pipeline, target_get_name(target)) scheduler$progress$register_built(target_get_name(target)) @@ -124,7 +124,7 @@ builder_conclude <- function(target, pipeline, scheduler, meta) { builder_error <- function(target, pipeline, scheduler, meta) { target_restore_buds(target, pipeline, scheduler, meta) - builder_record_error_meta(target, meta) + builder_record_error_meta(target, pipeline, meta) target_patternview_meta(target, pipeline, meta) builder_handle_error(target, pipeline, scheduler, meta) } @@ -230,8 +230,8 @@ builder_save_workspace <- function(target, pipeline, scheduler) { workspace_save(workspace_init(target, pipeline)) } -builder_record_error_meta <- function(target, meta) { - record <- target_produce_record(target, meta) +builder_record_error_meta <- function(target, pipeline, meta) { + record <- target_produce_record(target, pipeline, meta) meta$handle_error(record) meta$insert_record(record) } diff --git a/R/class_glimpse.R b/R/class_glimpse.R index 9f85a0744..3ed588d02 100644 --- a/R/class_glimpse.R +++ b/R/class_glimpse.R @@ -66,7 +66,7 @@ glimpse_class <- R6::R6Class( ) }, update_imports = function() { - envir <- self$pipeline$envir + envir <- self$pipeline$imports graph <- graph_envir(envir) edges <- lapply(as_data_frame(igraph::get.edgelist(graph)), as.character) edges <- data_frame(from = edges[[1]], to = edges[[2]]) @@ -99,7 +99,7 @@ glimpse_class <- R6::R6Class( bytes = rep(NA_real_, length(names)), branches = rep(NA_integer_, length(names)) ) - names <- c(names, names(self$pipeline$envir)) + names <- c(names, names(self$pipeline$imports)) edges <- pipeline_upstream_edges(self$pipeline, targets_only = FALSE) edges <- edges[edges$from %in% names & edges$to %in% names,, drop = FALSE] # nolint edges <- edges[edges$from != edges$to,, drop = FALSE] # nolint diff --git a/R/class_imports.R b/R/class_imports.R new file mode 100644 index 000000000..786abcda0 --- /dev/null +++ b/R/class_imports.R @@ -0,0 +1,44 @@ +imports_init <- function(envir) { + UseMethod("imports_init") +} + +#' @export +imports_init.tar_imports <- function(envir) { + envir +} + +#' @export +imports_init.default <- function(envir) { + imports <- new.env(parent = emptyenv()) + packages <- rev(tar_option_get("imports")) + lapply(packages, imports_set_package, imports = imports) + imports_set_envir(imports = imports, envir = envir) + imports_new(imports) +} + +imports_new <- function(envir) { + enclass(envir, "tar_imports") +} + +imports_set_package <- function(imports, package) { + envir <- getNamespace(package) + imports_set_envir(imports, envir) +} + +imports_set_envir <- function(imports, envir) { + lapply(names(envir), imports_set_object, imports = imports, envir = envir) +} + +imports_set_object <- function(imports, name, envir) { + assign( + x = name, + value = get(name, envir = envir, inherits = FALSE), + envir = imports, + inherits = FALSE + ) +} + +imports_validate <- function(imports) { + assert_inherits(imports, "tar_imports") + assert_envir(imports) +} diff --git a/R/class_inspection.R b/R/class_inspection.R index aaba90c90..4be4dbd7f 100644 --- a/R/class_inspection.R +++ b/R/class_inspection.R @@ -166,7 +166,7 @@ inspection_class <- R6::R6Class( merge(vertices, meta, all.x = TRUE, sort = FALSE) }, update_imports = function() { - envir <- self$pipeline$envir + envir <- self$pipeline$imports graph <- graph_envir(envir) edges <- lapply(as_data_frame(igraph::get.edgelist(graph)), as.character) edges <- data_frame(from = edges[[1]], to = edges[[2]]) @@ -181,7 +181,7 @@ inspection_class <- R6::R6Class( vertices <- data_frame(name = names) vertices <- self$resolve_target_status(vertices) vertices <- self$resolve_target_meta(vertices) - names <- c(names, names(self$pipeline$envir)) + names <- c(names, names(self$pipeline$imports)) edges <- pipeline_upstream_edges(self$pipeline, targets_only = FALSE) edges <- edges[edges$from %in% names & edges$to %in% names,, drop = FALSE] # nolint edges <- edges[edges$from != edges$to,, drop = FALSE] # nolint diff --git a/R/class_meta.R b/R/class_meta.R index 6be274eaa..4c0fb2376 100644 --- a/R/class_meta.R +++ b/R/class_meta.R @@ -44,7 +44,7 @@ meta_class <- R6::R6Class( self$database$list_rows() }, restrict_records = function(pipeline) { - names_envir <- names(pipeline$envir) + names_envir <- names(pipeline$imports) names_records <- self$list_records() names_children <- fltr( names_records, @@ -56,24 +56,22 @@ meta_class <- R6::R6Class( remove <- setdiff(names_records, names_current) self$del_records(remove) }, - hash_dep = function(name, target) { - exists <- self$exists_record(name) && ( - record_is_target(self$get_record(name)) || - memory_exists_object(target$cache$imports, name) - ) + hash_dep = function(name, pipeline) { + exists <- self$exists_record(name) && + pipeline_exists_object(pipeline, name) trn( exists, self$get_record(name)$data, "" ) }, - hash_deps = function(deps, target) { - hashes <- map_chr(sort(deps), self$hash_dep, target = target) + hash_deps = function(deps, pipeline) { + hashes <- map_chr(sort(deps), self$hash_dep, pipeline = pipeline) string <- paste(c(names(hashes), hashes), collapse = "") digest_chr64(string) }, - produce_depend = function(target) { - self$hash_deps(sort(target$command$deps), target) + produce_depend = function(target, pipeline) { + self$hash_deps(sort(target$command$deps), pipeline) }, handle_error = function(record) { if (!self$exists_record(record$name)) { diff --git a/R/class_outdated.R b/R/class_outdated.R index 7c131d37f..027702711 100644 --- a/R/class_outdated.R +++ b/R/class_outdated.R @@ -88,7 +88,7 @@ outdated_class <- R6::R6Class( target_skip(target, self$pipeline, self$scheduler, self$meta), error = function(e) warning(e$message) ) - target_update_depend(target, self$meta) + target_update_depend(target, self$pipeline, self$meta) if (target_should_run(target, self$meta)) { self$register_builder_outdated(target) } diff --git a/R/class_passive.R b/R/class_passive.R index 4ea1c0b9e..3844406a7 100644 --- a/R/class_passive.R +++ b/R/class_passive.R @@ -23,7 +23,7 @@ passive_class <- R6::R6Class( public = list( ensure_meta = function() { self$meta$database$ensure_preprocessed(write = FALSE) - self$meta$set_imports(self$pipeline$envir, self$pipeline) + self$meta$set_imports(self$pipeline$imports, self$pipeline) self$meta$restrict_records(self$pipeline) }, start = function() { diff --git a/R/class_pattern.R b/R/class_pattern.R index a0a25a573..72d783e2a 100644 --- a/R/class_pattern.R +++ b/R/class_pattern.R @@ -28,11 +28,11 @@ target_get_children.tar_pattern <- function(target) { } #' @export -target_produce_record.tar_pattern <- function(target, meta) { +target_produce_record.tar_pattern <- function(target, pipeline, meta) { record_init( name = target_get_name(target), type = target_get_type(target), - data = pattern_produce_data_hash(target, meta), + data = pattern_produce_data_hash(target, pipeline, meta), command = target$command$hash, bytes = target$patternview$bytes, format = target$settings$format, @@ -83,7 +83,7 @@ target_branches_over.tar_pattern <- function(target, name) { } #' @export -target_update_depend.tar_pattern <- function(target, meta) { +target_update_depend.tar_pattern <- function(target, pipeline, meta) { depends <- meta$depends memory_set_object(depends, target_get_name(target), null64) } @@ -219,8 +219,8 @@ pattern_priority <- function() { 1.1 } -pattern_produce_data_hash <- function(target, meta) { - hash_branches <- meta$hash_deps(target_get_children(target)) +pattern_produce_data_hash <- function(target, pipeline, meta) { + hash_branches <- meta$hash_deps(target_get_children(target), pipeline) digest_chr64(paste(target$settings$iteration, hash_branches)) } @@ -232,7 +232,7 @@ pattern_conclude_initial <- function(target, pipeline, scheduler, meta) { pattern_conclude_final <- function(target, pipeline, scheduler, meta) { pattern_skip_final(target, pipeline, scheduler, meta) - pattern_record_meta(target, meta) + pattern_record_meta(target, pipeline, meta) patternview_register_final(target$patternview, target, scheduler) } @@ -273,14 +273,14 @@ pipeline_assert_dimension <- function(target, pipeline, name) { } } -pattern_record_meta <- function(target, meta) { +pattern_record_meta <- function(target, pipeline, meta) { name <- target_get_name(target) old_data <- trn( meta$exists_record(name), meta$get_record(name)$data, NA_character_ ) - record <- target_produce_record(target, meta) + record <- target_produce_record(target, pipeline, meta) if (!identical(record$data, old_data)) { meta$insert_record(record) } diff --git a/R/class_pipeline.R b/R/class_pipeline.R index 2fd7f08c0..09cc2b8ce 100644 --- a/R/class_pipeline.R +++ b/R/class_pipeline.R @@ -1,8 +1,11 @@ pipeline_init <- function(targets = list()) { targets <- pipeline_targets_init(targets) + envir <- pipeline_envir(targets) + imports <- imports_init(envir) pipeline_new( targets = targets, - envir = pipeline_envir(targets), + envir = envir, + imports = imports, loaded = counter_init(), transient = counter_init() ) @@ -11,11 +14,13 @@ pipeline_init <- function(targets = list()) { pipeline_new <- function( targets = NULL, envir = NULL, + imports = NULL, loaded = NULL, transient = NULL ) { force(targets) force(envir) + force(imports) force(loaded) force(transient) enclass(environment(), "tar_pipeline") @@ -85,6 +90,15 @@ pipeline_exists_target <- function(pipeline, name) { exists(x = name, envir = envir, inherits = FALSE) } +pipeline_exists_import <- function(pipeline, name) { + exists(x = name, envir = pipeline$imports, inherits = FALSE) +} + +pipeline_exists_object <- function(pipeline, name) { + pipeline_exists_target(pipeline, name) || + pipeline_exists_import(pipeline, name) +} + pipeline_targets_only_edges <- function(edges) { edges[edges$from %in% edges$to,, drop = FALSE] # nolint } @@ -230,6 +244,7 @@ pipeline_validate_envirs <- function(pipeline) { "pipeline and target environments must agree." ) lapply(targets, pipeline_validate_envir, envir = envir) + assert_envir(pipeline$imports %||% tar_empty_envir) } pipeline_validate_envir <- function(target, envir) { diff --git a/R/class_sitrep.R b/R/class_sitrep.R index 983f2d69c..d8765d441 100644 --- a/R/class_sitrep.R +++ b/R/class_sitrep.R @@ -67,7 +67,7 @@ sitrep_class <- R6::R6Class( process_builder = function(target) { name <- target_get_name(target) target <- pipeline_get_target(self$pipeline, name) - target_update_depend(target, meta) + target_update_depend(target, self$pipeline, self$meta) self$sitrep[[name]] <- builder_sitrep(target, self$meta) trn( self$meta$exists_record(target_get_name(target)), diff --git a/R/class_stem.R b/R/class_stem.R index c564d3faa..f7163f8e5 100644 --- a/R/class_stem.R +++ b/R/class_stem.R @@ -55,7 +55,7 @@ target_produce_junction.tar_stem <- function(target, pipeline) { } #' @export -target_produce_record.tar_stem <- function(target, meta) { +target_produce_record.tar_stem <- function(target, pipeline, meta) { file <- target$store$file record_init( name = target_get_name(target), diff --git a/R/class_target.R b/R/class_target.R index 8579a98f9..e7b0ccf33 100644 --- a/R/class_target.R +++ b/R/class_target.R @@ -204,7 +204,7 @@ target_read_value <- function(target, pipeline) { UseMethod("target_read_value") } -target_produce_record <- function(target, meta) { +target_produce_record <- function(target, pipeline, meta) { UseMethod("target_produce_record") } @@ -281,7 +281,7 @@ target_restore_buds <- function(target, pipeline, scheduler, meta) { UseMethod("target_restore_buds") } -target_update_depend <- function(target, meta) { +target_update_depend <- function(target, pipeline, meta) { UseMethod("target_update_depend") } diff --git a/R/tar_option_get.R b/R/tar_option_get.R index d5026ba60..4ba387b0b 100644 --- a/R/tar_option_get.R +++ b/R/tar_option_get.R @@ -29,6 +29,7 @@ tar_option_default <- function(option) { option, tidy_eval = TRUE, packages = (.packages()), + imports = character(0), library = NULL, envir = globalenv(), format = "rds", diff --git a/R/tar_option_set.R b/R/tar_option_set.R index 377baa13f..1613eb1c5 100644 --- a/R/tar_option_set.R +++ b/R/tar_option_set.R @@ -7,6 +7,17 @@ #' `_targets.R` script before calls to [tar_target()] or [tar_target_raw()]. #' @return Nothing. #' @inheritParams tar_target +#' @param imports Character vector of package names to track +#' global dependencies. For example, if you write +#' `tar_option_set(imports = "yourAnalysisPackage")` early in `_targets.R`, +#' then `tar_make()` will automatically rerun or skip targets +#' in response to changes to the R functions and objects defined in +#' `yourAnalysisPackage`. Does not account for low-level compiled code +#' such as C/C++ or Fortran. If you supply multiple packages, +#' e.g. `tar_option_set(imports = c("p1", "p2"))`, then the objects in +#' `p1` override the objects in `p2` if there are name conflicts. +#' Similarly, objects in `tar_option_get("envir")` override +#' everything in `tar_option_get("imports")`. #' @param envir Environment containing functions and global objects #' used in the R commands to run targets. #' @param debug Character vector of names of targets to run in debug mode. @@ -36,6 +47,7 @@ tar_option_set <- function( tidy_eval = NULL, packages = NULL, + imports = NULL, library = NULL, envir = NULL, format = NULL, @@ -55,6 +67,7 @@ tar_option_set <- function( force(envir) tar_option_set_tidy_eval(tidy_eval) tar_option_set_packages(packages) + tar_option_set_imports(imports) tar_option_set_library(library) tar_option_set_envir(envir) tar_option_set_format(format) @@ -84,6 +97,12 @@ tar_option_set_packages <- function(packages) { assign("packages", packages, envir = tar_envir_options) } +tar_option_set_imports <- function(imports) { + imports <- imports %||% tar_option_get("imports") + assert_chr(imports, "imports in tar_option_set() must be character.") + assign("imports", imports, envir = tar_envir_options) +} + tar_option_set_library <- function(library) { library <- library %||% tar_option_get("library") assert_chr(library %||% character(0), "library must be NULL or character.") diff --git a/R/tar_outdated.R b/R/tar_outdated.R index 60d382f42..2e03bba24 100644 --- a/R/tar_outdated.R +++ b/R/tar_outdated.R @@ -106,7 +106,7 @@ tar_outdated_inner <- function( tar_outdated_globals <- function(pipeline, meta) { meta$database$ensure_preprocessed(write = FALSE) - new <- hash_imports(pipeline$envir) + new <- hash_imports(pipeline$imports) new$new <- new$data recorded <- fltr(new$name, ~meta$exists_record(.x)) if (!length(recorded)) { diff --git a/R/utils_imports.R b/R/utils_imports.R index bb3f45aa6..ba11f38b3 100644 --- a/R/utils_imports.R +++ b/R/utils_imports.R @@ -11,15 +11,15 @@ hash_imports_graph <- function(envir, graph) { data_frame(name = order, type = type, data = hash) } +graph_envir <- function(envir) { + graph_edges(edges_envir(envir)) +} + type_import <- function(name, envir) { object <- get(x = name, envir = envir, inherits = FALSE) ifelse(is.function(object), "function", "object") } -graph_envir <- function(envir) { - graph_edges(edges_envir(envir)) -} - graph_edges <- function(edges) { graph <- igraph::graph_from_data_frame(edges) graph <- igraph::simplify(graph) diff --git a/man/tar_option_set.Rd b/man/tar_option_set.Rd index cf14017cc..3116bd16c 100644 --- a/man/tar_option_set.Rd +++ b/man/tar_option_set.Rd @@ -7,6 +7,7 @@ tar_option_set( tidy_eval = NULL, packages = NULL, + imports = NULL, library = NULL, envir = NULL, format = NULL, @@ -34,6 +35,18 @@ the values of global objects.} the target builds. Use \code{tar_option_set()} to set packages globally for all subsequent targets you define.} +\item{imports}{Character vector of package names to track +global dependencies. For example, if you write +\code{tar_option_set(imports = "yourAnalysisPackage")} early in \verb{_targets.R}, +then \code{tar_make()} will automatically rerun or skip targets +in response to changes to the R functions and objects defined in +\code{yourAnalysisPackage}. Does not account for low-level compiled code +such as C/C++ or Fortran. If you supply multiple packages, +e.g. \code{tar_option_set(imports = c("p1", "p2"))}, then the objects in +\code{p1} override the objects in \code{p2} if there are name conflicts. +Similarly, objects in \code{tar_option_get("envir")} override +everything in \code{tar_option_get("imports")}.} + \item{library}{Character vector of library paths to try when loading \code{packages}.} diff --git a/tests/testthat/test-class_branch.R b/tests/testthat/test-class_branch.R index 6882a2d17..bf2394668 100644 --- a/tests/testthat/test-class_branch.R +++ b/tests/testthat/test-class_branch.R @@ -150,7 +150,7 @@ tar_test("branch$produce_record() of a successful branch", { local$run() meta <- local$meta target <- pipeline_get_target(pipeline, target_get_children(map)[2L]) - record <- target_produce_record(target, meta) + record <- target_produce_record(target, pipeline, meta) expect_silent(record_validate(record)) expect_true(grepl("^y_", record$name)) expect_equal(record$parent, "y") diff --git a/tests/testthat/test-class_builder.R b/tests/testthat/test-class_builder.R index cc5dbaac4..e4d3e3ad1 100644 --- a/tests/testthat/test-class_builder.R +++ b/tests/testthat/test-class_builder.R @@ -26,7 +26,7 @@ tar_test("target_run() on a errored builder", { x <- target_init(name = "abc", expr = quote(identity(identity(stop(123))))) target_run(x) meta <- meta_init() - target_update_depend(x, meta) + target_update_depend(x, pipeline_init(), meta) expect_error( target_conclude(x, pipeline_init(), scheduler_init(), meta), class = "condition_run" diff --git a/tests/testthat/test-class_imports.R b/tests/testthat/test-class_imports.R new file mode 100644 index 000000000..cecf7cc48 --- /dev/null +++ b/tests/testthat/test-class_imports.R @@ -0,0 +1,113 @@ +tar_test("imports_set_object()", { + imports <- imports_new(new.env(parent = emptyenv())) + envir <- new.env(parent = emptyenv()) + envir$a <- "x" + expect_null(imports$a) + imports_set_object(imports = imports, name = "a", envir = envir) + expect_equal(imports$a, "x") +}) + +tar_test("imports_set_envir()", { + imports <- imports_new(new.env(parent = emptyenv())) + envir <- new.env(parent = emptyenv()) + envir$.a <- "x" + envir$b <- "y" + envir$c <- "z" + expect_null(imports$.a) + expect_null(imports$b) + expect_null(imports$c) + imports_set_envir(imports = imports, envir = envir) + expect_equal(imports$.a, "x") + expect_equal(imports$b, "y") + expect_equal(imports$c, "z") +}) + +tar_test("imports_set_package()", { + imports <- imports_new(new.env(parent = emptyenv())) + expect_null(imports$head) + imports_set_package(imports = imports, package = "utils") + expect_true(is.function(imports$head)) +}) + +tar_test("imports_set_package()", { + imports <- imports_new(new.env(parent = emptyenv())) + expect_null(imports$head) + imports_set_package(imports = imports, package = "utils") + expect_true(is.function(imports$head)) +}) + +tar_test("imports_init()", { + tar_option_set(imports = c("utils", "digest")) + envir <- new.env(parent = emptyenv()) + envir$head <- "abc" + expect_null(envir$tail) + expect_null(envir$digest) + imports <- imports_init(envir) + expect_equal(imports$head, "abc") + expect_true(is.function(imports$tail)) + expect_true(is.function(imports$digest)) + expect_null(envir$tail) + expect_null(envir$digest) + expect_true(inherits(imports, "tar_imports")) + expect_false(inherits(envir, "tar_imports")) +}) + +tar_test("imports_init() idempotence", { + tar_option_set(imports = c("utils", "digest")) + imports <- imports_init(imports_new(new.env(parent = emptyenv()))) + expect_true(inherits(imports, "tar_imports")) + expect_equal(length(imports), 0L) + expect_null(imports$head) +}) + +tar_test("imports_validate()", { + expect_silent(imports_validate(imports_new(new.env()))) + expect_error(imports_validate(new.env()), class = "condition_validate") + expect_error(imports_validate(123), class = "condition_validate") +}) + +tar_test("imports setting works", { + skip_if_not_installed("pkgload") + dir_create("pkg") + dir_create(file.path("pkg", "R")) + writeLines( + "f <- function(x) g(x); g <- function(x) x + 1L", + file.path("pkg", "R", "fun.R") + ) + writeLines( + c( + "Package: pkgabcdefg", + "Maintainer: John Doe ", + "Type: Package", + "Version: 0.0.1" + ), + file.path("pkg", "DESCRIPTION") + ) + tar_script({ + pkgload::load_all("pkg", quiet = TRUE) + tar_option_set(imports = "pkgabcdefg") + tar_pipeline(tar_target(x, f(1L))) + }) + out <- tar_network(callr_function = NULL)$edges + expect_true(any(out$from == "g" & out$to == "f")) + expect_true(any(out$from == "f" & out$to == "x")) + tar_make(callr_function = NULL) + meta <- tar_meta(names = c("f", "g", "x")) + expect_true(all(c("f", "g", "x") %in% meta$name)) + expect_equal(tar_read(x), 2L) + # Should be up to date. + tar_make(callr_function = NULL) + expect_equal(nrow(tar_progress()), 0L) + out <- tar_outdated(callr_function = NULL, targets_only = FALSE) + expect_equal(out, character(0)) + # Change the inner function. + writeLines( + "f <- function(x) g(x); g <- function(x) x + 2L", + file.path("pkg", "R", "fun.R") + ) + out <- tar_outdated(callr_function = NULL, targets_only = FALSE) + expect_true(all(c("f", "g", "x") %in% out)) + tar_make(callr_function = NULL) + expect_equal(tar_progress()$name, "x") + expect_equal(tar_read(x), 3L) +}) diff --git a/tests/testthat/test-class_meta.R b/tests/testthat/test-class_meta.R index eeb315107..9a4d1f8fa 100644 --- a/tests/testthat/test-class_meta.R +++ b/tests/testthat/test-class_meta.R @@ -31,7 +31,7 @@ tar_test("builder metadata recording", { db$reset_storage() data <- db$read_data() expect_equal(nrow(data), 0L) - meta$insert_record(target_produce_record(target, meta)) + meta$insert_record(target_produce_record(target, pipeline, meta)) expect_true(db$exists_row(target_get_name(target))) data <- db$read_data() expect_equal(nrow(data), 1L) @@ -160,7 +160,7 @@ tar_test("meta$produce_depend() nonempty", { local <- local_init(pipeline) local$run() meta <- local$meta - out <- meta$produce_depend(y) + out <- meta$produce_depend(y, pipeline) expect_equal(length(out), 1L) expect_equal(nchar(out), 16L) }) diff --git a/tests/testthat/test-class_pattern.R b/tests/testthat/test-class_pattern.R index 00de87840..ace78b583 100644 --- a/tests/testthat/test-class_pattern.R +++ b/tests/testthat/test-class_pattern.R @@ -402,7 +402,7 @@ tar_test("pattern$produce_record() of a successful map", { local <- local_init(pipeline) local$run() meta <- local$meta - record <- target_produce_record(target, meta) + record <- target_produce_record(target, pipeline, meta) expect_silent(record_validate(record)) expect_equal(record$name, "y") expect_equal(record$parent, NA_character_) diff --git a/tests/testthat/test-class_stem.R b/tests/testthat/test-class_stem.R index 58f6d3914..8a9bb1b7d 100644 --- a/tests/testthat/test-class_stem.R +++ b/tests/testthat/test-class_stem.R @@ -119,7 +119,7 @@ tar_test("insert stem record of a successful stem", { db <- meta$database db$ensure_storage() db$reset_storage() - record <- target_produce_record(target, meta) + record <- target_produce_record(target, pipeline, meta) db$insert_row(record_produce_row(record)) data <- db$read_data() expect_equal(data$name, "x") @@ -145,7 +145,7 @@ tar_test("stem$produce_record() of a successful stem", { local <- local_init(pipeline) local$run() meta <- local$meta - record <- target_produce_record(target, meta) + record <- target_produce_record(target, pipeline, meta) expect_silent(record_validate(record)) expect_equal(record$name, "x") expect_equal(record$parent, NA_character_) @@ -170,7 +170,7 @@ tar_test("stem$produce_record() of a errored stem", { local <- local_init(pipeline) expect_error(local$run(), class = "condition_run") meta <- local$meta - record <- target_produce_record(target, meta) + record <- target_produce_record(target, pipeline, meta) expect_silent(record_validate(record)) expect_equal(record$name, "x") expect_equal(record$parent, NA_character_) @@ -195,7 +195,7 @@ tar_test("stem$produce_record() with no error message", { local <- local_init(pipeline) expect_error(local$run(), class = "condition_run") meta <- local$meta - record <- target_produce_record(target, meta) + record <- target_produce_record(target, pipeline, meta) expect_equal(record$error, ".") }) diff --git a/tests/testthat/test-method_skip.R b/tests/testthat/test-method_skip.R index e48642d35..eace86b3b 100644 --- a/tests/testthat/test-method_skip.R +++ b/tests/testthat/test-method_skip.R @@ -203,3 +203,50 @@ tar_test("changing pattern iteration mode forces downstream reaggregation", { local$run() expect_true("z" %in% counter_get_names(local$scheduler$progress$built)) }) + +tar_test("change a nested function", { + tar_script({ + envir <- new.env(parent = globalenv()) + evalq({ + f <- function(x) { + g(x) + } + g <- function(x) { + x + 1L + } + }, envir = envir) + tar_option_set(envir = envir) + tar_pipeline(tar_target(x, f(1L))) + }) + out <- tar_network(callr_function = NULL)$edges + expect_true(any(out$from == "g" & out$to == "f")) + expect_true(any(out$from == "f" & out$to == "x")) + tar_make(callr_function = NULL) + meta <- tar_meta(names = c("f", "g", "x")) + expect_true(all(c("f", "g", "x") %in% meta$name)) + expect_equal(tar_read(x), 2L) + # Should be up to date. + tar_make(callr_function = NULL) + expect_equal(nrow(tar_progress()), 0L) + out <- tar_outdated(callr_function = NULL, targets_only = FALSE) + expect_equal(out, character(0)) + # Change the inner function. + tar_script({ + envir <- new.env(parent = globalenv()) + evalq({ + f <- function(x) { + g(x) + } + g <- function(x) { + x + 2L + } + }, envir = envir) + tar_option_set(envir = envir) + tar_pipeline(tar_target(x, f(1L))) + }) + out <- tar_outdated(callr_function = NULL, targets_only = FALSE) + expect_true(all(c("f", "g", "x") %in% out)) + tar_make(callr_function = NULL) + expect_equal(tar_progress()$name, "x") + expect_equal(tar_read(x), 3L) +}) diff --git a/vignettes/need.Rmd b/vignettes/need.Rmd index 4371d82c7..caa0d181e 100644 --- a/vignettes/need.Rmd +++ b/vignettes/need.Rmd @@ -57,6 +57,14 @@ However, nearly four years of community feedback have exposed major user-side li The `targets` package solves all these issues by design. Functions `tar_make()`, `tar_make_clustermq()`, and `tar_make_future()` all create fresh new R sessions by default. They all require a `_targets.R` configuration file in the project root (working directory of the `tar_make()` call) so that the functions, global objects, and settings are all populated in the exact same way each session, leading to less frustration, greater consistency, and greater reproducibility. In addition, the `_targets/` data store always lives in the project root. +## Enhanced debugging support + +`targets` has enhanced debugging support. With the `workspaces` argument to `tar_option_set()`, users can locally recreate the conditions under which a target runs. This includes packages, global functions and objects, and the random number generator seed. Similarly, `tar_option_set(error = "workspace")` automatically saves debugging workspaces for targets that encounter errors. The `debug` option lets users enter an interactive debugger for a given target while the pipeline is running. And unlike `drake`, all debugging features are fully compatible with dynamic branching. + +## Improved tracking of package functions + +By default, `targets` ignores changes to functions inside external packages. However, if a workflow centers on a custom package with methodology under development, users can make `targets` automatically watch the package's functions for changes. Simply supply the names of the relevant packages to the `imports` argument of `tar_option_set()`. Unlike `drake`, `targets` can track multiple packages this way, and the internal mechanism is much safer. + ## Lighter, friendlier data management [`drake`](https://github.com/ropensci/drake)'s cache is an intricate file system in a hidden `.drake` folder. It contains multiple files for each target, and those names are not informative. (See the files in the `data/` folder in the diagram below.) Users often have trouble understanding how [`drake`](https://github.com/ropensci/drake) manages data, resolving problems when files are corrupted, placing the data under version control, collaborating with others on the same pipeline, and clearing out superfluous data when the cache grows large in storage.