feat: Implement generic mechanism for layout_() modifiers

R/layout.R

@@ -364,11 +364,34 @@ layout.auto <- function(graph, dim = 2, ...) {
 #' @aliases layout
 #' @section Modifiers:
 #' Modifiers modify how a layout calculation is performed.
-#' Currently implemented modifiers: \itemize{
-#'   \item `component_wise()` calculates the layout separately
-#'     for each component of the graph, and then merges
-#'     them.
-#'   \item `normalize()` scales the layout to a square.
+#' Modifiers are applied in the order they are specified as arguments to
+#' `layout_()`.
+#'
+#' There are two types of modifiers:
+#' \itemize{
+#'   \item **Pre-layout modifiers** affect how the layout is calculated.
+#'     Only one pre-layout modifier can be used at a time.
+#'   \item **Post-layout modifiers** transform the resulting coordinates.
+#'     Multiple post-layout modifiers can be chained together.
+#' }
+#'
+#' Currently implemented modifiers:
+#' \itemize{
+#'   \item `component_wise()` (pre-layout) calculates the layout separately
+#'     for each component of the graph, and then merges them.
+#'   \item `normalize()` (post-layout) scales the layout to a square.
+#' }
+#'
+#' Custom modifiers can be created using the `layout_modifier()` function.
+#' A custom modifier must specify:
+#' \itemize{
+#'   \item `id`: A unique identifier string for the modifier
+#'   \item `type`: Either `"pre"` for pre-layout or `"post"` for post-layout
+#'   \item `args`: A list of arguments to pass to the apply function
+#'   \item `apply`: A function with signature
+#'     `function(graph, layout, modifier_args)` that performs the modification.
+#'     For pre-layout modifiers, `layout` is the layout specification.
+#'     For post-layout modifiers, `layout` is the coordinate matrix to transform.
 #' }
 #'
 #' @param graph The input graph.
@@ -387,41 +410,56 @@ layout.auto <- function(graph, dim = 2, ...) {
 #' g <- make_ring(10) + make_full_graph(5)
 #' coords <- layout_(g, as_star())
 #' plot(g, layout = coords)
+#'
+#' # Using modifiers
+#' g <- make_ring(10) + make_ring(5)
+#' coords <- layout_(g, in_circle(), component_wise(), normalize())
+#' plot(g, layout = coords)
+#'
+#' # Creating a custom post-layout modifier
+#' scale_by <- function(factor) {
+#'   layout_modifier(
+#'     id = "scale_by",
+#'     type = "post",
+#'     args = list(factor = factor),
+#'     apply = function(graph, layout, modifier_args) {
+#'       layout * modifier_args$factor
+#'     }
+#'   )
+#' }
+#' coords <- layout_(make_ring(10), in_circle(), scale_by(3))
+#' plot(make_ring(10), layout = coords)
 layout_ <- function(graph, layout, ...) {
   modifiers <- list(...)
   stopifnot(all(sapply(modifiers, inherits, what = "igraph_layout_modifier")))
 
   ids <- sapply(modifiers, "[[", "id")
-  stopifnot(all(ids %in% c("component_wise", "normalize")))
   if (anyDuplicated(ids)) {
     cli::cli_abort("Duplicate modifiers.")
   }
   names(modifiers) <- ids
 
-  ## TODO: better, generic mechanism for modifiers
-  if ("component_wise" %in% ids) {
-    graph$id <- seq(vcount(graph))
-    comps <- decompose(graph)
-    coords <- lapply(comps, function(comp) {
-      do_call(layout$fun, list(graph = comp), layout$args)
-    })
-    all_coords <- merge_coords(
-      comps,
-      coords,
-      method = modifiers[["component_wise"]]$args$merge_method
-    )
-    all_coords[unlist(sapply(comps, vertex_attr, "id")), ] <- all_coords[]
-    result <- all_coords
+  # Separate modifiers by type
+  is_pre <- vapply(modifiers, function(m) isTRUE(m$type == "pre"), logical(1))
+  pre_modifiers <- modifiers[is_pre]
+  post_modifiers <- modifiers[!is_pre]
+
+  # Apply pre-layout modifiers
+  if (length(pre_modifiers) > 0) {
+    # Enforce single pre-layout modifier restriction
+    if (length(pre_modifiers) > 1) {
+      cli::cli_abort("Multiple pre-layout modifiers are not supported.")
+    }
+    modifier <- pre_modifiers[[1]]
+    result <- modifier$apply(graph, layout, modifier$args)
   } else {
+    # No pre-layout modifiers, do standard layout
     result <- do_call(layout$fun, list(graph = graph), layout$args)
   }
 
-  if ("normalize" %in% ids) {
-    result <- do_call(
-      norm_coords,
-      list(result),
-      modifiers[["normalize"]]$args
-    )
+  # Apply post-layout modifiers in order
+  for (modifier in post_modifiers) {
+    result <- modifier$apply(graph, result, modifier$args)
   }
 
   result
@@ -518,7 +556,22 @@ component_wise <- function(merge_method = "dla") {
 
   layout_modifier(
     id = "component_wise",
-    args = args
+    type = "pre",
+    args = args,
+    apply = function(graph, layout, modifier_args) {
+      graph$id <- seq(vcount(graph))
+      comps <- decompose(graph)
+      coords <- lapply(comps, function(comp) {
+        do_call(layout$fun, list(graph = comp), layout$args)
+      })
+      all_coords <- merge_coords(
+        comps,
+        coords,
+        method = modifier_args$merge_method
+      )
+      all_coords[unlist(sapply(comps, vertex_attr, "id")), ] <- all_coords[]
+      all_coords
+    }
   )
 }
 
@@ -548,7 +601,15 @@ normalize <- function(
 
   layout_modifier(
     id = "normalize",
-    args = args
+    type = "post",
+    args = args,
+    apply = function(graph, layout, modifier_args) {
+      do_call(
+        norm_coords,
+        list(layout),
+        modifier_args
+      )
+    }
   )
 }
 

tests/testthat/test-layout.R

@@ -375,3 +375,105 @@ test_that("layout normalization handles all-NaN coordinates correctly", {
   normalized_3d <- norm_coords(layout_3d_nan, 0, 1, 0, 1, 0, 1)
   expect_equal(normalized_3d, matrix(rep(0.5, 9), ncol = 3))
 })
+
+test_that("generic modifier mechanism works with existing modifiers", {
+  # Test that component_wise modifier still works
+  g <- make_ring(10) + make_ring(5)
+  l1 <- layout_(g, in_circle(), component_wise())
+  expect_equal(nrow(l1), vcount(g))
+  expect_equal(ncol(l1), 2)
+  expect_true(all(is.finite(l1)))
+
+  # Test that normalize modifier still works
+  g <- make_ring(10)
+  l2 <- layout_(g, with_fr(), normalize())
+  expect_equal(nrow(l2), vcount(g))
+  expect_equal(ncol(l2), 2)
+  expect_true(all(l2 >= -1 & l2 <= 1))
+
+  # Test that both modifiers work together
+  g <- make_ring(10) + make_ring(5)
+  l3 <- layout_(g, in_circle(), component_wise(), normalize())
+  expect_equal(nrow(l3), vcount(g))
+  expect_equal(ncol(l3), 2)
+  expect_true(all(is.finite(l3)))
+  expect_true(all(l3 >= -1 & l3 <= 1))
+})
+
+test_that("custom post-layout modifiers can be created", {
+  # Create a custom modifier that scales coordinates by a factor
+  scale_by <- function(factor = 2) {
+    layout_modifier(
+      id = "scale_by",
+      type = "post",
+      args = list(factor = factor),
+      apply = function(graph, layout, modifier_args) {
+        layout * modifier_args$factor
+      }
+    )
+  }
+
+  g <- make_ring(5)
+  l1 <- layout_(g, in_circle())
+  l2 <- layout_(g, in_circle(), scale_by(factor = 3))
+
+  # l2 should be 3x l1
+  expect_equal(l2, l1 * 3)
+})
+
+test_that("multiple post-layout modifiers are applied in order", {
+  # Create test modifiers
+  add_offset <- function(offset = 1) {
+    layout_modifier(
+      id = "add_offset",
+      type = "post",
+      args = list(offset = offset),
+      apply = function(graph, layout, modifier_args) {
+        layout + modifier_args$offset
+      }
+    )
+  }
+
+  multiply_by <- function(factor = 2) {
+    layout_modifier(
+      id = "multiply_by",
+      type = "post",
+      args = list(factor = factor),
+      apply = function(graph, layout, modifier_args) {
+        layout * modifier_args$factor
+      }
+    )
+  }
+
+  g <- make_ring(5)
+  base_layout <- layout_(g, in_circle())
+
+  # Apply add first, then multiply: (layout + 1) * 2
+  l1 <- layout_(g, in_circle(), add_offset(1), multiply_by(2))
+  expect_equal(l1, (base_layout + 1) * 2)
+
+  # Apply multiply first, then add: (layout * 2) + 1
+  l2 <- layout_(g, in_circle(), multiply_by(2), add_offset(1))
+  expect_equal(l2, (base_layout * 2) + 1)
+
+  # Results should be different
+  expect_false(isTRUE(all.equal(l1, l2)))
+})
+
+test_that("duplicate modifiers are rejected", {
+  g <- make_ring(5)
+  expect_error(
+    layout_(g, in_circle(), normalize(), normalize()),
+    "Duplicate modifiers"
+  )
+})
+
+test_that("modifier types are correctly identified", {
+  cw <- component_wise()
+  expect_equal(cw$type, "pre")
+  expect_true(is.function(cw$apply))
+
+  norm <- normalize()
+  expect_equal(norm$type, "post")
+  expect_true(is.function(norm$apply))
+})