Merge pull request #122 from wlandau/master

Add console messages for building the graph

R/check.R

@@ -10,6 +10,7 @@
 #' @param targets character vector of targets to make
 #' @param envir environment containing user-defined functions
 #' @param cache optional drake cache. See \code{\link{new_cache}()}
+#' @param verbose logical, whether to log progress to the console.
 #' @examples
 #' \dontrun{
 #' load_basic_example()
@@ -21,11 +22,12 @@ check <- function(
   plan = workplan(),
   targets = drake::possible_targets(plan),
   envir = parent.frame(),
-  cache = drake::get_cache()
+  cache = drake::get_cache(),
+  verbose = TRUE
 ){
   force(envir)
   config <- build_config(plan = plan, targets = targets, envir = envir,
-    verbose = TRUE, hook = function(code) force(code),
+    verbose = verbose, hook = function(code) force(code),
     cache = cache, parallelism = "mclapply",
     jobs = 1, packages = character(0),
     prepend = character(0), prework = character(0), command = character(0),

R/color.R

@@ -1,11 +1,12 @@
 # Below, the colors from "target" through
-# "unload" are for the console. The rest
+# "fail" are for the console. The rest
 # are for plot_graph().
 colors <- c(
   target = "green3",
   import = "dodgerblue3",
   missing = "darkorchid3",
   check = "skyblue1",
+  interconnect = "skyblue1",
   load = "#ff9933",
   unload = "#ff7221",
   timeout = "maroon",

R/console.R

@@ -15,6 +15,14 @@ console <- function(imported, target, config) {
     finish_console(message = message)
 }
 
+console_dependencies <- function(targets, config){
+  console_many_targets(
+    targets = targets,
+    message = "interconnect",
+    config = config
+  )
+}
+
 console_many_targets <- function(
   targets, message, config, color = color_of(message)
 ){

R/dataframes_graph.R

@@ -35,7 +35,7 @@
 #' @param subset Optional character vector of of target/import names.
 #' Subset of nodes to display in the graph.
 #' Applied after \code{from}, \code{mode}, and \code{order}.
-#' Be advised: edges are only kept for adgacent nodes in \code{subset}.
+#' Be advised: edges are only kept for adjacent nodes in \code{subset}.
 #' If you do not select all the intermediate nodes,
 #' edges will drop from the graph.
 #'

R/graph.R

@@ -42,8 +42,16 @@ build_graph <- function(
   )
   true_import_names <- setdiff(names(imports), targets)
   imports <- imports[true_import_names]
+  console_dependencies(
+    targets = names(imports),
+    config = list(verbose = verbose)
+  )
   import_deps <- lightly_parallelize(
     imports, import_dependencies, jobs = jobs)
+  console_dependencies(
+    targets = plan$target,
+    config = list(verbose = verbose)
+  )
   command_deps <- lightly_parallelize(
     plan$command, command_dependencies, jobs = jobs)
   names(command_deps) <- plan$target
@@ -88,6 +96,8 @@ build_graph <- function(
 #' @param jobs number of jobs to accelerate the construction
 #' of the dependency graph. A light \code{mclapply}-based
 #' parallelism is used if your operating system is not Windows.
+#' @param verbose logical, whether to print
+#' progress messages to the console.
 #' @examples
 #' \dontrun{
 #' load_basic_example()
@@ -97,11 +107,14 @@ tracked <- function(
   plan = workplan(),
   targets = drake::possible_targets(plan),
   envir = parent.frame(),
-  jobs = 1
+  jobs = 1,
+  verbose = TRUE
 ){
   force(envir)
   graph <- build_graph(
-    plan = plan, targets = targets, envir = envir, jobs = jobs)
+    plan = plan, targets = targets, envir = envir,
+    jobs = jobs, verbose = verbose
+  )
   V(graph)$name
 }
 

R/plotgraph.R

@@ -34,7 +34,7 @@
 #' @param subset Optional character vector of of target/import names.
 #' Subset of nodes to display in the graph.
 #' Applied after \code{from}, \code{mode}, and \code{order}.
-#' Be advised: edges are only kept for adgacent nodes in \code{subset}.
+#' Be advised: edges are only kept for adjacent nodes in \code{subset}.
 #' If you do not select all the intermediate nodes,
 #' edges will drop from the graph.
 #'

inst/examples/torque/torque.tmpl

@@ -1,15 +1,11 @@
-# from https://github.com/HenrikBengtsson/future.batchtools/blob/master/inst/templates/torque.tmpl
 #!/bin/bash
 ######################################################################
 # A batchtools launch script template for a Torque/PBS
-#
+# https://github.com/HenrikBengtsson/future.batchtools/blob/master/inst/templates/torque.tmpl
 # Author: Henrik Bengtsson 
 # Modified: Will Landau
 ######################################################################
 
-## Run all jobs in the current working directory.
-#PBS -D <%= getwd() %>
-
 ## Job name:
 #PBS -N <%= if (exists("job.name", mode = "character")) job.name else job.hash %>
 
@@ -19,5 +15,17 @@
 ## Merge standard error and output:
 #PBS -j oe
 
+## Email on abort (a) and termination (e), but not when starting (b)
+## Requires mailutils if on Linux.
+#PBS -m ae
+
+## Resources needed:
+<% if (length(resources) > 0) {
+  opts <- unlist(resources, use.names = TRUE)
+  opts <- sprintf("%s=%s", names(opts), opts)
+  opts <- paste(opts, collapse = ",") %>
+#PBS -l <%= opts %>
+<% } %>
+
 ## Launch R and evaluated the batchtools R job
-#Rscript -e 'batchtools::doJobCollection("<%= uri %>")'
+Rscript -e 'batchtools::doJobCollection("<%= uri %>")'

tests/testthat/test-dependencies.R

@@ -44,14 +44,15 @@ test_with_dir(
 
 test_with_dir("tracked() works", {
   config <- dbug()
-  x <- sort(tracked(plan = config$plan, envir = config$envir))
+  x <- sort(
+    tracked(plan = config$plan, envir = config$envir, verbose = FALSE))
   y <- sort(c("'intermediatefile.rds'",
     "yourinput", "nextone",
     "combined", "myinput", "final", "j", "i", "h", "g", "f",
     "c", "b", "a", "saveRDS", "'input.rds'", "readRDS"))
   expect_equal(x, y)
   x <- sort(tracked(plan = config$plan, targets = "myinput",
-    envir = config$envir))
+    envir = config$envir, verbose = FALSE))
   y <- sort(c("myinput", "'input.rds'", "readRDS"))
   expect_equal(x, y)
 })

tests/testthat/test-edge-cases.R

@@ -59,7 +59,7 @@ test_with_dir("different graphical arrangements for distributed parallelism", {
   expect_equal(2, max_useful_jobs(x, envir = e, config = con,
     parallelism = "future_lapply", jobs = 1))
   y <- workplan(a = 1, b = 2)
-  tmp <- dataframes_graph(y, parallelism = "Makefile")
+  tmp <- dataframes_graph(y, parallelism = "Makefile", verbose = FALSE)
   expect_true(is.list(tmp))
 })
 

tests/testthat/test-import-file.R

@@ -3,8 +3,12 @@ drake_context("import file")
 test_with_dir("responses to imported file", {
   config <- dbug()
   expect_output(check(plan = config$plan, envir = config$envir))
-  expect_warning(check(plan = config$plan[-1, ], envir = config$envir))
-  expect_silent(check(plan = config$plan[c(-1, -6), ], envir = config$envir))
+  expect_warning(
+    check(plan = config$plan[-1, ], envir = config$envir,
+          verbose = FALSE))
+  expect_silent(
+    check(plan = config$plan[c(-1, -6), ], envir = config$envir,
+          verbose = FALSE))
   testrun(config)
   expect_true(length(justbuilt(config)) > 0)
   testrun(config)

tests/testthat/test-other-features.R

@@ -95,7 +95,7 @@ test_with_dir(".onLoad() warns correctly and .onAttach() works", {
 
 test_with_dir("graph functions work", {
   config <- dbug()
-  expect_equal(class(build_graph(config$plan)), "igraph")
+  expect_equal(class(build_graph(config$plan, verbose = FALSE)), "igraph")
   pdf(NULL)
   tmp <- plot_graph(plan = config$plan, envir = config$envir,
     verbose = FALSE)
@@ -131,9 +131,9 @@ test_with_dir("targets can be partially specified", {
   testrun(config)
   expect_true(is.numeric(readd(final, search = FALSE)))
   pl <- workplan(x = 1, y = 2)
-  expect_error(check(pl, "lskjdf"))
-  expect_warning(check(pl, c("lskdjf", "x")))
-  expect_silent(check(pl))
+  expect_error(check(pl, "lskjdf", verbose = FALSE))
+  expect_warning(check(pl, c("lskdjf", "x"), verbose = FALSE))
+  expect_silent(check(pl, verbose = FALSE))
 })
 
 test_with_dir("misc stuff", {

tests/testthat/test-workplan.R

@@ -58,8 +58,7 @@ test_with_dir("plan set 4", {
     target = eply::quotes(letters[1:4], single = TRUE),
     command = c("c", "'c'", "d", "readRDS('e')"), stringsAsFactors = F)
   expect_equal(x, y)
-  expect_warning(check(x))
-
+  expect_warning(check(x, verbose = FALSE))
 })
 
 test_with_dir("workplan() trims outer whitespace in target names", {
@@ -84,25 +83,25 @@ test_with_dir("make() and check() trim outer whitespace in target names", {
     "nobody_home")))
 
   x <- data.frame(target = c("a", " a"), command = 1)
-  expect_error(check(x))
+  expect_error(check(x, verbose = FALSE))
 })
 
 test_with_dir("make() plays nicely with tibbles", {
   if (!("tibble" %in% rownames(installed.packages()))){
     skip("Package tibble not installed.")
   }
   x <- tibble::tribble(~target, ~command, "nothing", 1)
-  expect_silent(check(x))
+  expect_silent(check(x, verbose = FALSE))
   expect_silent(make(x, verbose = FALSE))
 })
 
 test_with_dir("check() finds bad symbols", {
   x <- data.frame(
     target = c("gotcha", "b", "\"targs\"", "a'x'", "b'x'"),
     command = 1)
-  expect_warning(o <- check(x))
+  expect_warning(o <- check(x, verbose = FALSE))
   x <- data.frame(
     target = c("gotcha", "b", "\"targs\""),
     command = 1)
-  expect_silent(o <- check(x))
+  expect_silent(o <- check(x, verbose = FALSE))
 })