R/sankey_drake_graph.R

In drake: A Pipeline Toolkit for Reproducible Computation at Scale

#' @title Show a Sankey graph of your drake project.
#' `r lifecycle::badge("stable")`
#' @description To save time for repeated plotting,
#' this function is divided into
#' [drake_graph_info()] and [render_sankey_drake_graph()].
#' A legend is unfortunately unavailable
#' for the graph itself, but you can see what all the colors mean with
#' `visNetwork::visNetwork(drake::legend_nodes())`.
#' @export
#' @seealso [render_sankey_drake_graph()], [vis_drake_graph()],
#'   [drake_ggraph()], [text_drake_graph()]
#' @return A `visNetwork` graph.
#' @inheritParams drake_graph_info
#' @inheritParams render_sankey_drake_graph
#' @param ... Arguments to [make()], such as `plan` and `targets`.
#' @examples
#' \dontrun{
#' isolate_example("Quarantine side effects.", {
#' if (suppressWarnings(require("knitr"))) {
#' load_mtcars_example() # Get the code with drake_example("mtcars").
#' if (requireNamespace("networkD3", quietly = TRUE)) {
#' if (requireNamespace("visNetwork", quietly = TRUE)) {
#' # Plot the network graph representation of the workflow.
#' sankey_drake_graph(my_plan)
#' # Show the legend separately.
#' visNetwork::visNetwork(nodes = drake::legend_nodes())
#' make(my_plan) # Run the project, build the targets.
#' sankey_drake_graph(my_plan) # The black nodes from before are now green.
#' # Plot a subgraph of the workflow.
#' sankey_drake_graph(my_plan, from = c("small", "reg2"))
#' }
#' }
#' }
#' })
#' }
sankey_drake_graph <- function(
  ...,
  file = character(0),
  selfcontained = FALSE,
  build_times = "build",
  digits = 3,
  targets_only = FALSE,
  from = NULL,
  mode = c("out", "in", "all"),
  order = NULL,
  subset = NULL,
  make_imports = TRUE,
  from_scratch = FALSE,
  group = NULL,
  clusters = NULL,
  show_output_files = TRUE,
  config = NULL
) {
}

#' @title Internal function with a drake_config() argument
#' @export
#' @keywords internal
#' @description Not a user-side function.
#' @param config A [drake_config()] object.
sankey_drake_graph_impl <- function(
  config,
  file = character(0),
  selfcontained = FALSE,
  build_times = "build",
  digits = 3,
  targets_only = FALSE,
  from = NULL,
  mode = c("out", "in", "all"),
  order = NULL,
  subset = NULL,
  make_imports = TRUE,
  from_scratch = FALSE,
  group = NULL,
  clusters = NULL,
  show_output_files = TRUE
) {
  assert_pkg("networkD3")
  graph_info <- drake_graph_info_impl(
    config = config,
    from = from,
    mode = mode,
    order = order,
    subset = subset,
    build_times = build_times,
    digits = digits,
    targets_only = targets_only,
    make_imports = make_imports,
    from_scratch = from_scratch,
    group = group,
    clusters = clusters,
    show_output_files = show_output_files
  )
  render_sankey_drake_graph(
    graph_info,
    file = file,
    selfcontained = selfcontained
  )
}

body(sankey_drake_graph) <- config_util_body(sankey_drake_graph_impl)

#' @title Render a Sankey diagram from [drake_graph_info()].
#' `r lifecycle::badge("stable")`
#' @description This function is called inside
#' [sankey_drake_graph()], which typical users
#' call more often. A legend is unfortunately unavailable
#' for the graph itself, but you can see what all the colors mean with
#' `visNetwork::visNetwork(drake::legend_nodes())`.
#' @export
#' @seealso [sankey_drake_graph()], [vis_drake_graph()],
#'   [drake_ggraph()]
#' @return A `visNetwork` graph.
#'
#' @param graph_info List of data frames generated by
#'   [drake_graph_info()].
#'   There should be 3 data frames: `nodes`, `edges`,
#'   and `legend_nodes`.
#'
#' @param file Name of a file to save the graph.
#'   If `NULL` or `character(0)`, no file is saved and
#'   the graph is rendered and displayed within R.
#'   If the file ends in a `.png`, `.jpg`, `.jpeg`, or `.pdf` extension,
#'   then a static image will be saved. In this case,
#'   the webshot package and PhantomJS are required:
#'   `install.packages("webshot"); webshot::install_phantomjs()`.
#'   If the file does not end in a `.png`, `.jpg`, `.jpeg`, or `.pdf`
#'   extension, an HTML file will be saved, and you can open the
#'   interactive graph using a web browser.
#'
#' @param selfcontained Logical, whether
#'   to save the `file` as a self-contained
#'   HTML file (with external resources base64 encoded) or a file with
#'   external resources placed in an adjacent directory. If `TRUE`,
#'   pandoc is required.
#'
#' @param ... Arguments passed to `networkD3::sankeyNetwork()`.
#'
#' @examples
#' \dontrun{
#' isolate_example("Quarantine side effects.", {
#' load_mtcars_example() # Get the code with drake_example("mtcars").
#' if (suppressWarnings(require("knitr"))) {
#' if (requireNamespace("networkD3", quietly = TRUE)) {
#' if (requireNamespace("visNetwork", quietly = TRUE)) {
#' # Instead of jumpting right to sankey_drake_graph(), get the data frames
#' # of nodes, edges, and legend nodes.
#' sankey_drake_graph(my_plan) # Jump straight to the interactive graph.
#' # Show the legend separately.
#' visNetwork::visNetwork(nodes = drake::legend_nodes())
#' # Get the node and edge info that sankey_drake_graph() just plotted:
#' graph <- drake_graph_info(my_plan)
#' # You can pass the data frames right to render_sankey_drake_graph()
#' # (as in sankey_drake_graph()) or you can create
#' # your own custom visNewtork graph.
#' render_sankey_drake_graph(graph)
#' }
#' }
#' }
#' })
#' }
render_sankey_drake_graph <- function(
  graph_info,
  file = character(0),
  selfcontained = FALSE,
  ...
) {
  assert_pkg("networkD3")
  nodes <- as.data.frame(graph_info$nodes)
  # Not the best solution for line breaks in labels.
  # There may be reasons for line breaks other than build times.
  # May revisit.
  timed <- grepl("\n", nodes$label)
  nodes$label <- gsub("\n", " (", nodes$label)
  nodes$label[timed] <- paste0(nodes$label[timed], ")")
  nodes$status <- gsub(pattern = " ", replacement = "_", x = nodes$status)
  edges <- as.data.frame(graph_info$edges)
  edges$src <- as.integer(match(edges$from, table = nodes$id) - 1)
  edges$target <- as.integer(match(edges$to, table = nodes$id) - 1)
  edges$value <- rep(1, nrow(edges))
  colordf <- nodes[, c("status", "color")]
  colordf <- colordf[!duplicated(colordf), ]
  domain <- paste(paste0("'", colordf$status, "'"), collapse = ", ")
  range <- paste(paste0("'", colordf$color, "'"), collapse = ", ")
  color <- paste0(
    "d3.scaleOrdinal() .domain([", domain, "]) .range([", range, "])"
  )
  sankey <- networkD3::sankeyNetwork(
    Links = edges,
    Nodes = nodes,
    NodeID = "label",
    Source = "src",
    Target = "target",
    NodeGroup = "status",
    Value = "value",
    colourScale = color,
    ... = ...
  )
  sankey_render_webshot(
    file = file,
    graph = sankey,
    selfcontained = selfcontained
  )
}

sankey_render_webshot <- function(file, graph, selfcontained) {
  if (!length(file)) {
    return(graph)
  }
  file <- path.expand(file)
  if (is_image_filename(file)) {
    assert_pkg("webshot")
    dir <- tempfile()
    dir.create(dir)
    url <- file.path(dir, "tmp.html")
    networkD3::saveNetwork(
      network = graph,
      file = url,
      selfcontained = FALSE
    )
    webshot::webshot(url = url, file = file)
  } else {
    networkD3::saveNetwork(
      network = graph,
      file = file,
      selfcontained = selfcontained
    )
  }
  invisible()
}