diff --git a/DESCRIPTION b/DESCRIPTION index 7162d2af..d2f20f05 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -36,7 +36,8 @@ Imports: withr, cli, vctrs, - lifecycle + lifecycle, + memoise Suggests: network, knitr, diff --git a/NAMESPACE b/NAMESPACE index f028280f..118af1a5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -46,6 +46,15 @@ export(StatEdgeArc2) export(StatEdgeBend) export(StatEdgeBend0) export(StatEdgeBend2) +export(StatEdgeBundleForce) +export(StatEdgeBundleForce0) +export(StatEdgeBundleForce2) +export(StatEdgeBundleMinimal) +export(StatEdgeBundleMinimal0) +export(StatEdgeBundleMinimal2) +export(StatEdgeBundlePath) +export(StatEdgeBundlePath0) +export(StatEdgeBundlePath2) export(StatEdgeDensity) export(StatEdgeDiagonal) export(StatEdgeDiagonal0) @@ -91,6 +100,15 @@ export(geom_edge_arc2) export(geom_edge_bend) export(geom_edge_bend0) export(geom_edge_bend2) +export(geom_edge_bundle_force) +export(geom_edge_bundle_force0) +export(geom_edge_bundle_force2) +export(geom_edge_bundle_minimal) +export(geom_edge_bundle_minimal0) +export(geom_edge_bundle_minimal2) +export(geom_edge_bundle_path) +export(geom_edge_bundle_path0) +export(geom_edge_bundle_path2) export(geom_edge_density) export(geom_edge_diagonal) export(geom_edge_diagonal0) @@ -314,6 +332,7 @@ importFrom(grid,setChildren) importFrom(grid,textGrob) importFrom(grid,unit) importFrom(igraph,"%--%") +importFrom(igraph,"V<-") importFrom(igraph,"vertex_attr<-") importFrom(igraph,E) importFrom(igraph,V) @@ -331,6 +350,7 @@ importFrom(igraph,delete_vertex_attr) importFrom(igraph,distances) importFrom(igraph,edge_attr) importFrom(igraph,ends) +importFrom(igraph,get.edge.ids) importFrom(igraph,gorder) importFrom(igraph,graph_attr) importFrom(igraph,gsize) @@ -338,6 +358,7 @@ importFrom(igraph,incident_edges) importFrom(igraph,induced_subgraph) importFrom(igraph,is.directed) importFrom(igraph,is.named) +importFrom(igraph,is_directed) importFrom(igraph,layout_as_bipartite) importFrom(igraph,layout_as_star) importFrom(igraph,layout_as_tree) @@ -355,6 +376,7 @@ importFrom(igraph,layout_with_kk) importFrom(igraph,layout_with_lgl) importFrom(igraph,layout_with_mds) importFrom(igraph,layout_with_sugiyama) +importFrom(igraph,mst) importFrom(igraph,neighbors) importFrom(igraph,permute) importFrom(igraph,shortest_paths) diff --git a/NEWS.md b/NEWS.md index 1351d80d..748073dc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -27,6 +27,9 @@ * Updated layout functions from the graphlayouts package to support grouped and constrained versions (centrality, focus, and stress layouts) * Added H Tree layout for binary trees (#58) +* Added `geom_edge_bundle_force()`, `geom_edge_bundle_path()`, and + `geom_edge_bundle_minimal()` (+ variants) to provide support for edge bundling + (#267) # ggraph 2.1.0 diff --git a/R/RcppExports.R b/R/RcppExports.R index 282688fa..d1a034ee 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -52,6 +52,10 @@ dendrogram_spread <- function(graph, starts, y, leaf, repel, pad, ratio) { .Call('_ggraph_dendrogram_spread', PACKAGE = 'ggraph', graph, starts, y, leaf, repel, pad, ratio) } +force_bundle_iter <- function(edges_xy, elist, K, C, P, P_rate, S, I, I_rate, compatibility_threshold, eps) { + .Call('_ggraph_force_bundle_iter', PACKAGE = 'ggraph', edges_xy, elist, K, C, P, P_rate, S, I, I_rate, compatibility_threshold, eps) +} + hTree <- function(parent, order) { .Call('_ggraph_hTree', PACKAGE = 'ggraph', parent, order) } diff --git a/R/geom_edge.R b/R/geom_edge.R index f0a0fac9..09837c49 100644 --- a/R/geom_edge.R +++ b/R/geom_edge.R @@ -525,7 +525,7 @@ GeomEdgeBspline <- ggproto('GeomEdgeBspline', GeomBspline0, na.rm = FALSE) { names(data) <- sub('edge_', '', names(data)) names(data)[names(data) == 'width'] <- 'linewidth' - GeomBspline0$draw_panel(data, panel_scales, coord, arrow, lineend, linejoin, linemitre, na.rm) + GeomBspline0$draw_panel(data, panel_scales, coord, arrow, type = "clamped", lineend, linejoin, linemitre, na.rm) }, draw_key = function(data, params, size) { segmentsGrob(0.1, 0.5, 0.9, 0.5, diff --git a/R/geom_edge_bundle_force.R b/R/geom_edge_bundle_force.R new file mode 100644 index 00000000..f0d703a8 --- /dev/null +++ b/R/geom_edge_bundle_force.R @@ -0,0 +1,304 @@ +#' Bundle edges using force directed edge bundling +#' +#' This geom performs force directed edge bundling to reduce visual clutter. +#' It uses a self-organizing approach to bundling in which edges are modeled as +#' flexible springs that can attract each other without the need of a hierarchy. +#' Be aware that this bundling technique works globally and thus may bundle +#' edges that is otherwise unrelated together. Care should be taken when +#' interpreting the resulting visual. An alternative approach to edge bundling +#' that uses the graph topology is provided by [geom_edge_bundle_path()]. +#' +#' @inheritSection geom_edge_link Edge variants +#' @inheritSection geom_edge_link Edge aesthetic name expansion +#' +#' @section Aesthetics: +#' `geom_edge_bundle_force` and `geom_edge_bundle_force0` understand the following +#' aesthetics. Bold aesthetics are automatically set, but can be overridden. +#' +#' - **x** +#' - **y** +#' - **xend** +#' - **yend** +#' - edge_colour +#' - edge_width +#' - edge_linetype +#' - edge_alpha +#' - filter +#' +#' `geom_edge_bundle_force2` understand the following aesthetics. Bold aesthetics are +#' automatically set, but can be overridden. +#' +#' - **x** +#' - **y** +#' - **group** +#' - edge_colour +#' - edge_width +#' - edge_linetype +#' - edge_alpha +#' - filter +#' +#' `geom_edge_bundle_force` and `geom_edge_bundle_force2` furthermore takes the following +#' aesthetics. +#' +#' - start_cap +#' - end_cap +#' - label +#' - label_pos +#' - label_size +#' - angle +#' - hjust +#' - vjust +#' - family +#' - fontface +#' - lineheight +#' +#' +#' @section Computed variables: +#' +#' \describe{ +#' \item{index}{The position along the path (not computed for the *0 version)} +#' } +#' +#' @inheritParams geom_edge_link +#' @inheritParams ggplot2::geom_path +#' +#' @param force The spring force during bundling +#' @param n_cycle number of iteration cycles +#' @param cuts_start initial number of edge divisions +#' @param step initial step size +#' @param cuts_new factor for how many new division points to add after a cycle +#' @param n_iter number of iteration steps per cycle +#' @param iter_new factor of how to decrease the number of iterations per cycle +#' @param threshold threshold for considering two edges to be interacting +#' @param eps tolerance +#' +#' @author David Schoch +#' +#' @family geom_edge_* +#' +#' @references +#' Holten, D. and Wijk, J.J.V. (2009). *Force‐Directed Edge Bundling for Graph +#' Visualization.* Computer Graphics Forum (Blackwell Publishing Ltd) 28, no. 3: +#' 983-990. https://doi.org/10.1111/j.1467-8659.2009.01450.x +#' +#' @rdname geom_edge_bundle_force +#' @name geom_edge_bundle_force +#' +#' @examples +#' # (not necessarily an insightful use) +#' ggraph(highschool) + +#' geom_edge_bundle_force(n_cycle = 2, threshold = 0.4) +#' +NULL + +#' @rdname ggraph-extensions +#' @format NULL +#' @usage NULL +#' @importFrom ggforce StatBspline +#' @export +StatEdgeBundleForce <- ggproto("StatEdgeBundleForce", Stat, + setup_data = function(data, params) { + StatEdgeBundleForce0$setup_data(data, params) + }, + compute_panel = function(data, scales, n = 100, force = 1, n_cycle = 6, + cuts_start = 1, step = 0.04, cuts_new = 2, n_iter = 50, + iter_new = 2/3, threshold = 0.6, eps = 1e-8) { + edges <- StatEdgeBundleForce0$compute_panel( + data, scales, force = force, n_cycle = n_cycle, cuts_start = cuts_start, + step = step, cuts_new = cuts_new, n_iter = n_iter, iter_new = iter_new, + threshold = threshold, eps = eps + ) + StatBspline$compute_layer(edges, list(n = n), NULL) + }, + required_aes = c("x", "y", "xend", "yend"), + default_aes = aes(filter = TRUE), + extra_params = c("na.rm") +) + +#' @rdname geom_edge_bundle_force +#' +#' @export +geom_edge_bundle_force <- function(mapping = NULL, data = get_edges(), + position = "identity", arrow = NULL, + n = 100, force = 1, n_cycle = 6, cuts_start = 1, + step = 0.04, cuts_new = 2, n_iter = 50, + iter_new = 2/3, threshold = 0.6, eps = 1e-8, + lineend = 'butt', linejoin = 'round', linemitre = 1, + label_colour = 'black', label_alpha = 1, + label_parse = FALSE, check_overlap = FALSE, + angle_calc = 'rot', force_flip = TRUE, + label_dodge = NULL, label_push = NULL, + show.legend = NA, ...) { + mapping <- complete_edge_aes(mapping) + mapping <- aes_intersect(mapping, aes( + x = x, y = y, xend = xend, yend = yend, group = edge.id + )) + layer( + data = data, mapping = mapping, stat = StatEdgeBundleForce, + geom = GeomEdgePath, position = position, + show.legend = show.legend, inherit.aes = FALSE, + params = expand_edge_aes( + list2( + arrow = arrow, lineend = lineend, linejoin = linejoin, + linemitre = linemitre, n = n, interpolate = FALSE, force = force, + n_cycle = n_cycle, cuts_start = cuts_start, step = step, + cuts_new = cuts_new, n_iter = n_iter, iter_new = iter_new, + threshold = threshold, eps = eps, label_colour = label_colour, + label_alpha = label_alpha, label_parse = label_parse, + check_overlap = check_overlap, angle_calc = angle_calc, + force_flip = force_flip, label_dodge = label_dodge, + label_push = label_push, ... + ) + ) + ) +} +#' @rdname ggraph-extensions +#' @format NULL +#' @usage NULL +#' @importFrom ggforce StatBspline +#' @export +StatEdgeBundleForce2 <- ggproto("StatEdgeBundleForce2", Stat, + setup_data = function(data, params) { + data <- StatFilter$setup_data(data, params) + remove_loop2(data) + }, + compute_panel = function(data, scales, n = 100, force = 1, n_cycle = 6, + cuts_start = 1, step = 0.04, cuts_new = 2, n_iter = 50, + iter_new = 2/3, threshold = 0.6, eps = 1e-8) { + data <- data[order(data$group), ] + edges <- cbind(data$x[c(TRUE, FALSE)], data$y[c(TRUE, FALSE)], data$x[c(FALSE, TRUE)], data$y[c(FALSE, TRUE)]) + edges <- force_bundle_mem(edges, K = force, C = n_cycle, P = cuts_start, + S = step, P_rate = cuts_new, I = n_iter, + I_rate = iter_new, compatibility_threshold = threshold, + eps = eps) + edges$PANEL <- data$PANEL[1] + edges$group <- data$group[edges$group * 2] + edges <- StatBspline$compute_layer(edges, list(n = n), NULL) + extra_data <- data[1, !names(data) %in% c("x", "y", "group", "PANEL")][rep(NA, nrow(edges)), ] + edges$.interp <- TRUE + ends <- !duplicated(edges$group) | !duplicated(edges$group, fromLast = TRUE) + edges$.interp[ends] <- FALSE + extra_data[ends, ] <- data[, names(extra_data)] + cbind(edges, extra_data) + }, + required_aes = c("x", "y"), + default_aes = aes(filter = TRUE), + extra_params = c("na.rm") +) + +#' @rdname geom_edge_bundle_force +#' +#' @export +geom_edge_bundle_force2 <- function(mapping = NULL, data = get_edges("long"), + position = "identity", arrow = NULL, + n = 100, force = 1, n_cycle = 6, cuts_start = 1, + step = 0.04, cuts_new = 2, n_iter = 50, + iter_new = 2/3, threshold = 0.6, eps = 1e-8, + lineend = 'butt', linejoin = 'round', linemitre = 1, + label_colour = 'black', label_alpha = 1, + label_parse = FALSE, check_overlap = FALSE, + angle_calc = 'rot', force_flip = TRUE, + label_dodge = NULL, label_push = NULL, + show.legend = NA, ...) { + mapping <- complete_edge_aes(mapping) + mapping <- aes_intersect(mapping, aes( + x = x, y = y, group = edge.id + )) + layer( + data = data, mapping = mapping, stat = StatEdgeBundleForce2, + geom = GeomEdgePath, position = position, + show.legend = show.legend, inherit.aes = FALSE, + params = expand_edge_aes( + list2( + arrow = arrow, lineend = lineend, linejoin = linejoin, + linemitre = linemitre, n = n, interpolate = TRUE, force = force, + n_cycle = n_cycle, cuts_start = cuts_start, step = step, + cuts_new = cuts_new, n_iter = n_iter, iter_new = iter_new, + threshold = threshold, eps = eps, label_colour = label_colour, + label_alpha = label_alpha, label_parse = label_parse, + check_overlap = check_overlap, angle_calc = angle_calc, + force_flip = force_flip, label_dodge = label_dodge, + label_push = label_push, ... + ) + ) + ) +} +#' @rdname ggraph-extensions +#' @format NULL +#' @usage NULL +#' @export +StatEdgeBundleForce0 <- ggproto('StatEdgeBundleForce0', Stat, + setup_data = function(data, params) { + data <- StatFilter$setup_data(data, params) + remove_loop(data) + }, + compute_panel = function(data, scales, force = 1, n_cycle = 6, + cuts_start = 1, step = 0.04, cuts_new = 2, n_iter = 50, + iter_new = 2/3, threshold = 0.6, eps = 1e-8) { + edges <- cbind(data$x, data$y, data$xend, data$yend) + edges <- force_bundle_mem(edges, K = force, C = n_cycle, P = cuts_start, + S = step, P_rate = cuts_new, I = n_iter, + I_rate = iter_new, compatibility_threshold = threshold, + eps = eps) + edges$PANEL <- data$PANEL[1] + edges$group <- data$group[edges$group] + cbind(edges, data[edges$group, !names(data) %in% c("x", "y", "xend", "yend", "PANEL", "group")]) + }, + required_aes = c('x', 'y', 'xend', 'yend'), + default_aes = aes(filter = TRUE), + extra_params = c('na.rm') +) +#' @rdname geom_edge_bundle_force +#' +#' @export +geom_edge_bundle_force0 <- function(mapping = NULL, data = get_edges(), + position = "identity", arrow = NULL, + force = 1, n_cycle = 6, cuts_start = 1, + step = 0.04, cuts_new = 2, n_iter = 50, + iter_new = 2/3, threshold = 0.6, eps = 1e-8, + lineend = 'butt', show.legend = NA, ...) { + mapping <- complete_edge_aes(mapping) + mapping <- aes_intersect(mapping, aes( + x = x, y = y, xend = xend, yend = yend, group = edge.id + )) + layer( + data = data, mapping = mapping, stat = StatEdgeBundleForce0, + geom = GeomEdgeBspline, position = position, + show.legend = show.legend, inherit.aes = FALSE, + params = expand_edge_aes( + list2( + arrow = arrow, lineend = lineend, force = force, + n_cycle = n_cycle, cuts_start = cuts_start, step = step, + cuts_new = cuts_new, n_iter = n_iter, iter_new = iter_new, + threshold = threshold, eps = eps, ... + ) + ) + ) +} + +force_bundle <- function(data, K, C, P, S, P_rate, I, I_rate, compatibility_threshold, eps) { + + # initialize matrix with coordinates + m <- nrow(data) + elist <- lapply(seq_len(m), function(i) { + matrix(as.vector(data[i, ]), ncol = 2, byrow = TRUE) + }) + + # main force bundling routine + elist <- force_bundle_iter( + data, elist, K, C, P, P_rate, + S, I, I_rate, compatibility_threshold, eps + ) + + # assemble data frame + segments <- nrow(elist[[1]]) + elist <- inject(rbind(!!!elist)) + + data_frame0( + x = elist[, 1], + y = elist[, 2], + group = rep(seq_len(m), each = segments) + ) +} + +force_bundle_mem <- memoise::memoise(force_bundle) diff --git a/R/geom_edge_bundle_minimal.R b/R/geom_edge_bundle_minimal.R new file mode 100644 index 00000000..fb4694ec --- /dev/null +++ b/R/geom_edge_bundle_minimal.R @@ -0,0 +1,277 @@ +#' Bundle edges along the minimal spanning tree +#' +#' This geom performs edge bundling by letting edges follow the shortest path +#' along the minimal spanning tree of the graph. Due to it's simplicity it is +#' very fast but does enforce a tree-like appearance to the bundling. Adjusting +#' the `max_distortion` and `tension` parameters may alleviate this to some +#' extend. +#' +#' @inheritSection geom_edge_link Edge variants +#' @inheritSection geom_edge_link Edge aesthetic name expansion +#' +#' @section Aesthetics: +#' `geom_edge_force_minimal` and `geom_edge_force_minimal0` understand the following +#' aesthetics. Bold aesthetics are automatically set, but can be overridden. +#' +#' - **x** +#' - **y** +#' - **xend** +#' - **yend** +#' - **edge_id** (should not be overwritten) +#' - edge_colour +#' - edge_width +#' - edge_linetype +#' - edge_alpha +#' - filter +#' +#' `geom_edge_force_minimal2` understand the following aesthetics. Bold aesthetics are +#' automatically set, but can be overridden. +#' +#' - **x** +#' - **y** +#' - **group** +#' - **edge_id** (should not be overwritten) +#' - edge_colour +#' - edge_width +#' - edge_linetype +#' - edge_alpha +#' - filter +#' +#' `geom_edge_force_minimal` and `geom_edge_force_minimal2` furthermore takes the following +#' aesthetics. +#' +#' - start_cap +#' - end_cap +#' - label +#' - label_pos +#' - label_size +#' - angle +#' - hjust +#' - vjust +#' - family +#' - fontface +#' - lineheight +#' +#' +#' @section Computed variables: +#' +#' \describe{ +#' \item{index}{The position along the path (not computed for the *0 version)} +#' } +#' +#' @inheritParams geom_edge_link +#' @inheritParams ggplot2::geom_path +#' @inheritParams geom_edge_bundle_path +#' +#' @author Thomas Lin Pedersen +#' +#' @family geom_edge_* +#' +#' @rdname geom_edge_bundle_minimal +#' @name geom_edge_bundle_minimal +#' +#' @examples +#' ggraph(highschool) + +#' geom_edge_bundle_minimal() +#' +#' # Allow more edges to bundle +#' ggraph(highschool) + +#' geom_edge_bundle_minimal(max_distortion = 5, tension = 0.9) +#' +NULL + +#' @rdname ggraph-extensions +#' @format NULL +#' @usage NULL +#' @importFrom ggforce StatBspline +#' @export +StatEdgeBundleMinimal <- ggproto("StatEdgeBundleMinimal", Stat, + setup_data = function(data, params) { + StatEdgeBundleMinimal0$setup_data(data, params) + }, + compute_panel = function(data, scales, n = 100, max_distortion = 2, + weight_fac = 2, tension = 1) { + edges <- StatEdgeBundleMinimal0$compute_panel( + data, scales, max_distortion = max_distortion, weight_fac = weight_fac, + tension = tension + ) + StatBspline$compute_layer(edges, list(n = n), NULL) + }, + required_aes = c('x', 'y', 'xend', 'yend', 'edge_id'), + default_aes = aes(filter = TRUE), + extra_params = c("na.rm") +) + +#' @rdname geom_edge_bundle_minimal +#' +#' @export +geom_edge_bundle_minimal <- function(mapping = NULL, data = get_edges(), + position = "identity", arrow = NULL, + n = 100, max_distortion = 2, weight_fac = 2, + tension = 1, lineend = 'butt', + linejoin = 'round', linemitre = 1, + label_colour = 'black', label_alpha = 1, + label_parse = FALSE, check_overlap = FALSE, + angle_calc = 'rot', force_flip = TRUE, + label_dodge = NULL, label_push = NULL, + show.legend = NA, ...) { + mapping <- complete_edge_aes(mapping) + mapping <- aes_intersect(mapping, aes( + x = x, y = y, xend = xend, yend = yend, group = edge.id, edge_id = edge.id + )) + layer( + data = data, mapping = mapping, stat = StatEdgeBundleMinimal, + geom = GeomEdgePath, position = position, + show.legend = show.legend, inherit.aes = FALSE, + params = expand_edge_aes( + list2( + arrow = arrow, lineend = lineend, linejoin = linejoin, + linemitre = linemitre, n = n, interpolate = FALSE, + max_distortion = max_distortion, weight_fac = weight_fac, + tension = tension, label_colour = label_colour, + label_alpha = label_alpha, label_parse = label_parse, + check_overlap = check_overlap, angle_calc = angle_calc, + force_flip = force_flip, label_dodge = label_dodge, + label_push = label_push, ... + ) + ) + ) +} +#' @rdname ggraph-extensions +#' @format NULL +#' @usage NULL +#' @importFrom ggforce StatBspline +#' @export +StatEdgeBundleMinimal2 <- ggproto("StatEdgeBundleMinimal2", Stat, + setup_data = function(data, params) { + data <- StatFilter$setup_data(data, params) + remove_loop2(data) + }, + compute_panel = function(data, scales, n = 100, max_distortion = 2, + weight_fac = 2, tension = 1) { + graph <- .G() + nodes <- data_frame0(x = .N()$.ggraph_layout_x, y = .N()$.ggraph_layout_y) + data <- data[order(data$group), ] + edge_id <- data$edge_id[c(TRUE, FALSE)] + edges <- minimal_bundle_mem(graph, nodes, .E()$from[edge_id], .E()$to[edge_id], + max_distortion = max_distortion, weight_fac = weight_fac) + if (tension < 1) edges <- relax(edges, tension) + edges$PANEL <- data$PANEL[1] + edges$group <- data$group[edges$group * 2] + edges <- StatBspline$compute_layer(edges, list(n = n), NULL) + extra_data <- data[1, !names(data) %in% c("x", "y", "group", "PANEL")][rep(NA, nrow(edges)), ] + edges$.interp <- TRUE + ends <- !duplicated(edges$group) | !duplicated(edges$group, fromLast = TRUE) + edges$.interp[ends] <- FALSE + extra_data[ends, ] <- data[, names(extra_data)] + cbind(edges, extra_data) + }, + required_aes = c("x", "y", "edge_id"), + default_aes = aes(filter = TRUE), + extra_params = c("na.rm") +) + +#' @rdname geom_edge_bundle_minimal +#' +#' @export +geom_edge_bundle_minimal2 <- function(mapping = NULL, data = get_edges("long"), + position = "identity", arrow = NULL, + n = 100, max_distortion = 2, weight_fac = 2, + tension = 1, lineend = 'butt', + linejoin = 'round', linemitre = 1, + label_colour = 'black', label_alpha = 1, + label_parse = FALSE, check_overlap = FALSE, + angle_calc = 'rot', force_flip = TRUE, + label_dodge = NULL, label_push = NULL, + show.legend = NA, ...) { + mapping <- complete_edge_aes(mapping) + mapping <- aes_intersect(mapping, aes( + x = x, y = y, group = edge.id, edge_id = edge.id + )) + layer( + data = data, mapping = mapping, stat = StatEdgeBundleMinimal2, + geom = GeomEdgePath, position = position, + show.legend = show.legend, inherit.aes = FALSE, + params = expand_edge_aes( + list2( + arrow = arrow, lineend = lineend, linejoin = linejoin, + linemitre = linemitre, n = n, interpolate = TRUE, + max_distortion = max_distortion, weight_fac = weight_fac, + tension = tension, label_colour = label_colour, + label_alpha = label_alpha, label_parse = label_parse, + check_overlap = check_overlap, angle_calc = angle_calc, + force_flip = force_flip, label_dodge = label_dodge, + label_push = label_push, ... + ) + ) + ) +} +#' @rdname ggraph-extensions +#' @format NULL +#' @usage NULL +#' @export +StatEdgeBundleMinimal0 <- ggproto('StatEdgeBundleMinimal0', Stat, + setup_data = function(data, params) { + data <- StatFilter$setup_data(data, params) + remove_loop(data) + }, + compute_panel = function(data, scales, max_distortion = 2, weight_fac = 2, + tension = 1) { + graph <- .G() + nodes <- data_frame0(x = .N()$.ggraph_layout_x, y = .N()$.ggraph_layout_y) + edges <- minimal_bundle_mem(graph, nodes, .E()$from[data$edge_id], .E()$to[data$edge_id], + max_distortion = max_distortion, weight_fac = weight_fac) + if (tension < 1) edges <- relax(edges, tension) + edges$PANEL <- data$PANEL[1] + edges$group <- data$group[edges$group] + cbind(edges, data[edges$group, !names(data) %in% c("x", "y", "xend", "yend", "PANEL", "group")]) + }, + required_aes = c('x', 'y', 'xend', 'yend', 'edge_id'), + default_aes = aes(filter = TRUE), + extra_params = c('na.rm') +) +#' @rdname geom_edge_bundle_minimal +#' +#' @export +geom_edge_bundle_minimal0 <- function(mapping = NULL, data = get_edges(), + position = "identity", arrow = NULL, + max_distortion = 2, weight_fac = 2, tension = 1, + lineend = 'butt', show.legend = NA, ...) { + mapping <- complete_edge_aes(mapping) + mapping <- aes_intersect(mapping, aes( + x = x, y = y, xend = xend, yend = yend, group = edge.id, edge_id = edge.id + )) + layer( + data = data, mapping = mapping, stat = StatEdgeBundleMinimal0, + geom = GeomEdgeBspline, position = position, + show.legend = show.legend, inherit.aes = FALSE, + params = expand_edge_aes( + list2( + arrow = arrow, lineend = lineend, max_distortion = max_distortion, + weight_fac = weight_fac, tension = tension, ... + ) + ) + ) +} +#' @importFrom igraph mst shortest_paths +minimal_bundle <- function(graph, nodes, from, to, max_distortion = 2, weight_fac = 2) { + edge_length <- sqrt((nodes$x[from] - nodes$x[to])^2 + (nodes$y[from] - nodes$y[to])^2) + weights <- edge_length^weight_fac + g_temp <- mst(graph, weights) + paths <- lapply(seq_along(from), function(f) { + s <- from[f] + t <- to[f] + path <- suppressWarnings(shortest_paths(g_temp, s, t, mode = "all", output = "vpath")$vpath[[1]]) + path_length <- sum(sqrt((nodes$x[path[-length(path)]] - nodes$x[path[-1]])^2 + (nodes$y[path[-length(path)]] - nodes$y[path[-1]])^2)) + if (path_length >= max_distortion * edge_length[f]) { + c(s, t) + } else { + path + } + }) + ids <- rep(seq_along(from), lengths(paths)) + paths <- unlist(paths) + data_frame0(x = nodes$x[paths], y = nodes$y[paths], group = ids) +} + +minimal_bundle_mem <- memoise::memoise(minimal_bundle) diff --git a/R/geom_edge_bundle_path.R b/R/geom_edge_bundle_path.R new file mode 100644 index 00000000..569246f9 --- /dev/null +++ b/R/geom_edge_bundle_path.R @@ -0,0 +1,328 @@ +#' Bundle edges using edge path bundling +#' +#' This geom performs edge bundling using the edge path algorithm. This approach +#' uses the underlying graph structure to find shortest paths for each edge in +#' a graph the is gradually removed of it's edges. Since it is based on the +#' topology of the graph it should lead to less spurious bundling of unrelated +#' edges compared to [geom_edge_bundle_force()] and also has a simpler parameter +#' space. +#' +#' @inheritSection geom_edge_link Edge variants +#' @inheritSection geom_edge_link Edge aesthetic name expansion +#' +#' @section Aesthetics: +#' `geom_edge_force_path` and `geom_edge_force_path0` understand the following +#' aesthetics. Bold aesthetics are automatically set, but can be overridden. +#' +#' - **x** +#' - **y** +#' - **xend** +#' - **yend** +#' - **edge_id** (should not be overwritten) +#' - edge_colour +#' - edge_width +#' - edge_linetype +#' - edge_alpha +#' - filter +#' +#' `geom_edge_force_path2` understand the following aesthetics. Bold aesthetics are +#' automatically set, but can be overridden. +#' +#' - **x** +#' - **y** +#' - **group** +#' - **edge_id** (should not be overwritten) +#' - edge_colour +#' - edge_width +#' - edge_linetype +#' - edge_alpha +#' - filter +#' +#' `geom_edge_force_path` and `geom_edge_force_path2` furthermore takes the following +#' aesthetics. +#' +#' - start_cap +#' - end_cap +#' - label +#' - label_pos +#' - label_size +#' - angle +#' - hjust +#' - vjust +#' - family +#' - fontface +#' - lineheight +#' +#' +#' @section Computed variables: +#' +#' \describe{ +#' \item{index}{The position along the path (not computed for the *0 version)} +#' } +#' +#' @inheritParams geom_edge_link +#' @inheritParams ggplot2::geom_path +#' +#' @param directed Logical. Should the shortest paths be calculated using +#' direction information of the graph. Setting this to `TRUE` can help split up +#' bundles that flows in opposite directions. Ignored for undirected graphs +#' @param max_distortion A multiplication factor to determine the maximum +#' allowed distortion of the path during bundling. If the new edge is longer +#' than `max_distortion` times the old length it is rejected. +#' @param weight_fac The exponent used to assign weights to the graph when +#' calculating the shortest path. The final weights are given as +#' `edge_length ^ weight_fac` meaning that sorter edges are prioritised when +#' calculating the weights. +#' @param tension A loosening factor when calculating the b-spline of the edge +#' based on the shortest path. Will move control points closer and closer to +#' the direct line as it approaches 0 +#' +#' @author Thomas Lin Pedersen and David Schoch +#' +#' @family geom_edge_* +#' +#' @references +#' Wallinger, M., Archambault, D., Auber, D., Nöllenburg, M., and Peltonen, J. +#' (2022). *Edge-Path Bundling: A Less Ambiguous Edge Bundling Approach.* IEEE +#' Transactions on Visualization and Computer Graphics 28(1) 313-323. +#' https://doi.org/10.1109/TVCG.2021.3114795 +#' +#' @rdname geom_edge_bundle_path +#' @name geom_edge_bundle_path +#' +#' @examples +#' ggraph(highschool) + +#' geom_edge_bundle_path() +#' +#' # Use tension to lessen the effect +#' ggraph(highschool) + +#' geom_edge_bundle_path(tension = 0.8) +#' +NULL + +#' @rdname ggraph-extensions +#' @format NULL +#' @usage NULL +#' @importFrom ggforce StatBspline +#' @export +StatEdgeBundlePath <- ggproto("StatEdgeBundlePath", Stat, + setup_data = function(data, params) { + StatEdgeBundlePath0$setup_data(data, params) + }, + compute_panel = function(data, scales, n = 100, directed = NULL, max_distortion = 2, + weight_fac = 2, tension = 1) { + edges <- StatEdgeBundlePath0$compute_panel( + data, scales, directed = directed, max_distortion = max_distortion, + weight_fac = weight_fac, tension = tension + ) + StatBspline$compute_layer(edges, list(n = n), NULL) + }, + required_aes = c('x', 'y', 'xend', 'yend', 'edge_id'), + default_aes = aes(filter = TRUE), + extra_params = c("na.rm") +) + +#' @rdname geom_edge_bundle_path +#' +#' @export +geom_edge_bundle_path <- function(mapping = NULL, data = get_edges(), + position = "identity", arrow = NULL, + n = 100, directed = NULL, max_distortion = 2, + weight_fac = 2, tension = 1, + lineend = 'butt', linejoin = 'round', linemitre = 1, + label_colour = 'black', label_alpha = 1, + label_parse = FALSE, check_overlap = FALSE, + angle_calc = 'rot', force_flip = TRUE, + label_dodge = NULL, label_push = NULL, + show.legend = NA, ...) { + mapping <- complete_edge_aes(mapping) + mapping <- aes_intersect(mapping, aes( + x = x, y = y, xend = xend, yend = yend, group = edge.id, edge_id = edge.id + )) + layer( + data = data, mapping = mapping, stat = StatEdgeBundlePath, + geom = GeomEdgePath, position = position, + show.legend = show.legend, inherit.aes = FALSE, + params = expand_edge_aes( + list2( + arrow = arrow, lineend = lineend, linejoin = linejoin, + linemitre = linemitre, n = n, interpolate = FALSE, directed = directed, + max_distortion = max_distortion, weight_fac = weight_fac, + tension = tension, label_colour = label_colour, + label_alpha = label_alpha, label_parse = label_parse, + check_overlap = check_overlap, angle_calc = angle_calc, + force_flip = force_flip, label_dodge = label_dodge, + label_push = label_push, ... + ) + ) + ) +} +#' @rdname ggraph-extensions +#' @format NULL +#' @usage NULL +#' @importFrom ggforce StatBspline +#' @export +StatEdgeBundlePath2 <- ggproto("StatEdgeBundlePath2", Stat, + setup_data = function(data, params) { + data <- StatFilter$setup_data(data, params) + remove_loop2(data) + }, + compute_panel = function(data, scales, n = 100, directed = NULL, max_distortion = 2, + weight_fac = 2, tension = 1) { + graph <- .G() + nodes <- data_frame0(x = .N()$.ggraph_layout_x, y = .N()$.ggraph_layout_y) + data <- data[order(data$group), ] + edge_id <- data$edge_id[c(TRUE, FALSE)] + edges <- path_bundle_mem(graph, nodes, .E()$from[edge_id], .E()$to[edge_id], + directed = directed, max_distortion = max_distortion, + weight_fac = weight_fac) + if (tension < 1) edges <- relax(edges, tension) + edges$PANEL <- data$PANEL[1] + edges$group <- data$group[edges$group * 2] + edges <- StatBspline$compute_layer(edges, list(n = n), NULL) + extra_data <- data[1, !names(data) %in% c("x", "y", "group", "PANEL")][rep(NA, nrow(edges)), ] + edges$.interp <- TRUE + ends <- !duplicated(edges$group) | !duplicated(edges$group, fromLast = TRUE) + edges$.interp[ends] <- FALSE + extra_data[ends, ] <- data[, names(extra_data)] + cbind(edges, extra_data) + }, + required_aes = c("x", "y", "edge_id"), + default_aes = aes(filter = TRUE), + extra_params = c("na.rm") +) + +#' @rdname geom_edge_bundle_path +#' +#' @export +geom_edge_bundle_path2 <- function(mapping = NULL, data = get_edges("long"), + position = "identity", arrow = NULL, + n = 100, directed = NULL, max_distortion = 2, + weight_fac = 2, tension = 1, + lineend = 'butt', linejoin = 'round', linemitre = 1, + label_colour = 'black', label_alpha = 1, + label_parse = FALSE, check_overlap = FALSE, + angle_calc = 'rot', force_flip = TRUE, + label_dodge = NULL, label_push = NULL, + show.legend = NA, ...) { + mapping <- complete_edge_aes(mapping) + mapping <- aes_intersect(mapping, aes( + x = x, y = y, group = edge.id, edge_id = edge.id + )) + layer( + data = data, mapping = mapping, stat = StatEdgeBundlePath2, + geom = GeomEdgePath, position = position, + show.legend = show.legend, inherit.aes = FALSE, + params = expand_edge_aes( + list2( + arrow = arrow, lineend = lineend, linejoin = linejoin, + linemitre = linemitre, n = n, interpolate = TRUE, directed = directed, + max_distortion = max_distortion, weight_fac = weight_fac, + tension = tension, label_colour = label_colour, + label_alpha = label_alpha, label_parse = label_parse, + check_overlap = check_overlap, angle_calc = angle_calc, + force_flip = force_flip, label_dodge = label_dodge, + label_push = label_push, ... + ) + ) + ) +} +#' @rdname ggraph-extensions +#' @format NULL +#' @usage NULL +#' @export +StatEdgeBundlePath0 <- ggproto('StatEdgeBundlePath0', Stat, + setup_data = function(data, params) { + data <- StatFilter$setup_data(data, params) + remove_loop(data) + }, + compute_panel = function(data, scales, directed = NULL, max_distortion = 2, + weight_fac = 2, tension = 1) { + graph <- .G() + nodes <- data_frame0(x = .N()$.ggraph_layout_x, y = .N()$.ggraph_layout_y) + from <- .E()$from[data$edge_id] + to <- .E()$to[data$edge_id] + edges <- path_bundle_mem(graph, nodes, from, to, directed = directed, + max_distortion = max_distortion, weight_fac = weight_fac) + if (tension < 1) edges <- relax(edges, tension) + edges$PANEL <- data$PANEL[1] + edges$group <- data$group[edges$group] + cbind(edges, data[edges$group, !names(data) %in% c("x", "y", "xend", "yend", "PANEL", "group")]) + }, + required_aes = c('x', 'y', 'xend', 'yend', 'edge_id'), + default_aes = aes(filter = TRUE), + extra_params = c('na.rm') +) +#' @rdname geom_edge_bundle_path +#' +#' @export +geom_edge_bundle_path0 <- function(mapping = NULL, data = get_edges(), + position = "identity", arrow = NULL, + directed = NULL, max_distortion = 2, + weight_fac = 2, tension = 1, + lineend = 'butt', show.legend = NA, ...) { + mapping <- complete_edge_aes(mapping) + mapping <- aes_intersect(mapping, aes( + x = x, y = y, xend = xend, yend = yend, group = edge.id, edge_id = edge.id + )) + layer( + data = data, mapping = mapping, stat = StatEdgeBundlePath0, + geom = GeomEdgeBspline, position = position, + show.legend = show.legend, inherit.aes = FALSE, + params = expand_edge_aes( + list2( + arrow = arrow, lineend = lineend, directed = directed, + max_distortion = max_distortion, weight_fac = weight_fac, + tension = tension, ... + ) + ) + ) +} +#' @importFrom igraph gsize delete_edges shortest_paths get.edge.ids is_directed +path_bundle <- function(graph, nodes, from, to, directed = directed, max_distortion = 2, weight_fac = 2) { + m <- gsize(graph) + lock <- rep(FALSE, m) + skip <- rep(FALSE, m) + + edge_length <- sqrt((nodes$x[from] - nodes$x[to])^2 + (nodes$y[from] - nodes$y[to])^2) + weights <- edge_length^weight_fac + edges_order <- order(weights, decreasing = TRUE) + paths <- vector("list", m) + if (is_directed(graph)) { + directed <- directed %||% TRUE + } else if (!is.null(directed)) { + cli::cli_warn("Ignoring {.arg directed} for undirected graphs") + } + mode <- if (is.null(directed) || !directed) "all" else "out" + # iterate + for (e in edges_order) { + s <- from[e] + t <- to[e] + paths[[e]] <- c(s, t) + if (lock[e]) { + next() + } + skip[e] <- TRUE + g_temp <- delete_edges(graph, which(skip)) + path <- suppressWarnings(shortest_paths(g_temp, s, t, weights = weights[!skip], mode = mode, output = "vpath")$vpath[[1]]) + if (length(path) < 2) { + skip[e] <- FALSE + next() + } + path_length <- sum(sqrt((nodes$x[path[-length(path)]] - nodes$x[path[-1]])^2 + (nodes$y[path[-length(path)]] - nodes$y[path[-1]])^2)) + if (path_length >= max_distortion * edge_length[e]) { + skip[e] <- FALSE + next() + } + all_edges_on_path <- rep(as.integer(path), each = 2) + all_edges_on_path <- all_edges_on_path[-c(1, length(all_edges_on_path))] + all_edges_on_path <- get.edge.ids(graph, all_edges_on_path, directed = mode != "all", error = FALSE, multi = TRUE) + lock[all_edges_on_path] <- TRUE + paths[[e]] <- path + } + ids <- rep(seq_along(from), lengths(paths)) + paths <- unlist(paths) + data_frame0(x = nodes$x[paths], y = nodes$y[paths], group = ids) +} + +path_bundle_mem <- memoise::memoise(path_bundle) diff --git a/R/tbl_graph.R b/R/tbl_graph.R index a0ff8bfc..fa3f21e9 100644 --- a/R/tbl_graph.R +++ b/R/tbl_graph.R @@ -1,7 +1,7 @@ #' @rdname ggraph #' @aliases layout_tbl_graph #' -#' @importFrom igraph gorder +#' @importFrom igraph gorder V<- #' @export #' create_layout.tbl_graph <- function(graph, layout, circular = FALSE, ...) { @@ -15,9 +15,10 @@ create_layout.tbl_graph <- function(graph, layout, circular = FALSE, ...) { } layout <- as_tibble(layout) layout$.ggraph.index <- seq_len(nrow(layout)) - if (is.null(attr(layout, 'graph'))) { - attr(layout, 'graph') <- graph - } + graph <- attr(layout, 'graph') %||% graph + V(graph)$.ggraph_layout_x <- layout$x + V(graph)$.ggraph_layout_y <- layout$y + attr(layout, 'graph') <- graph attr(layout, 'circular') <- circular class(layout) <- c( 'layout_tbl_graph', diff --git a/_pkgdown.yml b/_pkgdown.yml index f9db83f0..8349cabf 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -110,6 +110,9 @@ reference: - geom_edge_point - geom_edge_tile - geom_edge_density + - geom_edge_bundle_force + - geom_edge_bundle_path + - geom_edge_bundle_minimal - title: "Connections" desc: > Connections are meta-edges, connecting nodes that are not direct diff --git a/man/geom_edge_arc.Rd b/man/geom_edge_arc.Rd index ac69c107..3e6cf6df 100644 --- a/man/geom_edge_arc.Rd +++ b/man/geom_edge_arc.Rd @@ -277,6 +277,9 @@ ggraph(gr, 'linear', circular = TRUE) + \seealso{ Other geom_edge_*: \code{\link{geom_edge_bend}()}, +\code{\link{geom_edge_bundle_force}()}, +\code{\link{geom_edge_bundle_minimal}()}, +\code{\link{geom_edge_bundle_path}()}, \code{\link{geom_edge_density}()}, \code{\link{geom_edge_diagonal}()}, \code{\link{geom_edge_elbow}()}, diff --git a/man/geom_edge_bend.Rd b/man/geom_edge_bend.Rd index 3ff2c5d9..fefaa1e6 100644 --- a/man/geom_edge_bend.Rd +++ b/man/geom_edge_bend.Rd @@ -260,6 +260,9 @@ ggraph(gr, 'tree') + \seealso{ Other geom_edge_*: \code{\link{geom_edge_arc}()}, +\code{\link{geom_edge_bundle_force}()}, +\code{\link{geom_edge_bundle_minimal}()}, +\code{\link{geom_edge_bundle_path}()}, \code{\link{geom_edge_density}()}, \code{\link{geom_edge_diagonal}()}, \code{\link{geom_edge_elbow}()}, diff --git a/man/geom_edge_bundle_force.Rd b/man/geom_edge_bundle_force.Rd new file mode 100644 index 00000000..dc1d507d --- /dev/null +++ b/man/geom_edge_bundle_force.Rd @@ -0,0 +1,311 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/geom_edge_bundle_force.R +\name{geom_edge_bundle_force} +\alias{geom_edge_bundle_force} +\alias{geom_edge_bundle_force2} +\alias{geom_edge_bundle_force0} +\title{Bundle edges using force directed edge bundling} +\usage{ +geom_edge_bundle_force( + mapping = NULL, + data = get_edges(), + position = "identity", + arrow = NULL, + n = 100, + force = 1, + n_cycle = 6, + cuts_start = 1, + step = 0.04, + cuts_new = 2, + n_iter = 50, + iter_new = 2/3, + threshold = 0.6, + eps = 1e-08, + lineend = "butt", + linejoin = "round", + linemitre = 1, + label_colour = "black", + label_alpha = 1, + label_parse = FALSE, + check_overlap = FALSE, + angle_calc = "rot", + force_flip = TRUE, + label_dodge = NULL, + label_push = NULL, + show.legend = NA, + ... +) + +geom_edge_bundle_force2( + mapping = NULL, + data = get_edges("long"), + position = "identity", + arrow = NULL, + n = 100, + force = 1, + n_cycle = 6, + cuts_start = 1, + step = 0.04, + cuts_new = 2, + n_iter = 50, + iter_new = 2/3, + threshold = 0.6, + eps = 1e-08, + lineend = "butt", + linejoin = "round", + linemitre = 1, + label_colour = "black", + label_alpha = 1, + label_parse = FALSE, + check_overlap = FALSE, + angle_calc = "rot", + force_flip = TRUE, + label_dodge = NULL, + label_push = NULL, + show.legend = NA, + ... +) + +geom_edge_bundle_force0( + mapping = NULL, + data = get_edges(), + position = "identity", + arrow = NULL, + force = 1, + n_cycle = 6, + cuts_start = 1, + step = 0.04, + cuts_new = 2, + n_iter = 50, + iter_new = 2/3, + threshold = 0.6, + eps = 1e-08, + lineend = "butt", + show.legend = NA, + ... +) +} +\arguments{ +\item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{ggplot2::aes()}} +or \code{\link[ggplot2:aes_]{ggplot2::aes_()}}. By default x, y, xend, yend, group and +circular are mapped to x, y, xend, yend, edge.id and circular in the edge +data.} + +\item{data}{The return of a call to \code{get_edges()} or a data.frame +giving edges in correct format (see details for for guidance on the format). +See \code{\link[=get_edges]{get_edges()}} for more details on edge extraction.} + +\item{position}{Position adjustment, either as a string naming the adjustment +(e.g. \code{"jitter"} to use \code{position_jitter}), or the result of a call to a +position adjustment function. Use the latter if you need to change the +settings of the adjustment.} + +\item{arrow}{Arrow specification, as created by \code{\link[grid:arrow]{grid::arrow()}}.} + +\item{n}{The number of points to create along the path.} + +\item{force}{The spring force during bundling} + +\item{n_cycle}{number of iteration cycles} + +\item{cuts_start}{initial number of edge divisions} + +\item{step}{initial step size} + +\item{cuts_new}{factor for how many new division points to add after a cycle} + +\item{n_iter}{number of iteration steps per cycle} + +\item{iter_new}{factor of how to decrease the number of iterations per cycle} + +\item{threshold}{threshold for considering two edges to be interacting} + +\item{eps}{tolerance} + +\item{lineend}{Line end style (round, butt, square).} + +\item{linejoin}{Line join style (round, mitre, bevel).} + +\item{linemitre}{Line mitre limit (number greater than 1).} + +\item{label_colour}{The colour of the edge label. If \code{NA} it will use +the colour of the edge.} + +\item{label_alpha}{The opacity of the edge label. If \code{NA} it will use +the opacity of the edge.} + +\item{label_parse}{If \code{TRUE}, the labels will be parsed into expressions +and displayed as described in \code{\link[grDevices:plotmath]{grDevices::plotmath()}}.} + +\item{check_overlap}{If \code{TRUE}, text that overlaps previous text in the +same layer will not be plotted. \code{check_overlap} happens at draw time and in +the order of the data. Therefore data should be arranged by the label +column before calling \code{geom_text()}. Note that this argument is not +supported by \code{geom_label()}.} + +\item{angle_calc}{Either 'none', 'along', or 'across'. If 'none' the label will +use the angle aesthetic of the geom. If 'along' The label will be written +along the edge direction. If 'across' the label will be written across the +edge direction.} + +\item{force_flip}{Logical. If \code{angle_calc} is either 'along' or 'across' +should the label be flipped if it is on it's head. Default to \code{TRUE}.} + +\item{label_dodge}{A \code{\link[grid:unit]{grid::unit()}} giving a fixed vertical shift +to add to the label in case of \code{angle_calc} is either 'along' or 'across'} + +\item{label_push}{A \code{\link[grid:unit]{grid::unit()}} giving a fixed horizontal shift +to add to the label in case of \code{angle_calc} is either 'along' or 'across'} + +\item{show.legend}{logical. Should this layer be included in the legends? +\code{NA}, the default, includes if any aesthetics are mapped. +\code{FALSE} never includes, and \code{TRUE} always includes. +It can also be a named logical vector to finely select the aesthetics to +display.} + +\item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are +often aesthetics, used to set an aesthetic to a fixed value, like +\code{colour = "red"} or \code{size = 3}. They may also be parameters +to the paired geom/stat.} +} +\description{ +This geom performs force directed edge bundling to reduce visual clutter. +It uses a self-organizing approach to bundling in which edges are modeled as +flexible springs that can attract each other without the need of a hierarchy. +Be aware that this bundling technique works globally and thus may bundle +edges that is otherwise unrelated together. Care should be taken when +interpreting the resulting visual. An alternative approach to edge bundling +that uses the graph topology is provided by \code{\link[=geom_edge_bundle_path]{geom_edge_bundle_path()}}. +} +\section{Aesthetics}{ + +\code{geom_edge_bundle_force} and \code{geom_edge_bundle_force0} understand the following +aesthetics. Bold aesthetics are automatically set, but can be overridden. +\itemize{ +\item \strong{x} +\item \strong{y} +\item \strong{xend} +\item \strong{yend} +\item edge_colour +\item edge_width +\item edge_linetype +\item edge_alpha +\item filter +} + +\code{geom_edge_bundle_force2} understand the following aesthetics. Bold aesthetics are +automatically set, but can be overridden. +\itemize{ +\item \strong{x} +\item \strong{y} +\item \strong{group} +\item edge_colour +\item edge_width +\item edge_linetype +\item edge_alpha +\item filter +} + +\code{geom_edge_bundle_force} and \code{geom_edge_bundle_force2} furthermore takes the following +aesthetics. +\itemize{ +\item start_cap +\item end_cap +\item label +\item label_pos +\item label_size +\item angle +\item hjust +\item vjust +\item family +\item fontface +\item lineheight +} +} + +\section{Computed variables}{ + + +\describe{ +\item{index}{The position along the path (not computed for the *0 version)} +} +} + +\section{Edge variants}{ + +Many geom_edge_* layers comes in 3 flavors depending on the level of control +needed over the drawing. The default (no numeric postfix) generate a number +of points (\code{n}) along the edge and draws it as a path. Each point along +the line has a numeric value associated with it giving the position along the +path, and it is therefore possible to show the direction of the edge by +mapping to this e.g. \code{colour = after_stat(index)}. The version postfixed with a +"2" uses the "long" edge format (see \code{\link[=get_edges]{get_edges()}}) and makes it +possible to interpolate node parameter between the start and end node along +the edge. It is considerable less performant so should only be used if this +is needed. The version postfixed with a "0" draws the edge in the most +performant way, often directly using an appropriate grob from the grid +package, but does not allow for gradients along the edge. + +Often it is beneficial to stop the drawing of the edge before it reaches the +node, for instance in cases where an arrow should be drawn and the arrowhead +shouldn't lay on top or below the node point. geom_edge_* and geom_edge_*2 +supports this through the start_cap and end_cap aesthetics that takes a +\code{\link[=geometry]{geometry()}} specification and dynamically caps the termini of the +edges based on the given specifications. This means that if +\code{end_cap = circle(1, 'cm')} the edges will end at a distance of 1cm even +during resizing of the plot window. + +All \verb{geom_edge_*} and \code{geom_edge_*2} have the ability to draw a +label along the edge. The reason this is not a separate geom is that in order +for the label to know the location of the edge it needs to know the edge type +etc. Labels are drawn by providing a label aesthetic. The label_pos can be +used to specify where along the edge it should be drawn by supplying a number +between 0 and 1. The label_size aesthetic can be used to control the size of +the label. Often it is needed to have the label written along the direction +of the edge, but since the actual angle is dependent on the plot dimensions +this cannot be calculated beforehand. Using the angle_calc argument allows +you to specify whether to use the supplied angle aesthetic or whether to draw +the label along or across the edge. +} + +\section{Edge aesthetic name expansion}{ + +In order to avoid excessive typing edge aesthetic names are +automatically expanded. Because of this it is not necessary to write +\code{edge_colour} within the \code{aes()} call as \code{colour} will +automatically be renamed appropriately. +} + +\examples{ +# (not necessarily an insightful use) +ggraph(highschool) + + geom_edge_bundle_force(n_cycle = 2, threshold = 0.4) + +} +\references{ +Holten, D. and Wijk, J.J.V. (2009). \emph{Force‐Directed Edge Bundling for Graph +Visualization.} Computer Graphics Forum (Blackwell Publishing Ltd) 28, no. 3: +983-990. https://doi.org/10.1111/j.1467-8659.2009.01450.x +} +\seealso{ +Other geom_edge_*: +\code{\link{geom_edge_arc}()}, +\code{\link{geom_edge_bend}()}, +\code{\link{geom_edge_bundle_minimal}()}, +\code{\link{geom_edge_bundle_path}()}, +\code{\link{geom_edge_density}()}, +\code{\link{geom_edge_diagonal}()}, +\code{\link{geom_edge_elbow}()}, +\code{\link{geom_edge_fan}()}, +\code{\link{geom_edge_hive}()}, +\code{\link{geom_edge_link}()}, +\code{\link{geom_edge_loop}()}, +\code{\link{geom_edge_parallel}()}, +\code{\link{geom_edge_point}()}, +\code{\link{geom_edge_span}()}, +\code{\link{geom_edge_tile}()} +} +\author{ +David Schoch +} +\concept{geom_edge_*} diff --git a/man/geom_edge_bundle_minimal.Rd b/man/geom_edge_bundle_minimal.Rd new file mode 100644 index 00000000..a2ec2755 --- /dev/null +++ b/man/geom_edge_bundle_minimal.Rd @@ -0,0 +1,286 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/geom_edge_bundle_minimal.R +\name{geom_edge_bundle_minimal} +\alias{geom_edge_bundle_minimal} +\alias{geom_edge_bundle_minimal2} +\alias{geom_edge_bundle_minimal0} +\title{Bundle edges along the minimal spanning tree} +\usage{ +geom_edge_bundle_minimal( + mapping = NULL, + data = get_edges(), + position = "identity", + arrow = NULL, + n = 100, + max_distortion = 2, + weight_fac = 2, + tension = 1, + lineend = "butt", + linejoin = "round", + linemitre = 1, + label_colour = "black", + label_alpha = 1, + label_parse = FALSE, + check_overlap = FALSE, + angle_calc = "rot", + force_flip = TRUE, + label_dodge = NULL, + label_push = NULL, + show.legend = NA, + ... +) + +geom_edge_bundle_minimal2( + mapping = NULL, + data = get_edges("long"), + position = "identity", + arrow = NULL, + n = 100, + max_distortion = 2, + weight_fac = 2, + tension = 1, + lineend = "butt", + linejoin = "round", + linemitre = 1, + label_colour = "black", + label_alpha = 1, + label_parse = FALSE, + check_overlap = FALSE, + angle_calc = "rot", + force_flip = TRUE, + label_dodge = NULL, + label_push = NULL, + show.legend = NA, + ... +) + +geom_edge_bundle_minimal0( + mapping = NULL, + data = get_edges(), + position = "identity", + arrow = NULL, + max_distortion = 2, + weight_fac = 2, + tension = 1, + lineend = "butt", + show.legend = NA, + ... +) +} +\arguments{ +\item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{ggplot2::aes()}} +or \code{\link[ggplot2:aes_]{ggplot2::aes_()}}. By default x, y, xend, yend, group and +circular are mapped to x, y, xend, yend, edge.id and circular in the edge +data.} + +\item{data}{The return of a call to \code{get_edges()} or a data.frame +giving edges in correct format (see details for for guidance on the format). +See \code{\link[=get_edges]{get_edges()}} for more details on edge extraction.} + +\item{position}{Position adjustment, either as a string naming the adjustment +(e.g. \code{"jitter"} to use \code{position_jitter}), or the result of a call to a +position adjustment function. Use the latter if you need to change the +settings of the adjustment.} + +\item{arrow}{Arrow specification, as created by \code{\link[grid:arrow]{grid::arrow()}}.} + +\item{n}{The number of points to create along the path.} + +\item{max_distortion}{A multiplication factor to determine the maximum +allowed distortion of the path during bundling. If the new edge is longer +than \code{max_distortion} times the old length it is rejected.} + +\item{weight_fac}{The exponent used to assign weights to the graph when +calculating the shortest path. The final weights are given as +\code{edge_length ^ weight_fac} meaning that sorter edges are prioritised when +calculating the weights.} + +\item{tension}{A loosening factor when calculating the b-spline of the edge +based on the shortest path. Will move control points closer and closer to +the direct line as it approaches 0} + +\item{lineend}{Line end style (round, butt, square).} + +\item{linejoin}{Line join style (round, mitre, bevel).} + +\item{linemitre}{Line mitre limit (number greater than 1).} + +\item{label_colour}{The colour of the edge label. If \code{NA} it will use +the colour of the edge.} + +\item{label_alpha}{The opacity of the edge label. If \code{NA} it will use +the opacity of the edge.} + +\item{label_parse}{If \code{TRUE}, the labels will be parsed into expressions +and displayed as described in \code{\link[grDevices:plotmath]{grDevices::plotmath()}}.} + +\item{check_overlap}{If \code{TRUE}, text that overlaps previous text in the +same layer will not be plotted. \code{check_overlap} happens at draw time and in +the order of the data. Therefore data should be arranged by the label +column before calling \code{geom_text()}. Note that this argument is not +supported by \code{geom_label()}.} + +\item{angle_calc}{Either 'none', 'along', or 'across'. If 'none' the label will +use the angle aesthetic of the geom. If 'along' The label will be written +along the edge direction. If 'across' the label will be written across the +edge direction.} + +\item{force_flip}{Logical. If \code{angle_calc} is either 'along' or 'across' +should the label be flipped if it is on it's head. Default to \code{TRUE}.} + +\item{label_dodge}{A \code{\link[grid:unit]{grid::unit()}} giving a fixed vertical shift +to add to the label in case of \code{angle_calc} is either 'along' or 'across'} + +\item{label_push}{A \code{\link[grid:unit]{grid::unit()}} giving a fixed horizontal shift +to add to the label in case of \code{angle_calc} is either 'along' or 'across'} + +\item{show.legend}{logical. Should this layer be included in the legends? +\code{NA}, the default, includes if any aesthetics are mapped. +\code{FALSE} never includes, and \code{TRUE} always includes. +It can also be a named logical vector to finely select the aesthetics to +display.} + +\item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are +often aesthetics, used to set an aesthetic to a fixed value, like +\code{colour = "red"} or \code{size = 3}. They may also be parameters +to the paired geom/stat.} +} +\description{ +This geom performs edge bundling by letting edges follow the shortest path +along the minimal spanning tree of the graph. Due to it's simplicity it is +very fast but does enforce a tree-like appearance to the bundling. Adjusting +the \code{max_distortion} and \code{tension} parameters may alleviate this to some +extend. +} +\section{Aesthetics}{ + +\code{geom_edge_force_minimal} and \code{geom_edge_force_minimal0} understand the following +aesthetics. Bold aesthetics are automatically set, but can be overridden. +\itemize{ +\item \strong{x} +\item \strong{y} +\item \strong{xend} +\item \strong{yend} +\item \strong{edge_id} (should not be overwritten) +\item edge_colour +\item edge_width +\item edge_linetype +\item edge_alpha +\item filter +} + +\code{geom_edge_force_minimal2} understand the following aesthetics. Bold aesthetics are +automatically set, but can be overridden. +\itemize{ +\item \strong{x} +\item \strong{y} +\item \strong{group} +\item \strong{edge_id} (should not be overwritten) +\item edge_colour +\item edge_width +\item edge_linetype +\item edge_alpha +\item filter +} + +\code{geom_edge_force_minimal} and \code{geom_edge_force_minimal2} furthermore takes the following +aesthetics. +\itemize{ +\item start_cap +\item end_cap +\item label +\item label_pos +\item label_size +\item angle +\item hjust +\item vjust +\item family +\item fontface +\item lineheight +} +} + +\section{Computed variables}{ + + +\describe{ +\item{index}{The position along the path (not computed for the *0 version)} +} +} + +\section{Edge variants}{ + +Many geom_edge_* layers comes in 3 flavors depending on the level of control +needed over the drawing. The default (no numeric postfix) generate a number +of points (\code{n}) along the edge and draws it as a path. Each point along +the line has a numeric value associated with it giving the position along the +path, and it is therefore possible to show the direction of the edge by +mapping to this e.g. \code{colour = after_stat(index)}. The version postfixed with a +"2" uses the "long" edge format (see \code{\link[=get_edges]{get_edges()}}) and makes it +possible to interpolate node parameter between the start and end node along +the edge. It is considerable less performant so should only be used if this +is needed. The version postfixed with a "0" draws the edge in the most +performant way, often directly using an appropriate grob from the grid +package, but does not allow for gradients along the edge. + +Often it is beneficial to stop the drawing of the edge before it reaches the +node, for instance in cases where an arrow should be drawn and the arrowhead +shouldn't lay on top or below the node point. geom_edge_* and geom_edge_*2 +supports this through the start_cap and end_cap aesthetics that takes a +\code{\link[=geometry]{geometry()}} specification and dynamically caps the termini of the +edges based on the given specifications. This means that if +\code{end_cap = circle(1, 'cm')} the edges will end at a distance of 1cm even +during resizing of the plot window. + +All \verb{geom_edge_*} and \code{geom_edge_*2} have the ability to draw a +label along the edge. The reason this is not a separate geom is that in order +for the label to know the location of the edge it needs to know the edge type +etc. Labels are drawn by providing a label aesthetic. The label_pos can be +used to specify where along the edge it should be drawn by supplying a number +between 0 and 1. The label_size aesthetic can be used to control the size of +the label. Often it is needed to have the label written along the direction +of the edge, but since the actual angle is dependent on the plot dimensions +this cannot be calculated beforehand. Using the angle_calc argument allows +you to specify whether to use the supplied angle aesthetic or whether to draw +the label along or across the edge. +} + +\section{Edge aesthetic name expansion}{ + +In order to avoid excessive typing edge aesthetic names are +automatically expanded. Because of this it is not necessary to write +\code{edge_colour} within the \code{aes()} call as \code{colour} will +automatically be renamed appropriately. +} + +\examples{ +ggraph(highschool) + + geom_edge_bundle_minimal() + +# Allow more edges to bundle +ggraph(highschool) + + geom_edge_bundle_minimal(max_distortion = 5, tension = 0.9) + +} +\seealso{ +Other geom_edge_*: +\code{\link{geom_edge_arc}()}, +\code{\link{geom_edge_bend}()}, +\code{\link{geom_edge_bundle_force}()}, +\code{\link{geom_edge_bundle_path}()}, +\code{\link{geom_edge_density}()}, +\code{\link{geom_edge_diagonal}()}, +\code{\link{geom_edge_elbow}()}, +\code{\link{geom_edge_fan}()}, +\code{\link{geom_edge_hive}()}, +\code{\link{geom_edge_link}()}, +\code{\link{geom_edge_loop}()}, +\code{\link{geom_edge_parallel}()}, +\code{\link{geom_edge_point}()}, +\code{\link{geom_edge_span}()}, +\code{\link{geom_edge_tile}()} +} +\author{ +Thomas Lin Pedersen +} +\concept{geom_edge_*} diff --git a/man/geom_edge_bundle_path.Rd b/man/geom_edge_bundle_path.Rd new file mode 100644 index 00000000..41c90e2c --- /dev/null +++ b/man/geom_edge_bundle_path.Rd @@ -0,0 +1,300 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/geom_edge_bundle_path.R +\name{geom_edge_bundle_path} +\alias{geom_edge_bundle_path} +\alias{geom_edge_bundle_path2} +\alias{geom_edge_bundle_path0} +\title{Bundle edges using edge path bundling} +\usage{ +geom_edge_bundle_path( + mapping = NULL, + data = get_edges(), + position = "identity", + arrow = NULL, + n = 100, + directed = NULL, + max_distortion = 2, + weight_fac = 2, + tension = 1, + lineend = "butt", + linejoin = "round", + linemitre = 1, + label_colour = "black", + label_alpha = 1, + label_parse = FALSE, + check_overlap = FALSE, + angle_calc = "rot", + force_flip = TRUE, + label_dodge = NULL, + label_push = NULL, + show.legend = NA, + ... +) + +geom_edge_bundle_path2( + mapping = NULL, + data = get_edges("long"), + position = "identity", + arrow = NULL, + n = 100, + directed = NULL, + max_distortion = 2, + weight_fac = 2, + tension = 1, + lineend = "butt", + linejoin = "round", + linemitre = 1, + label_colour = "black", + label_alpha = 1, + label_parse = FALSE, + check_overlap = FALSE, + angle_calc = "rot", + force_flip = TRUE, + label_dodge = NULL, + label_push = NULL, + show.legend = NA, + ... +) + +geom_edge_bundle_path0( + mapping = NULL, + data = get_edges(), + position = "identity", + arrow = NULL, + directed = NULL, + max_distortion = 2, + weight_fac = 2, + tension = 1, + lineend = "butt", + show.legend = NA, + ... +) +} +\arguments{ +\item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{ggplot2::aes()}} +or \code{\link[ggplot2:aes_]{ggplot2::aes_()}}. By default x, y, xend, yend, group and +circular are mapped to x, y, xend, yend, edge.id and circular in the edge +data.} + +\item{data}{The return of a call to \code{get_edges()} or a data.frame +giving edges in correct format (see details for for guidance on the format). +See \code{\link[=get_edges]{get_edges()}} for more details on edge extraction.} + +\item{position}{Position adjustment, either as a string naming the adjustment +(e.g. \code{"jitter"} to use \code{position_jitter}), or the result of a call to a +position adjustment function. Use the latter if you need to change the +settings of the adjustment.} + +\item{arrow}{Arrow specification, as created by \code{\link[grid:arrow]{grid::arrow()}}.} + +\item{n}{The number of points to create along the path.} + +\item{directed}{Logical. Should the shortest paths be calculated using +direction information of the graph. Setting this to \code{TRUE} can help split up +bundles that flows in opposite directions. Ignored for undirected graphs} + +\item{max_distortion}{A multiplication factor to determine the maximum +allowed distortion of the path during bundling. If the new edge is longer +than \code{max_distortion} times the old length it is rejected.} + +\item{weight_fac}{The exponent used to assign weights to the graph when +calculating the shortest path. The final weights are given as +\code{edge_length ^ weight_fac} meaning that sorter edges are prioritised when +calculating the weights.} + +\item{tension}{A loosening factor when calculating the b-spline of the edge +based on the shortest path. Will move control points closer and closer to +the direct line as it approaches 0} + +\item{lineend}{Line end style (round, butt, square).} + +\item{linejoin}{Line join style (round, mitre, bevel).} + +\item{linemitre}{Line mitre limit (number greater than 1).} + +\item{label_colour}{The colour of the edge label. If \code{NA} it will use +the colour of the edge.} + +\item{label_alpha}{The opacity of the edge label. If \code{NA} it will use +the opacity of the edge.} + +\item{label_parse}{If \code{TRUE}, the labels will be parsed into expressions +and displayed as described in \code{\link[grDevices:plotmath]{grDevices::plotmath()}}.} + +\item{check_overlap}{If \code{TRUE}, text that overlaps previous text in the +same layer will not be plotted. \code{check_overlap} happens at draw time and in +the order of the data. Therefore data should be arranged by the label +column before calling \code{geom_text()}. Note that this argument is not +supported by \code{geom_label()}.} + +\item{angle_calc}{Either 'none', 'along', or 'across'. If 'none' the label will +use the angle aesthetic of the geom. If 'along' The label will be written +along the edge direction. If 'across' the label will be written across the +edge direction.} + +\item{force_flip}{Logical. If \code{angle_calc} is either 'along' or 'across' +should the label be flipped if it is on it's head. Default to \code{TRUE}.} + +\item{label_dodge}{A \code{\link[grid:unit]{grid::unit()}} giving a fixed vertical shift +to add to the label in case of \code{angle_calc} is either 'along' or 'across'} + +\item{label_push}{A \code{\link[grid:unit]{grid::unit()}} giving a fixed horizontal shift +to add to the label in case of \code{angle_calc} is either 'along' or 'across'} + +\item{show.legend}{logical. Should this layer be included in the legends? +\code{NA}, the default, includes if any aesthetics are mapped. +\code{FALSE} never includes, and \code{TRUE} always includes. +It can also be a named logical vector to finely select the aesthetics to +display.} + +\item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are +often aesthetics, used to set an aesthetic to a fixed value, like +\code{colour = "red"} or \code{size = 3}. They may also be parameters +to the paired geom/stat.} +} +\description{ +This geom performs edge bundling using the edge path algorithm. This approach +uses the underlying graph structure to find shortest paths for each edge in +a graph the is gradually removed of it's edges. Since it is based on the +topology of the graph it should lead to less spurious bundling of unrelated +edges compared to \code{\link[=geom_edge_bundle_force]{geom_edge_bundle_force()}} and also has a simpler parameter +space. +} +\section{Aesthetics}{ + +\code{geom_edge_force_path} and \code{geom_edge_force_path0} understand the following +aesthetics. Bold aesthetics are automatically set, but can be overridden. +\itemize{ +\item \strong{x} +\item \strong{y} +\item \strong{xend} +\item \strong{yend} +\item \strong{edge_id} (should not be overwritten) +\item edge_colour +\item edge_width +\item edge_linetype +\item edge_alpha +\item filter +} + +\code{geom_edge_force_path2} understand the following aesthetics. Bold aesthetics are +automatically set, but can be overridden. +\itemize{ +\item \strong{x} +\item \strong{y} +\item \strong{group} +\item \strong{edge_id} (should not be overwritten) +\item edge_colour +\item edge_width +\item edge_linetype +\item edge_alpha +\item filter +} + +\code{geom_edge_force_path} and \code{geom_edge_force_path2} furthermore takes the following +aesthetics. +\itemize{ +\item start_cap +\item end_cap +\item label +\item label_pos +\item label_size +\item angle +\item hjust +\item vjust +\item family +\item fontface +\item lineheight +} +} + +\section{Computed variables}{ + + +\describe{ +\item{index}{The position along the path (not computed for the *0 version)} +} +} + +\section{Edge variants}{ + +Many geom_edge_* layers comes in 3 flavors depending on the level of control +needed over the drawing. The default (no numeric postfix) generate a number +of points (\code{n}) along the edge and draws it as a path. Each point along +the line has a numeric value associated with it giving the position along the +path, and it is therefore possible to show the direction of the edge by +mapping to this e.g. \code{colour = after_stat(index)}. The version postfixed with a +"2" uses the "long" edge format (see \code{\link[=get_edges]{get_edges()}}) and makes it +possible to interpolate node parameter between the start and end node along +the edge. It is considerable less performant so should only be used if this +is needed. The version postfixed with a "0" draws the edge in the most +performant way, often directly using an appropriate grob from the grid +package, but does not allow for gradients along the edge. + +Often it is beneficial to stop the drawing of the edge before it reaches the +node, for instance in cases where an arrow should be drawn and the arrowhead +shouldn't lay on top or below the node point. geom_edge_* and geom_edge_*2 +supports this through the start_cap and end_cap aesthetics that takes a +\code{\link[=geometry]{geometry()}} specification and dynamically caps the termini of the +edges based on the given specifications. This means that if +\code{end_cap = circle(1, 'cm')} the edges will end at a distance of 1cm even +during resizing of the plot window. + +All \verb{geom_edge_*} and \code{geom_edge_*2} have the ability to draw a +label along the edge. The reason this is not a separate geom is that in order +for the label to know the location of the edge it needs to know the edge type +etc. Labels are drawn by providing a label aesthetic. The label_pos can be +used to specify where along the edge it should be drawn by supplying a number +between 0 and 1. The label_size aesthetic can be used to control the size of +the label. Often it is needed to have the label written along the direction +of the edge, but since the actual angle is dependent on the plot dimensions +this cannot be calculated beforehand. Using the angle_calc argument allows +you to specify whether to use the supplied angle aesthetic or whether to draw +the label along or across the edge. +} + +\section{Edge aesthetic name expansion}{ + +In order to avoid excessive typing edge aesthetic names are +automatically expanded. Because of this it is not necessary to write +\code{edge_colour} within the \code{aes()} call as \code{colour} will +automatically be renamed appropriately. +} + +\examples{ +ggraph(highschool) + + geom_edge_bundle_path() + +# Use tension to lessen the effect +ggraph(highschool) + + geom_edge_bundle_path(tension = 0.8) + +} +\references{ +Wallinger, M., Archambault, D., Auber, D., Nöllenburg, M., and Peltonen, J. +(2022). \emph{Edge-Path Bundling: A Less Ambiguous Edge Bundling Approach.} IEEE +Transactions on Visualization and Computer Graphics 28(1) 313-323. +https://doi.org/10.1109/TVCG.2021.3114795 +} +\seealso{ +Other geom_edge_*: +\code{\link{geom_edge_arc}()}, +\code{\link{geom_edge_bend}()}, +\code{\link{geom_edge_bundle_force}()}, +\code{\link{geom_edge_bundle_minimal}()}, +\code{\link{geom_edge_density}()}, +\code{\link{geom_edge_diagonal}()}, +\code{\link{geom_edge_elbow}()}, +\code{\link{geom_edge_fan}()}, +\code{\link{geom_edge_hive}()}, +\code{\link{geom_edge_link}()}, +\code{\link{geom_edge_loop}()}, +\code{\link{geom_edge_parallel}()}, +\code{\link{geom_edge_point}()}, +\code{\link{geom_edge_span}()}, +\code{\link{geom_edge_tile}()} +} +\author{ +Thomas Lin Pedersen and David Schoch +} +\concept{geom_edge_*} diff --git a/man/geom_edge_density.Rd b/man/geom_edge_density.Rd index aae52013..340f8c1e 100644 --- a/man/geom_edge_density.Rd +++ b/man/geom_edge_density.Rd @@ -93,6 +93,9 @@ ggraph(gr, 'stress') + Other geom_edge_*: \code{\link{geom_edge_arc}()}, \code{\link{geom_edge_bend}()}, +\code{\link{geom_edge_bundle_force}()}, +\code{\link{geom_edge_bundle_minimal}()}, +\code{\link{geom_edge_bundle_path}()}, \code{\link{geom_edge_diagonal}()}, \code{\link{geom_edge_elbow}()}, \code{\link{geom_edge_fan}()}, diff --git a/man/geom_edge_diagonal.Rd b/man/geom_edge_diagonal.Rd index b3224f86..c52fc64c 100644 --- a/man/geom_edge_diagonal.Rd +++ b/man/geom_edge_diagonal.Rd @@ -265,6 +265,9 @@ ggraph(gr, 'tree') + Other geom_edge_*: \code{\link{geom_edge_arc}()}, \code{\link{geom_edge_bend}()}, +\code{\link{geom_edge_bundle_force}()}, +\code{\link{geom_edge_bundle_minimal}()}, +\code{\link{geom_edge_bundle_path}()}, \code{\link{geom_edge_density}()}, \code{\link{geom_edge_elbow}()}, \code{\link{geom_edge_fan}()}, diff --git a/man/geom_edge_elbow.Rd b/man/geom_edge_elbow.Rd index 581ad9b0..93c50e13 100644 --- a/man/geom_edge_elbow.Rd +++ b/man/geom_edge_elbow.Rd @@ -267,6 +267,9 @@ ggraph(irisDen, 'dendrogram', height = height) + Other geom_edge_*: \code{\link{geom_edge_arc}()}, \code{\link{geom_edge_bend}()}, +\code{\link{geom_edge_bundle_force}()}, +\code{\link{geom_edge_bundle_minimal}()}, +\code{\link{geom_edge_bundle_path}()}, \code{\link{geom_edge_density}()}, \code{\link{geom_edge_diagonal}()}, \code{\link{geom_edge_fan}()}, diff --git a/man/geom_edge_fan.Rd b/man/geom_edge_fan.Rd index 856db78a..3c620add 100644 --- a/man/geom_edge_fan.Rd +++ b/man/geom_edge_fan.Rd @@ -268,6 +268,9 @@ ggraph(gr, 'stress') + Other geom_edge_*: \code{\link{geom_edge_arc}()}, \code{\link{geom_edge_bend}()}, +\code{\link{geom_edge_bundle_force}()}, +\code{\link{geom_edge_bundle_minimal}()}, +\code{\link{geom_edge_bundle_path}()}, \code{\link{geom_edge_density}()}, \code{\link{geom_edge_diagonal}()}, \code{\link{geom_edge_elbow}()}, diff --git a/man/geom_edge_hive.Rd b/man/geom_edge_hive.Rd index 9a7aa148..9bd66f69 100644 --- a/man/geom_edge_hive.Rd +++ b/man/geom_edge_hive.Rd @@ -269,6 +269,9 @@ ggraph(flareGr, 'hive', axis = type) + Other geom_edge_*: \code{\link{geom_edge_arc}()}, \code{\link{geom_edge_bend}()}, +\code{\link{geom_edge_bundle_force}()}, +\code{\link{geom_edge_bundle_minimal}()}, +\code{\link{geom_edge_bundle_path}()}, \code{\link{geom_edge_density}()}, \code{\link{geom_edge_diagonal}()}, \code{\link{geom_edge_elbow}()}, diff --git a/man/geom_edge_link.Rd b/man/geom_edge_link.Rd index ced90e96..f472ff9f 100644 --- a/man/geom_edge_link.Rd +++ b/man/geom_edge_link.Rd @@ -246,6 +246,9 @@ ggraph(gr, 'stress') + Other geom_edge_*: \code{\link{geom_edge_arc}()}, \code{\link{geom_edge_bend}()}, +\code{\link{geom_edge_bundle_force}()}, +\code{\link{geom_edge_bundle_minimal}()}, +\code{\link{geom_edge_bundle_path}()}, \code{\link{geom_edge_density}()}, \code{\link{geom_edge_diagonal}()}, \code{\link{geom_edge_elbow}()}, diff --git a/man/geom_edge_loop.Rd b/man/geom_edge_loop.Rd index 71ffdb66..7f7fa638 100644 --- a/man/geom_edge_loop.Rd +++ b/man/geom_edge_loop.Rd @@ -217,6 +217,9 @@ ggraph(gr, 'stress') + Other geom_edge_*: \code{\link{geom_edge_arc}()}, \code{\link{geom_edge_bend}()}, +\code{\link{geom_edge_bundle_force}()}, +\code{\link{geom_edge_bundle_minimal}()}, +\code{\link{geom_edge_bundle_path}()}, \code{\link{geom_edge_density}()}, \code{\link{geom_edge_diagonal}()}, \code{\link{geom_edge_elbow}()}, diff --git a/man/geom_edge_parallel.Rd b/man/geom_edge_parallel.Rd index 8eb6292a..1f2b72cd 100644 --- a/man/geom_edge_parallel.Rd +++ b/man/geom_edge_parallel.Rd @@ -263,6 +263,9 @@ ggraph(gr, 'stress') + Other geom_edge_*: \code{\link{geom_edge_arc}()}, \code{\link{geom_edge_bend}()}, +\code{\link{geom_edge_bundle_force}()}, +\code{\link{geom_edge_bundle_minimal}()}, +\code{\link{geom_edge_bundle_path}()}, \code{\link{geom_edge_density}()}, \code{\link{geom_edge_diagonal}()}, \code{\link{geom_edge_elbow}()}, diff --git a/man/geom_edge_point.Rd b/man/geom_edge_point.Rd index 4e8ad9c5..aa8cc18e 100644 --- a/man/geom_edge_point.Rd +++ b/man/geom_edge_point.Rd @@ -91,6 +91,9 @@ ggraph(gr, 'matrix', sort.by = node_rank_hclust()) + Other geom_edge_*: \code{\link{geom_edge_arc}()}, \code{\link{geom_edge_bend}()}, +\code{\link{geom_edge_bundle_force}()}, +\code{\link{geom_edge_bundle_minimal}()}, +\code{\link{geom_edge_bundle_path}()}, \code{\link{geom_edge_density}()}, \code{\link{geom_edge_diagonal}()}, \code{\link{geom_edge_elbow}()}, diff --git a/man/geom_edge_span.Rd b/man/geom_edge_span.Rd index 788fbf13..31a72996 100644 --- a/man/geom_edge_span.Rd +++ b/man/geom_edge_span.Rd @@ -262,6 +262,9 @@ ggraph(gr, 'fabric', sort.by = node_rank_fabric(), shadow.edges = TRUE) + Other geom_edge_*: \code{\link{geom_edge_arc}()}, \code{\link{geom_edge_bend}()}, +\code{\link{geom_edge_bundle_force}()}, +\code{\link{geom_edge_bundle_minimal}()}, +\code{\link{geom_edge_bundle_path}()}, \code{\link{geom_edge_density}()}, \code{\link{geom_edge_diagonal}()}, \code{\link{geom_edge_elbow}()}, diff --git a/man/geom_edge_tile.Rd b/man/geom_edge_tile.Rd index 2688afee..b860f85a 100644 --- a/man/geom_edge_tile.Rd +++ b/man/geom_edge_tile.Rd @@ -91,6 +91,9 @@ ggraph(gr, 'matrix', sort.by = node_rank_hclust()) + Other geom_edge_*: \code{\link{geom_edge_arc}()}, \code{\link{geom_edge_bend}()}, +\code{\link{geom_edge_bundle_force}()}, +\code{\link{geom_edge_bundle_minimal}()}, +\code{\link{geom_edge_bundle_path}()}, \code{\link{geom_edge_density}()}, \code{\link{geom_edge_diagonal}()}, \code{\link{geom_edge_elbow}()}, diff --git a/man/ggraph-extensions.Rd b/man/ggraph-extensions.Rd index 745631a2..f3f466bc 100644 --- a/man/ggraph-extensions.Rd +++ b/man/ggraph-extensions.Rd @@ -1,11 +1,13 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/aaa.R, R/facet_edges.R, R/facet_graph.R, % R/facet_nodes.R, R/geom_axis_hive.R, R/geom_conn_bundle.R, R/geom_edge.R, -% R/geom_edge_arc.R, R/geom_edge_bend.R, R/geom_edge_density.R, -% R/geom_edge_diagonal.R, R/geom_edge_elbow.R, R/geom_edge_fan.R, -% R/geom_edge_hive.R, R/geom_edge_link.R, R/geom_edge_loop.R, -% R/geom_edge_parallel.R, R/geom_node_arc_bar.R, R/geom_node_circle.R, -% R/geom_node_tile.R, R/geom_node_voronoi.R, R/ggproto-classes.R +% R/geom_edge_arc.R, R/geom_edge_bend.R, R/geom_edge_bundle_force.R, +% R/geom_edge_bundle_minimal.R, R/geom_edge_bundle_path.R, +% R/geom_edge_density.R, R/geom_edge_diagonal.R, R/geom_edge_elbow.R, +% R/geom_edge_fan.R, R/geom_edge_hive.R, R/geom_edge_link.R, +% R/geom_edge_loop.R, R/geom_edge_parallel.R, R/geom_node_arc_bar.R, +% R/geom_node_circle.R, R/geom_node_tile.R, R/geom_node_voronoi.R, +% R/ggproto-classes.R \docType{data} \name{StatFilter} \alias{StatFilter} @@ -34,6 +36,15 @@ \alias{StatEdgeBend} \alias{StatEdgeBend2} \alias{StatEdgeBend0} +\alias{StatEdgeBundleForce} +\alias{StatEdgeBundleForce2} +\alias{StatEdgeBundleForce0} +\alias{StatEdgeBundleMinimal} +\alias{StatEdgeBundleMinimal2} +\alias{StatEdgeBundleMinimal0} +\alias{StatEdgeBundlePath} +\alias{StatEdgeBundlePath2} +\alias{StatEdgeBundlePath0} \alias{StatEdgeDensity} \alias{GeomEdgeDensity} \alias{StatEdgeDiagonal} diff --git a/man/ggraph.Rd b/man/ggraph.Rd index ee766554..282beb30 100644 --- a/man/ggraph.Rd +++ b/man/ggraph.Rd @@ -130,6 +130,8 @@ details} \item{\code{unrooted}}{Draws unrooted trees based on equal angle with optional equal daylight modification. See \code{\link[=layout_tbl_graph_unrooted]{layout_tbl_graph_unrooted()}} for further details} +\item{\code{htree}}{Draws binary trees as a space filling fractal. See +\code{\link[=layout_tbl_graph_htree]{layout_tbl_graph_htree()}} for further details} } Alternatively a matrix or a data.frame can be provided to the \code{layout} diff --git a/man/layout_tbl_graph_htree.Rd b/man/layout_tbl_graph_htree.Rd index b72fc222..b2f88544 100644 --- a/man/layout_tbl_graph_htree.Rd +++ b/man/layout_tbl_graph_htree.Rd @@ -2,9 +2,14 @@ % Please edit documentation in R/layout_htree.R \name{layout_tbl_graph_htree} \alias{layout_tbl_graph_htree} -\title{Calculate nodes as areas dividing their parent} +\title{Layout binary trees in a fractal H formation} \usage{ -layout_tbl_graph_htree(graph, sort.by = NULL, direction = "out") +layout_tbl_graph_htree( + graph, + sort.by = NULL, + direction = "out", + circular = FALSE +) } \arguments{ \item{graph}{An \code{tbl_graph} object} @@ -15,53 +20,24 @@ layout_tbl_graph_htree(graph, sort.by = NULL, direction = "out") means that parents point towards their children, while \code{'in'} means that children point towards their parent.} -\item{weight}{An optional node variable to use as weight. Will only affect -the weight of leaf nodes as the weight of non-leaf nodes are derived from -their children.} - \item{circular}{Logical. Should the layout be transformed to a circular -representation. If \code{TRUE} the resulting layout will be a sunburst -diagram.} - -\item{height}{An optional node variable to use as height. If \code{NULL} -all nodes will be given a height of 1.} - -\item{const.area}{Logical. Should 'height' be scaled for area proportionality -when using \code{circular = TRUE}. Defaults to \code{TRUE}.} - -\item{offset}{If \code{circular = TRUE}, where should it begin. Defaults to -\code{pi/2} which is equivalent to 12 o'clock.} +representation. Ignored} } \value{ -If \code{circular = FALSE} A data.frame with the columns \code{x}, -\code{y}, \code{width}, \code{height}, \code{leaf}, -\code{depth}, \code{circular} as well as any information stored as node -variables in the tbl_graph object. -If \code{circular = TRUE} A data.frame with the columns \code{x}, \code{y}, -\code{r0}, \code{r}, \code{start}, \code{end}, \code{leaf}, -\code{depth}, \code{circular} as well as any information stored as node -variables in the tbl_graph object. +A data.frame with the columns \code{x}, \code{y}, \code{leaf}, \code{depth}, \code{circular} +as well as any information stored as node variables in the tbl_graph object. } \description{ -The partition layout is a way to show hierarchical data in the same way as -\code{\link[=layout_tbl_graph_treemap]{layout_tbl_graph_treemap()}}. Instead of subdividing the parent area -the partition layout shows the division of a nodes children next to the area -of the node itself. As such the node positions will be very reminiscent of -a reingold-tilford tree layout but by plotting nodes as areas it better -communicate the total weight of a node by summing up all its children. -Often partition layouts are called icicle plots or sunburst diagrams (in case -a radial transform is applied). +This is a spac efficient layout only useful for binary trees. It is fractal +and works by offsetting child nodes from their parent either horizontally or +vertically depending on depth. The offset is decreased at each step by a +factor of the square root of 2. } \note{ -partition is a layout intended for trees, that is, graphs where nodes +H Tree is a layout intended for trees, that is, graphs where nodes only have one parent and zero or more children. If the provided graph does not fit this format an attempt to convert it to such a format will be made. } -\references{ -Kruskal, J. B., Landwehr, J. M. (1983). \emph{Icicle Plots: Better Displays -for Hierarchical Clustering}. American Statistician Vol 37(2), 162-168. -https://doi.org/10.2307/2685881 -} \seealso{ Other layout_tbl_graph_*: \code{\link{layout_tbl_graph_auto}()}, diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 7734a724..bc730157 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -66,6 +66,27 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// force_bundle_iter +List force_bundle_iter(NumericMatrix edges_xy, List elist, double K, int C, int P, int P_rate, double S, int I, double I_rate, double compatibility_threshold, double eps); +RcppExport SEXP _ggraph_force_bundle_iter(SEXP edges_xySEXP, SEXP elistSEXP, SEXP KSEXP, SEXP CSEXP, SEXP PSEXP, SEXP P_rateSEXP, SEXP SSEXP, SEXP ISEXP, SEXP I_rateSEXP, SEXP compatibility_thresholdSEXP, SEXP epsSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< NumericMatrix >::type edges_xy(edges_xySEXP); + Rcpp::traits::input_parameter< List >::type elist(elistSEXP); + Rcpp::traits::input_parameter< double >::type K(KSEXP); + Rcpp::traits::input_parameter< int >::type C(CSEXP); + Rcpp::traits::input_parameter< int >::type P(PSEXP); + Rcpp::traits::input_parameter< int >::type P_rate(P_rateSEXP); + Rcpp::traits::input_parameter< double >::type S(SSEXP); + Rcpp::traits::input_parameter< int >::type I(ISEXP); + Rcpp::traits::input_parameter< double >::type I_rate(I_rateSEXP); + Rcpp::traits::input_parameter< double >::type compatibility_threshold(compatibility_thresholdSEXP); + Rcpp::traits::input_parameter< double >::type eps(epsSEXP); + rcpp_result_gen = Rcpp::wrap(force_bundle_iter(edges_xy, elist, K, C, P, P_rate, S, I, I_rate, compatibility_threshold, eps)); + return rcpp_result_gen; +END_RCPP +} // hTree NumericMatrix hTree(IntegerVector parent, IntegerVector order); RcppExport SEXP _ggraph_hTree(SEXP parentSEXP, SEXP orderSEXP) { @@ -161,6 +182,7 @@ static const R_CallMethodDef CallEntries[] = { {"_ggraph_pack", (DL_FUNC) &_ggraph_pack, 1}, {"_ggraph_circlePackLayout", (DL_FUNC) &_ggraph_circlePackLayout, 2}, {"_ggraph_dendrogram_spread", (DL_FUNC) &_ggraph_dendrogram_spread, 7}, + {"_ggraph_force_bundle_iter", (DL_FUNC) &_ggraph_force_bundle_iter, 11}, {"_ggraph_hTree", (DL_FUNC) &_ggraph_hTree, 2}, {"_ggraph_partitionTree", (DL_FUNC) &_ggraph_partitionTree, 4}, {"_ggraph_cut_lines", (DL_FUNC) &_ggraph_cut_lines, 9}, diff --git a/src/forceBundle.cpp b/src/forceBundle.cpp new file mode 100644 index 00000000..09a84cef --- /dev/null +++ b/src/forceBundle.cpp @@ -0,0 +1,321 @@ +// Re-implementation of https://github.com/upphiminn/d3.ForceBundle which +// implements Holten, Danny, and Jarke J. Van Wijk. "Force‐Directed Edge +// Bundling for Graph Visualization." Computer Graphics Forum (Blackwell +// Publishing Ltd) 28, no. 3 (2009): 983-990. +#include +using namespace Rcpp; + +double euclidean_distance(NumericVector P, NumericVector Q) { + return sqrt((P[0] - Q[0]) * (P[0] - Q[0]) + (P[1] - Q[1]) * (P[1] - Q[1])); +} + +double edge_length(NumericVector P, NumericVector Q, double eps) { + if ((std::abs(P[0] - Q[0]) < eps) && (std::abs(P[1] - Q[1]) < eps)) { + return eps; + } else { + return euclidean_distance(P, Q); + } +} + +double vector_dot_product(NumericVector P, NumericVector Q) { + return P[0] * Q[0] + P[1] * Q[1]; +} + +NumericVector edge_as_vector(NumericVector P) { + NumericVector vec = {P[2] - P[0], P[3] - P[1]}; + return vec; +} + +NumericVector project_point_on_line(NumericVector p, NumericVector Q) { + double Q_target_x = Q[2]; + double Q_source_x = Q[0]; + double Q_target_y = Q[3]; + double Q_source_y = Q[1]; + double p_x = p[0]; + double p_y = p[1]; + + double L = sqrt((Q_target_x - Q_source_x) * (Q_target_x - Q_source_x) + + (Q_target_y - Q_source_y) * (Q_target_y - Q_source_y)); + double r = ((Q_source_y - p_y) * (Q_source_y - Q_target_y) - + (Q_source_x - p_x) * (Q_target_x - Q_source_x)) / + (L * L); + + NumericVector vec = {(Q_source_x + r * (Q_target_x - Q_source_x)), + (Q_source_y + r * (Q_target_y - Q_source_y))}; + + return vec; +} + +double edge_visibility(NumericVector P, NumericVector Q) { + NumericVector qs = {Q[0], Q[1]}; + NumericVector qt = {Q[2], Q[3]}; + + NumericVector I0 = project_point_on_line(qs, P); + NumericVector I1 = project_point_on_line(qt, P); + + NumericVector midI = {(I0[0] + I1[0]) / 2.0, (I0[1] + I1[1]) / 2.0}; + NumericVector midP = {(P[0] + P[2]) / 2.0, (P[1] + P[3]) / 2.0}; + + double tmp = + 1.0 - 2.0 * euclidean_distance(midP, midI) / euclidean_distance(I0, I1); + if (tmp > 0) { + return tmp; + } else { + return 0; + } +} + +double compute_divided_edge_length(NumericMatrix emat) { + int segments = emat.rows() - 1; + double length = 0.0; + for (int i = 0; i < segments; ++i) { + double segment_length = euclidean_distance(emat(i, _), emat(i + 1, _)); + length += segment_length; + } + return length; +} + +List update_edge_divisions(List elist, int P) { + for (int e_idx = 0; e_idx < elist.length(); ++e_idx) { + NumericMatrix emat = elist[e_idx]; + if (P == 1) { + NumericMatrix emat_new(3, 2); + emat_new(0, 0) = emat(0, 0); + emat_new(0, 1) = emat(0, 1); + emat_new(1, 0) = (emat(0, 0) + emat(1, 0)) / 2.0; + emat_new(1, 1) = (emat(0, 1) + emat(1, 1)) / 2.0; + emat_new(2, 0) = emat(1, 0); + emat_new(2, 1) = emat(1, 1); + elist[e_idx] = emat_new; + } else { + double divided_edge_length = compute_divided_edge_length(emat); + double segment_length = divided_edge_length / (P + 1); + double current_segment_length = segment_length; + NumericMatrix emat_new(P + 2, 2); + emat_new(0, _) = emat(0, _); + emat_new((emat_new.rows() - 1), _) = emat((emat.rows() - 1), _); + int cur = 1; + for (int i = 1; i < emat.rows(); ++i) { + double old_segment_length = + euclidean_distance(emat(i - 1, _), emat(i, _)); + while (old_segment_length > current_segment_length) { + double percent_position = current_segment_length / old_segment_length; + double new_subdivision_point_x = emat(i - 1, 0); + double new_subdivision_point_y = emat(i - 1, 1); + + new_subdivision_point_x += + percent_position * (emat(i, 0) - emat(i - 1, 0)); + new_subdivision_point_y += + percent_position * (emat(i, 1) - emat(i - 1, 1)); + + emat_new(cur, 0) = new_subdivision_point_x; + emat_new(cur, 1) = new_subdivision_point_y; + cur += 1; + old_segment_length = old_segment_length - current_segment_length; + current_segment_length = segment_length; + } + current_segment_length -= old_segment_length; + } + elist[e_idx] = emat_new; + } + } + + return elist; +} + +double angle_compatibility(NumericVector P, NumericVector Q) { + NumericVector P_source = {P[0], P[1]}; + NumericVector P_target = {P[2], P[3]}; + NumericVector Q_source = {Q[0], Q[1]}; + NumericVector Q_target = {Q[2], Q[3]}; + + double dot_PQ = vector_dot_product(edge_as_vector(P), edge_as_vector(Q)); + double euc_PQ = euclidean_distance(P_source, P_target) * + euclidean_distance(Q_source, Q_target); + double frac_PQ = dot_PQ / euc_PQ; + return std::abs(frac_PQ); +} + +double scale_compatibility(NumericVector P, NumericVector Q) { + NumericVector P_source = {P[0], P[1]}; + NumericVector P_target = {P[2], P[3]}; + NumericVector Q_source = {Q[0], Q[1]}; + NumericVector Q_target = {Q[2], Q[3]}; + + double euc_P = euclidean_distance(P_source, P_target); + double euc_Q = euclidean_distance(Q_source, Q_target); + + double lavg = (euc_P + euc_Q) / 2.0; + return 2.0 / (lavg / std::min(euc_P, euc_Q) + std::max(euc_P, euc_Q) / lavg); +} + +double position_compatibility(NumericVector P, NumericVector Q) { + NumericVector P_source = {P[0], P[1]}; + NumericVector P_target = {P[2], P[3]}; + NumericVector Q_source = {Q[0], Q[1]}; + NumericVector Q_target = {Q[2], Q[3]}; + + double euc_P = euclidean_distance(P_source, P_target); + double euc_Q = euclidean_distance(Q_source, Q_target); + + double lavg = (euc_P + euc_Q) / 2.0; + + NumericVector midP = {(P_source[0] + P_target[0]) / 2.0, + (P_source[1] + P_target[1]) / 2.0}; + + NumericVector midQ = {(Q_source[0] + Q_target[0]) / 2.0, + (Q_source[1] + Q_target[1]) / 2.0}; + + double euc_mid = euclidean_distance(midP, midQ); + return lavg / (lavg + euc_mid); +} + +double visibility_compatibility(NumericVector P, NumericVector Q) { + return std::min(edge_visibility(P, Q), edge_visibility(Q, P)); +} + +double compatibility_score(NumericVector P, NumericVector Q) { + return angle_compatibility(P, Q) * scale_compatibility(P, Q) * + position_compatibility(P, Q) * visibility_compatibility(P, Q); +} + +bool are_compatible(NumericVector P, NumericVector Q, + double compatibility_threshold) { + return compatibility_score(P, Q) >= compatibility_threshold; +} + +List compute_compatibility_lists(NumericMatrix edges_xy, + double compatibility_threshold) { + int m = edges_xy.rows(); + List elist_comp(m); + for (int e = 0; e < (m - 1); ++e) { + NumericVector P = edges_xy(e, _); + for (int oe = (e + 1); oe < m; ++oe) { + NumericVector Q = edges_xy(oe, _); + if (are_compatible(P, Q, compatibility_threshold)) { + if (elist_comp[e] == R_NilValue) { + IntegerVector ecomp = {oe}; + elist_comp[e] = ecomp; + } else { + IntegerVector ecomp = elist_comp[e]; + ecomp.push_back(oe); + elist_comp[e] = ecomp; + } + if (elist_comp[oe] == R_NilValue) { + IntegerVector oecomp = {e}; + elist_comp[oe] = oecomp; + } else { + IntegerVector oecomp = elist_comp[oe]; + oecomp.push_back(e); + elist_comp[oe] = oecomp; + } + } + } + } + return elist_comp; +} + +NumericVector apply_spring_force(List elist, int e_idx, int i, double kP) { + NumericMatrix emat = elist[e_idx]; + NumericVector prec = emat(i - 1, _); + NumericVector succ = emat(i + 1, _); + NumericVector crnt = emat(i, _); + + double x = prec[0] - crnt[0] + succ[0] - crnt[0]; + double y = prec[1] - crnt[1] + succ[1] - crnt[1]; + + x *= kP; + y *= kP; + + return {x, y}; +} + +NumericVector apply_electrostatic_force(List elist, List elist_comp, int e_idx, + int i, double eps) { + NumericVector sum_of_forces(2); + if (elist_comp[e_idx] == R_NilValue) { + return sum_of_forces; + } + IntegerVector ecomps = elist_comp[e_idx]; + NumericMatrix emat = elist[e_idx]; + + for (int oe = 0; oe < ecomps.length(); ++oe) { + NumericMatrix oemat = elist[ecomps[oe]]; + NumericVector force = {oemat(i, 0) - emat(i, 0), oemat(i, 1) - emat(i, 1)}; + if ((std::abs(force[0]) > eps) || (std::abs(force[1]) > eps)) { + double euc = euclidean_distance(oemat(i, _), emat(i, _)); + double diff = std::pow(euc, -1.0); + + sum_of_forces[0] += force[0] * diff; + sum_of_forces[1] += force[1] * diff; + } + } + return sum_of_forces; +} + +NumericMatrix apply_resulting_forces_on_subdivision_points(List elist, + List elist_comp, + int e_idx, int P, + double S, double K, + double eps) { + NumericMatrix emat = elist[e_idx]; + + double kP = K / (edge_length(emat(0, _), emat(P + 1, _), eps) * (P + 1)); + + NumericMatrix resulting_forces_for_subdivision_points(P + 2, 2); + for (int i = 1; i < (P + 1); ++i) { + NumericMatrix resulting_force(2); + NumericVector spring_force = apply_spring_force(elist, e_idx, i, kP); + + NumericVector electrostatic_force = + apply_electrostatic_force(elist, elist_comp, e_idx, i, eps); + + resulting_force[0] = S * (spring_force[0] + electrostatic_force[0]); + resulting_force[1] = S * (spring_force[1] + electrostatic_force[1]); + + resulting_forces_for_subdivision_points(i, _) = resulting_force; + } + + return resulting_forces_for_subdivision_points; +} + +// [[Rcpp::export]] +List force_bundle_iter(NumericMatrix edges_xy, List elist, double K, int C, + int P, int P_rate, double S, int I, double I_rate, + double compatibility_threshold, double eps) { + int m = edges_xy.rows(); + // first division + + elist = update_edge_divisions(elist, P); + + // compute compatibility list + List elist_comp = + compute_compatibility_lists(edges_xy, compatibility_threshold); + + // main loop + for (int cycle = 0; cycle < C; ++cycle) { + for (int iteration = 0; iteration < I; ++iteration) { + List forces(m); + for (int e = 0; e < m; ++e) { + forces[e] = apply_resulting_forces_on_subdivision_points( + elist, elist_comp, e, P, S, K, eps); + } + for (int e = 0; e < m; ++e) { + NumericMatrix emat = elist[e]; + NumericMatrix fmat = forces[e]; + for (int i = 0; i < (P + 1); ++i) { + emat(i, 0) += fmat(i, 0); + emat(i, 1) += fmat(i, 1); + } + elist[e] = emat; + } + } + if (cycle != (C - 1)) { + S = S / 2.0; + P = P * P_rate; + I = I * I_rate; + elist = update_edge_divisions(elist, P); + } + } + return elist; +}