-
Notifications
You must be signed in to change notification settings - Fork 6
/
centrality_indices.R
170 lines (156 loc) · 6.21 KB
/
centrality_indices.R
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
#' @title PN Centrality Index
#' @description centrality index for signed networks by Everett and Borgatti
#'
#' @param g igraph object. Must have a "sign" edge attribute.
#' @param mode character string, “out” for out-pn, “in” for in-pn or “all” for undirected networks.
#' @return centrality scores as numeric vector.
#' @references Everett, M. and Borgatti, S. (2014) Networks containing negative ties. *Social Networks* 38 111-120
#' @author David Schoch
#' @importFrom Matrix t
#' @examples
#' library(igraph)
#' A <- matrix(c(0, 1, 0, 1, 0, 0, 0, -1, -1, 0,
#' 1, 0, 1, -1, 1, -1, -1, 0, 0, 0,
#' 0, 1, 0, 1, -1, 0, 0, 0, -1, 0,
#' 1, -1, 1, 0, 1, -1, -1, 0, 0, 0,
#' 0, 1, -1, 1, 0, 1, 0, -1, 0, -1,
#' 0, -1, 0, -1, 1, 0, 1, 0, 1, -1,
#' 0, -1, 0, -1, 0, 1, 0, 1, -1, 1,
#' -1, 0, 0, 0, -1, 0, 1, 0, 1, 0,
#' -1, 0, -1, 0, 0, 1, -1, 1, 0, 1,
#' 0, 0, 0, 0, -1, -1, 1, 0, 1, 0), 10, 10)
#'g <- igraph::graph_from_adjacency_matrix(A,"undirected",weighted = "sign")
#'pn_index(g)
#' @export
pn_index <- function(g,mode=c("all","in","out")){
if (!igraph::is_igraph(g)) {
stop("Not a graph object")
}
if(!"sign"%in%igraph::edge_attr_names(g)){
stop("network does not have a sign edge attribute")
}
mode <- match.arg(mode,c("all","in","out"))
if(!igraph::is.directed(g)){
mode <- "all"
}
if(igraph::is.directed(g) & mode=="all"){
stop('"all" only works with undirected networks.')
}
A <- as_adj_signed(g,sparse = TRUE)
n <- nrow(A)
P <- (A>0)+0
N <- (A<0)+0
I <- diag(1,n)
A <- P-2*N
res <- switch(mode,
all = solve(I-1/(2*n-2)*A),
`in` = solve(I-1/(4*(n-1)^2)*t(A)%*%A)%*%solve(I+1/(2*n-2)*t(A)),
out = solve(I-1/(4*(n-1)^2)*A%*%t(A))%*%solve(I+1/(2*n-2)*A)
)
return(rowSums(res))
}
#' @title Signed Degree
#' @description several options to calculate the signed degree of vertices
#'
#' @param g igraph object. Must have a "sign" edge attribute.
#' @param mode character string, “out” for out-degree, “in” for in-degree or “all” for undirected networks.
#' @param type character string, “pos” or “neg” for counting positive or negative neighbors only,
#' "ratio" for pos/(pos+neg), or "net" for pos-neg.
#' @return centrality scores as numeric vector.
#' @author David Schoch
#' @importFrom Matrix t
#' @export
degree_signed <- function(g,mode=c("all","in","out"), type = c("pos","neg","ratio","net")){
if (!igraph::is_igraph(g)) {
stop("Not a graph object")
}
if(!"sign"%in%igraph::edge_attr_names(g)){
stop("network does not have a sign edge attribute")
}
mode <- match.arg(mode,c("all","in","out"))
if(!igraph::is.directed(g)){
mode <- "all"
}
if(igraph::is.directed(g) & mode=="all"){
stop('"all" only works with undirected networks.')
}
type <- match.arg(type,c("pos","neg","ratio","net"))
A <- as_adj_signed(g)
P <- (A>0)+0
N <- (A<0)+0
if(mode=="all"){
res <- switch(type,
pos = Matrix::rowSums(P),
neg = Matrix::rowSums(N),
ratio = Matrix::rowSums(P)/(Matrix::rowSums(P)+Matrix::rowSums(N)),
net = Matrix::rowSums(P)-Matrix::rowSums(N)
)
res
} else if(mode=="out"){
res <- switch(type,
pos = Matrix::rowSums(P),
neg = Matrix::rowSums(N),
ratio = Matrix::rowSums(P)/(Matrix::rowSums(P)+Matrix::rowSums(N)),
net = Matrix::rowSums(P)-Matrix::rowSums(N)
)
res
} else if(mode=="in"){
res <- switch(type,
pos = Matrix::colSums(P),
neg = Matrix::colSums(N),
ratio = Matrix::colSums(P)/(Matrix::colSums(P)+Matrix::colSums(N)),
net = Matrix::colSums(P)-Matrix::colSums(N)
)
return(res)
}
}
#' @title Signed Eigenvector centrality
#' @description Calcul
#' @details Note that, with negative values, the adjacency matrix may not have a dominant eigenvalue.
#' This means it is not clear which eigenvector should be used. In addition it is possible for the adjacency matrix to have repeated #'eigenvalues and hence multiple linearly independent eigenvectors. In this case certain centralities can be arbitrarily assigned. The function returns an error if this is the case.
#' @param g igraph object. Must have a "sign" edge attribute.
#' @param scale Logical scalar, whether to scale the result to have a maximum score of one. If no scaling is used then the result vector is the same as returned by `eigen()`.
#' @return centrality scores as numeric vector.
#' @references
#' Bonacich, P. and Lloyd, P. (2004). "Calculating Status with Negative Relations." *Social Networks* 26 (4): 331–38.
#'
#' Everett, M. and Borgatti, S.P. (2014). "Networks Containing Negative Ties." *Social Networks* 38: 111–20.
#'
#' @author David Schoch
#' @examples
#' library(igraph)
#' # example for network without dominant eigenvalue (from Everett&Borgatti)
#'
#' A <- matrix(c( 0, 1, 1, -1, 0, 0, -1, 0, 0,
#' 1, 0, 1, 0, -1, 0, 0, -1, 0,
#' 1, 1, 0, 0, 0, -1, 0, 0, -1,
#' -1, 0, 0, 0, 1, 1, -1, 0, 0,
#' 0, -1, 0, 1, 0, 1, 0, -1, 0,
#' 0, 0, -1, 1, 1, 0, 0, 0, -1,
#' -1, 0, 0, -1, 0, 0, 0, 1, 1,
#' 0, -1, 0, 0, -1, 0, 1, 0, 1,
#' 0, 0, -1, 0, 0, -1, 1, 1, 0), 9, 9)
#' g <- graph_from_adjacency_matrix(A,"undirected",weighted = "sign")
#'
#' # eigen_centrality_signed(g)
#'
#' @export
eigen_centrality_signed <- function(g, scale = TRUE){
if (!igraph::is_igraph(g)) {
stop("Not a graph object")
}
if(!"sign"%in%igraph::edge_attr_names(g)){
stop("network does not have a sign edge attribute")
}
A <- as_adj_signed(g,sparse = TRUE)
sA <- eigen(A)
evals <- round(sA$values,8)
max_evals <- which(abs(evals)==max(abs(evals)))
if(length(max_evals)!=1){
stop("no dominant eigenvalue exists")
} else{
evcent <- sA$vectors[,max_evals]
}
if(scale) evcent <- evcent/max(evcent)
return(evcent)
}