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
|
#' Combine two graphs into a single graph
#'
#' @description
#'
#' Combine two graphs in order to make a new graph.
#'
#' @param x A `DiagrammeR` graph object to which another graph will be unioned.
#' This graph should be considered the graph from which global graph
#' attributes will be inherited in the resulting graph.
#' @param y A `DiagrammeR` graph object that is to be unioned with the graph
#' supplied as `x`.
#'
#' @return A graph object of class `dgr_graph`.
#'
#' @examples
#' # Create a graph with a cycle
#' # containing 6 nodes
#' graph_cycle <-
#' create_graph() %>%
#' add_cycle(n = 6)
#'
#' # Create a random graph with
#' # 8 nodes and 15 edges using the
#' # `add_gnm_graph()` function
#' graph_random <-
#' create_graph() %>%
#' add_gnm_graph(
#' n = 8,
#' m = 15,
#' set_seed = 23)
#'
#' # Combine the two graphs in a
#' # union operation
#' combined_graph <-
#' combine_graphs(
#' graph_cycle,
#' graph_random)
#'
#' # Get the number of nodes in
#' # the combined graph
#' combined_graph %>% count_nodes()
#'
#' # The `combine_graphs()`
#' # function will renumber
#' # node ID values in graph `y`
#' # during the union; this ensures
#' # that node ID values are unique
#' combined_graph %>% get_node_ids()
#'
#' @export
combine_graphs <- function(
x,
y
) {
# Get the time of function start
time_function_start <- Sys.time()
# Validation: Graph object `x` is valid
if (!graph_object_valid(x)) {
cli::cli_abort("The graph object supplied to `x` is not valid.")
}
# Validation: Graph object `y` is valid
if (!graph_object_valid(y)) {
cli::cli_abort("The graph object supplied to `y` is not valid.")
}
# Get the number of nodes ever created for
# graph `x`
nodes_created <- x$last_node
# Get the number of nodes in the graph
nodes_graph_1 <- x %>% count_nodes()
# Get the number of edges ever created for
# graph `x`
edges_created <- x$last_edge
# Get the number of edges in the graph
edges_graph_1 <- x %>% count_edges()
# Get the node data frame for graph `x`
x_nodes_df <- get_node_df(x)
# Get the node data frame for graph `y`
y_nodes_df <- get_node_df(y)
# Is label a copy of node IDs in graph `y`?
y_label_node <-
all(as.character(y_nodes_df[, 1]) == y_nodes_df[, 3]) &&
!anyNA(y_nodes_df[, 3])
# Add a new node attribute `new_node_id`
y_nodes_df$new_node_id <-
seq(nodes_created + 1L,
nodes_created + nrow(y_nodes_df))
# Get the edge data frame for graph `x`
x_edges_df <- get_edge_df(x)
# Get the edge data frame for graph `y`
y_edges_df <- get_edge_df(y)
y_edges_df <-
dplyr::inner_join(
y_edges_df,
y_nodes_df,
by = c("from" = "id")) %>%
dplyr::rename(from_new = "new_node_id") %>%
dplyr::select(-"type", -"label")
# Rename `id` if it has a `.x` suffix
if ("id.x" %in% colnames(y_edges_df)) {
y_edges_df <-
y_edges_df %>%
dplyr::rename(id = "id.x")
}
y_edges_df <-
dplyr::inner_join(
y_edges_df,
y_nodes_df,
by = c("to" = "id")) %>%
dplyr::rename(to_new = "new_node_id") %>%
dplyr::select(-"type", -"label")
# Rename `id` if it has a `.x` suffix
if ("id.x" %in% colnames(y_edges_df)) {
y_edges_df <-
y_edges_df %>%
dplyr::rename(id = "id.x")
}
# Copy new node IDs to `from` and `to` edge attrs
y_edges_df$from <- y_edges_df$from_new
y_edges_df$to <- y_edges_df$to_new
# Remove columns ending with `.x` or `_new`
y_edges_df <-
y_edges_df %>%
dplyr::select(
!dplyr::ends_with(c(".x", "_new")))
# Rename column names with `.y` suffixes
colnames(y_edges_df) <-
gsub(".y$", "", colnames(y_edges_df))
y_edges_df$id <- y_edges_df$id + edges_created
# Copy new node IDs to `nodes` node attr
y_nodes_df$id <- y_nodes_df$new_node_id
# Remove the last column from `y_nodes_df`
y_nodes_df <-
y_nodes_df[, -ncol(y_nodes_df)]
# If label is a copy of node ID in graph `y`,
# rewrite labels to match new node ID values
if (y_label_node) {
y_nodes_df[, 3] <- as.character(y_nodes_df[, 1])
}
# Combine the node data frames for both graphs
combined_nodes <-
dplyr::bind_rows(x_nodes_df, y_nodes_df)
# Combine the edge data frames for both graphs
combined_edges <-
dplyr::bind_rows(x_edges_df, y_edges_df)
# Modify the graph object and inherit attributes
# from the first graph provided (`x`)
x$nodes_df <- combined_nodes
x$edges_df <- combined_edges
x$directed <- is_graph_directed(x) && is_graph_directed(y)
x$last_node <- nrow(combined_nodes)
x$last_edge <- nrow(combined_edges)
# Get the updated number of nodes in the graph
nodes_graph_2 <- x %>% count_nodes()
# Get the number of nodes added to
# the graph
nodes_added <- nodes_graph_2 - nodes_graph_1
# Get the updated number of edges in the graph
edges_graph_2 <- x %>% count_edges()
# Get the number of edges added to
# the graph
edges_added <- edges_graph_2 - edges_graph_1
# Get the name of the function
fcn_name <- get_calling_fcn()
# Update the `graph_log` df with an action
x$graph_log <-
add_action_to_log(
graph_log = x$graph_log,
version_id = nrow(x$graph_log) + 1L,
function_used = fcn_name,
time_modified = time_function_start,
duration = graph_function_duration(time_function_start),
nodes = nrow(x$nodes_df),
edges = nrow(x$edges_df),
d_n = nodes_added,
d_e = edges_added)
# Write graph backup if the option is set
if (x$graph_info$write_backups) {
save_graph_as_rds(graph = x)
}
x
}
|