Try to reduce some overhead

ropensci · Nov 4, 2019 · 5a07f67 · 5a07f67
1 parent 596df3d
commit 5a07f67
Show file tree

Hide file tree

Showing 3 changed files with 35 additions and 3 deletions.
diff --git a/R/dynamic.R b/R/dynamic.R
@@ -203,6 +203,10 @@ dynamic_subvalue.data.frame <- function(value, index) {
   value[index,, drop = FALSE] # nolint
 }
 
+dynamic_subvalue.drake_dynamic <- function(value, index) {
+  dynamic_subvalue_vector(value, index)
+}
+
 dynamic_subvalue.default <- function(value, index) {
   if (is.null(dim(value))) {
     dynamic_subvalue_vector(value, index)
@@ -314,7 +318,7 @@ read_dynamic_hashes <- function(target, config) {
   meta <- config$cache$get(target, namespace = "meta")
   if (is.null(meta$dynamic_hashes)) {
     value <- config$cache$get(target)
-    meta$dynamic_hashes <- dynamic_hashes(meta$size, value, config)
+    meta$dynamic_hashes <- dynamic_hashes(value, meta$size, config)
   }
   meta$dynamic_hashes
 }

diff --git a/R/store_outputs.R b/R/store_outputs.R
@@ -171,7 +171,7 @@ finalize_meta <- function(target, value, meta, hash, config) {
     meta$subtargets <- config$layout[[target]]$subtargets
   }
   if (is_dynamic_dep(target, config)) {
-    meta$dynamic_hashes <- dynamic_hashes(meta$size, value, config)
+    meta$dynamic_hashes <- dynamic_hashes(value, meta$size, config)
   }
   meta
 }
@@ -199,7 +199,20 @@ finalize_triggers <- function(target, meta, config) {
   meta
 }
 
-dynamic_hashes <- function(size, value, config) {
+dynamic_hashes <- function(value, size, config) {
+  UseMethod("dynamic_hashes")
+}
+
+dynamic_hashes.drake_dynamic <- function(value, size, config) {
+  vapply(
+    seq_len(size),
+    dynamic_subvalue,
+    FUN.VALUE = character(1),
+    value = value
+  )
+}
+
+dynamic_hashes.default <- function(value, size, config) {
   vapply(
     seq_len(size),
     dynamic_hash,

diff --git a/tests/testthat/test-dynamic.R b/tests/testthat/test-dynamic.R
@@ -100,6 +100,21 @@ test_with_dir("invalidating a subtarget invalidates the parent", {
   expect_equal(sort(c(justbuilt(config))), exp)
 })
 
+test_with_dir("lots of maps", {
+  scenario <- get_testing_scenario()
+  envir <- eval(parse(text = scenario$envir))
+  suppressWarnings(rm(x1, x2, x3, x4, x5, envir = envir))
+  plan <- drake_plan(
+    x1 = seq_len(4),
+    x2 = target(x1, dynamic = map(x1)),
+    x3 = target(x2, dynamic = map(x2)),
+    x4 = target(x3, dynamic = map(x3)),
+    x5 = target(x4, dynamic = map(x4))
+  )
+  make(plan)
+  expect_equal(unlist(readd(x5)), seq_len(4))
+})
+
 test_with_dir("dynamic map flow", {
   scenario <- get_testing_scenario()
   envir <- eval(parse(text = scenario$envir))