#' @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()
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.