R/centrality.R

In tidygraph: A Tidy API for Graph Manipulation

#' Calculate node and edge centrality
#'
#' The centrality of a node measures the importance of node in the network. As
#' the concept of importance is ill-defined and dependent on the network and
#' the questions under consideration, many centrality measures exist.
#' `tidygraph` provides a consistent set of wrappers for all the centrality
#' measures implemented in `igraph` for use inside [dplyr::mutate()] and other
#' relevant verbs. All functions provided by `tidygraph` have a consistent
#' naming scheme and automatically calls the function on the graph, returning a
#' vector with measures ready to be added to the node data. Further `tidygraph`
#' provides access to the `netrankr` engine for centrality calculations and
#' define a number of centrality measures based on that, as well as provide a
#' manual mode for specifying more-or-less any centrality score. These measures
#' all only work on undirected graphs.
#'
#' @param weights The weight of the edges to use for the calculation. Will be
#' evaluated in the context of the edge data.
#' @param mode How should edges be followed. Ignored for undirected graphs
#' @param directed Should direction of edges be used for the calculations
#' @param loops Should loops be included in the calculation
#' @param scale Should the output be scaled between 0 and 1
#' @param rescale Should the output be scaled to sum up to 1
#' @param normalized Should the output be normalized
#' @param tol Tolerance for near-singularities during matrix inversion
#' @param options Settings passed on to `igraph::arpack()`
#' @param cutoff maximum path length to use during calculations
#' @param alpha Relative importance of endogenous vs exogenous factors (`centrality_alpha`), the exponent to the power transformation of the distance metric (`centrality_closeness_generalised`), the base of power transformation (`centrality_decay`), or the attenuation factor (`centrality_katz`)
#' @param exo The exogenous factors of the nodes. Either a scalar or a number
#' number for each node. Evaluated in the context of the node data.
#' @param exponent The decay rate for the Bonacich power centrality
#' @param damping The damping factor of the page rank algorithm
#' @param personalized The probability of jumping to a node when abandoning a
#' random walk. Evaluated in the context of the node data.
#'
#' @return A numeric vector giving the centrality measure of each node.
#'
#' @name centrality
#' @rdname centrality
#'
#' @examples
#' create_notable('bull') %>%
#'   activate(nodes) %>%
#'   mutate(importance = centrality_alpha())
#'
#' # Most centrality measures are for nodes but not all
#' create_notable('bull') %>%
#'   activate(edges) %>%
#'   mutate(importance = centrality_edge_betweenness())
NULL

#' @describeIn centrality Wrapper for [igraph::alpha_centrality()]
#' @importFrom igraph V alpha_centrality
#' @export
centrality_alpha <- function(weights = NULL, alpha = 1, exo = 1, tol = 1e-7, loops = FALSE) {
  expect_nodes()
  graph <- .G()
  weights <- enquo(weights)
  weights <- eval_tidy(weights, .E()) %||% NA
  exo <- enquo(exo)
  exo <- eval_tidy(exo, .N())
  alpha_centrality(graph = graph, nodes = focus_ind(graph, 'nodes'), alpha = alpha, exo = exo, weights = weights, tol = tol, loops = loops)
}
#' @describeIn centrality Wrapper for [igraph::authority_score()]
#' @importFrom igraph authority_score arpack_defaults
#' @export
centrality_authority <- function(weights = NULL, scale = TRUE, options = arpack_defaults()) {
  expect_nodes()
  weights <- enquo(weights)
  weights <- eval_tidy(weights, .E()) %||% NA
  graph <- .G()
  authority_score(graph = graph, scale = scale, weights = weights, options = options)$vector[focus_ind(graph, 'nodes')]
}
#' @describeIn centrality Wrapper for [igraph::betweenness()]
#' @importFrom igraph V betweenness
#' @importFrom rlang quos
#' @export
centrality_betweenness <- function(weights = NULL, directed = TRUE, cutoff = -1, normalized = FALSE) {
  expect_nodes()
  graph <- .G()
  weights <- enquo(weights)
  weights <- eval_tidy(weights, .E()) %||% NA
  cutoff <- cutoff %||% -1
  betweenness(graph = graph, v = focus_ind(graph, 'nodes'), directed = directed, cutoff = cutoff, weights = weights, normalized = normalized)

}
#' @describeIn centrality Wrapper for [igraph::power_centrality()]
#' @importFrom igraph V power_centrality
#' @export
centrality_power <- function(exponent = 1, rescale = FALSE, tol = 1e-7, loops = FALSE) {
  expect_nodes()
  graph <- .G()
  power_centrality(graph = graph, nodes = focus_ind(graph, 'nodes'), exponent = exponent, loops = loops, rescale = rescale, tol = tol)
}
#' @describeIn centrality Wrapper for [igraph::closeness()]
#' @importFrom igraph V closeness
#' @importFrom rlang quos
#' @export
centrality_closeness <- function(weights = NULL, mode = 'out', normalized = FALSE, cutoff = NULL) {
  expect_nodes()
  graph <- .G()
  weights <- enquo(weights)
  weights <- eval_tidy(weights, .E()) %||% NA
  cutoff <- cutoff %||% -1
  closeness(graph = graph, vids = focus_ind(graph, 'nodes'), mode = mode, cutoff = cutoff, weights = weights, normalized = normalized)
}
#' @describeIn centrality Wrapper for [igraph::eigen_centrality()]
#' @importFrom igraph eigen_centrality arpack_defaults
#' @export
centrality_eigen <- function(weights = NULL, directed = FALSE, scale = TRUE, options = arpack_defaults()) {
  expect_nodes()
  weights <- enquo(weights)
  weights <- eval_tidy(weights, .E()) %||% NA
  graph <- .G()
  eigen_centrality(graph = graph, directed = directed, scale = scale, weights = weights, options = options)$vector[focus_ind(graph, 'nodes')]
}
#' @describeIn centrality Wrapper for [igraph::hub_score()]
#' @importFrom igraph hub_score arpack_defaults
#' @export
centrality_hub <- function(weights = NULL, scale = TRUE, options = arpack_defaults()) {
  expect_nodes()
  weights <- enquo(weights)
  weights <- eval_tidy(weights, .E()) %||% NA
  graph <- .G()
  hub_score(graph = graph, scale = scale, weights = weights, options = options)$vector[focus_ind(graph, 'nodes')]
}
#' @describeIn centrality Wrapper for [igraph::page_rank()]
#' @importFrom igraph V page_rank
#' @export
centrality_pagerank <- function(weights = NULL, directed = TRUE, damping = 0.85, personalized = NULL) {
  expect_nodes()
  graph <- .G()
  weights <- enquo(weights)
  weights <- eval_tidy(weights, .E()) %||% NA
  personalized <- enquo(personalized)
  personalized <- eval_tidy(personalized, .N())
  page_rank(graph = graph, vids = focus_ind(graph, 'nodes'), directed = directed, damping = damping, personalized = personalized, weights = weights)$vector
}
#' @describeIn centrality Wrapper for [igraph::subgraph_centrality()]
#' @importFrom igraph subgraph_centrality
#' @export
centrality_subgraph <- function(loops = FALSE) {
  expect_nodes()
  graph <- .G()
  subgraph_centrality(graph = graph, diag = loops)[focus_ind(graph, 'nodes')]
}
#' @describeIn centrality Wrapper for [igraph::degree()] and [igraph::strength()]
#' @importFrom igraph V degree strength
#' @importFrom rlang quos
#' @export
centrality_degree <- function(weights = NULL, mode = 'out', loops = TRUE, normalized = FALSE) {
  expect_nodes()
  graph <- .G()
  weights <- enquo(weights)
  weights <- eval_tidy(weights, .E())
  if (is.null(weights)) {
    degree(graph = graph, v = focus_ind(graph, 'nodes'), mode = mode, loops = loops, normalized = normalized)
  } else {
    strength(graph = graph, vids = focus_ind(graph, 'nodes'), mode = mode, loops = loops, weights = weights)
  }
}
#' @describeIn centrality Wrapper for [igraph::edge_betweenness()]
#' @importFrom igraph edge_betweenness E
#' @importFrom rlang enquo eval_tidy
#' @export
centrality_edge_betweenness <- function(weights = NULL, directed = TRUE, cutoff = NULL) {
  expect_edges()
  graph <- .G()
  weights <- enquo(weights)
  weights <- eval_tidy(weights, .E()) %||% NA
  cutoff <- cutoff %||% -1
  edge_betweenness(graph = graph, e = focus_ind(graph, 'edges'), directed = directed, cutoff = cutoff, weights = weights)
}
#' @describeIn centrality Wrapper for [igraph::harmonic_centrality()]
#' @importFrom igraph harmonic_centrality
#' @importFrom rlang enquo eval_tidy
#' @export
centrality_harmonic <- function(weights = NULL, mode = 'out', normalized = FALSE, cutoff = NULL) {
  expect_nodes()
  graph <- .G()
  weights <- enquo(weights)
  weights <- eval_tidy(weights, .E()) %||% NA
  cutoff <- cutoff %||% -1
  harmonic_centrality(graph, vids = focus_ind(graph, 'nodes'), mode = mode, weights = weights, normalized = normalized, cutoff = cutoff)
}
#' @describeIn centrality Manually specify your centrality score using the `netrankr` framework (`netrankr`)
#' @param relation The indirect relation measure type to be used in `netrankr::indirect_relations`
#' @param aggregation The aggregation type to use on the indirect relations to be used in `netrankr::aggregate_positions`
#' @param ... Arguments to pass on to `netrankr::indirect_relations`
#' @export
#' @importFrom igraph is_directed
centrality_manual <- function(relation = 'dist_sp', aggregation = 'sum', ...) {
  expect_netrankr()
  expect_nodes()
  graph <- .G()
  if (is_directed(graph)) {
    cli::cli_abort("Centrality measures based on the {.pkg netrankr} package only works on undirected networks")
  }
  rel <- netrankr::indirect_relations(graph, type = relation, ...)
  netrankr::aggregate_positions(rel, type = aggregation)[focus_ind(graph, 'nodes')]
}
#' @describeIn centrality `r lifecycle::badge("deprecated")` centrality based on inverse shortest path (`netrankr`)
#' @export
centrality_closeness_harmonic <- function() {
  lifecycle::deprecate_soft('1.3.0', 'centrality_closeness_harmonic()', 'centrality_harmonic()')
  centrality_manual('dist_sp', FUN = netrankr::dist_inv)
}
#' @describeIn centrality centrality based on 2-to-the-power-of negative shortest path (`netrankr`)
#' @export
centrality_closeness_residual <- function() {
  centrality_manual('dist_sp', FUN = netrankr::dist_2pow)
}
#' @describeIn centrality centrality based on alpha-to-the-power-of negative shortest path (`netrankr`)
#' @export
centrality_closeness_generalised <- function(alpha) {
  centrality_manual('dist_sp', FUN = netrankr::dist_dpow, alpha = alpha)
}
#' @describeIn centrality centrality based on \eqn{1 - (x - 1)/max(x)} transformation of shortest path (`netrankr`)
#' @export
centrality_integration <- function() {
  centrality_manual('dist_sp', FUN = function(x) 1 - (x - 1)/max(x))
}
#' @describeIn centrality centrality an exponential tranformation of walk counts (`netrankr`)
#' @export
centrality_communicability <- function() {
  centrality_manual('walks', FUN = netrankr::walks_exp)
}
#' @describeIn centrality centrality an exponential tranformation of odd walk counts (`netrankr`)
#' @export
centrality_communicability_odd <- function() {
  centrality_manual('walks', FUN = netrankr::walks_exp_odd)
}
#' @describeIn centrality centrality an exponential tranformation of even walk counts (`netrankr`)
#' @export
centrality_communicability_even <- function() {
  centrality_manual('walks', FUN = netrankr::walks_exp_even)
}
#' @describeIn centrality subgraph centrality based on odd walk counts (`netrankr`)
#' @export
centrality_subgraph_odd <- function() {
  centrality_manual('walks', 'self', FUN = netrankr::walks_exp_odd)
}
#' @describeIn centrality subgraph centrality based on even walk counts (`netrankr`)
#' @export
centrality_subgraph_even <- function() {
  centrality_manual('walks', 'self', FUN = netrankr::walks_exp_even)
}
#' @describeIn centrality centrality based on walks penalizing distant nodes (`netrankr`)
#' @export
centrality_katz <- function(alpha = NULL) {
  if (is.null(alpha)) {
    centrality_manual('walks', FUN = netrankr::walks_attenuated)
  } else {
    centrality_manual('walks', FUN = netrankr::walks_attenuated, alpha = alpha)
  }
}
#' @describeIn centrality Betweenness centrality based on network flow (`netrankr`)
#' @param netflowmode The return type of the network flow distance, either `'raw'` or `'frac'`
#' @export
centrality_betweenness_network <- function(netflowmode = 'raw') {
  centrality_manual('depend_netflow', netflowmode = netflowmode)
}
#' @describeIn centrality Betweenness centrality based on current flow (`netrankr`)
#' @export
centrality_betweenness_current <- function() {
  centrality_manual('depend_curflow')
}
#' @describeIn centrality Betweenness centrality based on communicability (`netrankr`)
#' @export
centrality_betweenness_communicability <- function() {
  centrality_manual('depend_exp')
}
#' @describeIn centrality Betweenness centrality based on simple randomised shortest path dependencies (`netrankr`)
#' @param rspxparam inverse temperature parameter
#' @export
centrality_betweenness_rsp_simple <- function(rspxparam = 1) {
  centrality_manual('depend_rsps', rspxparam = rspxparam)
}
#' @describeIn centrality Betweenness centrality based on net randomised shortest path dependencies (`netrankr`)
#' @export
centrality_betweenness_rsp_net <- function(rspxparam = 1) {
  centrality_manual('depend_rspn', rspxparam = rspxparam)
}
#' @describeIn centrality centrality based on inverse sum of resistance distance between nodes (`netrankr`)
#' @export
centrality_information <- function() {
  centrality_manual('dist_resist', 'invsum')
}
#' @describeIn centrality based on a power transformation of the shortest path (`netrankr`)
#' @export
centrality_decay <- function(alpha = 1) {
  centrality_manual('dist_sp', FUN = netrankr::dist_powd, alpha = alpha)
}
#' @describeIn centrality centrality based on the inverse sum of expected random walk length between nodes (`netrankr`)
#' @export
centrality_random_walk <- function() {
  centrality_manual('dist_rwalk', 'invsum')
}
#' @describeIn centrality Expected centrality ranking based on exact rank probability (`netrankr`)
#' @export
centrality_expected <- function() {
  expect_netrankr()
  expect_nodes()
  graph <- .G()
  P <- netrankr::neighborhood_inclusion(graph)
  ranks <- netrankr::exact_rank_prob(P)
  ranks$expected.rank[focus_ind(graph, 'nodes')]
}