File: centrality.R

package info (click to toggle)
r-cran-tidygraph 1.3.1-2
  • links: PTS, VCS
  • area: main
  • in suites: sid, trixie
  • size: 880 kB
  • sloc: cpp: 41; sh: 13; makefile: 2
file content (307 lines) | stat: -rw-r--r-- 14,046 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
#' 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')]
}