Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Optional feature: cleanly track functions/objects from multiple external packages #241

Merged
merged 14 commits into from
Dec 2, 2020
1 change: 1 addition & 0 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -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),
4 changes: 2 additions & 2 deletions R/class_active.R
Original file line number Diff line number Diff line change
@@ -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),
2 changes: 1 addition & 1 deletion R/class_branch.R
Original file line number Diff line number Diff line change
@@ -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),
12 changes: 6 additions & 6 deletions R/class_builder.R
Original file line number Diff line number Diff line change
@@ -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,15 +116,15 @@ 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))
}

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)
}
4 changes: 2 additions & 2 deletions R/class_glimpse.R
Original file line number Diff line number Diff line change
@@ -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
4 changes: 2 additions & 2 deletions R/class_inspection.R
Original file line number Diff line number Diff line change
@@ -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
18 changes: 8 additions & 10 deletions R/class_meta.R
Original file line number Diff line number Diff line change
@@ -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)) {
2 changes: 1 addition & 1 deletion R/class_outdated.R
Original file line number Diff line number Diff line change
@@ -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)
}
2 changes: 1 addition & 1 deletion R/class_passive.R
Original file line number Diff line number Diff line change
@@ -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() {
16 changes: 8 additions & 8 deletions R/class_pattern.R
Original file line number Diff line number Diff line change
@@ -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)
}
17 changes: 16 additions & 1 deletion R/class_pipeline.R
Original file line number Diff line number Diff line change
@@ -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) {
2 changes: 1 addition & 1 deletion R/class_sitrep.R
Original file line number Diff line number Diff line change
@@ -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)),
2 changes: 1 addition & 1 deletion R/class_stem.R
Original file line number Diff line number Diff line change
@@ -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),
4 changes: 2 additions & 2 deletions R/class_target.R
Original file line number Diff line number Diff line change
@@ -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")
}

2 changes: 1 addition & 1 deletion R/tar_outdated.R
Original file line number Diff line number Diff line change
@@ -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)) {