#' Utility function that applies edge bundle and distance attributes to graph
#'
#' You will usually not need to call this function directly. [`greedy_search`]
#' will use it to apply the supplied edge bundle and distance attributes to the
#' graph. This function is exposed as a convenience in case you wish to access
#' those attributes on the graph.
#'
#' @inheritParams greedy_search
#'
#' @return A `pathfinder_graph` object.
#'
#' @import assertthat igraph
#' @export
decorate_graph <- function(graph, edge_bundles, distances) {
assert_that(inherits(graph, "igraph"), msg = "pathfinder currently only works with igraph objects")
assert_that(is.numeric(distances), msg = "distances must be a numeric vector")
assert_that(length(distances) == ecount(graph), msg = "distances must have the same length as there are edges in graph")
assert_that(noNA(distances), msg = "No NAs are allowed in distances")
assert_that(is.list(edge_bundles), msg = "edge_bundles must be a list of integer vectors")
lapply(edge_bundles, function(x) {
assert_that(all(x %in% seq_len(ecount(graph))),
msg = "All integers in each edge_bundles list element must match to edge indices in graph"
)
})
bundled_edges <- get_bundled_edges(edge_bundles)
edge_attr(graph, "pathfinder.edge_id") <- seq_len(ecount(graph))
edge_attr(graph, "pathfinder.distance") <- distances
edge_attr(graph, "pathfinder.required") <- FALSE
edge_attr(graph, "pathfinder.required", index = bundled_edges) <- TRUE
edge_attr(graph, "pathfinder.bundle_id") <- NA_integer_
edge_attr(graph, "pathfinder.bundle_id", index = bundled_edges) <- attr(bundled_edges, "pathfinder.bundle_ids")
vertex_attr(graph, "pathfinder.interface") <- FALSE
vertex_attr(graph, "pathfinder.interface", index = get_interface_points(graph, edge_bundles)) <- TRUE
class(graph) <- c(class(graph), "pathfinder_graph")
graph
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.