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 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328
|
#' Functions to generate alternate representations of graphs
#'
#' These functions are meant to be passed into [morph()] to create a temporary
#' alternate representation of the input graph. They are thus not meant to be
#' called directly. See below for detail of each morpher.
#'
#' @param graph A `tbl_graph`
#'
#' @param ... Arguments to pass on to [filter()], [group_by()], or the cluster
#' algorithm (see [igraph::cluster_walktrap()], [igraph::cluster_leading_eigen()],
#' and [igraph::cluster_edge_betweenness()])
#'
#' @param subset_by,split_by Whether to create subgraphs based on nodes or edges
#'
#' @return A list of `tbl_graph`s
#'
#' @rdname morphers
#' @name morphers
#'
#' @examples
#' # Compute only on a subgraph of every even node
#' create_notable('meredith') %>%
#' morph(to_subgraph, seq_len(graph_order()) %% 2 == 0) %>%
#' mutate(neighbour_count = centrality_degree()) %>%
#' unmorph()
NULL
#' @describeIn morphers Convert a graph to its line graph. When unmorphing node
#' data will be merged back into the original edge data. Edge data will be
#' ignored.
#' @importFrom igraph make_line_graph
#' @export
to_linegraph <- function(graph) {
line_graph <- as_tbl_graph(make_line_graph(graph))
line_graph <- mutate(activate(line_graph, 'nodes'), .tidygraph_edge_index = E(graph)$.tidygraph_edge_index)
list(
line_graph = line_graph
)
}
#' @describeIn morphers Convert a graph to a single subgraph. `...` is evaluated
#' in the same manner as `filter`. When unmorphing all data in the subgraph
#' will get merged back.
#' @importFrom igraph induced_subgraph subgraph.edges
#' @export
to_subgraph <- function(graph, ..., subset_by = NULL) {
if (is.null(subset_by)) {
subset_by <- active(graph)
message('Subsetting by ', subset_by)
}
ind <- as_tibble(graph, active = subset_by)
ind <- mutate(ind, .tidygraph_index = seq_len(n()))
ind <- filter(ind, ...)
ind <- ind$.tidygraph_index
subset <- switch(
subset_by,
nodes = induced_subgraph(graph, ind),
edges = subgraph.edges(graph, ind, delete.vertices = FALSE)
)
list(
subgraph = as_tbl_graph(subset)
)
}
#' @describeIn morphers Convert a graph to a single component containing the specified node
#' @param node The center of the neighborhood for `to_local_neighborhood()` and
#' the node to that should be included in the component for `to_subcomponent()`
#' @importFrom igraph gorder components
#' @export
to_subcomponent <- function(graph, node) {
node <- eval_tidy(enquo(node), as_tibble(graph, 'nodes'))
node <- as_ind(node, gorder(graph))
if (length(node) != 1) stop('Please provide a single node for defining the subcomponent', call. = FALSE)
component_membership <- components(graph)$membership == components(graph)$membership[node]
to_subgraph(graph, component_membership, subset_by = 'nodes')
}
#' @describeIn morphers Convert a graph into a list of separate subgraphs. `...`
#' is evaluated in the same manner as `group_by`. When unmorphing all data in
#' the subgraphs will get merged back, but in the case of `split_by = 'edges'`
#' only the first instance of node data will be used (as the same node can be
#' present in multiple subgraphs).
#' @importFrom igraph induced_subgraph subgraph.edges
#' @importFrom stats setNames
#' @importFrom dplyr group_rows
#' @export
to_split <- function(graph, ..., split_by = NULL) {
if (is.null(split_by)) {
split_by <- active(graph)
message('Subsetting by ', split_by)
}
ind <- as_tibble(graph, active = split_by)
ind <- group_by(ind, ...)
splits <- lapply(group_rows(ind), function(i) {
g <- switch(
split_by,
nodes = induced_subgraph(graph, i),
edges = subgraph.edges(graph, i)
)
as_tbl_graph(g)
})
split_names <- group_keys(ind)
split_names <- lapply(names(split_names), function(n) {
paste(n, split_names[[n]], sep = ': ')
})
split_names <- do.call(paste, modifyList(unname(split_names), list(sep = ', ')))
setNames(splits, split_names)
}
#' @describeIn morphers Split a graph into its separate components. When
#' unmorphing all data in the subgraphs will get merged back.
#' @param type The type of component to split into. Either `'weak'` or `'strong'`
#' @importFrom igraph decompose
#' @export
to_components <- function(graph, type = 'weak') {
graphs <- decompose(graph, mode = type)
graphs <- lapply(graphs, as_tbl_graph)
graphs
}
#' @describeIn morphers Convert a graph into its complement. When unmorphing
#' only node data will get merged back.
#' @param loops Should loops be included. Defaults to `FALSE`
#' @importFrom igraph complementer
#' @export
to_complement <- function(graph, loops = FALSE) {
complement <- complementer(graph, loops = loops)
list(
complement = as_tbl_graph(complement)
)
}
#' @describeIn morphers Convert a graph into the local neighborhood around a
#' single node. When unmorphing all data will be merged back.
#' @param order The radius of the neighborhood
#' @param mode How should edges be followed? `'out'` only follows outbound
#' edges, `'in'` only follows inbound edges, and `'all'` follows all edges. This
#' parameter is ignored for undirected graphs.
#' @importFrom igraph make_ego_graph gorder
#' @export
to_local_neighborhood <- function(graph, node, order = 1, mode = 'all') {
node <- eval_tidy(enquo(node), as_tibble(graph, 'nodes'))
node <- as_ind(node, gorder(graph))
ego <- make_ego_graph(graph, order = order, nodes = node, mode = mode)
list(
neighborhood = as_tbl_graph(ego[[1]])
)
}
#' @describeIn morphers Convert a graph into its dominator tree based on a
#' specific root. When unmorphing only node data will get merged back.
#' @param root The root of the tree
#' @importFrom igraph dominator_tree gorder
#' @export
to_dominator_tree <- function(graph, root, mode = 'out') {
root <- eval_tidy(enquo(root), as_tibble(graph, 'nodes'))
root <- as_ind(root, gorder(graph))
dom <- dominator_tree(graph, root = root, mode = mode)
list(
dominator_tree = as_tbl_graph(dom$domtree)
)
}
#' @describeIn morphers Convert a graph into its minimum spanning tree/forest.
#' When unmorphing all data will get merged back.
#' @param weights Optional edge weights for the calculations
#' @importFrom igraph mst
#' @importFrom rlang enquo eval_tidy
#' @export
to_minimum_spanning_tree <- function(graph, weights = NULL) {
weights <- eval_tidy(enquo(weights), as_tibble(graph, 'edges'))
algorithm <- if (is.null(weights)) 'unweighted' else 'prim'
mst <- mst(graph, weights = weights, algorithm = algorithm)
list(
mst = as_tbl_graph(mst)
)
}
#' @describeIn morphers Limit a graph to the shortest path between two nodes.
#' When unmorphing all data is merged back.
#' @param from,to The start and end node of the path
#' @importFrom igraph shortest_paths gorder
#' @importFrom rlang enquo eval_tidy
#' @export
to_shortest_path <- function(graph, from, to, mode = 'out', weights = NULL) {
nodes <- as_tibble(graph, 'nodes')
from <- eval_tidy(enquo(from), nodes)
from <- as_ind(from, gorder(graph))
to <- eval_tidy(enquo(to), nodes)
to <- as_ind(to, gorder(graph))
weights <- eval_tidy(enquo(weights), as_tibble(graph, active = 'edges'))
if (is.null(weights)) {
weights <- NA
}
path <- shortest_paths(graph, from = from, to = to, mode = mode, weights = weights, output = 'both')
short_path <- slice(activate(graph, 'edges'), as.integer(path$epath[[1]]))
short_path <- slice(activate(short_path, 'nodes'), as.integer(path$vpath[[1]]))
list(
shortest_path = short_path
)
}
#' @describeIn morphers Convert a graph into a breath-first search tree based on
#' a specific root. When unmorphing only node data is merged back.
#' @param unreachable Should the search jump to a node in a new component when
#' stuck.
#' @importFrom igraph bfs gorder
#' @export
to_bfs_tree <- function(graph, root, mode = 'out', unreachable = FALSE) {
root <- eval_tidy(enquo(root), as_tibble(graph, 'nodes'))
root <- as_ind(root, gorder(graph))
search <- bfs(graph, root, neimode = mode, unreachable = unreachable, father = TRUE)
bfs_graph <- search_to_graph(graph, search)
list(
bfs = bfs_graph
)
}
#' @describeIn morphers Convert a graph into a depth-first search tree based on
#' a specific root. When unmorphing only node data is merged back.
#' @importFrom igraph bfs gorder
#' @export
to_dfs_tree <- function(graph, root, mode = 'out', unreachable = FALSE) {
root <- eval_tidy(enquo(root), as_tibble(graph, 'nodes'))
root <- as_ind(root, gorder(graph))
search <- dfs(graph, root, neimode = mode, unreachable = unreachable, father = TRUE)
dfs_graph <- search_to_graph(graph, search)
list(
dfs = dfs_graph
)
}
#' @describeIn morphers Collapse parallel edges and remove loops in a graph.
#' When unmorphing all data will get merged back
#' @param remove_multiples Should edges that run between the same nodes be
#' reduced to one
#' @param remove_loops Should edges that start and end at the same node be removed
#' @importFrom igraph simplify
#' @export
to_simple <- function(graph, remove_multiples = TRUE, remove_loops = TRUE) {
edges <- as_tibble(graph, active = 'edges')
graph <- set_edge_attributes(graph, edges[, '.tidygraph_edge_index', drop = FALSE])
edges$.tidygraph_edge_index <- NULL
simple <- as_tbl_graph(simplify(graph, remove.multiple = remove_multiples, remove.loops = remove_loops, edge.attr.comb = list))
new_edges <- as_tibble(simple, active = 'edges')
new_edges$.orig_data <- lapply(new_edges$.tidygraph_edge_index, function(i) edges[i, , drop = FALSE])
simple <- set_edge_attributes(simple, new_edges)
list(
simple = simple
)
}
#' @describeIn morphers Combine multiple nodes into one. `...`
#' is evaluated in the same manner as `group_by`. When unmorphing all
#' data will get merged back.
#' @param simplify Should edges in the contracted graph be simplified? Defaults
#' to `TRUE`
#' @importFrom tidyr nest_legacy
#' @importFrom igraph contract
#' @export
to_contracted <- function(graph, ..., simplify = TRUE) {
nodes <- as_tibble(graph, active = 'nodes')
nodes <- group_by(nodes, ...)
ind <- group_indices(nodes)
contracted <- as_tbl_graph(contract(graph, ind, vertex.attr.comb = 'ignore'))
nodes <- nest_legacy(nodes, .key = '.orig_data')
ind <- lapply(nodes$.orig_data, `[[`, '.tidygraph_node_index')
nodes$.orig_data <- lapply(nodes$.orig_data, function(x) {x$.tidygraph_node_index <- NULL; x})
nodes$.tidygraph_node_index <- ind
contracted <- set_node_attributes(contracted, nodes)
if (simplify) {
contracted <- to_simple(contracted)[[1]]
}
list(
contracted = contracted
)
}
#' @describeIn morphers Unfold a graph to a tree or forest starting from
#' multiple roots (or one), potentially duplicating nodes and edges.
#' @importFrom igraph unfold_tree
#' @export
to_unfolded_tree <- function(graph, root, mode = 'out') {
root <- eval_tidy(enquo(root), as_tibble(graph, 'nodes'))
roots <- as_ind(root, gorder(graph))
unfolded <- unfold_tree(graph, mode, roots)
tree <- as_tbl_graph(unfolded$tree)
tree <- set_node_attributes(tree, as_tibble(graph, 'nodes')[unfolded$vertex_index, ])
tree <- set_edge_attributes(tree, as_tibble(graph, 'edges'))
list(
tree = tree
)
}
#' @describeIn morphers Make a graph directed in the direction given by from and
#' to
#' @export
to_directed <- function(graph) {
tbl_graph(as_tibble(graph, active = 'nodes'),
as_tibble(graph, active = 'edges'),
directed = TRUE) %gr_attr% graph
}
#' @describeIn morphers Make a graph undirected
#' @export
to_undirected <- function(graph) {
tbl_graph(as_tibble(graph, active = 'nodes'),
as_tibble(graph, active = 'edges'),
directed = FALSE) %gr_attr% graph
}
#' @describeIn morphers Convert a graph into a hierarchical clustering based on a grouping
#' @param method The clustering method to use. Either `'walktrap'`, `'leading_eigen'`, or `'edge_betweenness'`
#' @importFrom igraph cluster_walktrap cluster_leading_eigen cluster_edge_betweenness
#' @importFrom stats as.dendrogram
#' @importFrom rlang .data enquo eval_tidy
#' @export
to_hierarchical_clusters <- function(graph, method = 'walktrap', weights = NULL, ...) {
weights <- enquo(weights)
weights <- eval_tidy(weights, .E())
if (is.null(weights)) {
weights <- NA
}
hierarchy <- switch(
method,
walktrap = cluster_walktrap(graph, weights = weights, ...),
leading_eigen = cluster_leading_eigen(graph, weights = weights, ...),
edge_betweenness = cluster_edge_betweenness(graph, weights = weights, ...)
)
hierarchy <- as_tbl_graph(as.dendrogram(hierarchy))
hierarchy <- mutate(hierarchy, .tidygraph_node_index = as.integer(as.character(.data$label)),
label = NULL)
hierarchy <- left_join(hierarchy, as_tibble(graph, active = 'nodes'),
by = c('.tidygraph_node_index' = '.tidygraph_node_index'))
hierarchy %gr_attr% graph
}
# HELPERS -----------------------------------------------------------------
search_to_graph <- function(graph, search) {
nodes <- as_tibble(graph, active = 'nodes')
edges <- tibble(from = search$father, to = seq_len(nrow(nodes)))
edges <- edges[!is.na(edges$from), , drop = FALSE]
tbl_graph(nodes, edges)
}
|