forked from briatte/ggnet
-
Notifications
You must be signed in to change notification settings - Fork 1
/
ggnet.R
222 lines (195 loc) · 10.4 KB
/
ggnet.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
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
#' ggnet - Plot a network with ggplot2
#'
#' Function for making a network plot from an object of class \code{network} or \code{igraph}, using ggplot2.
#'
#' @export
#' @param net an object of class \code{igraph} or \code{network}. If the object is of class \code{igraph}, the \link{intergraph} package is used to convert it to class \code{network}.
#' @param mode a placement method from the list of modes provided in the \link{sna} package. Defaults to the Fruchterman-Reingold force-directed algorithm.
#' @param size size of the network nodes. Defaults to 12. If the nodes are weighted, their area is proportionally scaled up to the size set by \code{size}.
#' @param alpha a level of transparency for nodes, vertices and arrows. Defaults to 0.75.
#' @param weight.method a weighting method for the nodes. Accepts \code{"indegree"}, \code{"outdegree"} or \code{"degree"} (the default). Set to \code{"none"} to plot unweighted nodes.
#' @param names a character vector of two elements to use as legend titles for the node groups and node weights. Defaults to empty strings.
#' @param node.group a vector of character strings to label the nodes with, of the same length and order as the vertex names. Factors are converted to strings prior to plotting.
#' @param node.color a vector of character strings to color the nodes with, holding as many colors as there are levels in \code{node.group}. Tries to default to \code{"Set1"} if missing.
#' @param node.alpha transparency of the nodes. Inherits from \code{alpha}.
#' @param segment.alpha transparency of the vertex links. Inherits from \code{alpha}.
#' @param segment.color color of the vertex links. Defaults to \code{"grey"}.
#' @param segment.size size of the vertex links. Defaults to 0.25.
#' @param arrow.size size of the vertex arrows for directed network plotting. Defaults to 0.
#' @param label.nodes label nodes with their vertex attributes. If set to \code{TRUE}, all nodes are labelled. Also accepts a vector of character strings to match with vertex names.
#' @param top8.nodes use the top 8 nodes as node groups, colored with \code{"Set1"}. The rest of the network will be plotted as the ninth (grey) group. Experimental.
#' @param trim.labels removes '@', 'http://', 'www.' and the ending '/' from vertex names. Cleans up labels for website and Twitter networks. Defaults to \code{TRUE}.
#' @param quantize.weights break node weights to quartiles. Fails when quartiles do not uniquely identify nodes.
#' @param subset.threshold delete nodes prior to plotting, based on \code{weight.method} < \code{subset.threshold}. If \code{weight.method} is unspecified, total degree (Freeman's measure) is used. Defaults to 0 (no subsetting).
#' @param legend.position location of the captions for node colors and weights. Accepts all positions supported by ggplot2 themes. Defaults to "right".
#' @param ... other arguments supplied to geom_text for the node labels. Arguments pertaining to the title or other items can be achieved through ggplot2 methods.
#' @seealso \code{\link{gplot}} in the \link{sna} package
#' @author Moritz Marbach \email{mmarbach@@mail.uni-mannheim.de} and François Briatte \email{f.briatte@@ed.ac.uk}
#' @examples
#' # random network
#' rnd = ergm::as.network.numeric(10)
#' ggnet(rnd, label = TRUE, alpha = 1, color = "white", segment.color = "grey10")
#' # random groups
#' cat = LETTERS[rbinom(10, 4, .5)]
#' ggnet(rnd, label = TRUE, color = "white", segment.color = "grey10", node.group = cat)
#'
#' # City and service firms data from the UCIrvine Network Data Repository.
#' url = url("http://networkdata.ics.uci.edu/netdata/data/cities.RData")
#' print(load(url))
#' close(url)
#' # plot cities, firms and law firms
#' type = network::get.vertex.attribute(cities, "type")
#' type = ifelse(grepl("City|Law", type), gsub("I+", "", type), "Firm")
#' ggnet(cities, mode = "kamadakawai", alpha = .2, node.group = type,
#' label = c("Paris", "Beijing", "Chicago"), color = "darkred")
ggnet <- function(net, # an object of class network
mode = "fruchtermanreingold", # placement algorithm
size = 12, # node size
alpha = .75, # transparency
weight.method = "none", # what to weight the nodes with: "freeman", "indegree", "outdegree"
names = c("", ""), # what to call the node color and node weight legends
node.group = NULL, # what to color the nodes with
node.color = NULL, # what colors to use for the node classes
node.alpha = NULL, # transparency for nodes (inherits from alpha)
segment.alpha = NULL, # transparency for links (inherits from alpha)
segment.color = "grey", # default links are rgb(190, 190, 190)
segment.size = .25, # set to 0 to remove from plot
arrow.size = 0, # set to 0 to remove from plot
label.nodes = FALSE, # add vertex names in small print; can be a list of vertex names
top8.nodes = FALSE, # color the top 8 nodes by weighting method with ColorBrewer Set1
trim.labels = TRUE, # clean vertex names
quantize.weights = FALSE, # break weights to quartiles
subset.threshold = 0, # what nodes to exclude, based on weight.method ≥ subset
legend.position = "right",# set to "none" to remove from plot
...) # passed to geom_text for node labels
{
require(ggplot2) # plot
require(grid) # arrows
require(intergraph) # igraph conversion
require(network) # vertex attributes
require(RColorBrewer) # default colors
require(sna) # placement algorithm
# get arguments
weight = c("indegree", "outdegree")
weight = ifelse(weight.method %in% weight, weight.method, "freeman")
quartiles = quantize.weights
labels = label.nodes
# alpha default
inherit <- function(x) ifelse(is.null(x), alpha, x)
# support for igraph objects
if(class(net) == "igraph") net = asNetwork(net)
if(class(net) != "network")
stop("net must be a network object of class 'network' or 'igraph'")
# subset
if(subset.threshold > 0)
network::delete.vertices(net,
which(sna::degree(net,
cmode = weight) < subset.threshold))
# get sociomatrix
m <- as.matrix.network.adjacency(net)
# get coordinates placement algorithm
placement <- paste0("gplot.layout.", mode)
if(!exists(placement)) stop("Unsupported placement method.")
plotcord <- do.call(placement, list(m, NULL))
plotcord <- data.frame(plotcord)
colnames(plotcord) = c("X1", "X2")
# get edgelist
edglist <- as.matrix.network.edgelist(net)
edges <- data.frame(plotcord[edglist[, 1], ], plotcord[edglist[, 2], ])
# get node groups
if(!is.null(node.group)) {
network::set.vertex.attribute(net, "elements", as.character(node.group))
plotcord$group <- as.factor(network::get.vertex.attribute(net, "elements"))
}
# get node weights
degrees <- data.frame(id = network.vertex.names(net),
indegree = sapply(net$iel, length),
outdegree = sapply(net$oel, length))
degrees$freeman <- with(degrees, indegree + outdegree)
# trim vertex names
if(trim.labels) degrees$id = gsub("@|http://|www.|/$", "", degrees$id)
# set top 8 nodes as groups
if(top8.nodes) {
all = degrees[, weight]
top = degrees$id[order(all, decreasing = TRUE)[1:8]]
top = which(degrees$id %in% top)
plotcord$group = as.character(degrees$id)
plotcord$group[-top] = paste0("(", weight, " > ", subset.threshold - 1, ")")
node.group = plotcord$group
node.color = brewer.pal(9, "Set1")[c(9, 1:8)]
}
colnames(edges) <- c("X1", "Y1", "X2", "Y2")
# set vertex names
plotcord$id <- as.character(degrees$id)
if(is.logical(labels)) {
if(!labels) plotcord$id = ""
} else plotcord$id[-which(plotcord$id %in% labels)] = ""
# get vertice midpoints (not -yet- used later on)
edges$midX <- (edges$X1 + edges$X2) / 2
edges$midY <- (edges$Y1 + edges$Y2) / 2
# plot the network
pnet <- ggplot(plotcord, aes(X1, X2)) +
# plot vertices (links)
geom_segment(aes(x = X1, y = Y1, xend = X2, yend = Y2),
data = edges,
size = segment.size,
colour = segment.color,
alpha = inherit(segment.alpha),
arrow = arrow(type = "closed",
length = unit(arrow.size, "cm")))
# null weighting
if(weight.method == "none") {
pnet <- pnet + geom_point(data = plotcord,
alpha = inherit(node.alpha),
size = size)
}
else {
plotcord$weight <- degrees[, which(names(degrees) == weight)]
# show top weights
cat(nrow(plotcord), "nodes, weighted by", weight, "\n\n")
print(head(degrees[order(-degrees[weight]), ]))
# proportional scaling
sizer <- scale_size_area(names[2], max_size = size)
# quartiles
if(quartiles) {
plotcord$weight.label <- cut(plotcord$weight,
breaks = quantile(plotcord$weight),
include.lowest = TRUE, ordered = TRUE)
plotcord$weight <- as.integer(plotcord$weight.label)
sizer <- scale_size_area(names[2],
max_size = size,
labels = levels(plotcord$weight.label))
}
# add to plot
pnet <- pnet + geom_point(aes(size = weight),
data = plotcord,
alpha = inherit(node.alpha)) +
sizer
}
# default colors
n = length(unique(node.group))
if(length(node.color) != n &!is.null(node.group)) {
warning("Node groups and node colors are of unequal length; using default colors.")
if(n > 0 & n < 10) node.color = brewer.pal(9, "Set1")[1:n]
}
# color the nodes
if(!is.null(node.group)) pnet <- pnet +
aes(colour = group) +
scale_colour_manual(names[1], values = node.color,
guide = guide_legend(override.aes = list(size = sqrt(size))))
# add text labels
if(length(unique(plotcord$id)) > 1 | unique(plotcord$id)[1] != "")
pnet <- pnet + geom_text(aes(label = id), ...)
# finalize: remove grid, axes and scales
pnet <- pnet +
scale_x_continuous(breaks = NULL) +
scale_y_continuous(breaks = NULL) +
theme(
panel.background = element_rect(fill = "white"),
panel.grid = element_blank(),
axis.title = element_blank(),
legend.key = element_rect(colour = "white"),
legend.position = legend.position
)
return(pnet)
}