Fix NaN AUC in robustness_analysis and audit the pattern

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 {
 

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:

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
+}

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,

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.