Diff of /R/GatherGraphEdge.R [000000] .. [0f2269]

Switch to side-by-side view

--- a
+++ b/R/GatherGraphEdge.R
@@ -0,0 +1,48 @@
+#' Gather graph edge from 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!
+#' @param df A data frame
+#' @param index A vector of column names to group by
+#' @param root Root name for the root node connections, optional
+#' @return A tibble of graph edges
+#' @export
+#' @importFrom dplyr mutate select group_by summarise bind_rows all_of across
+#' @importFrom tidyr unite
+#' @importFrom tibble as_tibble
+#' @name gather_graph_edge
+gather_graph_edge <- function(df, index = NULL, root = NULL) {
+  if (length(index) < 2) {
+    stop("Please specify at least two index columns.")
+  }
+
+  prepare_edge <- function(data, from, to, sep = "/") {
+    data %>%
+      tidyr::unite("from", dplyr::all_of(from), sep = sep, remove = FALSE) %>%
+      tidyr::unite("to", dplyr::all_of(to), sep = sep) %>%
+      dplyr::select(.data$from, .data$to) %>%
+      dplyr::mutate(dplyr::across(c("from", "to"), as.character))
+  }
+
+  edges <- lapply(seq_along(index)[-1], function(i) {
+    prepare_edge(df, index[1:(i - 1)], index[1:i])
+  })
+
+  edges <- dplyr::bind_rows(edges)
+  edges <- tibble::as_tibble(edges)
+
+  if (!is.null(root)) {
+    root_edges <- df %>%
+      dplyr::group_by(.data[[index[1]]]) %>%
+      dplyr::summarise(count = dplyr::n(), .groups = 'drop') %>%
+      dplyr::mutate(from = root, to = as.character(.data[[index[1]]])) %>%
+      dplyr::select(.data$from, .data$to)
+
+    edges <- dplyr::bind_rows(root_edges, edges)
+  }
+
+  return(edges)
+}