R/drake_ggraph.R

In drake: A Pipeline Toolkit for Reproducible Computation at Scale

#' @title Visualize the workflow with `ggraph`/`ggplot2`
#' `r lifecycle::badge("stable")`
#' @description This function requires packages `ggplot2` and `ggraph`.
#'   Install them with `install.packages(c("ggplot2", "ggraph"))`.
#' @export
#' @seealso [vis_drake_graph()], [sankey_drake_graph()],
#'   [render_drake_ggraph()], [text_drake_graph()]
#' @return A `ggplot2` object, which you can modify with more layers,
#'   show with `plot()`, or save as a file with `ggsave()`.
#' @inheritParams drake_graph_info
#' @inheritParams render_drake_ggraph
#' @param ... Arguments to [make()], such as `plan` and `targets`.
#' @examples
#' \dontrun{
#' isolate_example("Quarantine side effects.", {
#' load_mtcars_example() # Get the code with drake_example("mtcars").
#' # Plot the network graph representation of the workflow.
#' if (requireNamespace("ggraph", quietly = TRUE)) {
#'   drake_ggraph(my_plan) # Save to a file with `ggplot2::ggsave()`.
#' }
#' })
#' }
drake_ggraph <- function(
  ...,
  build_times = "build",
  digits = 3,
  targets_only = FALSE,
  main = NULL,
  from = NULL,
  mode = c("out", "in", "all"),
  order = NULL,
  subset = NULL,
  make_imports = TRUE,
  from_scratch = FALSE,
  full_legend = FALSE,
  group = NULL,
  clusters = NULL,
  show_output_files = TRUE,
  label_nodes = FALSE,
  transparency = TRUE,
  config = NULL
) {
}

#' @title Internal function with a drake_config() argument
#' @export
#' @keywords internal
#' @description Not a user-side function.
#' @inheritParams outdated
#' @param config A [drake_config()] object.
drake_ggraph_impl <- function(
  config,
  build_times = "build",
  digits = 3,
  targets_only = FALSE,
  main = NULL,
  from = NULL,
  mode = c("out", "in", "all"),
  order = NULL,
  subset = NULL,
  make_imports = TRUE,
  from_scratch = FALSE,
  full_legend = FALSE,
  group = NULL,
  clusters = NULL,
  show_output_files = TRUE,
  label_nodes = FALSE,
  transparency = TRUE
) {
  assert_pkg("ggplot2")
  assert_pkg("ggraph")
  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,
    full_legend = full_legend,
    group = group,
    clusters = clusters,
    show_output_files = show_output_files
  )
  if (is.null(main)) {
    main <- graph_info$default_title
  }
  render_drake_ggraph(
    graph_info,
    main = main,
    label_nodes = label_nodes,
    transparency = transparency
  )
}

body(drake_ggraph) <- config_util_body(drake_ggraph_impl)

#' @title Visualize the workflow with `ggplot2`/`ggraph` using
#'   [drake_graph_info()] output.
#' `r lifecycle::badge("stable")`
#' @description This function requires packages `ggplot2` and `ggraph`.
#'   Install them with `install.packages(c("ggplot2", "ggraph"))`.
#' @export
#' @seealso [vis_drake_graph()], [sankey_drake_graph()], [drake_ggraph()]
#' @return A `ggplot2` object, which you can modify with more layers,
#'   show with `plot()`, or save as a file with `ggsave()`.
#' @param graph_info List of data frames generated by
#'   [drake_graph_info()].
#'   There should be 3 data frames: `nodes`, `edges`,
#'   and `legend_nodes`.
#' @param main Character string, title of the graph.
#' @param label_nodes Logical, whether to label the nodes.
#'   If `FALSE`, the graph will not have any text next to the nodes,
#'   which is recommended for large graphs with lots of targets.
#' @param transparency Logical, whether to allow transparency in
#'   the rendered graph. Set to `FALSE` if you get warnings
#'   like "semi-transparency is not supported on this device".
#' @examples
#' \dontrun{
#' isolate_example("Quarantine side effects.", {
#' load_mtcars_example() # Get the code with drake_example("mtcars").
#' if (requireNamespace("ggraph", quietly = TRUE)) {
#'   # Instead of jumpting right to vis_drake_graph(), get the data frames
#'   # of nodes, edges, and legend nodes.
#'   drake_ggraph(my_plan) # Jump straight to the static graph.
#'   # Get the node and edge info that vis_drake_graph() just plotted:
#'   graph <- drake_graph_info(my_plan)
#'   render_drake_ggraph(graph)
#' }
#' })
#' }
render_drake_ggraph <- function(
  graph_info,
  main = graph_info$default_title,
  label_nodes = FALSE,
  transparency = TRUE
) {
  assert_pkg("ggplot2")
  assert_pkg("ggraph")
  graph <- igraph::graph_from_data_frame(
    d = graph_info$edges %||%
      data.frame(from = character(0), to = character(0)),
    directed = TRUE,
    vertices = graph_info$nodes
  )
  colors <- graph_info$nodes$color
  names(colors) <- graph_info$nodes$status
  shapes <- graph_info$nodes$shape
  names(shapes) <- graph_info$nodes$type
  shapes <- gsub("dot", "circle", shapes)
  shapes <- gsub("star", "asterisk", shapes)
  # We do want to modify the coordinates to force a hierarchical layout,
  # so the warnings are spurious.
  layout <- suppressWarnings(ggraph::create_layout(graph, layout = "sugiyama"))
  layout$x <- graph_info$nodes$x
  layout$y <- graph_info$nodes$y
  layout$label <- paste0("\n\n", layout$label)
  status <- type <- label <- node1.name <- node2.name <- NULL
  alpha <- ifelse(transparency, 0.5, 1L)
  out <- ggraph::ggraph(layout)
  if (nrow(graph_info$edges)) {
    out <- out + ggraph::geom_edge_link(
      arrow = ggplot2::arrow(length = ggplot2::unit(2, "mm")),
      alpha = alpha,
      color = "gray"
    )
  }
  out <- out +
    ggraph::geom_node_point(
      ggplot2::aes(color = status, shape = type),
      size = 5,
      alpha = alpha
    ) +
    ggplot2::xlim(padded_scale(layout$x)) +
    ggplot2::ylim(padded_scale(layout$y)) +
    ggplot2::scale_color_manual(values = colors) +
    ggplot2::scale_shape_manual(values = shapes) +
    ggplot2::ggtitle(main) +
    ggplot2::labs(x = "", y = "") +
    ggplot2::theme_bw() +
    ggplot2::theme(
      panel.grid.major = ggplot2::element_blank(),
      panel.grid.minor = ggplot2::element_blank(),
      axis.text = ggplot2::element_blank(),
      axis.ticks = ggplot2::element_blank(),
      panel.border = ggplot2::element_blank()
    )
  if (label_nodes) {
    out <- out + ggraph::geom_node_text(ggplot2::aes(label = label))
  }
  out
}

padded_scale <- function(x) {
  r <- range(x)
  pad <- 0.2 * (r[2] - r[1])
  c(r[1] - pad, r[2] + pad)
}