R/vis_drake_graph.R

In wlandau-lilly/drake: A Pipeline Toolkit for Reproducible Computation at Scale

#' @title Show an interactive visual network representation
#'   of your drake project.
#' `r lifecycle::badge("stable")`
#' @description It is good practice to visualize the dependency graph
#'   before running the targets.
#' @details For enhanced interactivity in the graph, see the `mandrake`
#'   package.
#' @export
#' @seealso [render_drake_graph()], [sankey_drake_graph()],
#'   [drake_ggraph()], [text_drake_graph()]
#' @return A `visNetwork` graph.
#' @inheritParams drake_graph_info
#' @inheritParams render_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").
#' # Plot the network graph representation of the workflow.
#' if (requireNamespace("visNetwork", quietly = TRUE)) {
#' vis_drake_graph(my_plan)
#' make(my_plan) # Run the project, build the targets.
#' vis_drake_graph(my_plan) # The red nodes from before are now green.
#' # Plot a subgraph of the workflow.
#' vis_drake_graph(
#'   my_plan,
#'   from = c("small", "reg2")
#' )
#' }
#' }
#' })
#' }
vis_drake_graph <- function(
  ...,
  file = character(0),
  selfcontained = FALSE,
  build_times = "build",
  digits = 3,
  targets_only = FALSE,
  font_size = 20,
  layout = NULL,
  main = NULL,
  direction = NULL,
  hover = FALSE,
  navigationButtons = TRUE, # nolint
  from = NULL,
  mode = c("out", "in", "all"),
  order = NULL,
  subset = NULL,
  ncol_legend = 1,
  full_legend = FALSE,
  make_imports = TRUE,
  from_scratch = FALSE,
  group = NULL,
  clusters = NULL,
  show_output_files = TRUE,
  collapse = TRUE,
  on_select_col = NULL,
  on_select = NULL,
  level_separation = NULL,
  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.
vis_drake_graph_impl <- function(
  config,
  file = character(0),
  selfcontained = FALSE,
  build_times = "build",
  digits = 3,
  targets_only = FALSE,
  font_size = 20,
  layout = NULL,
  main = NULL,
  direction = NULL,
  hover = FALSE,
  navigationButtons = TRUE, # nolint
  from = NULL, mode = c("out", "in", "all"),
  order = NULL,
  subset = NULL,
  ncol_legend = 1,
  full_legend = FALSE,
  make_imports = TRUE,
  from_scratch = FALSE,
  group = NULL,
  clusters = NULL,
  show_output_files = TRUE,
  collapse = TRUE,
  on_select_col = NULL,
  on_select = NULL,
  level_separation = NULL
) {
  assert_pkg("visNetwork")
  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,
    font_size = font_size,
    make_imports = make_imports,
    from_scratch = from_scratch,
    full_legend = full_legend,
    group = group,
    clusters = clusters,
    show_output_files = show_output_files,
    hover = hover,
    on_select_col = on_select_col
  )
  if (is.null(main)) {
    main <- graph_info$default_title
  }
  render_drake_graph(
    graph_info,
    file = file,
    selfcontained = selfcontained,
    layout = layout,
    direction = direction,
    navigationButtons = navigationButtons, # nolint
    hover = hover,
    main = main,
    ncol_legend = ncol_legend,
    full_legend = full_legend,
    collapse = collapse,
    on_select = on_select,
    level_separation = level_separation
  )
}

body(vis_drake_graph) <- config_util_body(vis_drake_graph_impl)

#' @title Render a visualization using the data frames
#'   generated by [drake_graph_info()].
#' `r lifecycle::badge("stable")`
#' @description This function is called inside
#' [vis_drake_graph()], which typical users
#' call more often.
#' @details For enhanced interactivity in the graph, see the `mandrake`
#'   package.
#' @export
#' @seealso [vis_drake_graph()], [sankey_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 layout Deprecated.
#'
#' @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. The `selfcontained` argument only applies
#'   to HTML files. In other words, if `file` is a
#'   PNG, PDF, or JPEG file, for instance,
#'   the point is moot.
#'
#' @param direction Deprecated.
#'
#' @param navigationButtons Logical, whether to add navigation buttons with
#'   `visNetwork::visInteraction(navigationButtons = TRUE)`
#'
#' @param hover Logical, whether to show the command that generated the target
#'   when you hover over a node with the mouse. For imports, the label does not
#'   change with hovering.
#'
#' @param main Character string, title of the graph.
#'
#' @param ncol_legend Number of columns in the legend nodes.
#'   To remove the legend entirely, set `ncol_legend` to `NULL` or `0`.
#'
#' @param collapse Logical, whether to allow nodes to collapse
#'   if you double click on them.
#'   Analogous to `visNetwork::visOptions(collapse = TRUE)`.
#'
#' @param on_select defines node selection event handling.
#'   Either a string of valid JavaScript that may be passed to
#'   `visNetwork::visEvents()`, or one of the following:
#'   `TRUE`, `NULL`/`FALSE`. If `TRUE` , enables the default behavior of
#'   opening the link specified by the `on_select_col` given to
#'   `drake_graph_info()`. `NULL`/`FALSE` disables the behavior.
#'
#' @param level_separation Numeric, `levelSeparation` argument to
#'   `visNetwork::visHierarchicalLayout()`. Controls the distance
#'   between hierarchical levels. Consider setting if the
#'   aspect ratio of the graph is far from 1.
#'   Defaults to 150 through `visNetwork`.
#'
#' @param ... Arguments passed to `visNetwork()`.
#'
#' @examples
#' \dontrun{
#' isolate_example("Quarantine side effects.", {
#' if (suppressWarnings(require("knitr"))) {
#' load_mtcars_example() # Get the code with drake_example("mtcars").
#' if (requireNamespace("visNetwork", quietly = TRUE)) {
#' # Instead of jumping right to vis_drake_graph(), get the data frames
#' # of nodes, edges, and legend nodes.
#' vis_drake_graph(my_plan) # Jump straight to the interactive graph.
#' # Get the node and edge info that vis_drake_graph() just plotted:
#' graph <- drake_graph_info(my_plan)
#' # You can pass the data frames right to render_drake_graph()
#' # (as in vis_drake_graph()) or you can create
#' # your own custom visNewtork graph.
#' render_drake_graph(graph)
#' }
#' }
#' })
#' }
render_drake_graph <- function(
  graph_info, file = character(0),
  layout = NULL,
  direction = NULL,
  hover = TRUE,
  main = graph_info$default_title,
  selfcontained = FALSE,
  navigationButtons = TRUE, # nolint
  ncol_legend = 1,
  collapse = TRUE,
  on_select = NULL,
  level_separation = NULL,
  ...
) {
  assert_pkg("visNetwork")
  if (!hover) {
    graph_info$nodes$title <- NULL
  }
  deprecate_arg(direction, "direction") # 2019-04-16 # nolint
  deprecate_arg(layout, "layout") # 2019-04-16 # nolint
  out <- initialize_vis_network(
    graph_info = graph_info,
    collapse = collapse,
    ncol_legend = ncol_legend,
    main = main,
    navigationButtons = navigationButtons,
    ...
  )
  out <- visNetwork::visHierarchicalLayout(
    graph = out,
    direction = "LR",
    levelSeparation = level_separation
  )
  out <- vis_add_on_select(graph = out, on_select = on_select)
  out$x$nodes$x <- graph_info$nodes$x
  out$x$nodes$y <- graph_info$nodes$y
  vis_render_webshot(graph = out, file = file, selfcontained = selfcontained)
}

initialize_vis_network <- function(
  graph_info,
  collapse,
  ncol_legend,
  main,
  navigationButtons,
  ...
) {
  out <- visNetwork::visNetwork(
    nodes = graph_info$nodes,
    edges = graph_info$edges,
    main = main,
    ...
  )
  out <- visNetwork::visNodes(out, physics = FALSE)
  out <- visNetwork::visEdges(
    out,
    smooth = list(type = "cubicBezier", forceDirection = "horizontal")
  )
  if (collapse) {
    out <- visNetwork::visOptions(out, collapse = TRUE)
  }
  if (length(ncol_legend) && ncol_legend > 0) {
    out <- visNetwork::visLegend(
      graph = out,
      useGroups = FALSE,
      addNodes = graph_info$legend_nodes,
      ncol = ncol_legend
    )
  }
  if (navigationButtons) { # nolint
    out <- visNetwork::visInteraction(out, navigationButtons = TRUE) # nolint
  }
  out
}

vis_add_on_select <- function(graph, on_select) {
  out <- graph
  # Add on_select action
  if (is.null(on_select)) return(out)
  if (is.logical(on_select)) {
    if (!on_select) return(out)
    on_select <- on_select_default()
  }

  # Ideally showing a warning here would be nice
  # If on_select is enabled, there should have been a corresponding
  # on_select_col given
  if (is.null(graph$x$nodes$on_select_col)) return(out)

  out <- visNetwork::visEvents(out, selectNode = on_select)

  out
}

vis_render_webshot <- function(graph, file, 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")
    visNetwork::visSave(graph = graph, file = url, selfcontained = FALSE)
    webshot::webshot(url = url, file = file)
  } else {
    visNetwork::visSave(
      graph = graph,
      file = file,
      selfcontained = selfcontained
    )

  }
  return(invisible())
}

is_image_filename <- function(x) {
  tolower(file_extn(x)) %in% c("jpg", "jpeg", "pdf", "png")
}

file_extn <- function(x) {
  x <- basename(x)
  x <- strsplit(x, split = ".", fixed = TRUE)
  x <- unlist(x)
  x <- rev(x)
  x[1]
}

on_select_default <- function() {
  js <- "
  function(props) {
    window.open(
      this.body.data.nodes.get(props.nodes[0]).on_select_col,
      '_blank');
  }"
}