R/GatherGraphEdge.R

Defines functions gather_graph_edge

Documented in gather_graph_edge

#' 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)
}

Try the TransProR package in your browser

Any scripts or data that you put into this service are public.

TransProR documentation built on April 4, 2025, 3:16 a.m.