From 4286d1111e9fb1819d0b0d7a259340300440435f Mon Sep 17 00:00:00 2001 From: schochastics Date: Tue, 24 Jun 2025 11:14:23 +0200 Subject: [PATCH 01/18] adjust loop size for multi loops --- R/plot.R | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/R/plot.R b/R/plot.R index 43c75141150..db1b4f88cec 100644 --- a/R/plot.R +++ b/R/plot.R @@ -539,6 +539,14 @@ plot.igraph <- function( xx0 <- layout[loops.v, 1] + cos(la) * vs yy0 <- layout[loops.v, 2] - sin(la) * vs + + loop_table <- table(loops.v) + loop_idx <- ave(seq_along(loops.v), loops.v, FUN = seq_along) + base_loop_size <- loop.size + loop_increment <- 0.5 + + adjusted_loop_size <- base_loop_size + (loop_idx - 1) * loop_increment + mapply( loop, xx0, @@ -556,7 +564,8 @@ plot.igraph <- function( arrow.size = asize, arr.w = arrow.width, lab.x = loop.labx, - lab.y = loop.laby + lab.y = loop.laby, + loopSize = adjusted_loop_size ) } From 69dee27cc0b1f7d5404813009f92e112688a2d5a Mon Sep 17 00:00:00 2001 From: schochastics Date: Tue, 24 Jun 2025 21:12:55 +0200 Subject: [PATCH 02/18] decreased loop increment size --- R/plot.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/plot.R b/R/plot.R index db1b4f88cec..972b5df0a9a 100644 --- a/R/plot.R +++ b/R/plot.R @@ -543,7 +543,7 @@ plot.igraph <- function( loop_table <- table(loops.v) loop_idx <- ave(seq_along(loops.v), loops.v, FUN = seq_along) base_loop_size <- loop.size - loop_increment <- 0.5 + loop_increment <- 0.25 adjusted_loop_size <- base_loop_size + (loop_idx - 1) * loop_increment From 738b484464e96db57f5b81d21f5dc10210b7d08d Mon Sep 17 00:00:00 2001 From: schochastics Date: Tue, 24 Jun 2025 22:04:50 +0200 Subject: [PATCH 03/18] put loops in largest empty gap --- R/plot.R | 62 +++++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 50 insertions(+), 12 deletions(-) diff --git a/R/plot.R b/R/plot.R index 972b5df0a9a..1bbfd97ec79 100644 --- a/R/plot.R +++ b/R/plot.R @@ -439,13 +439,17 @@ plot.igraph <- function( ncol = 2, byrow = TRUE ) - phi <- atan2(cp[, 2] - center[2], cp[, 1] - center[1]) - r <- sqrt((cp[, 1] - center[1])**2 + (cp[, 2] - center[2])**2) + # Translate to local coordinates + cp_centered <- cp - + matrix(rep(center, each = nrow(cp)), ncol = 2, byrow = FALSE) - phi <- phi + rad + # Rotate all control points around the center + rotation_matrix <- matrix(c(cos(rad), -sin(rad), sin(rad), cos(rad)), ncol = 2) + cp_rotated <- t(rotation_matrix %*% t(cp_centered)) - cp[, 1] <- cx + r * cos(phi) - cp[, 2] <- cy + r * sin(phi) + # Translate back to global coordinates + cp <- cp_rotated + + matrix(rep(center, each = nrow(cp_rotated)), ncol = 2, byrow = FALSE) if (is.na(width)) { width <- 1 @@ -504,10 +508,10 @@ plot.igraph <- function( if (length(edge.width) > 1) { ew <- ew[loops.e] } - la <- loop.angle - if (length(loop.angle) > 1) { - la <- la[loops.e] - } + # la <- loop.angle + # if (length(loop.angle) > 1) { + # la <- la[loops.e] + # } lty <- edge.lty if (length(edge.lty) > 1) { lty <- lty[loops.e] @@ -537,9 +541,6 @@ plot.igraph <- function( lcex <- lcex[loops.e] } - xx0 <- layout[loops.v, 1] + cos(la) * vs - yy0 <- layout[loops.v, 2] - sin(la) * vs - loop_table <- table(loops.v) loop_idx <- ave(seq_along(loops.v), loops.v, FUN = seq_along) base_loop_size <- loop.size @@ -547,6 +548,43 @@ plot.igraph <- function( adjusted_loop_size <- base_loop_size + (loop_idx - 1) * loop_increment + la <- sapply(loops.v, function(v) { + # Get all incident non-loop edges + incident_edges <- incident(graph, v, mode = "all") + incident_edges <- incident_edges[!which_loop(graph)[incident_edges]] + + if (length(incident_edges) == 0) { + return(0) + } + + # Compute angles to the *other* node of each edge + angles <- sapply(incident_edges, function(e) { + ends_e <- ends(graph, e) + other <- if (as.numeric(ends_e[1]) == v) { + as.numeric(ends_e[2]) + } else { + as.numeric(ends_e[1]) + } + dx <- layout[other, 1] - layout[v, 1] + dy <- layout[other, 2] - layout[v, 2] + atan2(dy, dx) + }) + + # Normalize and sort + angles <- (angles + 2 * pi) %% (2 * pi) + angles <- sort(angles) + + if (length(angles) == 0) { + return(0) # Default angle if isolated node + } else { + gaps <- diff(c(angles, angles[1] + 2 * pi)) # wrap around + max_gap_index <- which.max(gaps) + (angles[max_gap_index] + gaps[max_gap_index] / 2) %% (2 * pi) + } + }) + xx0 <- layout[loops.v, 1] + cos(la) * vs + yy0 <- layout[loops.v, 2] + sin(la) * vs + ### CHANGED/ADDED: Dynamically calculate loop.angle based on largest gap mapply( loop, xx0, From 5ab009f9335bdd9553d4ebdb53fc87db0cfa2be0 Mon Sep 17 00:00:00 2001 From: schochastics Date: Tue, 24 Jun 2025 22:06:53 +0200 Subject: [PATCH 04/18] removed debug comments --- R/plot.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/plot.R b/R/plot.R index 1bbfd97ec79..9ca46484a00 100644 --- a/R/plot.R +++ b/R/plot.R @@ -549,7 +549,6 @@ plot.igraph <- function( adjusted_loop_size <- base_loop_size + (loop_idx - 1) * loop_increment la <- sapply(loops.v, function(v) { - # Get all incident non-loop edges incident_edges <- incident(graph, v, mode = "all") incident_edges <- incident_edges[!which_loop(graph)[incident_edges]] @@ -557,7 +556,6 @@ plot.igraph <- function( return(0) } - # Compute angles to the *other* node of each edge angles <- sapply(incident_edges, function(e) { ends_e <- ends(graph, e) other <- if (as.numeric(ends_e[1]) == v) { From 3585a0c85bb3c53cdc4b25ae3871e4a2e3641d3e Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 25 Jun 2025 09:11:06 +0200 Subject: [PATCH 05/18] make edge.loop.angle work with dynamic angles --- R/plot.R | 21 +++++++++++++-------- R/plot.common.R | 4 ++-- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/R/plot.R b/R/plot.R index 9ca46484a00..0f6131915e5 100644 --- a/R/plot.R +++ b/R/plot.R @@ -508,10 +508,10 @@ plot.igraph <- function( if (length(edge.width) > 1) { ew <- ew[loops.e] } - # la <- loop.angle - # if (length(loop.angle) > 1) { - # la <- la[loops.e] - # } + la <- loop.angle + if (length(loop.angle) > 1) { + la <- la[loops.e] + } lty <- edge.lty if (length(edge.lty) > 1) { lty <- lty[loops.e] @@ -541,6 +541,7 @@ plot.igraph <- function( lcex <- lcex[loops.e] } + # Get the number of loops per vertex to optimally align them loop_table <- table(loops.v) loop_idx <- ave(seq_along(loops.v), loops.v, FUN = seq_along) base_loop_size <- loop.size @@ -548,7 +549,8 @@ plot.igraph <- function( adjusted_loop_size <- base_loop_size + (loop_idx - 1) * loop_increment - la <- sapply(loops.v, function(v) { + # Calculate the angles for the loops to fit in the largest gap + la_dyn <- sapply(loops.v, function(v) { incident_edges <- incident(graph, v, mode = "all") incident_edges <- incident_edges[!which_loop(graph)[incident_edges]] @@ -568,21 +570,24 @@ plot.igraph <- function( atan2(dy, dx) }) - # Normalize and sort angles <- (angles + 2 * pi) %% (2 * pi) angles <- sort(angles) if (length(angles) == 0) { return(0) # Default angle if isolated node } else { - gaps <- diff(c(angles, angles[1] + 2 * pi)) # wrap around + gaps <- diff(c(angles, angles[1] + 2 * pi)) max_gap_index <- which.max(gaps) (angles[max_gap_index] + gaps[max_gap_index] / 2) %% (2 * pi) } }) + if (length(la) == 1) { + la <- rep(la, length(loops.v)) + } + la[is.na(la)] <- la_dyn[is.na(la)] xx0 <- layout[loops.v, 1] + cos(la) * vs yy0 <- layout[loops.v, 2] + sin(la) * vs - ### CHANGED/ADDED: Dynamically calculate loop.angle based on largest gap + mapply( loop, xx0, diff --git a/R/plot.common.R b/R/plot.common.R index 06a3327b9b9..81b0c3c6d61 100644 --- a/R/plot.common.R +++ b/R/plot.common.R @@ -355,7 +355,7 @@ #' Gives the angle in radians for plotting loop edges. #' See the `label.dist` vertex parameter to see how this is interpreted. #' -#' The default value is 0. +#' The default value is NA. This means that the loop edges will be drawn in the largest gap possible. #' } #' \item{loop.angle2}{ #' Gives the second angle in radians for plotting loop edges. @@ -4886,7 +4886,7 @@ i.edge.default <- list( label = i.get.edge.labels, lty = 1, width = 1, - loop.angle = 0, + loop.angle = NA, loop.angle2 = 0, label.family = "serif", label.font = 1, From c585b93bae6f8a75d8455514c5d90c4b65aa7f96 Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 25 Jun 2025 09:54:17 +0200 Subject: [PATCH 06/18] place loops next to each other rather than on top --- R/plot.R | 91 +++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 57 insertions(+), 34 deletions(-) diff --git a/R/plot.R b/R/plot.R index 0f6131915e5..f209406d72f 100644 --- a/R/plot.R +++ b/R/plot.R @@ -421,7 +421,8 @@ plot.igraph <- function( arr.w = arr.w, lab.x, lab.y, - loopSize = loop.size + loopSize = loop.size, + narrowing = 1 ) { rad <- angle center <- c(cx, cy) @@ -430,9 +431,9 @@ plot.igraph <- function( x0, y0, x0 + .4 * loopSize, - y0 + .2 * loopSize, + y0 + narrowing * .2 * loopSize, x0 + .4 * loopSize, - y0 - .2 * loopSize, + y0 - narrowing * .2 * loopSize, x0, y0 ), @@ -442,7 +443,7 @@ plot.igraph <- function( # Translate to local coordinates cp_centered <- cp - matrix(rep(center, each = nrow(cp)), ncol = 2, byrow = FALSE) - + print(cp_centered) # Rotate all control points around the center rotation_matrix <- matrix(c(cos(rad), -sin(rad), sin(rad), cos(rad)), ncol = 2) cp_rotated <- t(rotation_matrix %*% t(cp_centered)) @@ -541,53 +542,74 @@ plot.igraph <- function( lcex <- lcex[loops.e] } - # Get the number of loops per vertex to optimally align them + # For each loop, assign unique angle within largest gap (flower petal style) + la_dyn <- numeric(length(loops.v)) # one angle per loop + loop_table <- table(loops.v) loop_idx <- ave(seq_along(loops.v), loops.v, FUN = seq_along) - base_loop_size <- loop.size - loop_increment <- 0.25 + loop_count <- loop_table[as.character(loops.v)] + narrowing <- pmax(0.3, 1 - (loop_count - 1) * 0.15) - adjusted_loop_size <- base_loop_size + (loop_idx - 1) * loop_increment + for (v in unique(loops.v)) { + idx <- which(loops.v == v) - # Calculate the angles for the loops to fit in the largest gap - la_dyn <- sapply(loops.v, function(v) { + # Find largest angular gap for this vertex incident_edges <- incident(graph, v, mode = "all") incident_edges <- incident_edges[!which_loop(graph)[incident_edges]] if (length(incident_edges) == 0) { - return(0) - } - - angles <- sapply(incident_edges, function(e) { - ends_e <- ends(graph, e) - other <- if (as.numeric(ends_e[1]) == v) { - as.numeric(ends_e[2]) - } else { - as.numeric(ends_e[1]) - } - dx <- layout[other, 1] - layout[v, 1] - dy <- layout[other, 2] - layout[v, 2] - atan2(dy, dx) - }) - - angles <- (angles + 2 * pi) %% (2 * pi) - angles <- sort(angles) - - if (length(angles) == 0) { - return(0) # Default angle if isolated node + # No neighbors, spread loops in full circle + loop_angles <- seq(0, 2 * pi, length.out = length(idx) + 1)[-1] } else { + angles <- sapply(incident_edges, function(e) { + ends_e <- ends(graph, e) + other <- if (as.numeric(ends_e[1]) == v) { + as.numeric(ends_e[2]) + } else { + as.numeric(ends_e[1]) + } + dx <- layout[other, 1] - layout[v, 1] + dy <- layout[other, 2] - layout[v, 2] + atan2(dy, dx) + }) + + angles <- (angles + 2 * pi) %% (2 * pi) + angles <- sort(angles) gaps <- diff(c(angles, angles[1] + 2 * pi)) max_gap_index <- which.max(gaps) - (angles[max_gap_index] + gaps[max_gap_index] / 2) %% (2 * pi) + + gap_start <- angles[max_gap_index] + gap_end <- (gap_start + gaps[max_gap_index]) %% (2 * pi) + + # Generate equally spaced angles inside the gap + if (gap_end > gap_start) { + loop_angles <- seq(gap_start, gap_end, length.out = length(idx) + 2)[ + -c(1, length(idx) + 2) + ] + } else { + # wrapped gap + gap_end <- gap_end + 2 * pi + loop_angles <- seq(gap_start, gap_end, length.out = length(idx) + 2)[ + -c(1, length(idx) + 2) + ] %% + (2 * pi) + } } - }) + + la_dyn[idx] <- loop_angles + } if (length(la) == 1) { la <- rep(la, length(loops.v)) } la[is.na(la)] <- la_dyn[is.na(la)] + # === BEGIN: improved loop size/placement === + # All loops same size, but different directions like flower petals + adjusted_loop_size <- rep(loop.size, length(loops.v)) + + # Position loop attachment points using per-loop angles xx0 <- layout[loops.v, 1] + cos(la) * vs yy0 <- layout[loops.v, 2] + sin(la) * vs - + # === END: loop placement === mapply( loop, xx0, @@ -606,7 +628,8 @@ plot.igraph <- function( arr.w = arrow.width, lab.x = loop.labx, lab.y = loop.laby, - loopSize = adjusted_loop_size + loopSize = adjusted_loop_size, + narrowing = narrowing ) } From a78bc5a08e869bce177dcece6c46a093ddf33470 Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 25 Jun 2025 09:55:57 +0200 Subject: [PATCH 07/18] removed debug comments --- R/plot.R | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/R/plot.R b/R/plot.R index f209406d72f..566d229afe3 100644 --- a/R/plot.R +++ b/R/plot.R @@ -440,15 +440,12 @@ plot.igraph <- function( ncol = 2, byrow = TRUE ) - # Translate to local coordinates cp_centered <- cp - matrix(rep(center, each = nrow(cp)), ncol = 2, byrow = FALSE) - print(cp_centered) - # Rotate all control points around the center + rotation_matrix <- matrix(c(cos(rad), -sin(rad), sin(rad), cos(rad)), ncol = 2) cp_rotated <- t(rotation_matrix %*% t(cp_centered)) - # Translate back to global coordinates cp <- cp_rotated + matrix(rep(center, each = nrow(cp_rotated)), ncol = 2, byrow = FALSE) @@ -543,7 +540,7 @@ plot.igraph <- function( } # For each loop, assign unique angle within largest gap (flower petal style) - la_dyn <- numeric(length(loops.v)) # one angle per loop + la_dyn <- numeric(length(loops.v)) loop_table <- table(loops.v) loop_idx <- ave(seq_along(loops.v), loops.v, FUN = seq_along) @@ -553,7 +550,6 @@ plot.igraph <- function( for (v in unique(loops.v)) { idx <- which(loops.v == v) - # Find largest angular gap for this vertex incident_edges <- incident(graph, v, mode = "all") incident_edges <- incident_edges[!which_loop(graph)[incident_edges]] @@ -602,14 +598,12 @@ plot.igraph <- function( la <- rep(la, length(loops.v)) } la[is.na(la)] <- la_dyn[is.na(la)] - # === BEGIN: improved loop size/placement === # All loops same size, but different directions like flower petals adjusted_loop_size <- rep(loop.size, length(loops.v)) - # Position loop attachment points using per-loop angles xx0 <- layout[loops.v, 1] + cos(la) * vs yy0 <- layout[loops.v, 2] + sin(la) * vs - # === END: loop placement === + mapply( loop, xx0, From 180c54c71e6a1da51ff82f388d541baa1a28e905 Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 25 Jun 2025 11:06:59 +0200 Subject: [PATCH 08/18] fixed label placement and added tests --- R/plot.R | 15 ++--- .../_snaps/plot/basic-graph-layout-1.svg | 2 +- .../_snaps/plot/basic-graph-layout-2.svg | 2 +- .../_snaps/plot/basic-graph-spheres.svg | 2 +- tests/testthat/_snaps/plot/loop-graph.svg | 24 ++++---- .../testthat/_snaps/plot/multi-loops-many.svg | 56 +++++++++++++++++++ .../_snaps/plot/multi-loops-triangle.svg | 44 +++++++++++++++ tests/testthat/test-plot.R | 29 +++++++++- 8 files changed, 149 insertions(+), 25 deletions(-) create mode 100644 tests/testthat/_snaps/plot/multi-loops-many.svg create mode 100644 tests/testthat/_snaps/plot/multi-loops-triangle.svg diff --git a/R/plot.R b/R/plot.R index 566d229afe3..2552c7cc11e 100644 --- a/R/plot.R +++ b/R/plot.R @@ -465,16 +465,13 @@ plot.igraph <- function( ) if (is.language(label) || !is.na(label)) { - lx <- x0 + .3 - ly <- y0 - phi <- atan2(ly - center[2], lx - center[1]) - r <- sqrt((lx - center[1])**2 + (ly - center[2])**2) - - phi <- phi + rad - - lx <- cx + r * cos(phi) - ly <- cy + r * sin(phi) + # Get midpoint of the Bezier curve for label placement + p <- compute.bezier(cp, 50) + mid_index <- floor(ncol(p) / 2) + lx <- p[1, mid_index] + ly <- p[2, mid_index] + # Override if label position explicitly given if (!is.na(lab.x)) { lx <- lab.x } diff --git a/tests/testthat/_snaps/plot/basic-graph-layout-1.svg b/tests/testthat/_snaps/plot/basic-graph-layout-1.svg index d8d1dc241fa..089c3c6e71f 100644 --- a/tests/testthat/_snaps/plot/basic-graph-layout-1.svg +++ b/tests/testthat/_snaps/plot/basic-graph-layout-1.svg @@ -25,7 +25,7 @@ - + diff --git a/tests/testthat/_snaps/plot/basic-graph-layout-2.svg b/tests/testthat/_snaps/plot/basic-graph-layout-2.svg index f0808d3e4c3..d196b2c6456 100644 --- a/tests/testthat/_snaps/plot/basic-graph-layout-2.svg +++ b/tests/testthat/_snaps/plot/basic-graph-layout-2.svg @@ -25,7 +25,7 @@ - + diff --git a/tests/testthat/_snaps/plot/basic-graph-spheres.svg b/tests/testthat/_snaps/plot/basic-graph-spheres.svg index f35282245e1..d139a1cbfb3 100644 --- a/tests/testthat/_snaps/plot/basic-graph-spheres.svg +++ b/tests/testthat/_snaps/plot/basic-graph-spheres.svg @@ -25,7 +25,7 @@ - + diff --git a/tests/testthat/_snaps/plot/loop-graph.svg b/tests/testthat/_snaps/plot/loop-graph.svg index 91cf9f3730a..dbc868e079c 100644 --- a/tests/testthat/_snaps/plot/loop-graph.svg +++ b/tests/testthat/_snaps/plot/loop-graph.svg @@ -25,19 +25,19 @@ - -green - - -red -blue - - - + +green + + +red +blue + + + -1 -2 -3 +1 +2 +3 diff --git a/tests/testthat/_snaps/plot/multi-loops-many.svg b/tests/testthat/_snaps/plot/multi-loops-many.svg new file mode 100644 index 00000000000..a27b581d1b1 --- /dev/null +++ b/tests/testthat/_snaps/plot/multi-loops-many.svg @@ -0,0 +1,56 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1 +2 +3 +4 +5 + + diff --git a/tests/testthat/_snaps/plot/multi-loops-triangle.svg b/tests/testthat/_snaps/plot/multi-loops-triangle.svg new file mode 100644 index 00000000000..ed75631fba8 --- /dev/null +++ b/tests/testthat/_snaps/plot/multi-loops-triangle.svg @@ -0,0 +1,44 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +1 +2 +3 + + diff --git a/tests/testthat/test-plot.R b/tests/testthat/test-plot.R index d444050058f..7e50597d6ff 100644 --- a/tests/testthat/test-plot.R +++ b/tests/testthat/test-plot.R @@ -105,7 +105,13 @@ test_that("label colors are correct when loops are present", { vdiffr::expect_doppelganger( "loop graph", function() { - plot(g, edge.color = cols, edge.label.color = cols, edge.label = cols) + plot( + g, + edge.color = cols, + edge.label.color = cols, + edge.label = cols, + margin = 0.5 + ) } ) }) @@ -131,3 +137,24 @@ test_that("Edges stop at outside of rectangle node", { vdiffr::expect_doppelganger("rectangle-edges", rectangle_edges) }) + +test_that("Multi loops are arranged correctly", { + skip_if_not_installed("vdiffr") + + multi_loops_triangle <- function() { + g <- make_graph(c(1,2,2,3,3,1,1,1,1,1,1,1,1,1),directed = FALSE) + V(g)$x <- c(1,1.5,2) + V(g)$y <- c(0,1,0) + plot(g, margin = 0.2, loop.size = 2) + } + + vdiffr::expect_doppelganger("multi-loops-triangle", multi_loops_triangle) + + multi_loops_many <- function() { + withr::local_seed(42) + g2 <- make_graph(c(1,2, 2,3, 3,1, 1,4, 4,5, 5,1, 3,4, 5,2, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1),directed = FALSE) + plot(g2, loop.size = 2) + } + + vdiffr::expect_doppelganger("multi-loops-many", multi_loops_many) +}) From 871cb688d7921726ff8b37d20fe813f1e5532a13 Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 25 Jun 2025 12:07:26 +0200 Subject: [PATCH 09/18] adjust width of loop based on available space too --- R/plot.R | 35 ++++++++++++------- .../testthat/_snaps/plot/multi-loops-many.svg | 14 ++++---- .../_snaps/plot/multi-loops-triangle.svg | 8 ++--- 3 files changed, 34 insertions(+), 23 deletions(-) diff --git a/R/plot.R b/R/plot.R index 2552c7cc11e..31327f02da1 100644 --- a/R/plot.R +++ b/R/plot.R @@ -537,22 +537,24 @@ plot.igraph <- function( } # For each loop, assign unique angle within largest gap (flower petal style) + # depending on the number of loops and the available angular space la_dyn <- numeric(length(loops.v)) + narrowing <- numeric(length(loops.v)) loop_table <- table(loops.v) loop_idx <- ave(seq_along(loops.v), loops.v, FUN = seq_along) - loop_count <- loop_table[as.character(loops.v)] - narrowing <- pmax(0.3, 1 - (loop_count - 1) * 0.15) for (v in unique(loops.v)) { idx <- which(loops.v == v) + n_loops <- length(idx) incident_edges <- incident(graph, v, mode = "all") incident_edges <- incident_edges[!which_loop(graph)[incident_edges]] if (length(incident_edges) == 0) { - # No neighbors, spread loops in full circle - loop_angles <- seq(0, 2 * pi, length.out = length(idx) + 1)[-1] + # Full circle available if no edges + loop_angles <- seq(0, 2 * pi, length.out = n_loops + 1)[-1] + gap_span <- 2 * pi } else { angles <- sapply(incident_edges, function(e) { ends_e <- ends(graph, e) @@ -572,30 +574,39 @@ plot.igraph <- function( max_gap_index <- which.max(gaps) gap_start <- angles[max_gap_index] - gap_end <- (gap_start + gaps[max_gap_index]) %% (2 * pi) + gap_span <- gaps[max_gap_index] + gap_end <- (gap_start + gap_span) %% (2 * pi) - # Generate equally spaced angles inside the gap + # Generate loop angles spaced inside the gap if (gap_end > gap_start) { - loop_angles <- seq(gap_start, gap_end, length.out = length(idx) + 2)[ - -c(1, length(idx) + 2) + loop_angles <- seq(gap_start, gap_end, length.out = n_loops + 2)[ + -c(1, n_loops + 2) ] } else { - # wrapped gap + # wrap around gap_end <- gap_end + 2 * pi - loop_angles <- seq(gap_start, gap_end, length.out = length(idx) + 2)[ - -c(1, length(idx) + 2) + loop_angles <- seq(gap_start, gap_end, length.out = n_loops + 2)[ + -c(1, n_loops + 2) ] %% (2 * pi) } } la_dyn[idx] <- loop_angles + + # Compute narrowing factor based on angular space + angle_per_loop <- gap_span / n_loops + # Scale narrowing between 1 (wide) and ~0.3 (tight) + narrowing_factor <- pmin(1, pmax(0.2, angle_per_loop / (pi / 5))) # full width if ≥36°, compress below + print(narrowing_factor) + narrowing[idx] <- narrowing_factor } if (length(la) == 1) { la <- rep(la, length(loops.v)) } + la[is.na(la)] <- la_dyn[is.na(la)] - # All loops same size, but different directions like flower petals + adjusted_loop_size <- rep(loop.size, length(loops.v)) xx0 <- layout[loops.v, 1] + cos(la) * vs diff --git a/tests/testthat/_snaps/plot/multi-loops-many.svg b/tests/testthat/_snaps/plot/multi-loops-many.svg index a27b581d1b1..4541fe9af50 100644 --- a/tests/testthat/_snaps/plot/multi-loops-many.svg +++ b/tests/testthat/_snaps/plot/multi-loops-many.svg @@ -25,13 +25,13 @@ - - - - - - - + + + + + + + diff --git a/tests/testthat/_snaps/plot/multi-loops-triangle.svg b/tests/testthat/_snaps/plot/multi-loops-triangle.svg index ed75631fba8..423a6e806c1 100644 --- a/tests/testthat/_snaps/plot/multi-loops-triangle.svg +++ b/tests/testthat/_snaps/plot/multi-loops-triangle.svg @@ -25,10 +25,10 @@ - - - - + + + + From c4c4b273e3848977e2199ce89fcd5e8f56b7b5b2 Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" <41898282+github-actions[bot]@users.noreply.github.com> Date: Wed, 25 Jun 2025 12:17:56 +0200 Subject: [PATCH 10/18] test: Snapshot updates for rcc-smoke (null) (#1885) Co-authored-by: schochastics <17147355+schochastics@users.noreply.github.com> --- .../testthat/_snaps/plot/multi-loops-many.svg | 50 +++++++++---------- 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/tests/testthat/_snaps/plot/multi-loops-many.svg b/tests/testthat/_snaps/plot/multi-loops-many.svg index 4541fe9af50..69344a2cae4 100644 --- a/tests/testthat/_snaps/plot/multi-loops-many.svg +++ b/tests/testthat/_snaps/plot/multi-loops-many.svg @@ -25,32 +25,32 @@ - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + -1 -2 -3 -4 -5 +1 +2 +3 +4 +5 From 3824f46ab09aa0390a785f79cfe14009f5f34a3e Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 25 Jun 2025 10:25:06 +0000 Subject: [PATCH 11/18] chore: Auto-update from GitHub Actions Run: https://github.com/igraph/rigraph/actions/runs/15873713122 --- man/plot.common.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/plot.common.Rd b/man/plot.common.Rd index 99c01689b73..3c575cb1f7c 100644 --- a/man/plot.common.Rd +++ b/man/plot.common.Rd @@ -364,7 +364,7 @@ This is not very surprising, it is the expected behavior. Gives the angle in radians for plotting loop edges. See the \code{label.dist} vertex parameter to see how this is interpreted. -The default value is 0. +The default value is NA. This means that the loop edges will be drawn in the largest gap possible. } \item{loop.angle2}{ Gives the second angle in radians for plotting loop edges. From 6e40e7f8efe1d9f836b7392678043b135e102dfe Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 25 Jun 2025 12:34:02 +0200 Subject: [PATCH 12/18] make loops end in center of node instead of border --- R/plot.R | 6 +-- .../_snaps/plot/basic-graph-layout-1.svg | 2 +- .../_snaps/plot/basic-graph-layout-2.svg | 2 +- .../_snaps/plot/basic-graph-spheres.svg | 18 +++---- tests/testthat/_snaps/plot/loop-graph.svg | 4 +- .../testthat/_snaps/plot/multi-loops-many.svg | 50 +++++++++---------- .../_snaps/plot/multi-loops-triangle.svg | 8 +-- tests/testthat/test-plot.R | 2 +- 8 files changed, 46 insertions(+), 46 deletions(-) diff --git a/R/plot.R b/R/plot.R index 31327f02da1..46fb2bb3366 100644 --- a/R/plot.R +++ b/R/plot.R @@ -598,7 +598,6 @@ plot.igraph <- function( angle_per_loop <- gap_span / n_loops # Scale narrowing between 1 (wide) and ~0.3 (tight) narrowing_factor <- pmin(1, pmax(0.2, angle_per_loop / (pi / 5))) # full width if ≥36°, compress below - print(narrowing_factor) narrowing[idx] <- narrowing_factor } if (length(la) == 1) { @@ -609,8 +608,9 @@ plot.igraph <- function( adjusted_loop_size <- rep(loop.size, length(loops.v)) - xx0 <- layout[loops.v, 1] + cos(la) * vs - yy0 <- layout[loops.v, 2] + sin(la) * vs + r_offset <- 0 # radius offset for loops if needed later + xx0 <- layout[loops.v, 1] + cos(la) * r_offset + yy0 <- layout[loops.v, 2] + sin(la) * r_offset mapply( loop, diff --git a/tests/testthat/_snaps/plot/basic-graph-layout-1.svg b/tests/testthat/_snaps/plot/basic-graph-layout-1.svg index 089c3c6e71f..447b8f3955e 100644 --- a/tests/testthat/_snaps/plot/basic-graph-layout-1.svg +++ b/tests/testthat/_snaps/plot/basic-graph-layout-1.svg @@ -25,7 +25,7 @@ - + diff --git a/tests/testthat/_snaps/plot/basic-graph-layout-2.svg b/tests/testthat/_snaps/plot/basic-graph-layout-2.svg index d196b2c6456..994da3fe66c 100644 --- a/tests/testthat/_snaps/plot/basic-graph-layout-2.svg +++ b/tests/testthat/_snaps/plot/basic-graph-layout-2.svg @@ -25,7 +25,7 @@ - + diff --git a/tests/testthat/_snaps/plot/basic-graph-spheres.svg b/tests/testthat/_snaps/plot/basic-graph-spheres.svg index d139a1cbfb3..9e047bf05d8 100644 --- a/tests/testthat/_snaps/plot/basic-graph-spheres.svg +++ b/tests/testthat/_snaps/plot/basic-graph-spheres.svg @@ -25,16 +25,16 @@ - - - - - - + + + + + + -1 -2 -3 +1 +2 +3 diff --git a/tests/testthat/_snaps/plot/loop-graph.svg b/tests/testthat/_snaps/plot/loop-graph.svg index dbc868e079c..8f6af5eaa43 100644 --- a/tests/testthat/_snaps/plot/loop-graph.svg +++ b/tests/testthat/_snaps/plot/loop-graph.svg @@ -25,8 +25,8 @@ - -green + +green red diff --git a/tests/testthat/_snaps/plot/multi-loops-many.svg b/tests/testthat/_snaps/plot/multi-loops-many.svg index 69344a2cae4..f6239aaf584 100644 --- a/tests/testthat/_snaps/plot/multi-loops-many.svg +++ b/tests/testthat/_snaps/plot/multi-loops-many.svg @@ -25,32 +25,32 @@ - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + -1 -2 -3 -4 -5 +1 +2 +3 +4 +5 diff --git a/tests/testthat/_snaps/plot/multi-loops-triangle.svg b/tests/testthat/_snaps/plot/multi-loops-triangle.svg index 423a6e806c1..701ee9df382 100644 --- a/tests/testthat/_snaps/plot/multi-loops-triangle.svg +++ b/tests/testthat/_snaps/plot/multi-loops-triangle.svg @@ -25,10 +25,10 @@ - - - - + + + + diff --git a/tests/testthat/test-plot.R b/tests/testthat/test-plot.R index 7e50597d6ff..1c35043f50a 100644 --- a/tests/testthat/test-plot.R +++ b/tests/testthat/test-plot.R @@ -67,7 +67,7 @@ test_that("basic plot test, spheres", { vdiffr::expect_doppelganger( "Basic graph, spheres", function() { - plot(g, vertex.shape = "sphere", vertex.size = 100) + plot(g, vertex.shape = "sphere", vertex.size = 40) } ) }) From c9a965c915364767c384318c5eed85aade04b242 Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" <41898282+github-actions[bot]@users.noreply.github.com> Date: Wed, 25 Jun 2025 12:40:19 +0200 Subject: [PATCH 13/18] test: Snapshot updates for rcc-smoke (null) (#1886) Co-authored-by: schochastics <17147355+schochastics@users.noreply.github.com> --- .../testthat/_snaps/plot/multi-loops-many.svg | 50 +++++++++---------- 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/tests/testthat/_snaps/plot/multi-loops-many.svg b/tests/testthat/_snaps/plot/multi-loops-many.svg index f6239aaf584..e003ec2dee8 100644 --- a/tests/testthat/_snaps/plot/multi-loops-many.svg +++ b/tests/testthat/_snaps/plot/multi-loops-many.svg @@ -25,32 +25,32 @@ - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + -1 -2 -3 -4 -5 +1 +2 +3 +4 +5 From 778fd06f0a03f8e0043e1061f5003437b1eb5e4d Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 25 Jun 2025 12:48:59 +0200 Subject: [PATCH 14/18] slightly more narrow loops allowed --- R/plot.R | 4 +- .../testthat/_snaps/plot/multi-loops-many.svg | 50 +++++++++---------- 2 files changed, 27 insertions(+), 27 deletions(-) diff --git a/R/plot.R b/R/plot.R index 46fb2bb3366..b96e51fb88b 100644 --- a/R/plot.R +++ b/R/plot.R @@ -596,8 +596,8 @@ plot.igraph <- function( # Compute narrowing factor based on angular space angle_per_loop <- gap_span / n_loops - # Scale narrowing between 1 (wide) and ~0.3 (tight) - narrowing_factor <- pmin(1, pmax(0.2, angle_per_loop / (pi / 5))) # full width if ≥36°, compress below + # Scale narrowing between 1 (wide) and ~0.2 (tight) + narrowing_factor <- pmin(1, pmax(0.2, angle_per_loop / (pi / 4))) # full width if ≥45°, compress below narrowing[idx] <- narrowing_factor } if (length(la) == 1) { diff --git a/tests/testthat/_snaps/plot/multi-loops-many.svg b/tests/testthat/_snaps/plot/multi-loops-many.svg index e003ec2dee8..8f564791995 100644 --- a/tests/testthat/_snaps/plot/multi-loops-many.svg +++ b/tests/testthat/_snaps/plot/multi-loops-many.svg @@ -25,32 +25,32 @@ - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + -1 -2 -3 -4 -5 +1 +2 +3 +4 +5 From 770f32f8f586bd5592d2855c9a7a13ad4413fd72 Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" <41898282+github-actions[bot]@users.noreply.github.com> Date: Wed, 25 Jun 2025 13:06:49 +0200 Subject: [PATCH 15/18] test: Snapshot updates for rcc-smoke (null) (#1887) Co-authored-by: schochastics <17147355+schochastics@users.noreply.github.com> --- .../testthat/_snaps/plot/multi-loops-many.svg | 50 +++++++++---------- 1 file changed, 25 insertions(+), 25 deletions(-) diff --git a/tests/testthat/_snaps/plot/multi-loops-many.svg b/tests/testthat/_snaps/plot/multi-loops-many.svg index 8f564791995..4f554c09d97 100644 --- a/tests/testthat/_snaps/plot/multi-loops-many.svg +++ b/tests/testthat/_snaps/plot/multi-loops-many.svg @@ -25,32 +25,32 @@ - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + -1 -2 -3 -4 -5 +1 +2 +3 +4 +5 From 25afb4d1949c6772ca4b74fcadcad85f59b13f04 Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 25 Jun 2025 13:10:56 +0200 Subject: [PATCH 16/18] fixed layout for test graph --- .../testthat/_snaps/plot/multi-loops-many.svg | 50 +++++++++---------- tests/testthat/test-plot.R | 3 +- 2 files changed, 27 insertions(+), 26 deletions(-) diff --git a/tests/testthat/_snaps/plot/multi-loops-many.svg b/tests/testthat/_snaps/plot/multi-loops-many.svg index 4f554c09d97..c99ed95be4b 100644 --- a/tests/testthat/_snaps/plot/multi-loops-many.svg +++ b/tests/testthat/_snaps/plot/multi-loops-many.svg @@ -25,32 +25,32 @@ - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + -1 -2 -3 -4 -5 +1 +2 +3 +4 +5 diff --git a/tests/testthat/test-plot.R b/tests/testthat/test-plot.R index 1c35043f50a..bca9bdb7d74 100644 --- a/tests/testthat/test-plot.R +++ b/tests/testthat/test-plot.R @@ -151,8 +151,9 @@ test_that("Multi loops are arranged correctly", { vdiffr::expect_doppelganger("multi-loops-triangle", multi_loops_triangle) multi_loops_many <- function() { - withr::local_seed(42) g2 <- make_graph(c(1,2, 2,3, 3,1, 1,4, 4,5, 5,1, 3,4, 5,2, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1, 1,1),directed = FALSE) + V(g2)$x <- c(1,2,2,0,0) + V(g2)$y <- c(1,0,2,2,0) plot(g2, loop.size = 2) } From 903069bd413c1971ab271ad43e109605b931bda8 Mon Sep 17 00:00:00 2001 From: schochastics Date: Wed, 25 Jun 2025 16:04:46 +0200 Subject: [PATCH 17/18] dont use names --- R/plot.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/plot.R b/R/plot.R index b96e51fb88b..e6095c27ccc 100644 --- a/R/plot.R +++ b/R/plot.R @@ -557,7 +557,7 @@ plot.igraph <- function( gap_span <- 2 * pi } else { angles <- sapply(incident_edges, function(e) { - ends_e <- ends(graph, e) + ends_e <- ends(graph, e, names = FALSE) other <- if (as.numeric(ends_e[1]) == v) { as.numeric(ends_e[2]) } else { From 9436497783512d78691f8d6bddb1eaff348b40ee Mon Sep 17 00:00:00 2001 From: schochastics Date: Thu, 3 Jul 2025 12:14:15 +0200 Subject: [PATCH 18/18] changed NA to NULL --- R/plot.R | 6 +++--- R/plot.common.R | 4 ++-- man/plot.common.Rd | 2 +- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/plot.R b/R/plot.R index 24f2c13ee8d..518c17c581a 100644 --- a/R/plot.R +++ b/R/plot.R @@ -610,15 +610,15 @@ plot.igraph <- function( narrowing_factor <- pmin(1, pmax(0.2, angle_per_loop / (pi / 4))) # full width if ≥45°, compress below narrowing[idx] <- narrowing_factor } - if (length(la) == 1) { - la <- rep(la, length(loops.v)) + if (is.null(la)) { + la <- rep(NA, length(loops.v)) } la[is.na(la)] <- la_dyn[is.na(la)] adjusted_loop_size <- rep(loop.size, length(loops.v)) - r_offset <- 0 # radius offset for loops if needed later + r_offset <- 0 xx0 <- layout[loops.v, 1] + cos(la) * r_offset yy0 <- layout[loops.v, 2] + sin(la) * r_offset diff --git a/R/plot.common.R b/R/plot.common.R index baa97238a7f..72b07c6d1e6 100644 --- a/R/plot.common.R +++ b/R/plot.common.R @@ -348,7 +348,7 @@ #' Gives the angle in radians for plotting loop edges. #' See the `label.dist` vertex parameter to see how this is interpreted. #' -#' The default value is NA. This means that the loop edges will be drawn in the largest gap possible. +#' The default value is NULL. This means that the loop edges will be drawn automatically in the largest gap possible. #' } #' \item{loop.angle2}{ #' Gives the second angle in radians for plotting loop edges. @@ -4881,7 +4881,7 @@ i.edge.default <- list( label = i.get.edge.labels, lty = 1, width = 1, - loop.angle = NA, + loop.angle = NULL, loop.angle2 = 0, label.family = "serif", label.font = 1, diff --git a/man/plot.common.Rd b/man/plot.common.Rd index a24e5018a00..09b4ddb6cee 100644 --- a/man/plot.common.Rd +++ b/man/plot.common.Rd @@ -356,7 +356,7 @@ This is not very surprising, it is the expected behavior. Gives the angle in radians for plotting loop edges. See the \code{label.dist} vertex parameter to see how this is interpreted. -The default value is NA. This means that the loop edges will be drawn in the largest gap possible. +The default value is NULL. This means that the loop edges will be drawn automatically in the largest gap possible. } \item{loop.angle2}{ Gives the second angle in radians for plotting loop edges.