From 81b91e765325f87b54fbf731d0cd5e1eada96d53 Mon Sep 17 00:00:00 2001 From: Alex Gallinat Date: Sat, 3 Oct 2026 12:05:39 -0400 Subject: [PATCH] Fix NaN AUC in robustness_analysis() and audit the surrounding pattern Swept the package for the count/total mismatch behind the calculate_roles() bug -- a quantity derived one way divided by a total derived another. Found one more real instance, in robustness_analysis(). Global efficiency divides by n(n-1), which is 0 once a single vertex remains, so it evaluated to NaN and that NaN propagated through pracma::trapz() into the AUC. This fired on the *documented default call*: steps = 50 makes step_size = 1 for any graph of about 51 nodes or fewer, so the loop does reach one vertex. On a 50-node sample_pa, auc$efficiency came back NaN while the other two metrics looked fine. Efficiency is now 0 when fewer than two vertices remain -- a collapsed network has no paths -- which is also what the robustness literature reports. A second divide-by-zero sat behind it: every metric is scaled by max(metric), once for the AUC and six times inside the plot's aes() calls. When a metric is zero throughout, which global efficiency is for a graph with no edges, that made all seven NaN. Replaced with a normalize_metric() helper (R/utils-metrics.R) that leaves the series untouched when the maximum is zero or not finite. Also dropped `fill = "Metric"` from labs(), which made ggplot2 report "Ignoring unknown labels: fill" on every robustness plot, since no fill aesthetic is mapped. Audit conclusions for the sites that are NOT bugs, recorded so they are not "fixed" later: - plot_CCDF()/compute_ccdf() divides by sum(deg_tab), i.e. the same table it tallied. This is the correct form of the pattern. - summarize_graph_metrics() divides table(deg) by length(deg); degree() cannot return NA, so the two agree by construction. - The match() calls in calculate_roles(), find_modules() and assign_attributes() index with values that are guaranteed present, or handle NA explicitly. - summarize_graph_metrics() returns NaN for Average_path_length, Clustering_coefficient, Degree_assortativity, Gini_degree and Modularity on an edgeless graph. These are undefined quantities propagated from igraph and ineq, not arithmetic errors; substituting zeros would fabricate values. A test pins the exact set so a new NaN column shows up as a regression. Corrected summarize_graph_metrics()'s @return, which promised a tibble while the function returns a data.frame, and now documents the NaN cases. Tests go from 386 to 411. Co-Authored-By: Claude Opus 5 (1M context) --- R/robustness_analysis.R | 37 ++++++++++----- R/summarize_graph_metrics.R | 9 +++- R/utils-metrics.R | 22 +++++++++ man/summarize_graph_metrics.Rd | 9 +++- tests/testthat/test-robustness_analysis.R | 46 +++++++++++++++++++ tests/testthat/test-summarize_graph_metrics.R | 23 ++++++++++ 6 files changed, 132 insertions(+), 14 deletions(-) create mode 100644 R/utils-metrics.R diff --git a/R/robustness_analysis.R b/R/robustness_analysis.R index d78c7e1..51025f8 100644 --- a/R/robustness_analysis.R +++ b/R/robustness_analysis.R @@ -136,10 +136,21 @@ robustness_analysis <- function(graph, } if ("efficiency" %in% metrics) { - sp <- distances(g_tmp) - inv_sp <- 1 / sp - inv_sp[is.infinite(inv_sp)] <- 0 - row$efficiency <- sum(inv_sp) / (vcount(g_tmp)^2 - vcount(g_tmp)) + n_tmp <- vcount(g_tmp) + if (n_tmp < 2) { + # Global efficiency averages 1/d over ordered pairs, and a graph with + # fewer than two vertices has none: the n(n-1) denominator is 0, so + # computing it directly yields NaN. With the default steps = 50 the + # removal loop reaches a single remaining vertex for any graph of about + # 51 nodes or fewer, and that NaN then propagated into the AUC. A + # collapsed network has no paths left, so report 0. + row$efficiency <- 0 + } else { + sp <- distances(g_tmp) + inv_sp <- 1 / sp + inv_sp[is.infinite(inv_sp)] <- 0 + row$efficiency <- sum(inv_sp) / (n_tmp^2 - n_tmp) + } } if ("n_components" %in% metrics) { @@ -187,7 +198,7 @@ robustness_analysis <- function(graph, summary[[metric]] } - metric_vec <- metric_vec / max(metric_vec, na.rm = TRUE) + metric_vec <- normalize_metric(metric_vec) auc_val <- pracma::trapz(summary$removed_frac, metric_vec) auc_list[[metric]] <- auc_val } @@ -202,33 +213,35 @@ robustness_analysis <- function(graph, if ("lcc_size" %in% metrics) { if ("lcc_size_mean" %in% names(summary)) { p <- p + - geom_line(aes(y = lcc_size_mean / max(lcc_size_mean, na.rm = TRUE), color = "LCC Size")) + geom_line(aes(y = normalize_metric(lcc_size_mean), color = "LCC Size")) } else { - p <- p + geom_line(aes(y = lcc_size / max(lcc_size, na.rm = TRUE), color = "LCC Size")) + p <- p + geom_line(aes(y = normalize_metric(lcc_size), color = "LCC Size")) } } if ("efficiency" %in% metrics) { if ("efficiency_mean" %in% names(summary)) { p <- p + - geom_line(aes(y = efficiency_mean / max(efficiency_mean, na.rm = TRUE), color = "Efficiency")) + geom_line(aes(y = normalize_metric(efficiency_mean), color = "Efficiency")) } else { - p <- p + geom_line(aes(y = efficiency / max(efficiency, na.rm = TRUE), color = "Efficiency")) + p <- p + geom_line(aes(y = normalize_metric(efficiency), color = "Efficiency")) } } if ("n_components" %in% metrics) { if ("n_components_mean" %in% names(summary)) { p <- p + - geom_line(aes(y = n_components_mean / max(n_components_mean, na.rm = TRUE), color = "Components")) + geom_line(aes(y = normalize_metric(n_components_mean), color = "Components")) } else { - p <- p + geom_line(aes(y = n_components / max(n_components, na.rm = TRUE), color = "Components")) + p <- p + geom_line(aes(y = normalize_metric(n_components), color = "Components")) } } p <- p + scale_color_manual(values = c("LCC Size" = "steelblue", "Efficiency" = "darkgreen", "Components" = "red")) + - labs(color = "Metric", fill = "Metric") + # No fill aesthetic is mapped, so naming one made ggplot2 report + # "Ignoring unknown labels: fill". + labs(color = "Metric") } else { diff --git a/R/summarize_graph_metrics.R b/R/summarize_graph_metrics.R index 95410b3..2d05107 100644 --- a/R/summarize_graph_metrics.R +++ b/R/summarize_graph_metrics.R @@ -6,7 +6,14 @@ #' #' @param graph An `igraph` object or a data frame with columns `from` and `to` representing an edge list. #' -#' @return A tibble with one row and multiple columns, each representing a graph-level metric. +#' @return A one-row `data.frame`, each column a graph-level metric. +#' +#' Metrics that are mathematically undefined for the input are `NaN` rather than +#' substituted values, as returned by the underlying \pkg{igraph} and \pkg{ineq} +#' functions. On degenerate graphs this is expected: an edgeless graph has no paths +#' (`Average_path_length`), no connected triples (`Clustering_coefficient`), no +#' degree variance (`Degree_assortativity`) and a zero mean degree +#' (`Gini_degree`). #' #' @details #' Metrics computed: diff --git a/R/utils-metrics.R b/R/utils-metrics.R new file mode 100644 index 0000000..9b035f5 --- /dev/null +++ b/R/utils-metrics.R @@ -0,0 +1,22 @@ +#' Scale a metric series to its own maximum +#' +#' Internal helper. Robustness curves are plotted and integrated on a 0-1 scale by +#' dividing each metric by its maximum over the removal sequence. Dividing directly +#' is unsafe: if the maximum is zero (for example global efficiency on a graph with +#' no edges, which is zero at every step) every value becomes `NaN`, which then +#' propagates silently into [pracma::trapz()] and produces a `NaN` AUC. +#' +#' @param x Numeric vector of metric values, possibly containing `NA`/`NaN`. +#' +#' @return `x` divided by its maximum, or `x` unchanged when that maximum is zero or +#' not finite. +#' +#' @keywords internal +#' @noRd +normalize_metric <- function(x) { + m <- suppressWarnings(max(x, na.rm = TRUE)) + if (!is.finite(m) || m == 0) { + return(x) + } + x / m +} diff --git a/man/summarize_graph_metrics.Rd b/man/summarize_graph_metrics.Rd index b1f9fb6..93fba63 100644 --- a/man/summarize_graph_metrics.Rd +++ b/man/summarize_graph_metrics.Rd @@ -10,7 +10,14 @@ summarize_graph_metrics(graph) \item{graph}{An \code{igraph} object or a data frame with columns \code{from} and \code{to} representing an edge list.} } \value{ -A tibble with one row and multiple columns, each representing a graph-level metric. +A one-row \code{data.frame}, each column a graph-level metric. + +Metrics that are mathematically undefined for the input are \code{NaN} rather than +substituted values, as returned by the underlying \pkg{igraph} and \pkg{ineq} +functions. On degenerate graphs this is expected: an edgeless graph has no paths +(\code{Average_path_length}), no connected triples (\code{Clustering_coefficient}), no +degree variance (\code{Degree_assortativity}) and a zero mean degree +(\code{Gini_degree}). } \description{ Computes a comprehensive set of global topological metrics for an input graph, diff --git a/tests/testthat/test-robustness_analysis.R b/tests/testthat/test-robustness_analysis.R index e6fef9b..e70adce 100644 --- a/tests/testthat/test-robustness_analysis.R +++ b/tests/testthat/test-robustness_analysis.R @@ -91,6 +91,52 @@ test_that("a seed makes random removal reproducible", { without_progress(do.call(robustness_analysis, args))$summary) }) +test_that("AUC is finite for every metric under default arguments", { + # Regression guard. Global efficiency divides by n(n-1), which is 0 once a single + # vertex remains. With the default steps = 50, step_size becomes 1 for any graph + # of about 51 nodes or fewer, so the loop did reach one vertex and auc$efficiency + # came back NaN from the documented default call. + for (n in c(20, 50, 51)) { + gg <- test_graph(n = n, seed = 2) + res <- without_progress( + robustness_analysis(gg, removal_strategy = "degree", plot = FALSE, seed = 1) + ) + expect_false(any(is.nan(res$summary$efficiency)), info = paste("n =", n)) + for (m in names(res$auc)) { + expect_true(is.finite(res$auc[[m]]), info = paste("n =", n, "metric", m)) + } + } +}) + +test_that("a collapsed network reports zero efficiency rather than NaN", { + gg <- test_graph(n = 30, seed = 4) + res <- robustness_analysis(gg, removal_strategy = "degree", steps = 40, + plot = FALSE, seed = 1) + + # steps > vcount forces step_size = 1, so the final step leaves one vertex. + expect_equal(min(res$summary$lcc_size), 1) + expect_equal(utils::tail(res$summary$efficiency, 1), 0) +}) + +test_that("an all-zero metric does not produce a NaN AUC or NaN plot values", { + # Normalizing by max() is a divide-by-zero when a metric is zero throughout, as + # global efficiency is for a graph with no edges. + ge <- igraph::make_empty_graph(20, directed = FALSE) + igraph::V(ge)$name <- paste0("e", seq_len(20)) + + res <- draw_quietly( + robustness_analysis(ge, removal_strategy = "degree", steps = 5, + plot = TRUE, seed = 1) + ) + + expect_equal(res$auc$efficiency, 0) + for (m in names(res$auc)) expect_true(is.finite(res$auc[[m]]), info = m) + + built <- ggplot2::ggplot_build(res$plot) + ys <- unlist(lapply(built$data, function(d) d$y)) + expect_true(all(is.finite(ys))) +}) + test_that("metrics can be requested selectively", { res <- robustness_analysis(g, removal_strategy = "degree", metrics = "lcc_size", steps = 5, diff --git a/tests/testthat/test-summarize_graph_metrics.R b/tests/testthat/test-summarize_graph_metrics.R index 2da216c..6cf8c3c 100644 --- a/tests/testthat/test-summarize_graph_metrics.R +++ b/tests/testthat/test-summarize_graph_metrics.R @@ -54,6 +54,29 @@ test_that("isolated vertices are counted and bound the LCC", { expect_equal(m$LCC_percent, 5 / 7) }) +test_that("degenerate graphs return NaN only for genuinely undefined metrics", { + # These NaNs come from igraph/ineq and are correct: an edgeless graph has no + # paths, no connected triples, no degree variance and a zero mean degree. The + # test exists so that the set cannot silently grow -- a new NaN column would be a + # netkit bug, as auc$efficiency was. + g <- igraph::make_empty_graph(10, directed = FALSE) + igraph::V(g)$name <- paste0("v", seq_len(10)) + + m <- suppressWarnings(summarize_graph_metrics(g)) + numeric_cols <- m[vapply(m, is.numeric, logical(1))] + not_finite <- names(numeric_cols)[!vapply(numeric_cols, is.finite, logical(1))] + + expect_setequal(not_finite, c("Average_path_length", "Clustering_coefficient", + "Degree_assortativity", "Gini_degree", "Modularity")) + + # Everything structural is still exact. + expect_equal(m$Nodes, 10L) + expect_equal(m$Edges, 0L) + expect_equal(m$Components, 10L) + expect_equal(m$Single_nodes, 10L) + expect_equal(m$Avg_degree, 0) +}) + test_that("Avg_betweenness is skipped above the 5000-node guard", { # The guard exists because exact betweenness is the one metric that does not # scale; this asserts the cheap path is taken, not the value.