Fix #186

DESCRIPTION

@@ -9,7 +9,7 @@ Description: Function-oriented Make-like declarative pipelines for
   reproducible pipelines concisely and compactly.
   The methods in this package were influenced by the 'drake' R package
   by Will Landau (2018) <doi:10.21105/joss.00550>.
-Version: 0.9.1
+Version: 0.9.1.9000
 License: MIT + file LICENSE
 URL: https://docs.ropensci.org/tarchetypes/, https://github.com/ropensci/tarchetypes
 BugReports: https://github.com/ropensci/tarchetypes/issues

NAMESPACE

@@ -21,6 +21,7 @@ export(one_of)
 export(starts_with)
 export(tar_age)
 export(tar_append_static_values)
+export(tar_assign)
 export(tar_aws_file)
 export(tar_aws_fst)
 export(tar_aws_fst_dt)

NEWS.md

@@ -1,7 +1,8 @@
-# tarchetypes 0.9.1 (development)
+# tarchetypes 0.9.1.9000 (development)
 
 * Add a `delimiter` argument to `tar_map()` etc. for customizing separators in target names (#177, @psychelzh).
 * Add "raw" hook functions (#185, @multimeric).
+* Add `tar_assign()` (#186, https://github.com/ropensci/targets/issues/1309, @hadley).
 
 # tarchetypes 0.9.0
 

R/tar_assign.R

@@ -0,0 +1,78 @@
+#' @title An assignment-based pipeline DSL
+#' @export
+#' @family Domain-specific languages for pipeline construction
+#' @description An assignment-based domain-specific language for pipeline
+#'   construction.
+#' @return A list of `tar_target()` objects.
+#'   See the "Target objects" section for background.
+#' @inheritSection tar_map Target objects
+#' @param targets An expression with special syntax to define a
+#'   collection of targets in a pipeline.
+#'   Example: `tar_assign(x <- tar_target(get_data()))` is equivalent
+#'   to `list(tar_target(x, get_data()))`.
+#'   The rules of the syntax
+#'   are as follows:
+#'   * The code supplied to [tar_assign()] must be enclosed in curly braces
+#'     beginning with `{` and `}` unless it only contains a
+#'     one-line statement.
+#'   * Each statement in the code block must be of the form
+#'     `x <- f()`, where `x` is the name of a target and
+#'     `f()` is a function like `tar_target()` or [tar_quarto()]
+#'     which accepts a `name` argument.
+#'   * The native pipe operator `|>` is allowed because it lazily
+#'     evaluates its arguments and be converted into non-pipe syntax
+#'     without evaluating the code.
+#' @examples
+#' if (identical(Sys.getenv("TAR_LONG_EXAMPLES"), "true")) {
+#' targets::tar_dir({ # tar_dir() runs code from a temporary directory.
+#' readr::write_csv(airquality, "data.csv")
+#' targets::tar_script({
+#'   library(tarchetypes)
+#'   tar_option_set(packages = c("readr", "dplyr", "ggplot2"))
+#'   tar_assign({
+#'     file <- tar_target("data.csv", format = "file")
+#'
+#'     data <- read_csv(file, col_types = cols()) |> 
+#'       filter(!is.na(Ozone)) |> 
+#'       tar_target()
+#'
+#'     model <- lm(Ozone ~ Temp, data) |> 
+#'       coefficients() |> 
+#'       tar_target()
+#'
+#'     plot <- {
+#'         ggplot(data) +
+#'           geom_point(aes(x = Temp, y = Ozone)) +
+#'           geom_abline(intercept = model[1], slope = model[2]) +
+#'           theme_gray(24)
+#'       } |> 
+#'         tar_target()
+#'   })
+#' })
+#' targets::tar_make()
+#' })
+#' }
+tar_assign <- function(targets) {
+  expr <- match.call()$targets
+  statements <- if_any(
+    identical(expr[[1L]], quote(`{`)),
+    as.list(expr[-1L]),
+    list(expr)
+  )
+  targets::tar_assert_true(
+    all(map_lgl(statements, ~identical(.x[[1L]], quote(`<-`)))),
+    msg = paste(
+      "tar_assign() code must be enclosed in curly braces if",
+      "it has multiple statements, and each statement",
+      "must be an assignment statement using the left arrow <-"
+    )
+  )
+  envir <- targets::tar_option_get("envir")
+  lapply(statements, tar_assign_parse, envir = envir)
+}
+
+tar_assign_parse <- function(statement, envir) {
+  call <- statement[[3L]]
+  call$name <- statement[[2L]]
+  eval(call, envir = envir)
+}

tests/testthat/test-tar_assign.R

@@ -0,0 +1,39 @@
+targets::tar_test("tar_assign() single statement", {
+  targets::tar_script(tar_assign(x <- tar_target(c(1L, 2L))))
+  out <- targets::tar_manifest(callr_function = NULL)
+  expect_equal(out$name, "x")
+  expect_equal(out$command, "c(1L, 2L)")
+  targets::tar_make(callr_function = NULL)
+  expect_equal(targets::tar_read(x), c(1L, 2L))
+})
+
+targets::tar_test("tar_assign()", {
+  targets::tar_script({
+    tar_assign({
+      x <- tar_target(c(1L, 2L))
+      y <- tar_target(x + 1L, pattern = map(x))
+      z <- tar_rep(TRUE, batches = 2L)
+    })
+  })
+  out <- targets::tar_manifest(names = x, callr_function = NULL)
+  expect_equal(out$name, "x")
+  expect_equal(out$command, "c(1L, 2L)")
+  out <- targets::tar_manifest(names = y, callr_function = NULL)
+  expect_equal(out$name, "y")
+  expect_equal(out$command, "x + 1L")
+  expect_equal(out$pattern, "map(x)")
+  out <- targets::tar_manifest(names = z, callr_function = NULL)
+  expect_equal(out$name, "z")
+  expect_true(grepl("^tarchetypes::tar_rep_run\\(", out$command))
+  expect_equal(out$pattern, "map(z_batch)")
+  out <- targets::tar_manifest(names = z_batch, callr_function = NULL)
+  expect_equal(out$name, "z_batch")
+  expect_equal(out$command, "seq_len(2L)")
+  targets::tar_make(callr_function = NULL)
+  expect_equal(targets::tar_read(x), c(1L, 2L))
+  expect_equal(unname(targets::tar_read(y)), c(2L, 3L))
+  expect_equal(unname(targets::tar_read(y, branches = 1L)), 2L)
+  expect_equal(unname(targets::tar_read(y, branches = 2L)), 3L)
+  expect_equal(targets::tar_read(z_batch), c(1L, 2L))
+  expect_equal(unname(targets::tar_read(z)), rep(TRUE, 2L))
+})