Refactor and extend plot.igraph(): renderer pipeline, and new features

NAMESPACE

@@ -162,6 +162,7 @@ export(as_long_data_frame)
 export(as_membership)
 export(as_phylo)
 export(as_star)
+export(as_svg)
 export(as_tree)
 export(as_undirected)
 export(assortativity)
@@ -593,6 +594,7 @@ export(kautz_graph)
 export(keeping_degseq)
 export(knn)
 export(label.propagation.community)
+export(label_top)
 export(laplacian_matrix)
 export(largest.cliques)
 export(largest.independent.vertex.sets)
@@ -803,6 +805,9 @@ export(sample_traits_callaway)
 export(sample_tree)
 export(sbm)
 export(sbm.game)
+export(scale_color)
+export(scale_colour)
+export(scale_size)
 export(scan_stat)
 export(sequential_pal)
 export(set.edge.attribute)

R/plot-aes.R

@@ -0,0 +1,111 @@
+#   IGraph R package
+#   Copyright (C) 2003-2012  Gabor Csardi <csardi.gabor@gmail.com>
+#
+#   This program is free software; you can redistribute it and/or modify
+#   it under the terms of the GNU General Public License as published by
+#   the Free Software Foundation; either version 2 of the License, or
+#   (at your option) any later version.
+###################################################################
+
+# Turn resolved plotting parameters into a typed, rectangular aesthetic table so
+# that downstream code can slice it by vertex/edge index instead of
+# re-implementing the `if (length(x) > 1) x[idx]` idiom for every parameter.
+#
+# Aesthetic resolution itself (the precedence chain
+# argument > graph attribute > igraph option > default) still lives in
+# `i.parse.plot.params()`; this layer only packages the already-resolved values.
+
+# Build an aesthetic table from a named list of columns, each recycled to `n`
+# rows. Recycling uses `rep(length.out = n)` to match the historical (lenient)
+# plotting behavior; downstream consumers (`mapply()`, `igraph.Arrows()`) recycle
+# their arguments anyway, so a length-1 column behaves identically whether it is
+# kept scalar or expanded here.
+#
+# Returns a vctrs data frame, which is type-stable (no factor coercion) and can
+# be subset with `vctrs::vec_slice()`.
+i.aes_table <- function(cols, n) {
+  cols <- lapply(cols, function(x) rep(x, length.out = n))
+  vctrs::new_data_frame(cols, n = as.integer(n))
+}
+
+# igraph 3.0.0 breaking change: a per-element plotting aesthetic must have
+# length 1 or exactly the number of vertices/edges. Previously a wrong-length
+# vector (e.g. 3 colors for 5 vertices) was silently recycled, masking user
+# mistakes; now it is an error.
+#
+# `vertex` and `edge` are named lists of resolved aesthetic vectors to check
+# against `vc` / `ec`. Only unambiguous per-element aesthetics should be passed:
+# aesthetics with special length semantics (vertex `label.adj`, list-valued
+# `pie`/`raster`, the vertex-attribute `arrow.mode` "a:" form) are intentionally
+# excluded by the caller.
+i.check_aes_lengths <- function(
+  vertex,
+  edge,
+  vc,
+  ec,
+  call = rlang::caller_env()
+) {
+  one_scope <- function(lst, n, scope, plural) {
+    for (nm in names(lst)) {
+      len <- length(lst[[nm]])
+      if (len != 1L && len != n) {
+        cli::cli_abort(
+          c(
+            "Invalid length for {scope} aesthetic {.field {nm}}.",
+            "x" = "It has length {len}, but must be length 1 or {n}.",
+            "i" = "The graph has {n} {plural}."
+          ),
+          call = call
+        )
+      }
+    }
+  }
+  one_scope(vertex, vc, "vertex", "vertices")
+  one_scope(edge, ec, "edge", "edges")
+  invisible(NULL)
+}
+
+# Edge aesthetic table for the per-edge visual properties that are subset by
+# edge index when drawing loop vs. non-loop edges. `loop.angle` (nullable) and
+# vertex-scoped properties are handled separately by the caller.
+i.edge_aes_table <- function(
+  color,
+  width,
+  lty,
+  arrow.mode,
+  arrow.size,
+  arrow.width,
+  curved,
+  label.color,
+  label.family,
+  label.font,
+  label.cex,
+  label.halo,
+  label.halo.width,
+  style,
+  alpha,
+  gradient,
+  n
+) {
+  i.aes_table(
+    list(
+      color = color,
+      width = width,
+      lty = lty,
+      arrow.mode = arrow.mode,
+      arrow.size = arrow.size,
+      arrow.width = arrow.width,
+      curved = curved,
+      label.color = label.color,
+      label.family = label.family,
+      label.font = label.font,
+      label.cex = label.cex,
+      label.halo = label.halo,
+      label.halo.width = label.halo.width,
+      style = style,
+      alpha = alpha,
+      gradient = gradient
+    ),
+    n = n
+  )
+}

R/plot-labels.R

@@ -0,0 +1,81 @@
+#   IGraph R package
+#   Copyright (C) 2003-2012  Gabor Csardi <csardi.gabor@gmail.com>
+#
+#   This program is free software; you can redistribute it and/or modify
+#   it under the terms of the GNU General Public License as published by
+#   the Free Software Foundation; either version 2 of the License, or
+#   (at your option) any later version.
+###################################################################
+
+# Label decluttering: a helper that keeps only the most prominent labels and
+# blanks the rest with NA. Because plot.igraph() omits NA labels,
+# the result can be passed straight to a label argument, e.g.
+# plot(g, vertex.label = label_top(degree(g), n = 10)).
+
+#' Keep only the most prominent labels
+#'
+#' `label_top()` returns a label vector with `NA` everywhere except the entries
+#' that rank highest by `by`. Because [plot.igraph()] omits `NA` labels, this is
+#' a convenient way to declutter dense graphs by labelling only the most
+#' important vertices (or edges). Pass it to a label argument, e.g.
+#' `plot(g, vertex.label = label_top(degree(g), n = 10))`.
+#'
+#' To label everything above a fixed cutoff instead of a fixed count, you do not
+#' need this helper: `ifelse(metric > cutoff, labels, NA)` works directly.
+#'
+#' @param by A numeric vector of scores to rank by, e.g. `degree(g)` or
+#'   `betweenness(g)`. One score per vertex (or edge).
+#' @param n Number of labels to keep (the top `n` by `by`). Give either `n` or
+#'   `prop`, not both. If neither is given, all labels are kept.
+#' @param prop Proportion of labels to keep, between 0 and 1; rounded up. Give
+#'   either `n` or `prop`, not both.
+#' @param labels The labels to thin. Defaults to `names(by)` if present,
+#'   otherwise the integer positions. Must have the same length as `by`.
+#' @param decreasing Logical; if `TRUE` (the default) the highest `by` values
+#'   are kept, otherwise the lowest.
+#' @return A character vector the same length as `by`, with `NA` in the
+#'   positions that are not kept.
+#' @examples
+#' g <- make_ring(10)
+#' plot(g, vertex.label = label_top(degree(g), n = 3))
+#' @export
+label_top <- function(
+  by,
+  n = NULL,
+  prop = NULL,
+  labels = NULL,
+  decreasing = TRUE
+) {
+  if (!is.numeric(by)) {
+    cli::cli_abort("{.arg by} must be a numeric vector.")
+  }
+  if (!is.null(n) && !is.null(prop)) {
+    cli::cli_abort("Give either {.arg n} or {.arg prop}, not both.")
+  }
+
+  labels <- labels %||% names(by) %||% as.character(seq_along(by))
+  if (length(labels) != length(by)) {
+    cli::cli_abort("{.arg labels} must have the same length as {.arg by}.")
+  }
+
+  k <- if (!is.null(n)) {
+    as.integer(n)
+  } else if (!is.null(prop)) {
+    if (prop < 0 || prop > 1) {
+      cli::cli_abort("{.arg prop} must be between 0 and 1.")
+    }
+    as.integer(ceiling(prop * length(by)))
+  } else {
+    length(by)
+  }
+
+  keep <- rank(
+    if (decreasing) -by else by,
+    ties.method = "min",
+    na.last = TRUE
+  ) <=
+    k
+  out <- as.character(labels)
+  out[!keep] <- NA_character_
+  out
+}