diff --git a/NEWS.md b/NEWS.md index 5c9b81e70eb..2d4f00315d9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,13 @@ # igraph 2.2.1.9002 +## Breaking changes (future) + +- The default value of the `mode` parameter will change from `"all"` to `"out"` in a future version for the following functions: `distances()`, `degree()`, `strength()`, `eccentricity()`, `radius()`, `graph_center()`, `ego()`, `ego_size()`, and `make_ego_graph()`. + This change makes the default behavior more intuitive by respecting edge directions in directed graphs instead of ignoring them. + A deprecation warning is now issued when these functions are called on directed graphs without explicitly specifying the `mode` parameter. + To prepare for this change and avoid warnings, please specify `mode` explicitly in your code. + ## Bug fixes - Use `LC_ALL=C` instead of `LOCALE=C` in `deps.mk` (#2446, #2447). diff --git a/R/centrality.R b/R/centrality.R index a79e3410bed..8ef70e566fd 100644 --- a/R/centrality.R +++ b/R/centrality.R @@ -1408,6 +1408,18 @@ strength <- function( loops = TRUE, weights = NULL ) { + # Warn about upcoming change in default mode parameter + if (missing(mode) && is_directed(graph)) { + lifecycle::deprecate_soft( + "2.1.0", + "strength(mode =)", + details = paste( + "The default value of `mode` will change from \"all\" to \"out\" in a future version.", + "Please specify `mode` explicitly to avoid this warning and ensure consistent behavior." + ) + ) + } + strength_impl( graph = graph, vids = vids, diff --git a/R/embedding.R b/R/embedding.R index 406f7338aa9..eb59c54deb2 100644 --- a/R/embedding.R +++ b/R/embedding.R @@ -108,7 +108,7 @@ embed_adjacency_matrix <- function( weights = NULL, which = c("lm", "la", "sa"), scaled = TRUE, - cvec = strength(graph, weights = weights) / (vcount(graph) - 1), + cvec = strength(graph, weights = weights, mode = "all") / (vcount(graph) - 1), options = arpack_defaults() ) { adjacency_spectral_embedding_impl( diff --git a/R/paths.R b/R/paths.R index 972bcc136b7..28bdd67e6de 100644 --- a/R/paths.R +++ b/R/paths.R @@ -306,6 +306,18 @@ eccentricity <- function( } } + # Warn about upcoming change in default mode parameter + if (missing(mode) && is_directed(graph)) { + lifecycle::deprecate_soft( + "2.1.0", + "eccentricity(mode =)", + details = paste( + "The default value of `mode` will change from \"all\" to \"out\" in a future version.", + "Please specify `mode` explicitly to avoid this warning and ensure consistent behavior." + ) + ) + } + eccentricity_dijkstra_impl( graph = graph, vids = vids, @@ -365,6 +377,18 @@ radius <- function( } } + # Warn about upcoming change in default mode parameter + if (missing(mode) && is_directed(graph)) { + lifecycle::deprecate_soft( + "2.1.0", + "radius(mode =)", + details = paste( + "The default value of `mode` will change from \"all\" to \"out\" in a future version.", + "Please specify `mode` explicitly to avoid this warning and ensure consistent behavior." + ) + ) + } + radius_dijkstra_impl( graph = graph, weights = weights, @@ -405,6 +429,18 @@ graph_center <- function( weights = NULL, mode = c("all", "out", "in", "total") ) { + # Warn about upcoming change in default mode parameter + if (missing(mode) && is_directed(graph)) { + lifecycle::deprecate_soft( + "2.1.0", + "graph_center(mode =)", + details = paste( + "The default value of `mode` will change from \"all\" to \"out\" in a future version.", + "Please specify `mode` explicitly to avoid this warning and ensure consistent behavior." + ) + ) + } + graph_center_dijkstra_impl( graph = graph, weights = weights, diff --git a/R/structural-properties.R b/R/structural-properties.R index 71f8bc54bbe..8e3eca8c657 100644 --- a/R/structural-properties.R +++ b/R/structural-properties.R @@ -919,6 +919,19 @@ degree <- function( normalized = FALSE ) { ensure_igraph(graph) + + # Warn about upcoming change in default mode parameter + if (missing(mode) && is_directed(graph)) { + lifecycle::deprecate_soft( + "2.1.0", + "degree(mode =)", + details = paste( + "The default value of `mode` will change from \"all\" to \"out\" in a future version.", + "Please specify `mode` explicitly to avoid this warning and ensure consistent behavior." + ) + ) + } + v <- as_igraph_vs(graph, v) mode <- igraph.match.arg(mode) @@ -1205,6 +1218,18 @@ distances <- function( ) { ensure_igraph(graph) + # Warn about upcoming change in default mode parameter + if (missing(mode) && is_directed(graph)) { + lifecycle::deprecate_soft( + "2.1.0", + "distances(mode =)", + details = paste( + "The default value of `mode` will change from \"all\" to \"out\" in a future version.", + "Please specify `mode` explicitly to avoid this warning and ensure consistent behavior." + ) + ) + } + # make sure that the lower-level function in C gets mode == "out" # unconditionally when the graph is undirected; this is used for # the selection of Johnson's algorithm in automatic mode @@ -2054,6 +2079,19 @@ ego_size <- function( mindist = 0 ) { ensure_igraph(graph) + + # Warn about upcoming change in default mode parameter + if (missing(mode) && is_directed(graph)) { + lifecycle::deprecate_soft( + "2.1.0", + "ego_size(mode =)", + details = paste( + "The default value of `mode` will change from \"all\" to \"out\" in a future version.", + "Please specify `mode` explicitly to avoid this warning and ensure consistent behavior." + ) + ) + } + mode <- igraph.match.arg(mode) mode <- switch(mode, "out" = 1, "in" = 2, "all" = 3) mindist <- as.numeric(mindist) @@ -2168,6 +2206,19 @@ ego <- function( mindist = 0 ) { ensure_igraph(graph) + + # Warn about upcoming change in default mode parameter + if (missing(mode) && is_directed(graph)) { + lifecycle::deprecate_soft( + "2.1.0", + "ego(mode =)", + details = paste( + "The default value of `mode` will change from \"all\" to \"out\" in a future version.", + "Please specify `mode` explicitly to avoid this warning and ensure consistent behavior." + ) + ) + } + mode <- igraph.match.arg(mode) mode <- switch(mode, "out" = 1, "in" = 2, "all" = 3) mindist <- as.numeric(mindist) @@ -2203,6 +2254,19 @@ make_ego_graph <- function( mindist = 0 ) { ensure_igraph(graph) + + # Warn about upcoming change in default mode parameter + if (missing(mode) && is_directed(graph)) { + lifecycle::deprecate_soft( + "2.1.0", + "make_ego_graph(mode =)", + details = paste( + "The default value of `mode` will change from \"all\" to \"out\" in a future version.", + "Please specify `mode` explicitly to avoid this warning and ensure consistent behavior." + ) + ) + } + mode <- igraph.match.arg(mode) mode <- switch(mode, "out" = 1L, "in" = 2L, "all" = 3L) mindist <- as.numeric(mindist) diff --git a/man/embed_adjacency_matrix.Rd b/man/embed_adjacency_matrix.Rd index 443e6489b90..502f0d65ce2 100644 --- a/man/embed_adjacency_matrix.Rd +++ b/man/embed_adjacency_matrix.Rd @@ -10,7 +10,7 @@ embed_adjacency_matrix( weights = NULL, which = c("lm", "la", "sa"), scaled = TRUE, - cvec = strength(graph, weights = weights)/(vcount(graph) - 1), + cvec = strength(graph, weights = weights, mode = "all")/(vcount(graph) - 1), options = arpack_defaults() ) } diff --git a/tests/testthat/test-conversion.R b/tests/testthat/test-conversion.R index 5fddb5f12fb..9559df3eeec 100644 --- a/tests/testthat/test-conversion.R +++ b/tests/testthat/test-conversion.R @@ -1,19 +1,19 @@ test_that("as_directed works", { gnp_undirected <- sample_gnp(100, 2 / 100) gnp_mutual <- as_directed(gnp_undirected, mode = "mutual") - expect_equal(degree(gnp_undirected), degree(gnp_mutual) / 2) + expect_equal(degree(gnp_undirected), degree(gnp_mutual, mode = "all") / 2) expect_isomorphic(gnp_undirected, as_undirected(gnp_mutual)) gnp_arbitrary <- as_directed(gnp_undirected, mode = "arbitrary") - expect_equal(degree(gnp_undirected), degree(gnp_arbitrary)) + expect_equal(degree(gnp_undirected), degree(gnp_arbitrary, mode = "all")) expect_isomorphic(gnp_undirected, as_undirected(gnp_arbitrary)) gnp_random <- as_directed(gnp_undirected, mode = "random") - expect_equal(degree(gnp_undirected), degree(gnp_random)) + expect_equal(degree(gnp_undirected), degree(gnp_random, mode = "all")) expect_isomorphic(gnp_undirected, as_undirected(gnp_random)) gnp_acyclic <- as_directed(gnp_undirected, mode = "acyclic") - expect_equal(degree(gnp_undirected), degree(gnp_acyclic)) + expect_equal(degree(gnp_undirected), degree(gnp_acyclic, mode = "all")) expect_isomorphic(gnp_undirected, as_undirected(gnp_acyclic)) }) diff --git a/tests/testthat/test-embedding.R b/tests/testthat/test-embedding.R index 50927d52c09..929c0bbd35c 100644 --- a/tests/testthat/test-embedding.R +++ b/tests/testthat/test-embedding.R @@ -24,7 +24,12 @@ test_that("embed_adjacency_matrix -- Undirected, unweighted case works", { no <- 7 A <- g[] A <- A + - 1 / 2 * as(Matrix::Matrix(diag(degree(g)), doDiag = FALSE), "generalMatrix") + 1 / + 2 * + as( + Matrix::Matrix(diag(degree(g, mode = "all")), doDiag = FALSE), + "generalMatrix" + ) ss <- eigen(A) U <- standardize_eigen_signs(ss$vectors) @@ -34,14 +39,14 @@ test_that("embed_adjacency_matrix -- Undirected, unweighted case works", { g, no = no, which = "la", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = TRUE ) as_la <- embed_adjacency_matrix( g, no = no, which = "la", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = FALSE ) @@ -57,14 +62,14 @@ test_that("embed_adjacency_matrix -- Undirected, unweighted case works", { g, no = no, which = "lm", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = TRUE ) as_lm <- embed_adjacency_matrix( g, no = no, which = "lm", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = FALSE ) @@ -83,14 +88,14 @@ test_that("embed_adjacency_matrix -- Undirected, unweighted case works", { g, no = no, which = "sa", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = TRUE ) as_sa <- embed_adjacency_matrix( g, no = no, which = "sa", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = FALSE ) @@ -111,7 +116,12 @@ test_that("embed_adjacency_matrix -- Undirected, weighted case works", { no <- 3 A <- g[] A <- A + - 1 / 2 * as(Matrix::Matrix(diag(degree(g)), doDiag = FALSE), "generalMatrix") + 1 / + 2 * + as( + Matrix::Matrix(diag(degree(g, mode = "all")), doDiag = FALSE), + "generalMatrix" + ) ss <- eigen(A) U <- standardize_eigen_signs(ss$vectors) @@ -121,14 +131,14 @@ test_that("embed_adjacency_matrix -- Undirected, weighted case works", { g, no = no, which = "la", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = TRUE ) as_la <- embed_adjacency_matrix( g, no = no, which = "la", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = FALSE ) @@ -144,14 +154,14 @@ test_that("embed_adjacency_matrix -- Undirected, weighted case works", { g, no = no, which = "lm", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = TRUE ) as_lm <- embed_adjacency_matrix( g, no = no, which = "lm", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = FALSE ) @@ -170,14 +180,14 @@ test_that("embed_adjacency_matrix -- Undirected, weighted case works", { g, no = no, which = "sa", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = TRUE ) as_sa <- embed_adjacency_matrix( g, no = no, which = "sa", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = FALSE ) @@ -195,7 +205,12 @@ test_that("embed_adjacency_matrix -- Directed, unweighted case works", { no <- 3 A <- g[] A <- A + - 1 / 2 * as(Matrix::Matrix(diag(degree(g)), doDiag = FALSE), "generalMatrix") + 1 / + 2 * + as( + Matrix::Matrix(diag(degree(g, mode = "all")), doDiag = FALSE), + "generalMatrix" + ) ss <- svd(A) U <- standardize_eigen_signs(ss$u) @@ -207,14 +222,14 @@ test_that("embed_adjacency_matrix -- Directed, unweighted case works", { g, no = no, which = "la", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = TRUE ) as_la <- embed_adjacency_matrix( g, no = no, which = "la", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = FALSE ) @@ -235,14 +250,14 @@ test_that("embed_adjacency_matrix -- Directed, unweighted case works", { g, no = no, which = "lm", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = TRUE ) as_lm <- embed_adjacency_matrix( g, no = no, which = "lm", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = FALSE ) @@ -263,14 +278,14 @@ test_that("embed_adjacency_matrix -- Directed, unweighted case works", { g, no = no, which = "sa", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = TRUE ) as_sa <- embed_adjacency_matrix( g, no = no, which = "sa", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = FALSE ) @@ -296,7 +311,12 @@ test_that("embed_adjacency_matrix -- Directed, weighted case works", { no <- 3 A <- g[] A <- A + - 1 / 2 * as(Matrix::Matrix(diag(degree(g)), doDiag = FALSE), "generalMatrix") + 1 / + 2 * + as( + Matrix::Matrix(diag(degree(g, mode = "all")), doDiag = FALSE), + "generalMatrix" + ) ss <- svd(A) U <- standardize_eigen_signs(ss$u) @@ -308,14 +328,14 @@ test_that("embed_adjacency_matrix -- Directed, weighted case works", { g, no = no, which = "la", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = TRUE ) as_la <- embed_adjacency_matrix( g, no = no, which = "la", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = FALSE ) @@ -334,14 +354,14 @@ test_that("embed_adjacency_matrix -- Directed, weighted case works", { g, no = no, which = "lm", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = TRUE ) as_lm <- embed_adjacency_matrix( g, no = no, which = "lm", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = FALSE ) @@ -360,14 +380,14 @@ test_that("embed_adjacency_matrix -- Directed, weighted case works", { g, no = no, which = "sa", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = TRUE ) as_sa <- embed_adjacency_matrix( g, no = no, which = "sa", - cvec = degree(g) / 2, + cvec = degree(g, mode = "all") / 2, scaled = FALSE ) @@ -415,7 +435,10 @@ test_that("embed_laplacian_matrix -- Undirected, unweighted, D-A case works", { g <- sample_gnm(10, 20, directed = FALSE) no <- 3 - A <- as(Matrix::Matrix(diag(degree(g)), doDiag = FALSE), "generalMatrix") - + A <- as( + Matrix::Matrix(diag(degree(g, mode = "all")), doDiag = FALSE), + "generalMatrix" + ) - g[] ss <- eigen(A) @@ -514,7 +537,7 @@ test_that("embed_laplacian_matrix -- Undirected, unweighted, DAD case works", { g <- sample_gnm(10, 20, directed = FALSE) no <- 3 - D12 <- diag(1 / sqrt(degree(g))) + D12 <- diag(1 / sqrt(degree(g, mode = "all"))) A <- D12 %*% g[] %*% D12 ss <- eigen(A) @@ -613,7 +636,7 @@ test_that("embed_laplacian_matrix -- Undirected, unweighted, I-DAD case works", g <- sample_gnm(10, 20, directed = FALSE) no <- 3 - D12 <- diag(1 / sqrt(degree(g))) + D12 <- diag(1 / sqrt(degree(g, mode = "all"))) A <- diag(vcount(g)) - D12 %*% g[] %*% D12 ss <- eigen(A) @@ -810,7 +833,7 @@ test_that("embed_laplacian_matrix -- Undirected, unweighted, DAD case works", { g <- sample_gnm(10, 20, directed = FALSE) no <- 3 - D12 <- diag(1 / sqrt(degree(g))) + D12 <- diag(1 / sqrt(degree(g, mode = "all"))) A <- D12 %*% g[] %*% D12 ss <- eigen(A) @@ -910,7 +933,7 @@ test_that("embed_laplacian_matrix -- Undirected, unweighted, I-DAD case works", g <- sample_gnm(10, 20, directed = FALSE) no <- 3 - D12 <- diag(1 / sqrt(degree(g))) + D12 <- diag(1 / sqrt(degree(g, mode = "all"))) A <- diag(vcount(g)) - D12 %*% g[] %*% D12 ss <- eigen(A) diff --git a/tests/testthat/test-games.R b/tests/testthat/test-games.R index 0c786e1d23a..1939102f85c 100644 --- a/tests/testthat/test-games.R +++ b/tests/testthat/test-games.R @@ -339,15 +339,15 @@ test_that("sample_pa can start from a graph", { expect_ecount(g_pa1, 5) expect_vcount(g_pa1, 10) - is_degree_zero <- (degree(g_pa1) == 0) + is_degree_zero <- (degree(g_pa1, mode = "all") == 0) expect_true(sum(is_degree_zero) %in% 0:4) # 2 3 4 5 6 7 8 10 # 25 302 1820 2563 3350 1093 816 31 - is_degree_one <- (degree(g_pa1) == 1) + is_degree_one <- (degree(g_pa1, mode = "all") == 1) expect_true(sum(is_degree_one) %in% c(2:8, 10L)) # 0 1 2 3 4 # 879 2271 5289 1532 29 - is_degree_two_or_three <- (degree(g_pa1) %in% 2:3) + is_degree_two_or_three <- (degree(g_pa1, mode = "all") %in% 2:3) expect_true(sum(is_degree_two_or_three) %in% 0:4) g_pa2 <- sample_pa(10, m = 1, algorithm = "bag", start.graph = make_star(10)) diff --git a/tests/testthat/test-paths.R b/tests/testthat/test-paths.R index 85f76ce094c..711bebbbda3 100644 --- a/tests/testthat/test-paths.R +++ b/tests/testthat/test-paths.R @@ -2,7 +2,7 @@ test_that("radius() works", { withr::local_seed(42) g <- make_tree(10, 2) - expect_equal(radius(g), 3) + expect_equal(radius(g, mode = "all"), 3) expect_equal(radius(g, mode = "in"), 0) expect_equal(radius(g, mode = "out"), 0) }) @@ -26,7 +26,7 @@ test_that("eccentricity() works", { withr::local_seed(42) g <- make_tree(10, 2) - expect_equal(eccentricity(g), c(3, 3, 4, 4, 4, 5, 5, 5, 5, 5)) + expect_equal(eccentricity(g, mode = "all"), c(3, 3, 4, 4, 4, 5, 5, 5, 5, 5)) expect_equal(eccentricity(g, mode = "in"), c(0, 1, 1, 2, 2, 2, 2, 3, 3, 3)) expect_equal(eccentricity(g, mode = "out"), c(3, 2, 1, 1, 1, 0, 0, 0, 0, 0)) }) @@ -49,7 +49,7 @@ test_that("eccentricity() works -- lifecycle", { test_that("graph_center() works", { withr::local_seed(42) g <- make_tree(100, 7) - expect_equal(as.numeric(graph_center(g)), c(1, 2)) + expect_equal(as.numeric(graph_center(g, mode = "all")), c(1, 2)) expect_equal(as.numeric(graph_center(g, mode = "in")), 1) expect_equal(as.numeric(graph_center(g, mode = "out")), 16:100) })