Fix #1077

NEWS.md

@@ -5,6 +5,7 @@
 - Prevent `drake::drake_plan(x = target(...))` from throwing an error if `drake` is not loaded (#1039, @mstr3336).
 - Move the `transformations` lifecycle badge to the proper location in the docstring (#1040, @jeroen).
 - Prevent `readd()` / `loadd()` from turning an imported function into a target (#1067).
+- Align in-memory `disk.frame` targets with their stored values (#1077, @brendanf).
 
 ## New features
 

R/local_build.R

@@ -323,9 +323,7 @@ conclude_build <- function(build, config) {
     config = config
   )
   store_outputs(target = target, value = value, meta = meta, config = config)
-  if (!is_subtarget(target, config)) {
-    assign_to_envir(target = target, value = value, config = config)
-  }
+  assign_to_envir(target = target, value = value, config = config)
   invisible(value)
 }
 
@@ -339,7 +337,7 @@ assign_format <- function(target, value, format, config) {
   }
   config$logger$minor("format", format, target = target)
   out <- list(value = value)
-  class(out) <- paste0("drake_format_", format)
+  class(out) <- c(paste0("drake_format_", format), "drake_format")
   sanitize_format(x = out, target = target, config = config)
 }
 
@@ -405,31 +403,42 @@ sanitize_format.drake_format_diskframe <- function(x, target, config) { # nolint
 }
 
 assign_to_envir <- function(target, value, config) {
+  if (is_subtarget(target, config)) {
+    return()
+  }
   memory_strategy <- config$layout[[target]]$memory_strategy %||NA%
     config$memory_strategy
-  if (memory_strategy %in% c("autoclean", "unload", "none")) {
+  skip_memory <- memory_strategy %in% c("autoclean", "unload", "none")
+  if (skip_memory) {
     return()
   }
-  if (
-    identical(config$lazy_load, "eager") &&
+  do_assign <- identical(config$lazy_load, "eager") &&
     !is_encoded_path(target) &&
     !is_imported(target, config)
-  ) {
+  if (do_assign) {
     assign(
       x = target,
-      value = value_format(value),
+      value = value_format(value, target, config),
       envir = config$envir_targets
     )
   }
   invisible()
 }
 
-value_format <- function(x) {
-  if (any(grepl("^drake_format_", class(x)))) {
-    x$value
-  } else {
-    x
-  }
+value_format <- function(value, target, config) {
+  UseMethod("value_format")
+}
+
+value_format.drake_format_diskframe <- function(value, target, config) { # nolint
+  config$cache$get(target)
+}
+
+value_format.drake_format <- function(value, target, config) {
+  value$value
+}
+
+value_format.default <- function(value, target, config) {
+  value
 }
 
 assert_output_files <- function(target, meta, config) {

tests/testthat/test-decorated-storr.R

@@ -184,6 +184,7 @@ test_with_dir("no special format", {
   cache <- drake_cache()
   ref2 <- cache$storr$get("y")
   expect_identical(ref2, "normal format")
+  expect_false(inherits(ref2, "drake_format"))
   expect_false(inherits(ref2, "drake_format_rds"))
 })
 
@@ -208,12 +209,14 @@ test_with_dir("rds format", {
   cache <- drake_cache()
   expect_equal(cache$get_value(cache$get_hash("x")), exp)
   ref <- cache$storr$get("x")
+  expect_true(inherits(ref, "drake_format"))
   expect_true(inherits(ref, "drake_format_rds"))
   expect_equal(length(ref), 1L)
   expect_true(nchar(ref) < 100)
   expect_false(is.list(ref))
   ref2 <- cache$storr$get("y")
   expect_identical(ref2, "normal format")
+  expect_false(inherits(ref2, "drake_format"))
   expect_false(inherits(ref2, "drake_format_rds"))
 })
 
@@ -232,12 +235,14 @@ test_with_dir("rds format with hpc checksum", {
   cache <- drake_cache()
   expect_equal(cache$get_value(cache$get_hash("x")), exp)
   ref <- cache$storr$get("x")
+  expect_true(inherits(ref, "drake_format"))
   expect_true(inherits(ref, "drake_format_rds"))
   expect_equal(length(ref), 1L)
   expect_true(nchar(ref) < 100)
   expect_false(is.list(ref))
   ref2 <- cache$storr$get("y")
   expect_identical(ref2, "normal format")
+  expect_false(inherits(ref2, "drake_format"))
   expect_false(inherits(ref2, "drake_format_rds"))
 })
 
@@ -251,6 +256,7 @@ test_with_dir("flow with rds format", {
   make(plan)
   for (target in c("x", "y")) {
     ref <- config$cache$storr$get("x")
+    expect_true(inherits(ref, "drake_format"))
     expect_true(inherits(ref, "drake_format_rds"))
   }
   expect_equal(sort(justbuilt(config)), sort(c("x", "y")))
@@ -281,6 +287,7 @@ test_with_dir("rds format with environment storr", {
   expect_equal(out, exp)
   expect_equal(cache$get_value(cache$get_hash("x")), exp)
   ref <- cache$storr$get("x")
+  expect_true(inherits(ref, "drake_format"))
   expect_true(inherits(ref, "drake_format_rds"))
   expect_equal(length(ref), 1L)
   expect_true(nchar(ref) < 100)
@@ -347,6 +354,7 @@ test_with_dir("Can save fst data frames", {
   cache <- drake_cache()
   expect_equal(cache$get_value(cache$get_hash("x")), exp)
   ref <- cache$storr$get("x")
+  expect_true(inherits(ref, "drake_format"))
   expect_true(inherits(ref, "drake_format_fst"))
   expect_equal(length(ref), 1L)
   expect_true(nchar(ref) < 100)
@@ -403,6 +411,7 @@ test_with_dir("fst_dt", {
   cache <- drake_cache()
   expect_equal(cache$get_value(cache$get_hash("x")), exp)
   ref <- cache$storr$get("x")
+  expect_true(inherits(ref, "drake_format"))
   expect_true(inherits(ref, "drake_format_fst_dt"))
   expect_equal(length(ref), 1L)
   expect_true(nchar(ref) < 100)
@@ -451,6 +460,7 @@ test_with_dir("disk.frame (#1004)", {
     exp
   )
   ref <- cache$storr$get("x")
+  expect_true(inherits(ref, "drake_format"))
   expect_true(inherits(ref, "drake_format_diskframe"))
   expect_equal(length(ref), 1L)
   expect_true(nchar(ref) < 100)
@@ -591,3 +601,22 @@ test_with_dir("safe_get*() methods", {
     expect_false(is.na(cache$safe_get_hash("a", namespace = ns)))
   }
 })
+
+test_with_dir("in-memory representation of disk.frame targets (#1077)", {
+  n <- 200
+  observations <- data.frame(
+    type = sample(letters[seq_len(3)], n, replace = TRUE),
+    size = runif(n),
+    stringsAsFactors = FALSE
+  )
+  plan <- drake_plan(
+    all_data = target(
+      observations,
+      format = "fst"
+    ),
+    result = as.data.frame(head(all_data))
+  )
+  make(plan)
+  out <- readd(result)
+  expect_equal(dim(out), c(6L, 2L))
+})