[e25014]: / R / GatherGraphNode.R

Download this file

55 lines (49 with data), 2.2 kB

 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
#' Gather graph nodes from a data frame
#' Please note that this function is from the 'ggraph' package and has not been altered in functionality,
#' but it has been optimized and iterated.
#' It is not original content of 'TransProR'.
#' However, since 'ggraph' caused frequent GitHub Action errors during the creation of 'TransProR',
#' the author directly referenced the involved functions in 'TransProR'.
#' This is not the author's original creation. All users please be aware!
#' @inheritParams gather_graph_edge
#' @param value Column name used for summarizing node size, defaults to the last column
#' @return a tibble of graph nodes
#' @export
#' @importFrom dplyr group_by summarise mutate bind_rows n all_of across
#' @importFrom tidyr unite
#' @importFrom tibble as_tibble
#' @importFrom utils tail
gather_graph_node <- function(df, index = NULL, value = utils::tail(colnames(df), 1), root = NULL) {
if (length(index) < 2) {
stop("Please specify at least two index columns.")
} else {
nodes_list <- lapply(seq_along(index), function(i) {
dots <- index[1:i]
df %>%
dplyr::group_by(dplyr::across(dplyr::all_of(dots))) %>%
dplyr::summarise(node.size = sum(.data[[value]], na.rm = TRUE),
node.level = index[i],
node.count = dplyr::n(), .groups = 'drop') %>%
dplyr::mutate(node.short_name = as.character(.data[[dots[length(dots)]]]),
node.branch = as.character(.data[[dots[1]]])) %>%
tidyr::unite(col = "node.name", all_of(dots), sep = "/")
})
nodes <- dplyr::bind_rows(nodes_list) %>%
tibble::as_tibble()
nodes$node.level <- factor(nodes$node.level, levels = index)
if (!is.null(root)) {
root_data <- data.frame(
node.name = root,
node.size = sum(df[[value]], na.rm = TRUE),
node.level = root,
node.count = 1,
node.short_name = root,
node.branch = root,
stringsAsFactors = FALSE
)
nodes <- dplyr::bind_rows(root_data, nodes)
nodes$node.level <- factor(nodes$node.level, levels = c(root, index))
}
return(nodes)
}
}