diff --git a/DESCRIPTION b/DESCRIPTION index bc1dcf4db..06dea5e8a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Package: drake Title: Data Frames in R for Make Description: An R-focused pipeline toolkit for reproducible code and high-performance computing. -Version: 5.0.1.9000 +Version: 5.0.1.9001 License: GPL-3 URL: https://github.com/ropensci/drake BugReports: https://github.com/ropensci/drake/issues @@ -59,6 +59,7 @@ Imports: parallel, plyr, R.utils, + rlang, rprojroot, stats, storr (>= 1.1.0), diff --git a/NAMESPACE b/NAMESPACE index b6e782307..af0927377 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -162,6 +162,8 @@ importFrom(parallel,parLapply) importFrom(parallel,stopCluster) importFrom(plyr,ddply) importFrom(plyr,dlply) +importFrom(rlang,expr) +importFrom(rlang,exprs) importFrom(rprojroot,find_root) importFrom(stats,coef) importFrom(stats,complete.cases) diff --git a/NEWS.md b/NEWS.md index 82b61135b..dde6ef6bf 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ -# Version 5.0.2 +# Version 5.1.0 +- Evaluate the quasiquotation operator `!!` for the `...` argument to `drake_plan()`. Suppress this behavior using `tidy_evaluation = FALSE` or by passing in commands passed through the `list` argument. +- Preprocess workflow plan commands with `rlang::expr()` before evaluating them. That means you can use the quasiquotation operator `!!` in your commands, and `make()` will evaluate them according to the tidy evaluation paradigm. - Restructure `drake_example("basic")`, `drake_example("gsp")`, and `drake_example("packages")` to demonstrate how to set up the files for serious `drake` projects. More guidance was needed in light of [this issue](https://github.com/ropensci/drake/issues/193). - Improve the examples of `drake_plan()` in the help file (`?drake_plan`). diff --git a/R/build.R b/R/build.R index 8eb90f434..822776110 100644 --- a/R/build.R +++ b/R/build.R @@ -76,8 +76,7 @@ build_in_hook <- function(target, meta, config) { } build_target <- function(target, config) { - command <- get_command(target = target, config = config) %>% - functionize + command <- get_evaluation_command(target = target, config = config) seed <- list(seed = config$seed, target = target) %>% seed_from_object value <- run_command( diff --git a/R/dependencies.R b/R/dependencies.R index 4c1e1c7fe..a87d4b39b 100644 --- a/R/dependencies.R +++ b/R/dependencies.R @@ -99,7 +99,9 @@ dependency_profile <- function(target, config){ names(hashes_of_dependencies) <- deps out <- list( cached_command = meta$command, - current_command = get_command(target = target, config = config), + current_command = get_standardized_command( + target = target, config = config + ), cached_file_modification_time = meta$mtime, current_file_modification_time = suppressWarnings( file.mtime(drake::drake_unquote(target)) @@ -286,7 +288,45 @@ is_not_file <- function(x){ !is_file(x) } -tidy_command <- function(x) { +braces <- function(x) { + paste("{\n", x, "\n}") +} + +# This is the version of the command that is +# actually run in make(), not the version +# that is cached and treated as a dependency. +# It needs to (1) wrap the command in a function +# to protect the user's environment from side effects, +# and (2) call rlang::expr() to enable tidy evaluation +# features such as quasiquotation. +get_evaluation_command <- function(target, config){ + raw_command <- config$plan$command[config$plan$target == target] %>% + functionize + unevaluated <- paste0("rlang::expr(", raw_command, ")") + quasiquoted <- eval(parse(text = unevaluated), envir = config$envir) + wide_deparse(quasiquoted) +} + +# This version of the command will be hashed and cached +# as a dependency. When the command changes nontrivially, +# drake will react. Otherwise, changes to whitespace or +# comments are just standardized away, and drake +# ignores them. Thus, superfluous builds are not triggered. +get_standardized_command <- function(target, config) { + config$plan$command[config$plan$target == target] %>% + standardize_command +} + +# The old standardization command +# that relies on formatR. +# Eventually, we may move to styler, +# since it is now the preferred option for +# text tidying. +# The important thing for drake's standardization of commands +# is to stay stable here, not to be super correct. +# If styler's behavior changes a lot, it will +# put targets out of date. +standardize_command <- function(x) { formatR::tidy_source( source = NULL, comment = FALSE, @@ -301,12 +341,3 @@ tidy_command <- function(x) { paste(collapse = "\n") %>% braces } - -braces <- function(x) { - paste("{\n", x, "\n}") -} - -get_command <- function(target, config) { - config$plan$command[config$plan$target == target] %>% - tidy_command -} diff --git a/R/make.R b/R/make.R index 1393833a2..4fb8e0b23 100644 --- a/R/make.R +++ b/R/make.R @@ -308,6 +308,16 @@ #' # Requires Rtools on Windows. #' # make(my_plan, parallelism = "Makefile", jobs = 4, # nolint #' # recipe_command = "R -q -e") # nolint +#' # +#' # make() respects tidy evaluation as implemented in the rlang package. +#' # This workflow plan uses rlang's quasiquotation operator `!!`. +#' my_plan <- drake_plan(list = c( +#' little_b = "\"b\"", +#' letter = "!!little_b" +#' )) +#' my_plan +#' make(my_plan) +#' readd(letter) # "b" #' }) #' } make <- function( diff --git a/R/meta.R b/R/meta.R index f811115b8..2d20955e4 100644 --- a/R/meta.R +++ b/R/meta.R @@ -72,7 +72,7 @@ drake_meta <- function(target, config) { # fields at the beginning of build_in_hook(), # but only after drake decides to actually build the target. if (trigger %in% triggers_with_command()){ - meta$command <- get_command(target = target, config = config) + meta$command <- get_standardized_command(target = target, config = config) } if (trigger %in% triggers_with_depends()){ meta$depends <- dependency_hash(target = target, config = config) @@ -101,7 +101,7 @@ finish_meta <- function(target, meta, config){ meta$file <- file_hash(target = target, config = config) } if (is.null(meta$command)){ - meta$command <- get_command(target = target, config = config) + meta$command <- get_standardized_command(target = target, config = config) } if (is.null(meta$depends)){ meta$depends <- dependency_hash(target = target, config = config) diff --git a/R/migrate.R b/R/migrate.R index bd1fad306..be01ca51b 100644 --- a/R/migrate.R +++ b/R/migrate.R @@ -253,7 +253,7 @@ hashes <- function(target, config) { } legacy_dependency_hash <- function(target, config) { - command <- legacy_get_command(target = target, config = config) + command <- legacy_get_tidy_command(target = target, config = config) stopifnot(length(command) == 1) dependencies(target, config) %>% legacy_self_hash(config = config) %>% @@ -261,7 +261,7 @@ legacy_dependency_hash <- function(target, config) { digest::digest(algo = config$long_hash_algo) } -legacy_get_command <- function(target, config){ +legacy_get_tidy_command <- function(target, config){ config$plan$command[config$plan$target == target] %>% legacy_tidy } diff --git a/R/package.R b/R/package.R index 60750fe34..00c8e683e 100644 --- a/R/package.R +++ b/R/package.R @@ -54,6 +54,7 @@ #' mclapply parLapply stopCluster #' @importFrom plyr ddply dlply #' @importFrom R.utils isPackageLoaded withTimeout +#' @importFrom rlang expr exprs #' @importFrom rprojroot find_root #' @importFrom stats coef complete.cases lm rnorm rpois runif setNames #' @importFrom storr encode64 storr_environment storr_rds diff --git a/R/workplan.R b/R/workplan.R index 636a20135..4c9ba1e5a 100644 --- a/R/workplan.R +++ b/R/workplan.R @@ -38,6 +38,10 @@ #' \code{...} argument. R will either convert all these quotes #' to single quotes or double quotes. Literal quotes in the #' \code{list} argument are left alone. +#' @param tidy_evaluation logical, whether to use tidy evaluation +#' such as quasiquotation +#' when evaluating commands passed through the free-form +#' \code{...} argument. #' @examples #' # Create example workflow plan data frames for make() #' drake_plan(small = simulate(5), large = simulate(50)) @@ -76,14 +80,40 @@ #' ) #' mtcars_plan #' # make(mtcars_plan) # Would write output_file.csv. # nolint +#' # In the free-form `...` argument +#' # drake_plan() uses tidy evaluation to figure out your commands. +#' # For example, it respects the quasiquotation operator `!!` +#' # when it figures out what your code should be. +#' # Suppress this with `tidy_evaluation = FALSE` or +#' # with the `list` argument. +#' my_variable <- 5 +#' drake_plan( +#' a = !!my_variable, +#' b = !!my_variable + 1, +#' list = c(d = "!!my_variable") +#' ) +#' drake_plan( +#' a = !!my_variable, +#' b = !!my_variable + 1, +#' list = c(d = "!!my_variable"), +#' tidy_evaluation = FALSE +#' ) +#' # For instances of !! that remain unevaluated in the workflow plan, +#' # make() will run these commands in tidy fashion, +#' # evaluating the !! operator using the environment you provided. drake_plan <- function( ..., list = character(0), file_targets = FALSE, - strings_in_dots = c("filenames", "literals") + strings_in_dots = c("filenames", "literals"), + tidy_evaluation = TRUE ){ strings_in_dots <- match.arg(strings_in_dots) - dots <- match.call(expand.dots = FALSE)$... + if (tidy_evaluation){ + dots <- rlang::exprs(...) # Enables quasiquotation via rlang. + } else { + dots <- match.call(expand.dots = FALSE)$... + } commands_dots <- lapply(dots, wide_deparse) names(commands_dots) <- names(dots) commands <- c(commands_dots, list) diff --git a/inst/WORDLIST b/inst/WORDLIST index dd45a5dc6..9e496c7cd 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -82,6 +82,7 @@ prework programmatically Programmatically PSOCK +quasiquotation quickstart Quickstart RDS diff --git a/inst/examples/basic/interactive-tutorial.R b/inst/examples/basic/interactive-tutorial.R index a9cad55d6..66cd41e1d 100644 --- a/inst/examples/basic/interactive-tutorial.R +++ b/inst/examples/basic/interactive-tutorial.R @@ -158,6 +158,31 @@ report <- drake_plan( my_plan <- rbind(report, my_datasets, my_analyses, results) +# For the commands you specify the free-form `...` argument, +# `drake_plan()` also supports tidy evaluation. +# For example, it supports quasiquotation with the `!!` argument. +# Use `tidy_evaluation = FALSE` or the `list` argument +# to suppress this behavior. + +my_variable <- 5 + +drake_plan( + a = !!my_variable, + b = !!my_variable + 1, + list = c(d = "!!my_variable") +) + +drake_plan( + a = !!my_variable, + b = !!my_variable + 1, + list = c(d = "!!my_variable"), + tidy_evaluation = FALSE +) + +# For instances of !! that remain in the workflow plan, +# make() will run these commands in tidy fashion, +# evaluating the !! operator using the environment you provided. + ##################################### ### CHECK AND DEBUG WORKFLOW PLAN ### ##################################### diff --git a/man/drake_plan.Rd b/man/drake_plan.Rd index 184d2bd49..b68c6e255 100644 --- a/man/drake_plan.Rd +++ b/man/drake_plan.Rd @@ -6,7 +6,7 @@ for the \code{plan} argument of \code{\link{make}}.} \usage{ drake_plan(..., list = character(0), file_targets = FALSE, - strings_in_dots = c("filenames", "literals")) + strings_in_dots = c("filenames", "literals"), tidy_evaluation = TRUE) } \arguments{ \item{...}{A collection of symbols/targets @@ -30,6 +30,11 @@ you cannot simply leave literal quotes alone in the \code{...} argument. R will either convert all these quotes to single quotes or double quotes. Literal quotes in the \code{list} argument are left alone.} + +\item{tidy_evaluation}{logical, whether to use tidy evaluation +such as quasiquotation +when evaluating commands passed through the free-form +\code{...} argument.} } \value{ A data frame of targets and commands. @@ -94,4 +99,25 @@ mtcars_plan <- drake_plan( ) mtcars_plan # make(mtcars_plan) # Would write output_file.csv. # nolint +# In the free-form `...` argument +# drake_plan() uses tidy evaluation to figure out your commands. +# For example, it respects the quasiquotation operator `!!` +# when it figures out what your code should be. +# Suppress this with `tidy_evaluation = FALSE` or +# with the `list` argument. +my_variable <- 5 +drake_plan( + a = !!my_variable, + b = !!my_variable + 1, + list = c(d = "!!my_variable") +) +drake_plan( + a = !!my_variable, + b = !!my_variable + 1, + list = c(d = "!!my_variable"), + tidy_evaluation = FALSE +) +# For instances of !! that remain unevaluated in the workflow plan, +# make() will run these commands in tidy fashion, +# evaluating the !! operator using the environment you provided. } diff --git a/man/make.Rd b/man/make.Rd index e6f9a7261..ac2a09a4e 100644 --- a/man/make.Rd +++ b/man/make.Rd @@ -324,6 +324,16 @@ clean() # Start from scratch. # Requires Rtools on Windows. # make(my_plan, parallelism = "Makefile", jobs = 4, # nolint # recipe_command = "R -q -e") # nolint +# +# make() respects tidy evaluation as implemented in the rlang package. +# This workflow plan uses rlang's quasiquotation operator `!!`. +my_plan <- drake_plan(list = c( + little_b = "\\"b\\"", + letter = "!!little_b" +)) +my_plan +make(my_plan) +readd(letter) # "b" }) } } diff --git a/tests/testthat/test-tidy-eval.R b/tests/testthat/test-tidy-eval.R new file mode 100644 index 000000000..df0a5e18f --- /dev/null +++ b/tests/testthat/test-tidy-eval.R @@ -0,0 +1,45 @@ +drake_context("tidy eval") + +# From Kendon Bell: https://github.com/ropensci/drake/issues/200 +test_with_dir("drake_plan does tidy eval in `...` argument", { + my_variable <- 5 + plan1 <- drake_plan( + a = !!my_variable, + b = !!my_variable + 1, + list = c(d = "!!my_variable") + ) + plan2 <- data.frame( + target = c("a", "b", "d"), + command = c("5", "6", "!!my_variable"), + stringsAsFactors = FALSE + ) + expect_equal(plan1, plan2) +}) + +# From Alex Axthelm: https://github.com/ropensci/drake/issues/200 +test_with_dir("drake_plan tidy eval can be disabled", { + plan1 <- drake_plan( + a = !!my_variable, + b = !!my_variable + 1, + list = c(d = "!!my_variable"), + tidy_evaluation = FALSE + ) + plan2 <- data.frame( + target = c("a", "b", "d"), + command = c("!(!my_variable)", "!(!my_variable + 1)", "!!my_variable"), + stringsAsFactors = FALSE + ) + expect_equal(plan1, plan2) +}) + +# From Kendon Bell: https://github.com/ropensci/drake/issues/200 +test_with_dir("make() does tidy eval in commands", { + con <- dbug() + con$plan <- drake_plan(list = c( + little_b = "\"b\"", + letter = "!!little_b" + )) + con$targets <- con$plan$target + testrun(con) + expect_equal(readd(letter), "b") +}) diff --git a/tests/testthat/test-workflow-plan.R b/tests/testthat/test-workflow-plan.R index 54691a704..cf87eda1c 100644 --- a/tests/testthat/test-workflow-plan.R +++ b/tests/testthat/test-workflow-plan.R @@ -11,73 +11,95 @@ test_with_dir("empty plan", { }) test_with_dir("plan set 1", { - x <- drake_plan( - a = c, - b = "c", - list = c(c = "d", d = "readRDS('e')")) - y <- data.frame( - target = letters[1:4], - command = c("c", "'c'", - "d", "readRDS('e')"), - stringsAsFactors = F) - expect_equal(x, y) + for (tidy_evaluation in c(TRUE, FALSE)){ + x <- drake_plan( + a = c, + b = "c", + list = c(c = "d", d = "readRDS('e')"), + tidy_evaluation = tidy_evaluation + ) + y <- data.frame( + target = letters[1:4], + command = c("c", "'c'", + "d", "readRDS('e')"), + stringsAsFactors = F) + expect_equal(x, y) + } }) test_with_dir("plan set 2", { - x <- drake_plan(a = c, - b = "c", - list = c(c = "d", d = "readRDS('e')"), - strings_in_dots = "literals") - y <- data.frame( - target = letters[1:4], - command = c("c", "\"c\"", - "d", "readRDS('e')"), stringsAsFactors = F) - expect_equal(x, y) + for (tidy_evaluation in c(TRUE, FALSE)){ + x <- drake_plan(a = c, + b = "c", + list = c(c = "d", d = "readRDS('e')"), + strings_in_dots = "literals", + tidy_evaluation = tidy_evaluation) + y <- data.frame( + target = letters[1:4], + command = c("c", "\"c\"", + "d", "readRDS('e')"), stringsAsFactors = F) + expect_equal(x, y) + } }) test_with_dir("plan set 3", { + for (tidy_evaluation in c(TRUE, FALSE)){ x <- drake_plan( a = c, b = "c", list = c(c = "d", d = "readRDS('e')"), - strings_in_dots = "literals", file_targets = TRUE) + strings_in_dots = "literals", file_targets = TRUE, + tidy_evaluation = tidy_evaluation) y <- data.frame( target = drake::drake_quotes(letters[1:4], single = TRUE), command = c("c", "\"c\"", "d", "readRDS('e')"), stringsAsFactors = F) expect_equal(x, y) + } }) test_with_dir("plan set 4", { - x <- drake_plan( - a = c, - b = "c", - list = c(c = "d", d = "readRDS('e')"), - strings_in_dots = "filenames", file_targets = TRUE) - y <- data.frame( - target = drake::drake_quotes(letters[1:4], single = TRUE), - command = c("c", "'c'", "d", "readRDS('e')"), stringsAsFactors = F) - expect_equal(x, y) - expect_warning(check_plan(x, verbose = FALSE)) + for (tidy_evaluation in c(TRUE, FALSE)){ + x <- drake_plan( + a = c, + b = "c", + list = c(c = "d", d = "readRDS('e')"), + strings_in_dots = "filenames", file_targets = TRUE, + tidy_evaluation = tidy_evaluation) + y <- data.frame( + target = drake::drake_quotes(letters[1:4], single = TRUE), + command = c("c", "'c'", "d", "readRDS('e')"), stringsAsFactors = F) + expect_equal(x, y) + expect_warning(check_plan(x, verbose = FALSE)) + } }) test_with_dir("drake_plan() trims outer whitespace in target names", { - x <- drake_plan(list = c(` a` = 1, `b \t\n` = 2)) - y <- drake_plan(a = 1, b = 2) - expect_equal(x$target, y$target) + for (tidy_evaluation in c(TRUE, FALSE)){ + x <- drake_plan(list = c(` a` = 1, `b \t\n` = 2), + tidy_evaluation = tidy_evaluation) + y <- drake_plan(a = 1, b = 2, tidy_evaluation = tidy_evaluation) + expect_equal(x$target, y$target) + } }) test_with_dir("make() and check_plan() trim outer whitespace in target names", { x <- data.frame(target = c("a\n", " b", "c ", "\t d "), - command = 1) + command = 1) expect_silent(make(x, verbose = FALSE, session_info = FALSE)) expect_equal(sort(cached()), letters[1:4]) stat <- c(a = "finished", b = "finished", c = "finished", - d = "finished") + d = "finished") expect_equal(progress(), stat) - expect_warning(make(x, verbose = FALSE, targets = c("a", - "nobody_home"), session_info = FALSE)) + expect_warning( + make( + x, + verbose = FALSE, + targets = c("a", "nobody_home"), + session_info = FALSE + ) + ) x <- data.frame(target = c("a", " a"), command = 1) expect_error(check_plan(x, verbose = FALSE)) diff --git a/vignettes/caution.Rmd b/vignettes/caution.Rmd index da14526d0..6931e28f5 100644 --- a/vignettes/caution.Rmd +++ b/vignettes/caution.Rmd @@ -126,6 +126,42 @@ You must properly install `drake` using `install.packages()`, `devtools::install Your workflow may depend on external packages such as [ggplot2](https://CRAN.R-project.org/package=ggplot2), [dplyr](https://CRAN.R-project.org/package=dplyr), and [MASS](https://CRAN.R-project.org/package=MASS). Such packages must be formally installed with `install.packages()`, `devtools::install_github()`, `devtools::install_local()`, or a similar command. If you load uninstalled packages with `devtools::load_all()`, results may be unpredictable and incorrect. +## A note on tidy evaluation + +Running commands in your R console is not always exactly like running them with `make()`. That's because `make()` uses tidy evaluation as implemented in the [`rlang` package](https://github.com/tidyverse/rlang). + +```{r demotidyeval} +# This workflow plan uses rlang's quasiquotation operator `!!`. +my_plan <- drake_plan(list = c( + little_b = "\"b\"", + letter = "!!little_b" +)) +my_plan +make(my_plan) +readd(letter) +``` + +For the commands you specify the free-form `...` argument, `drake_plan()` also supports tidy evaluation. For example, it supports quasiquotation with the `!!` argument. Use `tidy_evaluation = FALSE` or the `list` argument to suppress this behavior. + +```{r testquasiquoplan} +my_variable <- 5 + +drake_plan( + a = !!my_variable, + b = !!my_variable + 1, + list = c(d = "!!my_variable") +) + +drake_plan( + a = !!my_variable, + b = !!my_variable + 1, + list = c(d = "!!my_variable"), + tidy_evaluation = FALSE +) +``` + +For instances of `!!` that remain in the workflow plan, `make()` will run these commands in tidy fashion, evaluating the `!!` operator using the environment you provided. + ## Find and diagnose your errors. When `make()` fails, use `failed()` and `diagnose()` to debug. Try the following out yourself. diff --git a/vignettes/debug.Rmd b/vignettes/debug.Rmd index d4a947542..fd0bcbd68 100644 --- a/vignettes/debug.Rmd +++ b/vignettes/debug.Rmd @@ -311,6 +311,22 @@ f <- function(x){ drake_build(target = "my_target", config = config) ``` +## Tidy evaluation: a caveat to diagnosing interactively + +Running commands in your R console is not always exactly like running them with `make()`. That's because `make()` uses tidy evaluation as implemented in the [`rlang` package](https://github.com/tidyverse/rlang). + +```{r demotidyeval} +# This workflow plan uses rlang's quasiquotation operator `!!`. +my_plan <- drake_plan(list = c( + little_b = "\"b\"", + letter = "!!little_b" +)) +my_plan +make(my_plan) +readd(letter) +``` + + # Debrief a build session. After your project is at least somewhat built, you can inspect and read your results from the cache. diff --git a/vignettes/drake.Rmd b/vignettes/drake.Rmd index 9b90e8b0b..9325ef386 100644 --- a/vignettes/drake.Rmd +++ b/vignettes/drake.Rmd @@ -99,6 +99,27 @@ whole_plan <- rbind(dataset_plan, analysis_plan) whole_plan ``` +For the commands you pass in with the free-form `...` argument, `drake_plan()` uses tidy evaluation. For example, it supports quasiquotation with the `!!` argument. Use `tidy_evaluation = FALSE` or the `list` argument to suppress this behavior. + +```{r testquasiquoplan} +my_variable <- 5 + +drake_plan( + a = !!my_variable, + b = !!my_variable + 1, + list = c(d = "!!my_variable") +) + +drake_plan( + a = !!my_variable, + b = !!my_variable + 1, + list = c(d = "!!my_variable"), + tidy_evaluation = FALSE +) +``` + +For instances of `!!` that remain in the workflow plan, `make()` will run these commands in tidy fashion, evaluating the `!!` operator using the environment you provided. + Using static code analysis, `drake` detects the dependencies of all your targets. The result is an interactive network diagram. ```{r drakevisgraph, eval = FALSE} diff --git a/vignettes/quickstart.Rmd b/vignettes/quickstart.Rmd index 6cbb29f17..312397124 100644 --- a/vignettes/quickstart.Rmd +++ b/vignettes/quickstart.Rmd @@ -468,6 +468,42 @@ As you have seen with `reg2()`, `drake` reacts to changes in dependencies. In ot To enhance reproducibility beyond the scope of drake, you might consider [packrat](https://rstudio.github.io/packrat) and [Docker](https://www.docker.com/). [Packrat](https://rstudio.github.io/packrat) creates a tightly-controlled local library of packages to extend the shelf life of your project. And with [Docker](https://www.docker.com/), you can execute your project on a [virtual machine](https://en.wikipedia.org/wiki/Virtual_machine) to ensure platform independence. Together, [packrat](https://rstudio.github.io/packrat) and [Docker](https://www.docker.com/) can help others reproduce your work even if they have different software and hardware. +# A note on tidy evaluation + +Running commands in your R console is not always exactly like running them with `make()`. That's because `make()` uses tidy evaluation as implemented in the [`rlang` package](https://github.com/tidyverse/rlang). + +```{r demotidyeval} +# This workflow plan uses rlang's quasiquotation operator `!!`. +my_plan <- drake_plan(list = c( + little_b = "\"b\"", + letter = "!!little_b" +)) +my_plan +make(my_plan) +readd(letter) +``` + +For the commands you specify the free-form `...` argument, `drake_plan()` also supports tidy evaluation. For example, it supports quasiquotation with the `!!` argument. Use `tidy_evaluation = FALSE` or the `list` argument to suppress this behavior. + +```{r testquasiquoplan} +my_variable <- 5 + +drake_plan( + a = !!my_variable, + b = !!my_variable + 1, + list = c(d = "!!my_variable") +) + +drake_plan( + a = !!my_variable, + b = !!my_variable + 1, + list = c(d = "!!my_variable"), + tidy_evaluation = FALSE +) +``` + +For instances of `!!` that remain in the workflow plan, `make()` will run these commands in tidy fashion, evaluating the `!!` operator using the environment you provided. + # Need more speed? `Drake` has extensive high-performance computing support, from local multicore processing to serious distributed computing across multiple nodes of a cluster. See the [parallelism vignette](https://github.com/ropensci/drake/blob/master/vignettes/parallelism.Rmd) for detailed instructions.