R/centrality.R

Defines functions .temporal_reach_values .temporal_closeness_values .temporal_betweenness_values .optimal_endpoint_dependency .temporal_measure .temporal_centrality .measure_label .eigen_prestige .domain_proximity_prestige .domain_prestige .indegree_prestige .rowcol_balance .rowcol_sweep .total_support .perfect_matching .snapshot_measure .window_weight_share dyn_centrality path_centrality centrality_series .measure_modes .resolve_modes

Documented in centrality_series dyn_centrality path_centrality

# ===========================================================================
# centrality_series() and path_centrality() — vertex centrality over time
# ===========================================================================

.node_measures <- c("degree", "indegree", "outdegree", "strength", "prestige",
                    "closeness", "betweenness",
                    "eigenvector", "pagerank", "hub", "authority",
                    "coreness", "constraint", "power", "harary",
                    "information", "load", "flow_betweenness", "diffusion")

# The measures that read a direction off the adjacency and are therefore
# undefined on an undirected network. `centrality_series()` and the proximity
# plot both gate on this, so it is named once rather than spelled out twice.
.directed_only_measures <- c("indegree", "outdegree", "prestige",
                             "hub", "authority")

# The measures for which "out" and "in" mean something. Every other measure
# has a single directional definition and ignores `mode`, as in igraph.
.mode_aware_measures <- c("degree", "indegree", "outdegree", "strength",
                          "closeness", "coreness", "harary", "eigenvector",
                          "diffusion")

.temporal_measures <- c("closeness", "betweenness", "reach", "reach_count")

#' Resolve the `mode` argument, which may name several directions at once
#'
#' The signature carries every direction as its default, so an untouched `mode`
#' has to be read as `"all"` rather than as a request for all three.
#'
#' @param mode The `mode` argument as supplied.
#' @return A character vector of unique modes.
#' @examples
#' Dynet:::.resolve_modes(c("all", "out", "in"))
#' Dynet:::.resolve_modes("in")
#' @noRd
.resolve_modes <- function(mode) {
  choices <- c("all", "out", "in")
  if (identical(mode, choices)) return("all")
  .check("`mode` must be a character vector naming one or more directions." =
           is.character(mode) && length(mode) > 0L && !anyNA(mode))
  # `match.arg(several.ok = TRUE)` drops names it cannot match and only errors
  # when none match at all, so an unknown direction would pass unnoticed.
  unknown <- setdiff(mode, choices)
  if (length(unknown) > 0L) {
    stop(errorCondition(
      sprintf("Unknown `mode` %s; use %s.",
              paste(sQuote(unknown), collapse = ", "),
              paste(sQuote(choices), collapse = ", ")),
      class = "dynet_bad_input", call = NULL))
  }
  unique(mode)
}

#' Expand measures across directions into one job per output column
#'
#' Asking for in- and out-degree in one call must not silently return two
#' identically named stacks, and asking a direction-blind measure for three
#' directions must not compute it three times. Directions are therefore
#' dropped where they mean nothing, and the surviving ones are suffixed only
#' when more than one direction was requested -- so a single-`mode` call keeps
#' the plain measure name it has always had.
#'
#' @param measure Character vector of measures.
#' @param mode Character vector of resolved directions.
#' @param directed Whether the network is directed.
#' @return A data frame with `measure`, `mode` and `label`, one row per column
#'   the result will carry.
#' @examples
#' Dynet:::.measure_modes("degree", c("in", "out"), TRUE)
#' Dynet:::.measure_modes(c("degree", "betweenness"), c("all", "in"), TRUE)
#' @noRd
.measure_modes <- function(measure, mode, directed) {
  many <- length(mode) > 1L
  rows <- lapply(measure, function(m) {
    aware <- directed && m %in% .mode_aware_measures
    modes <- if (aware) mode else mode[[1L]]
    data.frame(
      measure = m, mode = modes,
      label = if (many && aware) {
        ifelse(modes == "all", m, paste0(m, "_", modes))
      } else m,
      stringsAsFactors = FALSE
    )
  })
  out <- do.call(rbind, rows)
  rownames(out) <- NULL
  out
}

#' Time-varying vertex centrality
#'
#' @description
#' Centrality for every vertex at every time point. Ask for several measures
#' in one call and they arrive stacked in a single tidy frame, one row per
#' vertex, time point and measure.
#'
#' Each value measures the network as it stands in one time bin, so the
#' result is a trajectory of ordinary centrality. Order within a bin is not
#' used: every tie active in the bin counts as present. Centrality computed
#' from time-respecting paths across the whole period is [path_centrality()].
#'
#' @param dn A temporal network from [dynet()].
#' @param measure One or more of `"degree"`, `"strength"`, `"prestige"`, `"closeness"`,
#'   `"betweenness"`, `"eigenvector"`, `"pagerank"`, `"hub"`, `"authority"`,
#'   `"coreness"`, `"constraint"`, `"power"`, `"harary"`, `"information"`,
#'   `"load"`, `"flow_betweenness"`, or `"diffusion"`.
#'   The deprecated names `"indegree"` and
#'   `"outdegree"`, which warn with class `dynet_deprecated` and are replaced
#'   by `measure = "degree"` with `mode = "in"` or `mode = "out"`. Defaults to
#'   `"degree"`. Any other
#'   name raises an error of class `dynet_unknown_measure`; the directed-only
#'   measures `"prestige"`, `"hub"`, `"authority"` and the two deprecated
#'   names `"indegree"` and `"outdegree"` raise `dynet_needs_directed` on an
#'   undirected network.
#' @param mode Which edges count on a directed network: `"all"` both
#'   directions, `"out"` outgoing only, `"in"` incoming only. Defaults to
#'   `"all"`; any other string raises an error of class `dynet_bad_input`.
#'   Name several at
#'   once -- `mode = c("all", "in", "out")` -- to get degree, in-degree and
#'   out-degree from a single call; the extra directions are then labelled
#'   `degree_in` and `degree_out` in the `measure` column, while a call naming
#'   one direction keeps the plain measure name. Applies to
#'   `"degree"`, `"strength"`, `"closeness"`, `"coreness"`, `"harary"`,
#'   `"eigenvector"` and `"diffusion"`; the remaining measures have a single
#'   directional definition and ignore it. Ignored
#'   entirely on an undirected network. In-degree is therefore
#'   `mode = "in"`. The old `"indegree"` and `"outdegree"` measure names
#'   remain as deprecated aliases.
#' @param sessions How to treat sessions: `"bounded"` (the default) keeps
#'   paths inside a
#'   session, `"collapse"` ignores sessions, `"separate"` reports each session
#'   on its own rows. `"separate"` on a network built without a session column
#'   raises an error of class `dynet_no_sessions`.
#' @param sample Deprecated. `"instant"` is equivalent to `window = 0`;
#'   `"window"` uses the current positive/default window.
#' @param start,end First and last time at which to measure. Default to the
#'   observed range. A network built from dates may be addressed with dates.
#' @param step How often to measure. Defaults to the interval the network was
#'   built with.
#' @param window How much time each measurement covers. Defaults to `step`,
#'   which tiles the period into disjoint bins. A larger value slides an
#'   overlapping window; `0` samples the network at each point in time.
#'   `"all"` measures the whole observed period as one window, closed on the
#'   right so an event at the final instant is inside it; it cannot be combined
#'   with `step`, and under `sessions = "separate"` or discontinuous
#'   observation it gives one window per session or observed component.
#' @param damping Damping factor for PageRank; a single number strictly
#'   between zero and one, `0.85` by default.
#' @param exponent Attenuation factor for Bonacich `"power"`, a single finite
#'   number, `1` by default. Positive rewards
#'   being connected to well-connected others; negative rewards the opposite,
#'   which is the bargaining reading.
#' @param lambda Nonnegative multiplier for `"diffusion"`, `1` by default.
#'   Diffusion degree is
#'   the sum of the selected degree of a vertex and all of its one-step
#'   neighbours, multiplied by `lambda`.
#' @param prestige Prestige definition, `"indegree"` by default.
#'   `"indegree"` counts distinct active
#'   incoming dyads. `"indegree.rownorm"` first gives every active sender one
#'   unit split equally across its distinct outgoing dyads, then sums the
#'   received mass. `"indegree.rowcolnorm"` balances a total-support binary
#'   adjacency to doubly stochastic form; feasible scores are necessarily
#'   uniform. `"domain"` counts the distinct other vertices with a directed
#'   path into each vertex in the active snapshot. `"domain.proximity"`
#'   discounts that incoming domain fraction by its mean directed hop distance.
#'   `"eigenvector"` uses the unique nonnegative Perron ray of the transposed
#'   binary adjacency. `"eigenvector.rownorm"` first divides every nonzero
#'   binary sender row by its outgoing-dyad count and then solves the same
#'   certified incoming Perron equation. `"eigenvector.colnorm"` instead
#'   divides every nonzero binary receiver column by its incoming-dyad count
#'   before solving. `"eigenvector.rowcolnorm"` first certifies total support
#'   and balances binary adjacency to doubly stochastic form. Prestige is
#'   directed and snapshot-only.
#' @param rescale Whether to divide prestige by its total independently
#'   inside every reported time/session block; `FALSE` by default. Zero-total
#'   count/proximity
#'   definitions return `NaN`; structurally undefined spectral definitions
#'   return `NA`. This argument requires `measure = "prestige"`, and raises
#'   `dynet_bad_input` otherwise.
#' @param plot Whether to draw the result as well as return it. Drawing is a
#'   side effect in the manner of [graphics::hist()]: the verb still returns
#'   its tidy table, invisibly when it has drawn, so `plot = TRUE` saves the
#'   wrapping `plot()` call without changing what comes back. Use `plot()` on
#'   the result when the figure needs arguments of its own.
#' @return A `dynet_metric`: a tidy data frame with one row per vertex, time
#'   point and measure. Columns are `session` (only under
#'   `sessions = "separate"`, which is the only mode that keeps session labels
#'   apart), `time`, `node`, `measure` and `value`.
#'   Print it, [summary()] it, [plot()] it, or take the plain frame with
#'   [as.data.frame()]. Prestige stores its mathematical choices as direct
#'   attributes for a prestige-only result and as named records under
#'   `measure_metadata` otherwise. When a prestige
#'   variant is structurally undefined or fails to converge, the affected
#'   values are `NA`, a warning says how many reporting blocks were affected,
#'   and a record naming the stage and reason for each comes out through
#'   `as.data.frame(x, what = "diagnostics")`.
#'
#' @details
#' `step` and `window` are separate on purpose. `step` is how often you look;
#' `window` is how much of the timeline each look takes in. Setting them equal
#' partitions the period; setting `window` larger than `step` is a rolling
#' window, which keeps the resolution of the smaller step while smoothing over
#' the noise of a sparse bin. The arguments match `tsna::tSnaStats()`, where
#' they are called `time.interval` and `aggregate.dur`.
#'
#' Snapshot `"degree"` counts distinct active binary dyads, so duplicate,
#' split and overlapping spells do not multiply it; `mode = "all"` on a
#' directed snapshot is in-degree plus out-degree. `"strength"` is the same
#' margin taken over spell weights rather than over binary dyads. In a
#' positive window each spell contributes its weight in proportion to the
#' share of its duration that falls inside the window, `weight * overlap /
#' duration`, so a spell straddling two tiled windows splits its weight
#' between them and the pieces add back to the whole. A point contact has no
#' duration to split and contributes its full weight to the window holding
#' it. With `window = 0` every active spell contributes its full weight at
#' that instant. The share uses the spell's recorded duration, so the part of
#' a spell outside the observation period is not reassigned to observed
#' windows. [snapshots()] and the network plots keep full weights per bin, so
#' their `weight` column is not the input to this strength.
#'
#' Snapshot `"closeness"` is **not** Freeman's \eqn{1 / \sum_z d_{sz}}, which
#' is
#' undefined once a snapshot is disconnected -- and a time bin almost always
#' is. It is the reciprocal of the mean geodesic distance to the vertices a
#' vertex can actually reach: with \eqn{R_s} the reachable nonself set,
#' \deqn{C(s) = |R_s| / \sum_{z \in R_s} d_{sz},}
#' which is zero for an isolate and equals Freeman's normalised closeness
#' \eqn{(n - 1) / \sum_z d_{sz}} on a connected snapshot. `"harary"` is the
#' reciprocal of
#' eccentricity, zero for a vertex that cannot reach everything.
#'
#' `"eigenvector"`, `"hub"` and `"authority"` are certified the way eigenvector
#' prestige is: a snapshot whose spectral radius is zero (no cycle) or whose
#' Perron root is repeated (components of equal weight) has no single answer,
#' and every vertex of that block is `NA` under a warning of class
#' `dynet_eigen_undefined`.
#' `"eigenvector"` is uniquely determined when the Perron eigenvalue has a
#' one-dimensional eigenspace; strong connectivity is a sufficient condition.
#' Disconnected snapshots with equally dominant components can have more than
#' one correct eigenvector, so read the result as a within-snapshot ranking
#' rather than an automatically comparable number across the whole series.
#'
#' Indegree prestige is the column sum of the directed binary active-dyad
#' adjacency matrix. It is exactly snapshot degree with `mode = "in"`:
#' duplicate, split, and overlapping spells and edge weights do not multiply
#' the result, while an explicitly retained directed loop contributes once.
#' With `rescale = TRUE`, the column sums are divided by their block total. A
#' zero total is mathematically undefined and is returned as literal `NaN`.
#'
#' Row-normalised indegree prestige first converts every nonzero binary
#' adjacency row to sum one; zero rows remain all zero. Its column sums are the
#' received sender-nomination mass, so their total is the number of active
#' senders. `rescale = TRUE` divides again by that block total. This closed-form
#' transform is the `sna::prestige(cmode = "indegree.rownorm")` definition on
#' binary matrices. Dynet deliberately ignores edge weights, whereas `sna`
#' uses their magnitudes on valued matrices.
#'
#' Row-column-normalised prestige uses deterministic Sinkhorn--Knopp scaling
#' only when the full binary vertex matrix has total support: every active dyad
#' must belong to a perfect matching. It preserves all binary dyads and does
#' not remove isolates or unsupported edges. Infeasible blocks return `NA` for
#' every vertex with a classed warning. A feasible transform has every incoming
#' column sum equal to one, so raw prestige is uniformly one and rescaled
#' prestige uniformly `1 / n`; this definition is a transform diagnostic, not
#' a vertex ranking. Dynet uses fixed-order sweeps, maximum absolute row/column
#' residual `1e-12`, and at most 10,000 sweeps. It never returns a partial
#' iterate. This deliberately differs from the randomised loose-tolerance
#' annealer in `sna` 2.8.
#'
#' Domain prestige is incoming indegree in the directed reachability graph
#' after excluding its reflexive diagonal. If `H[i,j]` records whether `i = j`
#' or a directed path from `i` to `j` exists, then
#' `p[j] = sum(H[,j]) - 1`. Every distinct reaching vertex counts once,
#' regardless of path length or multiplicity. Loops cannot add self credit,
#' isolates score zero, and a zero-total rescaling returns literal `NaN`.
#' Closure is computed on the binary active snapshot for each reporting block,
#' not on chronologically ordered temporal journeys through the raw spells.
#'
#' Domain-proximity prestige additionally uses the shortest incoming hop
#' distances. For the nonself domain `D[j]`, let `r[j]` be its size and `s[j]`
#' the sum of its finite distances into `j`. The score is zero when `r[j] = 0`
#' and otherwise `r[j]^2 / ((n - 1) * s[j])`: the incoming domain fraction
#' divided by mean hop distance. Unreachable vertices are omitted before the
#' distance sum. This deliberately fixes an arithmetic artefact in `sna` 2.8,
#' whose `FALSE * Inf` operation incorrectly zeros partial nonempty domains.
#'
#' Eigenvector prestige solves `t(B) %*% p = rho * p` for the nonnegative
#' Perron ray of binary adjacency `B`. It requires positive spectral radius and
#' a one-dimensional Perron eigenspace. Raw scores have Euclidean norm one;
#' `rescale = TRUE` makes their sum one. Zero-radius or nonunique blocks return
#' all `NA` with a classed warning and diagnostics. Periodic cycles remain
#' valid even when negative or complex roots share the spectral radius. Dynet
#' uses direct eigenvalues plus an SVD nullity/residual check at tolerance
#' `1e-10`, orients the ray as nonnegative, and never applies elementwise
#' absolute value.
#'
#' Row-normalised eigenvector prestige first forms binary adjacency `B` and
#' divides each nonzero sender row by its number of distinct outgoing dyads;
#' zero rows remain exactly zero. It then solves the certified incoming Perron
#' equation for the transpose of that row-stochastic matrix. Thus each active
#' sender distributes one unit of recursive nomination mass, with no
#' teleportation or dangling-row imputation. Binary session union and retained
#' loop policy occur before row normalisation. The positive-radius, geometric-
#' uniqueness, nonnegative-sign, L2/sum-scale, warning, and diagnostic rules
#' are otherwise exactly those of ordinary eigenvector prestige.
#'
#' Column-normalised eigenvector prestige divides each nonzero binary receiver
#' column by its number of distinct incoming dyads; zero columns remain zero.
#' It solves the incoming Perron equation only after that transform. If every
#' vertex has positive indegree, the transformed transpose is row-stochastic
#' and every certified score is necessarily uniform. Nonuniform defined scores
#' therefore require a zero-indegree vertex. Binary union and retained-loop
#' policy precede normalisation; certification and scaling remain those above.
#'
#' Row-column-normalised eigenvector prestige composes the total-support and
#' deterministic Sinkhorn--Knopp contract with the certified Perron contract.
#' Infeasible support and nonconvergent balancing terminate before the spectral
#' solve. A completed doubly stochastic transform always has the all-ones
#' Perron ray, but reducible transforms have several such rays and remain
#' undefined. Every fully certified score is therefore exactly uniform:
#' `1 / sqrt(n)` raw or `1 / n` rescaled. This selector diagnoses support,
#' balance, and irreducibility; it is not a vertex ranking.
#'
#' @section Conditions:
#' Errors: `dynet_unknown_measure` (a measure not listed above),
#' `dynet_needs_directed` (`"prestige"`, `"hub"`, `"authority"`,
#' `"indegree"` or `"outdegree"` on an undirected network),
#' `dynet_no_sessions` (`sessions = "separate"` without a session column),
#' `dynet_outside_observation` (the requested range misses observed support;
#' it also carries `dynet_bad_input`),
#' and `dynet_bad_input` for every other broken contract -- `dn` not a
#' `dynet`, an unknown `mode`, an out-of-range `damping`, `exponent`,
#' `lambda`, `prestige`, `rescale`, `start`, `end`, `step` or `window`, and
#' `rescale = TRUE` without `measure = "prestige"`.
#'
#' Warnings: `dynet_deprecated` (`measure = "indegree"`/`"outdegree"`, or the
#' retired `sample` argument), `dynet_eigen_undefined` and
#' `dynet_kernel_singular` (both also carrying `dynet_measure_undefined`) when
#' a snapshot's eigenvector, hub, authority, Bonacich power or information
#' kernel has no unique answer, and `dynet_prestige_infeasible`,
#' `dynet_prestige_nonconvergence` and `dynet_prestige_eigen_undefined` when a
#' prestige variant is structurally undefined or fails to converge.
#'
#' @references
#' Holme, P., & Saramaki, J. (2012). Temporal networks. *Physics Reports*,
#' 519(3), 97-125.
#'
#' Wasserman, S., & Faust, K. (1994). *Social Network Analysis: Methods and
#' Applications*. Cambridge University Press, Chapter 5.
#'
#' Butts, C. T. (2024). *sna: Tools for Social Network Analysis*, version 2.8.
#' doi:10.32614/CRAN.package.sna.
#'
#' Lin, N. (1976). *Foundations of Social Research*. McGraw-Hill.
#'
#' Freeman, L. C. (1979). Centrality in social networks: conceptual
#' clarification. *Social Networks*, 1(3), 215-239.
#' \doi{10.1016/0378-8733(78)90021-7}
#'
#' Brandes, U. (2001). A faster algorithm for betweenness centrality.
#' *Journal of Mathematical Sociology*, 25(2), 163-177.
#'
#' Bonacich, P. (1987). Power and centrality: a family of measures.
#' *American Journal of Sociology*, 92(5), 1170-1182.
#'
#' Hage, P., & Harary, F. (1995). Eccentricity and centrality in networks.
#' *Social Networks*, 17(1), 57-63.
#'
#' Stephenson, K., & Zelen, M. (1989). Rethinking centrality. *Social
#' Networks*, 11(1), 1-37.
#'
#' Goh, K.-I., Kahng, B., & Kim, D. (2001). Universal behavior of load
#' distribution in scale-free networks. *Physical Review Letters*, 87(27),
#' 278701.
#'
#' Freeman, L. C., Borgatti, S. P., & White, D. R. (1991). Centrality in
#' valued graphs. *Social Networks*, 13(2), 141-154.
#'
#' Page, L., Brin, S., Motwani, R., & Winograd, T. (1999). *The PageRank
#' citation ranking: bringing order to the web*. Technical Report 1999-66,
#' Stanford InfoLab.
#'
#' Kleinberg, J. M. (1999). Authoritative sources in a hyperlinked
#' environment. *Journal of the ACM*, 46(5), 604-632.
#' doi:10.1145/324133.324140.
#'
#' Seidman, S. B. (1983). Network structure and minimum degree. *Social
#' Networks*, 5(3), 269-287. doi:10.1016/0378-8733(83)90028-X.
#'
#' Burt, R. S. (1992). *Structural Holes: The Social Structure of
#' Competition*. Harvard University Press.
#'
#' Kundu, S., Murthy, C. A., & Pal, S. K. (2011). A new centrality measure for
#' influence maximization in social networks. In *Pattern Recognition and
#' Machine Intelligence*, Lecture Notes in Computer Science 6744 (pp. 242-247).
#' Springer. doi:10.1007/978-3-642-21786-9_40.
#'
#' Bonacich, P. (1972). Factoring and weighting approaches to status scores
#' and clique identification. *Journal of Mathematical Sociology*, 2, 113-120.
#' doi:10.1080/0022250X.1972.9989806.
#'
#' Berman, A., & Plemmons, R. J. (1994). *Nonnegative Matrices in the
#' Mathematical Sciences*. SIAM. doi:10.1137/1.9781611971262.
#'
#' Sinkhorn, R. (1964). A relationship between arbitrary positive matrices
#' and doubly stochastic matrices. *Annals of Mathematical Statistics*, 35,
#' 876-879. doi:10.1214/aoms/1177703591.
#'
#' Sinkhorn, R., & Knopp, P. (1967). Concerning nonnegative matrices and
#' doubly stochastic matrices. *Pacific Journal of Mathematics*, 21, 343-348.
#' doi:10.2140/pjm.1967.21.343.
#'
#' Knight, P. A. (2008). The Sinkhorn-Knopp algorithm: convergence and
#' applications. *SIAM Journal on Matrix Analysis and Applications*, 30,
#' 261-275. doi:10.1137/060659624.
#'
#' @examples
#' dn <- dynet(school_contacts)
#'
#' centrality_series(dn, measure = "degree")
#' centrality_series(dn, measure = c("degree", "betweenness"))
#' centrality_series(dn, measure = "prestige", rescale = TRUE)
#' centrality_series(dn, measure = "prestige",
#'                   prestige = "indegree.rownorm")
#' centrality_series(dn, measure = "prestige", prestige = "domain")
#' centrality_series(dn, measure = "prestige",
#'                   prestige = "domain.proximity")
#' centrality_series(dn, measure = "prestige", prestige = "eigenvector")
#' centrality_series(dn, measure = "prestige",
#'                   prestige = "eigenvector.rownorm")
#' centrality_series(dn, measure = "prestige",
#'                   prestige = "eigenvector.colnorm")
#' centrality_series(dn, measure = "prestige",
#'                   prestige = "eigenvector.rowcolnorm")
#'
#' # A seven-day window, stepped one day at a time.
#' centrality_series(dn, measure = "degree", step = 1, window = 7)
#'
#' degree <- centrality_series(dn, measure = "degree")
#' summary(degree)
#'
#' @details
#' Declared vertex activity induces the eligible vertex population before any
#' kernel is evaluated. Positive windows independently use any-time vertex and
#' edge unions before induction, while `window = 0` evaluates the exact state.
#' Results remain rectangular over the fixed vertex universe: inactive
#' vertices receive typed `NA`, while eligible isolates keep the centrality
#' kernel's ordinary static result.
#'
#' @seealso [path_centrality()] for closeness and betweenness on
#'   time-respecting paths; [reachability()] for temporal reach.
#' @export
centrality_series <- function(dn,
                              measure = "degree",
                              sessions = c("bounded", "collapse", "separate"),
                              sample = NULL,
                              damping = 0.85,
                              mode = c("all", "out", "in"),
                              start = NULL, end = NULL,
                              step = NULL, window = NULL,
                              exponent = 1,
                              prestige = "indegree", rescale = FALSE,
                              lambda = 1, plot = FALSE) {
  sessions <- match.arg(sessions)
  .check_dynet(dn, sessions)
  mode  <- .resolve_modes(mode)
  window <- .legacy_sample(window, sample)
  .check(
    "`measure` must be a character vector." = is.character(measure),
    "`measure` must name at least one measure." = length(measure) > 0L,
    "`measure` cannot contain missing values." = !anyNA(measure),
    "`damping` must be a single number strictly between zero and one." =
      is.numeric(damping) && length(damping) == 1L && damping > 0 && damping < 1,
    "`exponent` must be a single finite number." =
      is.numeric(exponent) && length(exponent) == 1L && is.finite(exponent),
    "`lambda` must be a single non-negative finite number." =
      is.numeric(lambda) && length(lambda) == 1L && is.finite(lambda) &&
        lambda >= 0,
    "`prestige` must be one of \"indegree\", \"indegree.rownorm\", \"indegree.rowcolnorm\", \"domain\", \"domain.proximity\", \"eigenvector\", \"eigenvector.rownorm\", \"eigenvector.colnorm\", or \"eigenvector.rowcolnorm\"." =
      is.character(prestige) && length(prestige) == 1L &&
        !is.na(prestige) &&
        prestige %in% c("indegree", "indegree.rownorm",
                        "indegree.rowcolnorm", "domain", "domain.proximity",
                        "eigenvector", "eigenvector.rownorm",
                        "eigenvector.colnorm", "eigenvector.rowcolnorm"),
    "`rescale` must be a single non-missing logical value." =
      is.logical(rescale) && length(rescale) == 1L && !is.na(rescale)
  )

  if (rescale && !"prestige" %in% measure) {
    stop(errorCondition(
      "`rescale = TRUE` requires `measure = \"prestige\"`.",
      class = "dynet_bad_input", call = NULL
    ))
  }

  bad <- setdiff(measure, .node_measures)
  if (length(bad) > 0L) {
    stop(errorCondition(
      sprintf("Unknown measure %s. Available: %s%s",
              paste(sQuote(bad), collapse = ", "),
              paste(.node_measures, collapse = ", "),
              if (any(bad %in% c("reach", "reach_count"))) {
                "; temporal reach is `reachability()`"
              } else ""),
      class = "dynet_unknown_measure", call = NULL))
  }
  retired <- intersect(measure, c("indegree", "outdegree"))
  if (length(retired) > 0L) {
    warning(warningCondition(sprintf(
      "%s deprecated; use `measure = \"degree\"` with %s.",
      paste(sQuote(retired), collapse = " and "),
      paste(sprintf("`mode = \"%s\"`", sub("degree$", "", retired)),
            collapse = " and ")),
      class = "dynet_deprecated", call = NULL))
  }
  if (!dn$directed) {
    directed_only <- intersect(measure, .directed_only_measures)
    if (length(directed_only) > 0L) {
      stop(errorCondition(
        sprintf("%s needs a directed network; this one is undirected.",
                paste(sQuote(directed_only), collapse = ", ")),
        class = "dynet_needs_directed", call = NULL))
    }
  }

  jobs <- .measure_modes(measure, mode, dn$directed)
  spec <- .window_spec(dn, start, end, step, window)
  prestige_diagnostics <- list()
  undefined_blocks <- list()
  df <- .over_bins(dn, sessions, node_level = TRUE, spec = spec,
    snapshot = TRUE, fun = function(enc, act, bin, state) {
      binary_full <- .adjacency(enc, act, dn$directed, weighted = FALSE)
      binary_a <- binary_full[state$index, state$index, drop = FALSE]
      valued_a <- if ("strength" %in% measure) {
        shared <- enc
        shared$weight <- enc$weight * .window_weight_share(enc, bin,
                                                           spec$window)
        valued_full <- .adjacency(shared, act, dn$directed, weighted = TRUE)
        valued_full[state$index, state$index, drop = FALSE]
      } else {
        binary_a
      }
      values <- lapply(seq_len(nrow(jobs)), function(job) {
        m <- jobs$measure[[job]]
        value <- if (length(state$index)) {
          .snapshot_measure(
            m, if (identical(m, "strength")) valued_a else binary_a,
            dn$directed, damping, jobs$mode[[job]], exponent, prestige,
            rescale, lambda
          )
        } else numeric()
        if (isTRUE(attr(value, "undefined"))) {
          undefined_blocks[[m]] <<- (undefined_blocks[[m]] %||% 0L) + 1L
        }
        diagnostic <- attr(value, "prestige_diagnostic")
        if (!is.null(diagnostic)) {
          session_label <- if (identical(sessions, "separate")) {
            labels <- unique(enc$session[!is.na(enc$session)])
            if (length(labels) == 1L) labels else NA_character_
          } else {
            NA_character_
          }
          prestige_diagnostics[[length(prestige_diagnostics) + 1L]] <<-
            data.frame(
              session = session_label, time = bin$time,
              stage = diagnostic$stage %||% if (
                identical(diagnostic$status, "infeasible")
              ) {
                "support"
              } else if (identical(diagnostic$status, "nonconverged")) {
                "balance"
              } else {
                "spectrum"
              },
              status = diagnostic$status, reason = diagnostic$reason,
              iterations = diagnostic$iterations %||% NA_integer_,
              residual = diagnostic$residual %||% NA_real_,
              balance_status = diagnostic$balance_status %||% if (
                diagnostic$status %in% c("infeasible", "nonconverged")
              ) diagnostic$status else NA_character_,
              balance_reason = diagnostic$balance_reason %||% if (
                diagnostic$status %in% c("infeasible", "nonconverged")
              ) diagnostic$reason else NA_character_,
              balance_iterations =
                diagnostic$balance_iterations %||% if (
                  diagnostic$status %in% c("infeasible", "nonconverged")
                ) diagnostic$iterations %||% NA_integer_ else NA_integer_,
              balance_residual = diagnostic$balance_residual %||% if (
                diagnostic$status %in% c("infeasible", "nonconverged")
              ) diagnostic$residual %||% NA_real_ else NA_real_,
              spectral_radius = diagnostic$spectral_radius %||% NA_real_,
              eigenspace_dimension =
                diagnostic$eigenspace_dimension %||% NA_integer_,
              eigen_residual = diagnostic$eigen_residual %||% if (
                identical(diagnostic$status, "undefined")
              ) diagnostic$residual %||% NA_real_ else NA_real_,
              stringsAsFactors = FALSE
            )
        }
        expanded <- rep(NA_real_, enc$n)
        expanded[state$index] <- as.numeric(value)
        expanded
      })
      stats::setNames(values, jobs$label)
    })

  out <- .metric(
    df, level = "node",
    what = if (nrow(jobs) == 1L) {
      .measure_label(measure, prestige)
    } else {
      "Centrality"
    },
    dn = dn, spec = spec,
    mode = if (length(mode) == 1L && !identical(mode, "all") && dn$directed &&
              any(measure %in% .mode_aware_measures)) mode else NULL
  )
  attr(out, "vertex_population") <- "eligible_window_any_induced"
  attr(out, "vertex_window_rule") <- if (spec$window == 0) {
    "instant_exact"
  } else "any"
  attr(out, "edge_endpoint_rule") <- "induced_after_elementwise_union"
  attr(out, "inactive_vertex_value") <- "NA"
  attr(out, "eligible_kernel_order") <- "induce_then_compute_then_expand"
  attr(out, "vertex_observation") <- "component_intersection_non_destructive"
  attr(out, "session_vertex_aggregation") <- switch(
    sessions, collapse = "calendar_union", bounded = "session_induced_union",
    separate = "session_local"
  )
  if ("prestige" %in% measure) {
    metadata <- list(
      definition = prestige,
      direction = "incoming",
      matrix_transform = if (prestige %in% c(
        "eigenvector", "eigenvector.rownorm", "eigenvector.colnorm",
        "eigenvector.rowcolnorm"
      )) {
        if (identical(prestige, "eigenvector.rownorm")) {
          "transpose_row_stochastic_binary_adjacency"
        } else if (identical(prestige, "eigenvector.colnorm")) {
          "transpose_column_stochastic_binary_adjacency"
        } else if (identical(prestige, "eigenvector.rowcolnorm")) {
          "transpose_sinkhorn_knopp_balanced_binary_adjacency"
        } else {
          "transpose_binary_adjacency"
        }
      } else if (identical(prestige, "domain.proximity")) {
        "directed_unweighted_geodesics"
      } else if (identical(prestige, "domain")) {
        "directed_transitive_closure"
      } else if (identical(prestige, "indegree.rowcolnorm")) {
        "sinkhorn_knopp_row_column"
      } else if (identical(prestige, "indegree.rownorm")) {
        "row_stochastic"
      } else {
        "none"
      },
      normalization = if (rescale) {
        "sum_to_one"
      } else if (prestige %in% c(
        "eigenvector", "eigenvector.rownorm", "eigenvector.colnorm",
        "eigenvector.rowcolnorm"
      )) {
        "l2_unit"
      } else {
        "none"
      },
      unit = if (prestige %in% c(
        "eigenvector", "eigenvector.rownorm", "eigenvector.colnorm",
        "eigenvector.rowcolnorm"
      )) {
        if (identical(prestige, "eigenvector.rownorm")) {
          if (rescale) {
            "share_of_incoming_row_stochastic_perron_weight"
          } else {
            "l2_incoming_row_stochastic_perron_weight"
          }
        } else if (identical(prestige, "eigenvector.colnorm")) {
          if (rescale) {
            "share_of_incoming_column_stochastic_perron_weight"
          } else {
            "l2_incoming_column_stochastic_perron_weight"
          }
        } else if (identical(prestige, "eigenvector.rowcolnorm")) {
          if (rescale) {
            "share_of_incoming_doubly_stochastic_perron_weight"
          } else {
            "l2_incoming_doubly_stochastic_perron_weight"
          }
        } else if (rescale) {
          "share_of_incoming_perron_weight"
        } else {
          "l2_incoming_perron_weight"
        }
      } else if (identical(prestige, "domain.proximity")) {
        if (rescale) {
          "share_of_lin_domain_proximity"
        } else {
          "lin_domain_proximity"
        }
      } else if (identical(prestige, "domain")) {
        if (rescale) {
          "share_of_ordered_reachable_pairs"
        } else {
          "distinct_reaching_vertices"
        }
      } else if (identical(prestige, "indegree.rowcolnorm")) {
        if (rescale) {
          "share_of_balanced_incoming_nomination_mass"
        } else {
          "balanced_incoming_nomination_mass"
        }
      } else if (identical(prestige, "indegree.rownorm")) {
        if (rescale) {
          "share_of_active_sender_nomination_mass"
        } else {
          "active_sender_nomination_mass"
        }
      } else if (rescale) {
        "share_of_active_binary_dyads"
      } else {
        "active_binary_dyads"
      },
      weights = "ignored",
      loops = if (prestige %in% c(
        "eigenvector", "eigenvector.rownorm", "eigenvector.colnorm",
        "eigenvector.rowcolnorm"
      )) {
        if (identical(prestige, "eigenvector.rownorm")) {
          "retained_once_before_row_normalization"
        } else if (identical(prestige, "eigenvector.colnorm")) {
          "retained_once_before_column_normalization"
        } else if (identical(prestige, "eigenvector.rowcolnorm")) {
          "retained_once_before_support_and_balancing"
        } else {
          "retained_once_before_eigensolve"
        }
      } else if (prestige %in% c("domain", "domain.proximity")) {
        "no_effect_self_excluded"
      } else if (identical(prestige, "indegree.rowcolnorm")) {
        "retained_once_before_balancing"
      } else {
        "retained_once"
      },
      zero_total = if (prestige %in%
                       c("indegree.rowcolnorm", "eigenvector",
                         "eigenvector.rownorm", "eigenvector.colnorm",
                         "eigenvector.rowcolnorm")) {
        "not_applicable_feasible"
      } else {
        "NaN"
      },
      session_aggregation = if (identical(sessions, "separate")) {
        "session_local"
      } else {
        "binary_calendar_union"
      }
    )
    if (identical(prestige, "indegree.rownorm")) {
      metadata$zero_rows <- "all_zero"
    }
    if (identical(prestige, "indegree.rowcolnorm")) {
      metadata$support_requirement <- "total_support_full_vertex_matrix"
      metadata$support_policy <- "preserve_all_binary_dyads"
      metadata$undefined <- "NA"
      metadata$solver_tolerance <- 1e-12
      metadata$error_norm <- "max_absolute_margin"
      metadata$maximum_iterations <- 10000L
    }
    if (identical(prestige, "domain")) {
      metadata$path_scope <- "static_active_snapshot"
      metadata$path_weighting <- "unweighted_distinct_reachers"
      metadata$self_reach <- "excluded"
      metadata$unreachable <- "zero"
    }
    if (identical(prestige, "domain.proximity")) {
      metadata$path_scope <- "static_active_snapshot"
      metadata$domain <- "distinct_reaching_nonself_vertices"
      metadata$distance <- "minimum_hop_count"
      metadata$path_weighting <- "domain_fraction_over_mean_distance"
      metadata$unreachable <- "excluded_from_domain_and_distance_sum"
      metadata$formula <- "r^2/((n-1)*sum_distance)"
      metadata$network_size_normalization <- "n_minus_one"
      metadata$zero_domain <- "zero"
    }
    if (prestige %in% c(
      "eigenvector", "eigenvector.rownorm", "eigenvector.colnorm",
      "eigenvector.rowcolnorm"
    )) {
      metadata$eigenvalue <- "positive_perron_root"
      metadata$spectral_requirement <-
        "positive_radius_unique_perron_eigenspace"
      metadata$uniqueness <- "geometric_multiplicity_one"
      metadata$sign <- "nonnegative"
      metadata$undefined <- "NA"
      metadata$solver <- "base_eigen_svd_nullity"
      metadata$solver_tolerance <- 1e-10
      metadata$error_norm <- "max_absolute_eigen_residual"
    }
    if (identical(prestige, "eigenvector.rownorm")) {
      metadata$row_denominator <- "distinct_outgoing_binary_dyads"
      metadata$zero_rows <- "all_zero"
    }
    if (identical(prestige, "eigenvector.colnorm")) {
      metadata$column_denominator <- "distinct_incoming_binary_dyads"
      metadata$zero_columns <- "all_zero"
    }
    if (identical(prestige, "eigenvector.rowcolnorm")) {
      metadata$pipeline_order <-
        "binary_union_total_support_balance_transpose_perron"
      metadata$support_requirement <- "total_support_full_vertex_matrix"
      metadata$support_policy <- "preserve_all_binary_dyads"
      metadata$balance_solver <- "fixed_order_sinkhorn_knopp"
      metadata$balance_solver_tolerance <- 1e-12
      metadata$balance_error_norm <- "max_absolute_margin"
      metadata$balance_maximum_iterations <- 10000L
      metadata$defined_values <- "uniform"
      metadata$terminal_stages <- "support_balance_spectrum"
    }
    if (identical(measure, "prestige")) {
      for (field in names(metadata)) { # Direct attributes mirror one record.
        attr(out, field) <- metadata[[field]]
      }
    } else {
      attr(out, "measure_metadata") <- list(prestige = metadata)
    }
  }
  spectral_undefined <- sum(unlist(undefined_blocks[intersect(names(undefined_blocks), c("eigenvector", "hub", "authority"))]))
  if (spectral_undefined > 0L) {
    warning(warningCondition(sprintf(
      "Eigenvector, hub or authority centrality is undefined in %d reporting block(s): the snapshot's spectral radius is zero or its Perron root is repeated, so no single eigenvector exists; values are NA.",
      spectral_undefined
    ), class = c("dynet_eigen_undefined", "dynet_measure_undefined"), call = NULL))
  }
  singular <- sum(unlist(undefined_blocks[intersect(names(undefined_blocks), c("power", "information"))]))
  if (singular > 0L) {
    warning(warningCondition(sprintf(
      "Bonacich power or information centrality is undefined in %d reporting block(s): the linear system is singular; values are NA.",
      singular
    ), class = c("dynet_kernel_singular", "dynet_measure_undefined"), call = NULL))
  }
  if (length(prestige_diagnostics)) {
    diagnostics <- do.call(rbind, prestige_diagnostics)
    rownames(diagnostics) <- NULL
    attr(out, "prestige_diagnostics") <- diagnostics
    if (any(diagnostics$status == "infeasible")) {
      warning(warningCondition(sprintf(
        "Row-column prestige is structurally undefined in %d reporting block(s); values are NA. See `as.data.frame(x, what = \"diagnostics\")`.",
        sum(diagnostics$status == "infeasible")
      ), class = "dynet_prestige_infeasible", call = NULL))
    }
    if (any(diagnostics$status == "nonconverged")) {
      warning(warningCondition(sprintf(
        "Row-column prestige did not converge in %d reporting block(s); values are NA. See `as.data.frame(x, what = \"diagnostics\")`.",
        sum(diagnostics$status == "nonconverged")
      ), class = "dynet_prestige_nonconvergence", call = NULL))
    }
    if (any(diagnostics$status == "undefined")) {
      warning(warningCondition(sprintf(
        "Eigenvector prestige is undefined in %d reporting block(s); values are NA. See `as.data.frame(x, what = \"diagnostics\")`.",
        sum(diagnostics$status == "undefined")
      ), class = "dynet_prestige_eigen_undefined", call = NULL))
    }
  }
  .maybe_plot(out, plot)
}

#' Closeness and betweenness on time-respecting paths
#'
#' @description
#' Centrality computed from the time-respecting paths that [paths()] finds,
#' taken across the whole observation period (or the `start`-to-`end`
#' window). A path may only continue along a tie that is available after it
#' arrives, so these values cannot be inflated by ties that occur in the
#' wrong order, as a flattened network is. The result is one value per
#' vertex, not a series: for centrality that changes from window to window,
#' use [centrality_series()]; for the number of vertices a vertex can reach,
#' use [reachability()].
#'
#' @param dn A temporal network from [dynet()].
#' @param measure One or both of `"closeness"` (the default) and
#'   `"betweenness"`. Any other name raises `dynet_unknown_measure`.
#' @param sessions How to treat sessions: `"bounded"` (the default) keeps
#'   paths inside a session, `"collapse"` ignores sessions, `"separate"`
#'   reports each session on its own rows. `"separate"` on a network built
#'   without a session column raises `dynet_no_sessions`.
#' @param start,end Inclusive path-traversal bounds. Default to the observed
#'   range. A network built from dates may be addressed with dates.
#' @param traversal_time Nonnegative duration charged for every hop, in the
#'   network's time unit; `0` by default. A calendar network also accepts a
#'   scalar `difftime`.
#' @param plot Whether to draw the result as well as return it. Drawing is a
#'   side effect in the manner of [graphics::hist()]: the verb still returns
#'   its tidy table, invisibly when it has drawn.
#' @return A node-level `dynet_metric`: a tidy data frame with one row per
#'   vertex and measure, columns `node`, `measure` and `value`, preceded by
#'   `session` under `sessions = "separate"`. There is no `time` column. A
#'   single-measure result stores its mathematical choices as direct
#'   attributes; a two-measure result stores named records under
#'   `measure_metadata`.
#'
#' @details
#' Betweenness is the raw dependency sum over reachable forward
#' ordered pairs. For each source-target pair, its unit dependency is divided
#' equally over every canonical shortest-foremost journey, and an internal
#' vertex receives the fraction of those journeys that contain it. Sources and
#' targets receive no endpoint credit. This ordered-pair convention also
#' applies to undirected contacts because temporal reach is generally
#' asymmetric. The result is not normalised; its fixed range is
#' `[0, (n - 1) * (n - 2)]`.
#'
#' Closeness is inverse mean forward latency over reachable vertices:
#' if \eqn{R_s} is the set of reachable vertices other than source \eqn{s},
#' \deqn{C(s) = |R_s| / \sum_{z \in R_s} (a_z - o_s),}
#' where \eqn{a_z} is the foremost arrival time and \eqn{o_s} is the source's
#' resolved origin: the traversal window's lower bound, or -- when vertex
#' activity was declared -- the source's first presence inside that window.
#' Every reachable endpoint is included once, regardless
#' of how many optimal paths reach it. A source with no reachable nonself
#' endpoints has value zero. If all reachable endpoints have zero latency, the
#' value is `Inf`; zero-latency endpoints remain in the numerator when mixed
#' with positive latencies. The measure therefore has inverse-time units, is
#' invariant to translating the time axis, and scales inversely when time is
#' rescaled.
#'
#' Both measures use [paths()] traversal semantics: nondecreasing
#' times, unlimited waiting, half-open interval spells, and a separate exact
#' timestamp rule for point events. Positive `traversal_time` requires an
#' interval traversal to finish within continuous pair activity; a point event
#' triggers at its timestamp and reaches its endpoint after that duration.
#' `start` and `end` bound every measure. In separate-session output, a
#' session outside a one-sided bound contributes zero rows.
#'
#' Declared vertex activity gates the exact source anchor and every hop.
#' Waiting after a valid anchor may cross inactivity; interval traversal
#' requires both endpoints through completion, while a point trigger requires
#' the receiver again after any traversal delay. Fixed node rows and
#' full-network denominators are retained.
#'
#' @section Conditions:
#' Errors: `dynet_unknown_measure` (a measure other than `"closeness"` or
#' `"betweenness"`), `dynet_no_sessions` (`sessions = "separate"` without a
#' session column), `dynet_outside_observation` (the requested range misses
#' observed support; it also carries `dynet_bad_input`), and
#' `dynet_bad_input` for every other broken contract -- `dn` not a `dynet`, a
#' malformed `measure`, an out-of-range `start`, `end` or `traversal_time`.
#'
#' @references
#' Pan, R. K., & Saramaki, J. (2011). Path lengths, correlations, and
#' centrality in temporal networks. *Physical Review E*, 84(1), 016105.
#'
#' Tang, J., Musolesi, M., Mascolo, C., Latora, V., & Nicosia, V. (2010).
#' Analysing information flows and key mediators through temporal centrality
#' metrics. *Proceedings of SNS '10*.
#'
#' Buss, S., Molter, H., Niedermeier, R., & Rymar, M. (2024). Algorithmic
#' aspects of temporal betweenness. *Network Science*, 12(2), 160-188.
#'
#' Nicosia, V., Tang, J., Mascolo, C., Musolesi, M., Russo, G., & Latora, V.
#' (2013). Graph metrics for temporal networks. In *Temporal Networks*
#' (pp. 15-40). Springer.
#'
#' @examples
#' # Every ordered pair is searched, so the cost grows steeply with the
#' # vertex count; a subgraph keeps the example quick.
#' dn <- dynet(school_contacts)
#' few <- induce_subgraph(dn, nodes = c("Ana", "Ben", "Cara", "Dan", "Eve",
#'                                      "Finn", "Gita", "Hugo"))
#' path_centrality(few)
#' path_centrality(few, measure = c("closeness", "betweenness"),
#'                 start = 0, end = 10)
#' @seealso [paths()], [reachability()], [centrality_series()].
#' @export
path_centrality <- function(dn, measure = "closeness",
                            sessions = c("bounded", "collapse", "separate"),
                            start = NULL, end = NULL, traversal_time = 0,
                            plot = FALSE) {
  sessions <- match.arg(sessions)
  .check_dynet(dn, sessions)
  traversal_time <- .as_traversal_time(traversal_time, dn)
  .check(
    "`measure` must be a character vector." = is.character(measure),
    "`measure` must name at least one measure." = length(measure) > 0L,
    "`measure` cannot contain missing values." = !anyNA(measure)
  )
  allowed <- c("closeness", "betweenness")
  bad <- setdiff(measure, allowed)
  if (length(bad) > 0L) {
    stop(errorCondition(
      sprintf("Unknown measure %s. Available: %s%s",
              paste(sQuote(bad), collapse = ", "),
              paste(allowed, collapse = ", "),
              if (any(bad %in% c("reach", "reach_count"))) {
                "; temporal reach is `reachability()`"
              } else ""),
      class = "dynet_unknown_measure", call = NULL))
  }
  out <- .temporal_centrality(dn, measure, sessions, start, end,
                              traversal_time)
  .maybe_plot(out, plot)
}

#' Deprecated name for `centrality_series()` and `path_centrality()`
#'
#' `dyn_centrality()` was split in two. Its default `scope = "snapshot"` is
#' now [centrality_series()]; `scope = "temporal"` is [path_centrality()]
#' for closeness and betweenness and [reachability()] for reach. The old
#' name still works and returns what it always returned, with a warning of
#' class `dynet_deprecated`. It will be removed in a future release.
#'
#' @param dn,measure,sessions,sample,damping,mode,start,end,step,window,exponent,prestige,rescale,lambda,plot
#'   As in [centrality_series()].
#' @param scope `"snapshot"` (the default) or `"temporal"`.
#' @param traversal_time As in [path_centrality()]; nonzero only with
#'   `scope = "temporal"`.
#' @return A node-level `dynet_metric`, as returned by the function it
#'   forwards to.
#' @section Conditions:
#' Warning: `dynet_deprecated` on every call. Errors are those of the
#' function it forwards to, plus `dynet_bad_input` for `mode`, `step` or
#' `window` with `scope = "temporal"` and a nonzero `traversal_time` with
#' `scope = "snapshot"`.
#' @examples
#' dn <- dynet(school_contacts)
#' # Warns, then returns what centrality_series(dn) returns.
#' dyn_centrality(dn)
#' @keywords internal
#' @export
dyn_centrality <- function(dn,
                           measure = "degree",
                           scope = c("snapshot", "temporal"),
                           sessions = c("bounded", "collapse", "separate"),
                           sample = NULL,
                           damping = 0.85,
                           mode = c("all", "out", "in"),
                           start = NULL, end = NULL,
                           step = NULL, window = NULL,
                           exponent = 1, traversal_time = 0,
                           prestige = "indegree", rescale = FALSE,
                           lambda = 1, plot = FALSE) {
  scope <- match.arg(scope)
  warning(warningCondition(sprintf(
    "`dyn_centrality()` is deprecated; use %s.",
    if (identical(scope, "temporal")) {
      "`path_centrality()` or, for reach, `reachability()`"
    } else "`centrality_series()`"
  ), class = "dynet_deprecated", call = NULL))
  if (identical(scope, "snapshot")) {
    if (!isTRUE(all.equal(traversal_time, 0))) {
      stop(errorCondition(
        "A nonzero `traversal_time` applies only to `path_centrality()`.",
        class = "dynet_bad_input", call = NULL))
    }
    return(centrality_series(
      dn, measure = measure, sessions = sessions, sample = sample,
      damping = damping, mode = mode, start = start, end = end, step = step,
      window = window, exponent = exponent, prestige = prestige,
      rescale = rescale, lambda = lambda, plot = plot
    ))
  }
  sessions <- match.arg(sessions)
  .check_dynet(dn, sessions)
  traversal_time <- .as_traversal_time(traversal_time, dn)
  if (!identical(.resolve_modes(mode), "all")) {
    stop(errorCondition(
      "`mode` has no meaning for time-respecting paths, which use the network's recorded direction.",
      class = "dynet_bad_input", call = NULL))
  }
  given <- c("step", "window")[!vapply(list(step, window), is.null,
                                       logical(1L))]
  if (length(given) > 0L) {
    stop(errorCondition(sprintf(
      "%s %s no meaning for time-respecting paths, which are measured across the whole window rather than a grid of snapshots.",
      paste(sQuote(given), collapse = ", "),
      if (length(given) == 1L) "has" else "have"),
      class = "dynet_bad_input", call = NULL))
  }
  .check(
    "`measure` must be a character vector." = is.character(measure),
    "`measure` must name at least one measure." = length(measure) > 0L,
    "`measure` cannot contain missing values." = !anyNA(measure)
  )
  bad <- setdiff(measure, .temporal_measures)
  if (length(bad) > 0L) {
    stop(errorCondition(
      sprintf("Unknown measure %s for scope \"temporal\". Available: %s",
              paste(sQuote(bad), collapse = ", "),
              paste(.temporal_measures, collapse = ", ")),
      class = "dynet_unknown_measure", call = NULL))
  }
  .maybe_plot(.temporal_centrality(dn, measure, sessions, start, end,
                                   traversal_time), plot)
}

#' Share of each spell's weight that belongs to a reporting window
#'
#' A spell's weight is spread evenly over its recorded duration, so the share
#' a window receives is the fraction of that duration inside it. Rows are
#' observation fragments, so the overlap is taken on the fragment and the
#' denominator on the raw spell. Point contacts, zero-duration spells and
#' point windows keep a share of one.
#'
#' @param enc Encoded edge rows.
#' @param bin One-row reporting window with `lo` and `hi`.
#' @param window Reporting-window width.
#' @return A numeric vector in `[0, 1]`, one value per encoded row.
#' @examples
#' dn <- dynet(data.frame(from = "A", to = "B", start = 0, end = 4))
#' Dynet:::.window_weight_share(Dynet:::.encode(dn),
#'   data.frame(lo = 1, hi = 2), 1)
#' @noRd
.window_weight_share <- function(enc, bin, window) {
  if (!length(enc$weight) || window == 0) return(rep(1, length(enc$weight)))
  duration <- enc$raw_end - enc$raw_start
  overlap <- pmax(0, pmin(enc$end, bin$hi[[1L]]) -
                     pmax(enc$start, bin$lo[[1L]]))
  point <- enc$instant | duration <= .time_tol(enc$raw_start, enc$raw_end)
  share <- rep(1, length(duration))
  share[!point] <- pmin(1, overlap[!point] / duration[!point])
  share
}

#' Compute one snapshot centrality measure
#' @param m Measure name.
#' @param a Adjacency matrix for the bin.
#' @param directed Whether the network is directed.
#' @param damping PageRank damping factor.
#' @param mode Which edges count: `"all"`, `"out"` or `"in"`.
#' @param exponent Attenuation factor for Bonacich power.
#' @param prestige Prestige definition.
#' @param rescale Whether to normalise prestige by its block total.
#' @param lambda Diffusion-degree multiplier.
#' @return A numeric vector, one value per vertex.
#' @noRd
.snapshot_measure <- function(m, a, directed, damping, mode = "all",
                              exponent = 1, prestige = "indegree",
                              rescale = FALSE, lambda = 1) {
  b <- .binary(a, directed)
  degree_b <- (a > 0) * 1
  if (!directed) {
    degree_b <- pmax(degree_b, t(degree_b))
    # An undirected loop contributes two stubs, as in igraph and cograph.
    diag(degree_b) <- 2 * (diag(a) > 0)
  }
  switch(m,
    degree      = .margin(degree_b, directed, mode),
    indegree    = .margin(degree_b, directed, "in"),
    outdegree   = .margin(degree_b, directed, "out"),
    strength    = .margin(a, directed, mode),
    prestige    = if (prestige %in% c(
      "eigenvector", "eigenvector.rownorm", "eigenvector.colnorm",
      "eigenvector.rowcolnorm"
    )) {
      .eigen_prestige(a, rescale, definition = prestige, warn = FALSE)
    } else if (identical(prestige, "domain.proximity")) {
      .domain_proximity_prestige(a, rescale)
    } else if (identical(prestige, "domain")) {
      .domain_prestige(a, rescale)
    } else {
      .indegree_prestige(a, rescale, prestige, warn = FALSE)
    },
    closeness   = .closeness(a, directed, mode),
    betweenness = .betweenness(a, directed),
    # `b`, not `a`: an edge counts once however many spells produced it, as
    # for every other centrality here. Volume is what `strength` is for.
    eigenvector = .eigen_centrality(b, directed, mode),
    pagerank    = .pagerank(b, damping),
    hub         = .hits(b, "hub"),
    authority   = .hits(b, "authority"),
    coreness    = .coreness(a, directed, mode),
    constraint  = .constraint(b),
    power       = .bonacich_power(a, directed, exponent),
    harary      = .harary(a, directed, mode),
    information = .information(a),
    load        = .load(a, directed),
    flow_betweenness = .flow_betweenness(a, directed),
    diffusion   = .diffusion_degree(a, directed, mode, lambda)
  )
}

#' Deterministic bipartite perfect matching
#'
#' Rows and columns are the two vertex copies of a square binary support
#' matrix. Ordered augmenting paths make the returned matching reproducible.
#'
#' @param a Square numeric or logical support matrix.
#' @return An integer vector mapping every row to its matched column, or `NULL`
#'   when no perfect matching exists.
#' @examples
#' cycle <- matrix(c(0, 1, 1, 0), 2, 2, byrow = TRUE)
#' Dynet:::.perfect_matching(cycle)
#' @references
#' Sinkhorn, R., & Knopp, P. (1967). Concerning nonnegative matrices and
#' doubly stochastic matrices. *Pacific Journal of Mathematics*, 21, 343-348.
#' doi:10.2140/pjm.1967.21.343.
#' @noRd
.perfect_matching <- function(a) {
  b <- a > 0
  n <- nrow(b)
  if (n != ncol(b) || n == 0L) return(NULL)
  match_col <- integer(n)
  augment <- function(i) {
    neighbours <- which(b[i, ])
    # Reassignment along an augmenting path is sequential by definition.
    for (j in neighbours) {
      if (seen[j]) next
      seen[j] <<- TRUE
      owner <- match_col[j]
      if (owner == 0L || augment(owner)) {
        match_col[j] <<- i
        return(TRUE)
      }
    }
    FALSE
  }
  # Each successful row extends the preceding partial matching.
  for (i in seq_len(n)) {
    seen <- rep(FALSE, n)
    if (!augment(i)) return(NULL)
  }
  row_match <- integer(n)
  row_match[match_col] <- seq_len(n)
  row_match
}

#' Certify total support of a binary matrix
#'
#' A support has total support exactly when every positive entry belongs to a
#' perfect matching. Relative to one matching, nonmatching edges belong to an
#' alternating cycle precisely when their row endpoints lie in the same
#' strongly connected component.
#'
#' @param a Square numeric or logical support matrix.
#' @return A list with logical `ok`, character `reason`, the selected
#'   `matching`, and logical `unsupported` matrix.
#' @examples
#' Dynet:::.total_support(matrix(c(0, 1, 1, 0), 2, 2, byrow = TRUE))
#' Dynet:::.total_support(matrix(c(1, 1, 0, 1), 2, 2, byrow = TRUE))
#' @references
#' Sinkhorn, R., & Knopp, P. (1967). Concerning nonnegative matrices and
#' doubly stochastic matrices. *Pacific Journal of Mathematics*, 21, 343-348.
#' doi:10.2140/pjm.1967.21.343.
#' @noRd
.total_support <- function(a) {
  b <- a > 0
  n <- nrow(b)
  blank <- matrix(FALSE, n, n)
  if (n != ncol(b) || n == 0L ||
      any(rowSums(b) == 0L) || any(colSums(b) == 0L)) {
    return(list(ok = FALSE, reason = "zero_margin", matching = NULL,
                unsupported = b))
  }
  matching <- .perfect_matching(b)
  if (is.null(matching)) {
    return(list(ok = FALSE, reason = "no_perfect_matching", matching = NULL,
                unsupported = b))
  }

  match_col <- integer(n)
  match_col[matching] <- seq_len(n)
  edges <- which(b, arr.ind = TRUE)
  next_row <- match_col[edges[, 2L]]
  alternating <- blank
  alternating[cbind(edges[, 1L], next_row)] <- TRUE
  reach <- alternating
  diag(reach) <- TRUE
  # Transitive closure is sequential because paths through k depend on the
  # closure already established through vertices 1, ..., k - 1.
  for (k in seq_len(n)) {
    reach <- reach | outer(reach[, k], reach[k, ], FUN = "&")
  }
  allowed <- edges[, 1L] == next_row |
    reach[cbind(next_row, edges[, 1L])]
  unsupported <- blank
  if (any(!allowed)) unsupported[edges[!allowed, , drop = FALSE]] <- TRUE
  list(
    ok = !any(unsupported),
    reason = if (any(unsupported)) "not_total_support" else NA_character_,
    matching = matching,
    unsupported = unsupported
  )
}

#' One fixed-order Sinkhorn--Knopp sweep
#'
#' @param x Positive-support matrix with no zero row or column.
#' @return `x` after dividing rows by their sums and then columns by theirs.
#' @examples
#' Dynet:::.rowcol_sweep(matrix(c(1, 1, 1, 0), 2, 2))
#' @references
#' Sinkhorn, R., & Knopp, P. (1967). Concerning nonnegative matrices and
#' doubly stochastic matrices. *Pacific Journal of Mathematics*, 21, 343-348.
#' doi:10.2140/pjm.1967.21.343.
#' @noRd
.rowcol_sweep <- function(x) {
  x <- x / rowSums(x)
  t(t(x) / colSums(x))
}

#' Deterministic row-column balancing of binary support
#'
#' For total-support binary `B`, fixed-order Sinkhorn--Knopp sweeps seek the
#' unique doubly stochastic matrix `X = D_r B D_c`. The maximum absolute row
#' or column margin error controls termination. No partial result is approved
#' after the iteration cap.
#'
#' @param a Square adjacency or support matrix; positive values are binarised.
#' @param tol Positive maximum permitted absolute margin error.
#' @param max_iter Positive integer cap on complete row-plus-column sweeps.
#' @return A list containing `matrix`, `status`, `reason`, `iterations`, and
#'   `residual`. Status is `"ok"`, `"infeasible"`, or `"nonconverged"`.
#' @examples
#' b <- matrix(c(1, 1, 0, 1, 1, 1, 0, 1, 1), 3, 3, byrow = TRUE)
#' Dynet:::.rowcol_balance(b)
#' @references
#' Sinkhorn, R. (1964). A relationship between arbitrary positive matrices
#' and doubly stochastic matrices. *Annals of Mathematical Statistics*, 35,
#' 876-879. doi:10.1214/aoms/1177703591.
#'
#' Knight, P. A. (2008). The Sinkhorn-Knopp algorithm: convergence and
#' applications. *SIAM Journal on Matrix Analysis and Applications*, 30,
#' 261-275. doi:10.1137/060659624.
#' @noRd
.rowcol_balance <- function(a, tol = 1e-12, max_iter = 10000L) {
  b <- (a > 0) * 1
  support <- .total_support(b)
  if (!support$ok) {
    return(list(
      matrix = matrix(NA_real_, nrow(b), ncol(b)),
      status = "infeasible", reason = support$reason,
      iterations = 0L, residual = NA_real_
    ))
  }
  residual <- function(x) max(
    abs(rowSums(x) - 1), abs(colSums(x) - 1)
  )
  x <- b
  error <- residual(x)
  if (is.finite(error) && error <= tol) {
    return(list(matrix = x, status = "ok", reason = NA_character_,
                iterations = 0L, residual = error))
  }
  # Every sweep depends on the complete scaling produced by its predecessor.
  for (iteration in seq_len(max_iter)) {
    x <- .rowcol_sweep(x)
    supported <- b > 0
    numerically_valid <- all(x[!supported] == 0) &&
      all(is.finite(x[supported])) && all(x[supported] > 0)
    if (!numerically_valid) {
      return(list(
        matrix = matrix(NA_real_, nrow(b), ncol(b)),
        status = "nonconverged", reason = "nonfinite_arithmetic",
        iterations = as.integer(iteration), residual = Inf
      ))
    }
    error <- residual(x)
    if (is.finite(error) && error <= tol) {
      return(list(matrix = x, status = "ok", reason = NA_character_,
                  iterations = as.integer(iteration), residual = error))
    }
  }
  list(matrix = matrix(NA_real_, nrow(b), ncol(b)), status = "nonconverged",
       reason = "iteration_cap", iterations = as.integer(max_iter),
       residual = error)
}

#' Directed indegree prestige
#'
#' @details
#' For binary adjacency `B`, ordinary indegree prestige is the column sum
#' `p[j] = sum(B[, j])`. For `definition = "indegree.rownorm"`, each positive
#' row is first divided by its row sum and each zero row remains zero, so
#' `p[j] = sum(B[i, j] / sum(B[i, ]))` over active senders. The optional final
#' rescaling divides `p` by `sum(p)`; an all-zero total yields literal `NaN`.
#' For `"indegree.rowcolnorm"`, total support is certified first and
#' deterministic Sinkhorn--Knopp scaling makes every row and column sum one.
#' Feasible scores are therefore exactly one, or `1 / n` when rescaled;
#' structurally undefined or nonconvergent blocks return `NA`.
#'
#' @param a Binary directed adjacency matrix for one snapshot block.
#' @param rescale Whether to divide the column sums by their total.
#' @param definition One of ordinary `"indegree"`,
#'   `"indegree.rownorm"`, which divides every nonzero binary row by its sum
#'   before taking column sums, or `"indegree.rowcolnorm"`, which requires
#'   total support and doubly stochastic scaling.
#' @param tol Internal S03 maximum absolute margin error.
#' @param max_iter Internal S03 cap on complete balancing sweeps.
#' @param warn Whether direct nonconvergence emits its classed warning. Public
#'   calls aggregate warnings after all reporting blocks.
#' @return A numeric vector, one value per matrix column. Ordinary zero-total
#'   rescaling yields `NaN`; undefined S03 blocks yield `NA` and carry an
#'   internal diagnostic attribute.
#' @examples
#' a <- matrix(c(0, 0, 1, 0), 2, 2)
#' Dynet:::.indegree_prestige(a)
#' Dynet:::.indegree_prestige(a, rescale = TRUE)
#' Dynet:::.indegree_prestige(a, definition = "indegree.rownorm")
#' Dynet:::.indegree_prestige(diag(2), definition = "indegree.rowcolnorm")
#' @references
#' Wasserman, S., & Faust, K. (1994). *Social Network Analysis: Methods and
#' Applications*. Cambridge University Press, Chapter 5.
#'
#' Butts, C. T. (2024). *sna: Tools for Social Network Analysis*, version 2.8.
#' doi:10.32614/CRAN.package.sna.
#' @noRd
.indegree_prestige <- function(a, rescale = FALSE, definition = "indegree",
                               tol = 1e-12, max_iter = 10000L,
                               warn = TRUE) {
  b <- (a > 0) * 1
  if (identical(definition, "indegree.rowcolnorm")) {
    balanced <- .rowcol_balance(b, tol, max_iter)
    if (!identical(balanced$status, "ok")) {
      value <- rep(NA_real_, ncol(b))
      attr(value, "prestige_diagnostic") <- balanced[
        c("status", "reason", "iterations", "residual")
      ]
      if (warn && identical(balanced$status, "nonconverged")) {
        warning(warningCondition(sprintf(
          "Row-column prestige did not converge after %d sweeps (residual %.6g).",
          balanced$iterations, balanced$residual
        ), class = "dynet_prestige_nonconvergence", call = NULL))
      }
      return(value)
    }
    return(if (rescale) rep(1 / ncol(b), ncol(b)) else rep(1, ncol(b)))
  }
  if (identical(definition, "indegree.rownorm")) {
    denominator <- rowSums(b)
    positive <- denominator > 0
    b[positive, ] <- b[positive, , drop = FALSE] / denominator[positive]
  }
  value <- unname(colSums(b))
  if (rescale) value <- value / sum(value)
  value
}

#' Directed reachability-domain prestige
#'
#' For binary directed adjacency `B`, let `H[i,j]` be true when `i = j` or a
#' directed path from `i` to `j` exists. Domain prestige excludes self and is
#' the incoming reachability count `p[j] = sum(H[,j]) - 1`. Every distinct
#' predecessor vertex counts once; path length and multiplicity do not enter.
#'
#' @param a Directed adjacency matrix for one snapshot block. Positive values
#'   are treated as binary dyads and loops have no effect.
#' @param rescale Whether to divide the counts by their total. A zero total
#'   yields literal `NaN` for every vertex.
#' @return A numeric vector of incoming nonself reachability counts, or their
#'   block-total shares.
#' @examples
#' chain <- matrix(c(0, 1, 0, 0, 0, 1, 0, 0, 0), 3, 3, byrow = TRUE)
#' Dynet:::.domain_prestige(chain)
#' Dynet:::.domain_prestige(chain, rescale = TRUE)
#' @references
#' Lin, N. (1976). *Foundations of Social Research*. McGraw-Hill.
#'
#' Wasserman, S., & Faust, K. (1994). *Social Network Analysis: Methods and
#' Applications*. Cambridge University Press, Chapter 5.
#' @noRd
.domain_prestige <- function(a, rescale = FALSE) {
  distance <- .geodesic(a, directed = TRUE)
  reachable <- is.finite(distance)
  diag(reachable) <- FALSE
  value <- unname(colSums(reachable))
  if (rescale) value <- value / sum(value)
  value
}

#' Directed domain-proximity prestige
#'
#' Let `D[j]` be the distinct nonself vertices with a finite directed
#' unweighted distance into `j`, `r[j]` its size, and `s[j]` the sum of those
#' distances. Lin's proximity prestige is zero for an empty domain and
#' otherwise `r[j]^2 / ((n - 1) * s[j])`: domain fraction divided by mean hop
#' distance. Unreachable vertices are excluded before summing distances.
#'
#' @param a Directed adjacency matrix for one snapshot block. Positive values
#'   are treated as binary dyads and loops have no effect.
#' @param rescale Whether to divide scores by their block total. A zero total
#'   yields literal `NaN` for every vertex.
#' @return A numeric vector in `[0,1]`, or its block-total shares.
#' @examples
#' chain <- matrix(c(0, 1, 0, 0, 0, 1, 0, 0, 0), 3, 3, byrow = TRUE)
#' Dynet:::.domain_proximity_prestige(chain)
#' Dynet:::.domain_proximity_prestige(chain, rescale = TRUE)
#' @references
#' Lin, N. (1976). *Foundations of Social Research*. McGraw-Hill.
#'
#' Wasserman, S., & Faust, K. (1994). *Social Network Analysis: Methods and
#' Applications*. Cambridge University Press, Chapter 5.
#' @noRd
.domain_proximity_prestige <- function(a, rescale = FALSE) {
  distance <- .geodesic(a, directed = TRUE)
  finite <- is.finite(distance)
  diag(finite) <- FALSE
  domain <- colSums(finite)
  distance_sum <- colSums(ifelse(finite, distance, 0))
  value <- if (nrow(a) <= 1L) {
    rep(0, nrow(a))
  } else {
    ifelse(domain == 0, 0,
           domain^2 / ((nrow(a) - 1) * distance_sum))
  }
  value <- unname(value)
  if (rescale) value <- value / sum(value)
  value
}

#' Incoming binary Perron prestige with uniqueness certification
#'
#' For binary directed adjacency `B`, ordinary eigenvector prestige solves
#' `t(B) %*% p = rho(B) * p`. The row-normalised definition first forms
#' `P[i,j] = B[i,j] / sum(B[i,])` for positive row totals, leaving zero rows
#' exactly zero. The column-normalised definition analogously forms
#' `Q[i,j] = B[i,j] / sum(B[,j])` and leaves zero columns zero. The row-column
#' definition first certifies total support and balances binary `B` to doubly
#' stochastic form. Each then solves the transposed Perron equation on its
#' transformed matrix. A score is
#' published only when the spectral radius is positive and the Perron
#' eigenspace is one-dimensional. Raw values have Euclidean norm one;
#' optional rescaling makes their sum one. Zero-radius and nonunique blocks
#' return `NA` with a diagnostic rather than an arbitrary eigenvector.
#'
#' @param a Directed adjacency matrix for one snapshot block. Positive values
#'   are treated as binary dyads; retained loops remain on the diagonal.
#' @param rescale Whether to normalise the feasible Perron vector to sum one.
#' @param definition Ordinary `"eigenvector"`, `"eigenvector.rownorm"`,
#'   which row-normalises binary adjacency, `"eigenvector.colnorm"`, which
#'   column-normalises it, or `"eigenvector.rowcolnorm"`, which requires total
#'   support and deterministic doubly stochastic balancing before transpose
#'   and eigensolving.
#' @param tol Fixed relative tolerance for root, nullity, sign, and residual
#'   checks.
#' @param balance_tol Internal S09 maximum absolute margin error.
#' @param balance_max_iter Internal S09 cap on complete balancing sweeps.
#' @param warn Whether an undefined direct call emits its classed warning.
#'   Public calls aggregate warnings after all reporting blocks.
#' @return A numeric vector with L2 norm or sum one. Undefined blocks are all
#'   `NA` and carry a `prestige_diagnostic` attribute.
#' @examples
#' cycle <- matrix(c(0, 1, 0, 0, 0, 1, 1, 0, 0), 3, 3, byrow = TRUE)
#' Dynet:::.eigen_prestige(cycle)
#' Dynet:::.eigen_prestige(cycle, rescale = TRUE)
#' Dynet:::.eigen_prestige(cycle, definition = "eigenvector.rownorm")
#' Dynet:::.eigen_prestige(cycle, definition = "eigenvector.colnorm")
#' Dynet:::.eigen_prestige(cycle, definition = "eigenvector.rowcolnorm")
#' @references
#' Bonacich, P. (1972). Factoring and weighting approaches to status scores
#' and clique identification. *Journal of Mathematical Sociology*, 2, 113-120.
#' doi:10.1080/0022250X.1972.9989806.
#'
#' Berman, A., & Plemmons, R. J. (1994). *Nonnegative Matrices in the
#' Mathematical Sciences*. SIAM. doi:10.1137/1.9781611971262.
#' @noRd
.eigen_prestige <- function(a, rescale = FALSE,
                            definition = c("eigenvector",
                                           "eigenvector.rownorm",
                                           "eigenvector.colnorm",
                                           "eigenvector.rowcolnorm"),
                            tol = 1e-10, balance_tol = 1e-12,
                            balance_max_iter = 10000L, warn = TRUE) {
  definition <- match.arg(definition)
  b <- (a > 0) * 1
  balance <- NULL
  if (identical(definition, "eigenvector.rownorm")) {
    denominator <- rowSums(b)
    positive <- denominator > 0
    b[positive, ] <- b[positive, , drop = FALSE] / denominator[positive]
  }
  if (identical(definition, "eigenvector.colnorm")) {
    denominator <- colSums(b)
    positive <- denominator > 0
    b[, positive] <- sweep(
      b[, positive, drop = FALSE], 2L, denominator[positive], "/"
    )
  }
  if (identical(definition, "eigenvector.rowcolnorm")) {
    balance <- .rowcol_balance(b, balance_tol, balance_max_iter)
    if (!identical(balance$status, "ok")) {
      value <- rep(NA_real_, nrow(b))
      stage <- if (identical(balance$status, "infeasible")) {
        "support"
      } else {
        "balance"
      }
      attr(value, "prestige_diagnostic") <- list(
        stage = stage, status = balance$status, reason = balance$reason,
        iterations = balance$iterations, residual = balance$residual,
        balance_status = balance$status, balance_reason = balance$reason,
        balance_iterations = balance$iterations,
        balance_residual = balance$residual,
        spectral_radius = NA_real_, eigenspace_dimension = NA_integer_,
        eigen_residual = NA_real_
      )
      if (warn) {
        if (identical(balance$status, "infeasible")) {
          warning(warningCondition(sprintf(
            "Row-column eigenvector prestige is infeasible (%s); values are NA.",
            balance$reason
          ), class = "dynet_prestige_infeasible", call = NULL))
        } else {
          warning(warningCondition(sprintf(
            paste0(
              "Row-column eigenvector prestige did not converge after %d ",
              "sweeps (residual %.6g); values are NA."
            ), balance$iterations, balance$residual
          ), class = "dynet_prestige_nonconvergence", call = NULL))
        }
      }
      return(value)
    }
    b <- balance$matrix
  }
  n <- nrow(b)
  undefined <- function(reason, spectral_radius = NA_real_,
                        eigenspace_dimension = NA_integer_,
                        residual = NA_real_) {
    value <- rep(NA_real_, n)
    attr(value, "prestige_diagnostic") <- list(
      stage = "spectrum", status = "undefined", reason = reason,
      iterations = balance$iterations %||% NA_integer_,
      spectral_radius = spectral_radius,
      eigenspace_dimension = as.integer(eigenspace_dimension),
      residual = residual,
      balance_status = balance$status %||% NA_character_,
      balance_reason = balance$reason %||% NA_character_,
      balance_iterations = balance$iterations %||% NA_integer_,
      balance_residual = balance$residual %||% NA_real_,
      eigen_residual = residual
    )
    if (warn) {
      warning(warningCondition(sprintf(
        "Eigenvector prestige is undefined (%s); values are NA.", reason
      ), class = "dynet_prestige_eigen_undefined", call = NULL))
    }
    value
  }
  if (n == 0L) return(undefined("zero_spectral_radius", 0))
  spectrum <- tryCatch(eigen(t(b), only.values = TRUE)$values,
                       error = function(e) NULL)
  if (is.null(spectrum) || any(!is.finite(spectrum))) {
    return(undefined("numerical_failure"))
  }
  radius <- max(Mod(spectrum))
  scale <- max(1, radius)
  if (radius <= tol * scale) {
    return(undefined("zero_spectral_radius", radius))
  }
  candidates <- which(
    abs(Im(spectrum)) <= tol * scale &
      abs(Re(spectrum) - radius) <= tol * scale
  )
  if (!length(candidates)) {
    return(undefined("numerical_failure", radius))
  }
  perron <- max(Re(spectrum[candidates]))
  shifted <- t(b) - diag(perron, n)
  decomposition <- tryCatch(svd(shifted, nu = n, nv = n),
                            error = function(e) NULL)
  if (is.null(decomposition) || any(!is.finite(decomposition$d))) {
    return(undefined("numerical_failure", perron))
  }
  singular_scale <- max(1, perron, decomposition$d)
  null <- which(decomposition$d <= tol * singular_scale)
  dimension <- length(null)
  if (dimension != 1L) {
    return(undefined("nonunique_perron_eigenspace", perron, dimension))
  }
  vector <- decomposition$v[, null]
  if (sum(vector) < 0) vector <- -vector
  vector_scale <- max(1, abs(vector))
  if (!all(is.finite(vector)) || any(vector < -tol * vector_scale)) {
    return(undefined("numerical_failure", perron, dimension))
  }
  vector[vector < 0] <- 0
  norm <- sqrt(sum(vector^2))
  if (!is.finite(norm) || norm <= tol) {
    return(undefined("numerical_failure", perron, dimension))
  }
  vector <- vector / norm
  residual <- max(abs(t(b) %*% vector - perron * vector))
  if (!is.finite(residual) || residual > tol * max(1, perron)) {
    return(undefined("numerical_failure", perron, dimension, residual))
  }
  if (identical(definition, "eigenvector.rowcolnorm")) {
    return(rep(if (rescale) 1 / n else 1 / sqrt(n), n))
  }
  if (rescale) vector <- vector / sum(vector)
  unname(vector)
}

#' Human-readable label for a measure name
#' @param m Measure name.
#' @param prestige Prestige definition used when `m = "prestige"`.
#' @return A single character string.
#' @noRd
.measure_label <- function(m, prestige = "indegree") {
  if (identical(m, "prestige")) {
    return(switch(prestige,
      indegree = "Indegree prestige",
      indegree.rownorm = "Row-normalized indegree prestige",
      indegree.rowcolnorm = "Row-column-normalized indegree prestige",
      domain = "Domain prestige",
      domain.proximity = "Domain proximity prestige",
      eigenvector = "Eigenvector prestige",
      eigenvector.rownorm = "Row-normalized eigenvector prestige",
      eigenvector.colnorm = "Column-normalized eigenvector prestige",
      eigenvector.rowcolnorm = "Row-column-normalized eigenvector prestige"
    ))
  }
  lookup <- c(degree = "Degree", indegree = "In-degree",
              outdegree = "Out-degree", strength = "Strength",
              closeness = "Closeness", betweenness = "Betweenness",
              eigenvector = "Eigenvector centrality", pagerank = "PageRank",
              hub = "Hub score", authority = "Authority score",
              coreness = "Coreness", constraint = "Burt's constraint",
              power = "Bonacich power", harary = "Harary graph centrality",
              information = "Information centrality", load = "Load centrality",
              flow_betweenness = "Flow betweenness",
              diffusion = "Diffusion degree",
              reach = "Reachability", reach_count = "Reach count")
  unname(lookup[m] %||% m)
}

#' Vertex centrality over time-respecting paths
#' @param dn A `dynet` object.
#' @param measure One or more of "closeness", "betweenness", "reach",
#'   "reach_count".
#' @param sessions Session mode.
#' @param start,end Optional traversal bounds for every temporal measure.
#' @param traversal_time Nonnegative duration charged for every hop.
#' @return A `dynet_metric` at node level with no time column.
#' @noRd
.temporal_centrality <- function(dn, measure, sessions,
                                 start = NULL, end = NULL,
                                 traversal_time = 0) {
  parts <- .split_sessions(dn, sessions)
  bounded <- identical(sessions, "bounded")
  frames <- Map(function(enc, label) {
    walk <- .undirect_or_reverse(enc, dn$directed, "forward")
    encoding_range <- .encoding_time_range(dn, enc)
    horizon <- .path_window(
      dn, "forward", start = start, end = end,
      default_start = encoding_range[["start"]],
      default_end = encoding_range[["end"]],
      clamp_missing = identical(sessions, "separate")
    )
    activity <- .prepare_path_encoding(
      dn, walk,
      session = if (identical(sessions, "separate")) label else NULL,
      erase_sessions = !identical(sessions, "separate")
    )$path_activity
    trees <- lapply(seq_len(enc$n), function(s) {
      t0 <- .presence_anchor(activity, s, "forward", horizon$start,
                             horizon$end)
      if (is.na(t0)) return(.absent_search(enc$n, s, "forward"))
      .optimal_bounded_search(
        dn, walk, s, t0, "forward", bounded,
        lower = horizon$start, upper = horizon$end,
        traversal_time = traversal_time,
        activity_mode = if (identical(sessions, "separate")) {
          "separate"
        } else {
          "collapse"
        },
        activity_session = if (identical(sessions, "separate")) label else NULL
      )
    })
    vals <- stats::setNames(lapply(measure, function(m)
      .temporal_measure(m, trees, enc)), measure)
    data.frame(session = label, node = enc$names,
               measure = rep(measure, each = enc$n),
               value = unlist(vals, use.names = FALSE),
               stringsAsFactors = FALSE)
  }, parts, names(parts))
  df <- do.call(rbind, frames)

  out <- .metric(
    df, level = "node",
    what = if (length(measure) == 1L) .measure_label(measure) else "Temporal centrality",
    dn = dn,
    note = if (is.null(start) && is.null(end))
      "computed on time-respecting paths across the whole window" else
      "computed on time-respecting paths within the requested traversal window",
    traversal_time = traversal_time
  )
  closeness_metadata <- list(
    criterion = "foremost_then_shortest",
    distance = "forward_latency",
    normalization = "reachable_inverse_mean"
  )
  betweenness_metadata <- list(
    criterion = "foremost_then_shortest",
    pair_domain = "forward_reachable_ordered",
    normalization = "none",
    path_identity = "canonical_atom_sequence"
  )
  if (identical(measure, "closeness")) {
    attr(out, "criterion") <- closeness_metadata$criterion
    attr(out, "distance") <- closeness_metadata$distance
    attr(out, "normalization") <- closeness_metadata$normalization
  } else if (identical(measure, "betweenness")) {
    attr(out, "criterion") <- betweenness_metadata$criterion
    attr(out, "pair_domain") <- betweenness_metadata$pair_domain
    attr(out, "normalization") <- betweenness_metadata$normalization
    attr(out, "path_identity") <- betweenness_metadata$path_identity
  } else {
    metadata <- list()
    if ("closeness" %in% measure) metadata$closeness <- closeness_metadata
    if ("betweenness" %in% measure) {
      metadata$betweenness <- betweenness_metadata
    }
    if (length(metadata)) attr(out, "measure_metadata") <- metadata
  }
  effective_mode <- if (identical(sessions, "bounded") &&
                        is.null(dn$meta$sessions)) "collapse" else sessions
  .vertex_path_metadata(out, effective_mode)
}

#' Reduce a set of optimal forward searches to one temporal measure
#' @param m Measure name.
#' @param trees List of optimal search results, one per source.
#' @param enc Encoded edge list.
#' @return A numeric vector, one value per vertex.
#' @noRd
.temporal_measure <- function(m, trees, enc) {
  n <- enc$n
  switch(m,
    reach = .temporal_reach_values(trees, n, m)[[1L]],
    reach_count = .temporal_reach_values(trees, n, m)[[1L]],
    closeness = .temporal_closeness_values(trees, n),
    betweenness = .temporal_betweenness_values(trees, n)
  )
}

#' Count optimal endpoint routes through each named vertex
#'
#' The result is a numerator, not a fraction. It is computed from exact prefix
#' and suffix counts on one direct appearance DAG and never expands route rows.
#'
#' @param search A direct result from `.optimal_path_search()`.
#' @param endpoint Integer target vertex.
#' @return A numeric vector of exact path counts, one per named vertex.
#' @examples
#' dn <- dynet(school_contacts)
#' enc <- Dynet:::.encode(dn)
#' search <- Dynet:::.optimal_path_search(enc, 1L, 0, upper = 10)
#' Dynet:::.optimal_endpoint_dependency(search, 2L)
#' @noRd
.optimal_endpoint_dependency <- function(search, endpoint) {
  n <- search$n
  out <- numeric(n)
  if (endpoint == search$source || search$n_paths[[endpoint]] == 0) return(out)
  terminal <- search$selected_states[[endpoint]]
  if (!length(terminal)) return(out)

  state <- search$state
  suffix <- numeric(length(state$vertex))
  suffix[terminal] <- 1
  # A suffix count depends on every child one hop deeper, so descending hop
  # order is a genuine sequential dependency.
  for (child in order(state$hops, decreasing = TRUE)) {
    if (suffix[[child]] == 0 || !length(state$pred_state[[child]])) next
    parents <- state$pred_state[[child]]
    for (parent in parents) {
      suffix[[parent]] <- .path_count_add(suffix[[parent]], suffix[[child]])
    }
  }
  through <- state$count * suffix
  out <- vapply(seq_len(n), function(vertex) {
    sum(through[state$vertex == vertex])
  }, numeric(1L))
  out[c(search$source, endpoint)] <- 0
  out
}

#' Reduce optimal appearance DAGs to raw temporal betweenness
#'
#' For every reachable ordered source-target pair, the exact number of
#' shortest-foremost canonical atom journeys through a named internal vertex
#' is divided by the complete pair-family count. Bounded searches combine
#' numerators only from full-cost winning sessions before division.
#'
#' @param trees List of direct or bounded optimal searches, one per source.
#' @param n Size of the fixed vertex universe.
#' @return A nonnegative numeric vector, one raw dependency sum per vertex.
#' @examples
#' dn <- dynet(school_contacts)
#' enc <- Dynet:::.encode(dn)
#' searches <- lapply(seq_len(enc$n), function(source) {
#'   Dynet:::.optimal_path_search(enc, source, 0, upper = 10)
#' })
#' Dynet:::.temporal_betweenness_values(searches, enc$n)
#' @noRd
.temporal_betweenness_values <- function(trees, n) {
  per_source <- lapply(trees, function(search) {
    fractions <- lapply(seq_len(n), function(endpoint) {
      sigma <- search$n_paths[[endpoint]]
      if (endpoint == search$source || sigma == 0) return(numeric(n))
      numerator <- if (is.null(search$per_session)) {
        .optimal_endpoint_dependency(search, endpoint)
      } else {
        winners <- search$best_sessions[[endpoint]]
        if (!length(winners)) return(numeric(n))
        Reduce(`+`, lapply(winners, function(index) {
          .optimal_endpoint_dependency(search$per_session[[index]], endpoint)
        }))
      }
      numerator / sigma
    })
    Reduce(`+`, fractions)
  })
  Reduce(`+`, per_source)
}

#' Reduce temporal search trees to inverse mean forward latency
#'
#' Each reachable nonself endpoint contributes once. Zero-latency endpoints
#' are retained, so an all-zero reachable set has infinite closeness, while a
#' source with no reachable nonself endpoint has closeness zero.
#'
#' @param trees List of temporal search results, one per source.
#' @param n Size of the fixed vertex universe.
#' @return A numeric vector, one value per source vertex.
#' @examples
#' trees <- list(list(
#'   arrival = c(0, 0, 2), source = 1L, origin = 0
#' ))
#' Dynet:::.temporal_closeness_values(trees, 3L)
#' @noRd
.temporal_closeness_values <- function(trees, n) {
  values <- vapply(trees, function(tree) {
    target <- seq_len(n) != tree$source & is.finite(tree$arrival)
    if (!any(target)) return(0)
    latency <- tree$arrival[target] - tree$origin
    .check(
      "Internal temporal search returned an arrival before its origin." =
        all(latency >= 0)
    )
    1 / mean(latency)
  }, numeric(1L))
  # A mean latency of exactly zero is reachable: every vertex joined within one
  # instant, which `traversal_time = 0` permits. 1/0 is Inf, and Inf is the
  # honest limit -- instantaneous reach -- but returning it without a word is a
  # silent failure. Warn, and still return it.
  if (any(is.infinite(values))) {
    warning(warningCondition(
      paste0("Zero-latency reachable sets make temporal closeness infinite; ",
             "set a positive `traversal_time`."),
      class = "dynet_zero_latency"))
  }
  values
}

#' Reduce temporal search trees to source-excluding reach measures
#'
#' @param trees List of temporal search results, one per source.
#' @param n Size of the fixed vertex universe.
#' @param measure One or more of `"reach"` and `"reach_count"`.
#' @return A named list of numeric vectors in requested-measure order.
#' @noRd
.temporal_reach_values <- function(trees, n, measure) {
  count <- vapply(
    trees,
    function(tree) as.numeric(sum(
      is.finite(tree$arrival) & seq_len(n) != tree$source
    )),
    numeric(1L)
  )
  stats::setNames(lapply(measure, function(m) {
    if (identical(m, "reach_count")) count else count / max(1, n - 1L)
  }), measure)
}

Try the Dynet package in your browser

Any scripts or data that you put into this service are public.

Dynet documentation built on Oct. 7, 2026, 5:08 p.m.