From 2d6022352fe5c13716b073910971f0f9867083ad Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Tue, 10 Dec 2024 12:25:40 +0100 Subject: [PATCH 1/5] chore: deprecate `scale` argument of `centr_eigen()` and `centr_eigen_tmax()` --- R/centralization.R | 52 +++++++++++++++++++++++++++---- man/centr_eigen.Rd | 6 ++-- man/centr_eigen_tmax.Rd | 11 +++++-- man/centralization.evcent.Rd | 4 +-- man/centralization.evcent.tmax.Rd | 4 +-- 5 files changed, 61 insertions(+), 16 deletions(-) diff --git a/R/centralization.R b/R/centralization.R index 469bc6c7cd..e18feb400a 100644 --- a/R/centralization.R +++ b/R/centralization.R @@ -448,8 +448,8 @@ centr_clo_tmax <- centralization_closeness_tmax_impl #' @param graph The input graph. #' @param directed logical scalar, whether to use directed shortest paths for #' calculating eigenvector centrality. -#' @param scale Whether to rescale the eigenvector centrality scores, such that -#' the maximum score is one. +#' @param scale `r lifecycle::badge("deprecated")` Ignored. Computing +#' eigenvector centralization requires normalized eigenvector centrality scores. #' @param options This is passed to [eigen_centrality()], the options #' for the ARPACK eigensolver. #' @param normalized Logical scalar. Whether to normalize the graph level @@ -481,7 +481,28 @@ centr_clo_tmax <- centralization_closeness_tmax_impl #' centr_eigen(g0)$centralization #' centr_eigen(g1)$centralization #' @cdocs igraph_centralization_eigenvector_centrality -centr_eigen <- centralization_eigenvector_centrality_impl +centr_eigen <- function(graph, + directed = FALSE, + scale = deprecated(), + options = arpack_defaults(), + normalized = TRUE) { + + if (lifecycle::is_present(scale)) { + lifecycle::deprecate_soft( + "2.1.3", + "centr_eigen(scale = )", + details = "The function always behaves as if `scale` were TRUE. + The argument will be removed in the future." + ) + } + + centralization_eigenvector_centrality_impl( + graph = graph, + directed = directed, + options = options, + normalized = normalized + ) +} #' Theoretical maximum for eigenvector centralization #' @@ -493,8 +514,8 @@ centr_eigen <- centralization_eigenvector_centrality_impl #' given. #' @param directed logical scalar, whether to consider edge directions #' during the calculation. Ignored in undirected graphs. -#' @param scale Whether to rescale the eigenvector centrality scores, -#' such that the maximum score is one. +#' @param scale `r lifecycle::badge("deprecated")` Ignored. Computing +#' eigenvector centralization requires normalized eigenvector centrality scores. #' @return Real scalar, the theoretical maximum (unnormalized) graph #' eigenvector centrality score for graphs with given vertex count and #' other parameters. @@ -510,4 +531,23 @@ centr_eigen <- centralization_eigenvector_centrality_impl #' `/`(centr_eigen_tmax(g)) #' centr_eigen(g, normalized = TRUE)$centralization #' @cdocs igraph_centralization_eigenvector_centrality_tmax -centr_eigen_tmax <- centralization_eigenvector_centrality_tmax_impl +centr_eigen_tmax <- function(graph = NULL, + nodes = 0, + directed = FALSE, + scale = deprecated()) { + + if (lifecycle::is_present(scale)) { + lifecycle::deprecate_soft( + "2.1.3", + "centr_eigen_tmax(scale = )", + details = "The function always behaves as if `scale` were TRUE. + The argument will be removed in the future." + ) + } + + centralization_eigenvector_centrality_tmax_impl( + graph = graph, + nodes = nodes, + directed = directed + ) +} diff --git a/man/centr_eigen.Rd b/man/centr_eigen.Rd index f3efd32294..64fd75e185 100644 --- a/man/centr_eigen.Rd +++ b/man/centr_eigen.Rd @@ -7,7 +7,7 @@ centr_eigen( graph, directed = FALSE, - scale = TRUE, + scale = deprecated(), options = arpack_defaults(), normalized = TRUE ) @@ -18,8 +18,8 @@ centr_eigen( \item{directed}{logical scalar, whether to use directed shortest paths for calculating eigenvector centrality.} -\item{scale}{Whether to rescale the eigenvector centrality scores, such that -the maximum score is one.} +\item{scale}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Ignored. Computing +eigenvector centralization requires normalized eigenvector centrality scores.} \item{options}{This is passed to \code{\link[=eigen_centrality]{eigen_centrality()}}, the options for the ARPACK eigensolver.} diff --git a/man/centr_eigen_tmax.Rd b/man/centr_eigen_tmax.Rd index a1e2760bfa..06fd7b2225 100644 --- a/man/centr_eigen_tmax.Rd +++ b/man/centr_eigen_tmax.Rd @@ -4,7 +4,12 @@ \alias{centr_eigen_tmax} \title{Theoretical maximum for eigenvector centralization} \usage{ -centr_eigen_tmax(graph = NULL, nodes = 0, directed = FALSE, scale = TRUE) +centr_eigen_tmax( + graph = NULL, + nodes = 0, + directed = FALSE, + scale = deprecated() +) } \arguments{ \item{graph}{The input graph. It can also be \code{NULL}, if @@ -16,8 +21,8 @@ given.} \item{directed}{logical scalar, whether to consider edge directions during the calculation. Ignored in undirected graphs.} -\item{scale}{Whether to rescale the eigenvector centrality scores, -such that the maximum score is one.} +\item{scale}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Ignored. Computing +eigenvector centralization requires normalized eigenvector centrality scores.} } \value{ Real scalar, the theoretical maximum (unnormalized) graph diff --git a/man/centralization.evcent.Rd b/man/centralization.evcent.Rd index 7ea5b0ca71..ed31018fb4 100644 --- a/man/centralization.evcent.Rd +++ b/man/centralization.evcent.Rd @@ -18,8 +18,8 @@ centralization.evcent( \item{directed}{logical scalar, whether to use directed shortest paths for calculating eigenvector centrality.} -\item{scale}{Whether to rescale the eigenvector centrality scores, such that -the maximum score is one.} +\item{scale}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Ignored. Computing +eigenvector centralization requires normalized eigenvector centrality scores.} \item{options}{This is passed to \code{\link[=eigen_centrality]{eigen_centrality()}}, the options for the ARPACK eigensolver.} diff --git a/man/centralization.evcent.tmax.Rd b/man/centralization.evcent.tmax.Rd index 43b1652ed8..688913f841 100644 --- a/man/centralization.evcent.tmax.Rd +++ b/man/centralization.evcent.tmax.Rd @@ -21,8 +21,8 @@ given.} \item{directed}{logical scalar, whether to consider edge directions during the calculation. Ignored in undirected graphs.} -\item{scale}{Whether to rescale the eigenvector centrality scores, -such that the maximum score is one.} +\item{scale}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Ignored. Computing +eigenvector centralization requires normalized eigenvector centrality scores.} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} From 0beeb6304ac94e7b4335faf6e29c58b0477fb43e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Tue, 10 Dec 2024 12:39:06 +0100 Subject: [PATCH 2/5] test: add tests for `centralization.R` --- tests/testthat/_snaps/centralization.md | 27 ++++++++++++++ tests/testthat/test-centralization.R | 47 +++++++++++++++++++++++++ 2 files changed, 74 insertions(+) create mode 100644 tests/testthat/_snaps/centralization.md create mode 100644 tests/testthat/test-centralization.R diff --git a/tests/testthat/_snaps/centralization.md b/tests/testthat/_snaps/centralization.md new file mode 100644 index 0000000000..830f352bbd --- /dev/null +++ b/tests/testthat/_snaps/centralization.md @@ -0,0 +1,27 @@ +# centr_eigen_tmax() deprecated argument + + Code + c <- centr_eigen_tmax(g, scale = FALSE) + Condition + Warning: + The `scale` argument of `centr_eigen_tmax()` is deprecated as of igraph 2.1.3. + i The function always behaves as if `scale` were TRUE. The argument will be removed in the future. + +# centr_eigen() deprecated argument + + Code + c <- centr_eigen(g, scale = FALSE) + Condition + Warning: + The `scale` argument of `centr_eigen()` is deprecated as of igraph 2.1.3. + i The function always behaves as if `scale` were TRUE. The argument will be removed in the future. + +# centr_degree_tmax() deprecated argument + + Code + c <- centr_degree_tmax(g) + Condition + Warning: + The `loops` argument of `centr_degree_tmax()` must be explicit as of igraph 2.0.0. + i Default value (`FALSE`) will be dropped in next release, add an explicit value for the loops argument. + diff --git a/tests/testthat/test-centralization.R b/tests/testthat/test-centralization.R new file mode 100644 index 0000000000..945c35579e --- /dev/null +++ b/tests/testthat/test-centralization.R @@ -0,0 +1,47 @@ +test_that("centr_eigen_tmax() works", { + withr::local_seed(42) + g <- sample_pa(1000, m = 4) + expect_equal(centr_eigen_tmax(g), 998) +}) + +test_that("centr_eigen_tmax() deprecated argument", { + g <- sample_pa(1000, m = 4) + expect_snapshot(c <- centr_eigen_tmax(g, scale = FALSE)) +}) + +test_that("centr_eigen() works", { + withr::local_seed(42) + g <- sample_pa(1000, m = 4) + centr_eigen <- centr_eigen(g) + expect_setequal( + names(centr_eigen), + c("vector", "value", "options", "centralization", "theoretical_max") + ) + expect_equal(centr_eigen$centralization, 0.9432924, tolerance = 1e-06) +}) + +test_that("centr_eigen() deprecated argument", { + g <- sample_pa(1000, m = 4) + expect_snapshot(c <- centr_eigen(g, scale = FALSE)) +}) + +test_that("centr_degree_tmax() works", { + withr::local_seed(42) + g <- sample_pa(1000, m = 4) + expect_gt(centr_degree_tmax(g, loops = TRUE), 1990000) +}) + +test_that("centr_degree_tmax() deprecated argument", { + g <- sample_pa(1000, m = 4) + expect_snapshot(c <- centr_degree_tmax(g)) +}) + +test_that("centr_betw() works", { + withr::local_seed(42) + g <- sample_pa(1000, m = 4) + expect_setequal( + names(centr_betw(g)), + c("res", "centralization", "theoretical_max") + ) + expect_equal(centr_betw(g)$theoretical_max, 996004998) +}) From f174e4ecf646852899ffce8b539fb05e0a5a8092 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Thu, 12 Dec 2024 10:00:49 +0100 Subject: [PATCH 3/5] chore: fix indentation --- R/centralization.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/centralization.R b/R/centralization.R index e18feb400a..0a4a8b1df9 100644 --- a/R/centralization.R +++ b/R/centralization.R @@ -534,7 +534,7 @@ centr_eigen <- function(graph, centr_eigen_tmax <- function(graph = NULL, nodes = 0, directed = FALSE, - scale = deprecated()) { + scale = deprecated()) { if (lifecycle::is_present(scale)) { lifecycle::deprecate_soft( From d8024c43aa6dfa1f59e490f06c3c0fde1c1d2be8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Thu, 12 Dec 2024 10:02:05 +0100 Subject: [PATCH 4/5] fix: explicitly pass `scale=TRUE` to C --- R/centralization.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/centralization.R b/R/centralization.R index 0a4a8b1df9..cd7e3f960a 100644 --- a/R/centralization.R +++ b/R/centralization.R @@ -500,7 +500,8 @@ centr_eigen <- function(graph, graph = graph, directed = directed, options = options, - normalized = normalized + normalized = normalized, + scale = TRUE ) } @@ -548,6 +549,7 @@ centr_eigen_tmax <- function(graph = NULL, centralization_eigenvector_centrality_tmax_impl( graph = graph, nodes = nodes, - directed = directed + directed = directed, + scale = TRUE ) } From 2003162e3b8e0905a478a9caa5733e9b2df7b0eb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ma=C3=ABlle=20Salmon?= Date: Tue, 17 Dec 2024 15:35:54 +0100 Subject: [PATCH 5/5] docs: improve phrasing of deprecation message --- R/centralization.R | 2 +- tests/testthat/_snaps/centralization.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/centralization.R b/R/centralization.R index cd7e3f960a..47cdbe5bcb 100644 --- a/R/centralization.R +++ b/R/centralization.R @@ -288,7 +288,7 @@ centr_degree_tmax <- function(graph = NULL, lifecycle::deprecate_warn( when = "2.0.0", what = "centr_degree_tmax(loops = 'must be explicit')", - details = "Default value (`FALSE`) will be dropped in next release, add an explicit value for the loops argument." + details = "The default value (currently `FALSE`) will be dropped in the next release, add an explicit value for the loops argument." ) loops <- FALSE } diff --git a/tests/testthat/_snaps/centralization.md b/tests/testthat/_snaps/centralization.md index 830f352bbd..6a2ee859c4 100644 --- a/tests/testthat/_snaps/centralization.md +++ b/tests/testthat/_snaps/centralization.md @@ -23,5 +23,5 @@ Condition Warning: The `loops` argument of `centr_degree_tmax()` must be explicit as of igraph 2.0.0. - i Default value (`FALSE`) will be dropped in next release, add an explicit value for the loops argument. + i The default value (currently `FALSE`) will be dropped in the next release, add an explicit value for the loops argument.