R/edge2HPD.R

In HiveR: 2D and 3D Hive Plots for R

#' Process an Edge List into a Hive Plot Data Object
#'
#' This function will take an edge list and convert it into a basic
#' \code{\link{HivePlotData}} object.  Further manipulation by
#' \code{\link{mineHPD}} will almost certainly be required before the data can
#' be plotted.
#'
#' This function produces a "bare bones" \code{HivePlotData} object.  The user
#' will likely have to make some changes manually to the resulting
#' \code{HivePlotData} object before plotting.  Alternatively,
#' \code{\link{mineHPD}} may be able to extract some information buried in the
#' data, but even then, the user might need to make some adjustments.  See the
#' examples.
#'
#' @param edge_df A data frame containing edge list information. Columns should
#' be node1, node2, edge weight (column names are arbitrary).  Edge weight
#' information is optional. If missing, edge weights will be set to 1.
#'
#' @param axis.cols A character vector giving the colors desired for the axes.
#'
#' @param type One of \code{c("2D", "3D")}.  If \code{2D}, a
#' \code{HivePlotData} object suitable for use with \code{\link{plotHive}} will
#' be created and the eventual hive plot will be static and 2D.  If \code{3D},
#' the \code{HivePlotData} object will be suitable for a 3D interactive plot
#' using \code{\link{plot3dHive}}.
#'
#' @param desc Character.  A description of the data set.
#'
#' @param \dots Other parameters to be passed downstream.
#'
#' @return A \code{\link{HivePlotData}} object.
#'
#' @author Jonathan H. Chung, with minor changes for consistency by Bryan A.
#' Hanson.
#'
#' @seealso \code{\link{dot2HPD}} and \code{\link{adj2HPD}}
#'
#' @keywords utilities
#'
#' @export edge2HPD
#'
#' @examples
#'
#' # Create a simple edge list & process it
#' edges <- data.frame(
#'   lab1 = LETTERS[c(1:8, 7)],
#'   lab2 = LETTERS[c(2:4, 1:3, 4, 2, 2)],
#'   weight = c(1, 1, 2, 2, 3, 1, 2, 3, 1)
#' )
#'
#' td <- edge2HPD(edge_df = edges, desc = "Test of edge2HPD")
#' td.out <- sumHPD(td, plot.list = TRUE)
#' # compare:
#' edges
#' td.out[, c(3, 7, 8)]
edge2HPD <- function(edge_df = NULL, axis.cols = NULL, type = "2D", desc = NULL, ...) {

  # Authored and contributed to HiveR by Jonathan H. Chung, June 2013.
  # Thanks Jon.  Some changes for consistency by Bryan A. Hanson
  # A few boo-boos caught by Vesna Memisevic

  if (is.null(edge_df)) {
    stop("No edge data provided")
  }
  if (!is.data.frame(edge_df)) {
    stop("edge_df is not a data frame")
  }

  ### Process nodes
  # Get node labels
  lab1 <- unlist(edge_df[, 1])
  lab1 <- as.character(lab1)
  lab2 <- unlist(edge_df[, 2])
  lab2 <- as.character(lab2)

  # Get number of unique nodes
  nn <- length(unique(c(lab1, lab2)))

  # Set default node size to 1
  size <- rep(1, nn)
  # Create a vector for node ID
  id <- 1:nn

  # Assign default axis
  axis <- rep(1, nn)
  # Assign node color
  color <- as.character(rep("black", nn))
  # Assign radius
  radius <- rep(1, nn)

  # Create empty HPD object
  HPD <- list()

  # Assemble node attributes
  HPD$nodes$id <- id
  HPD$nodes$lab <- unique(c(lab1, lab2))
  HPD$nodes$axis <- axis
  HPD$nodes$radius <- radius
  HPD$nodes$size <- size
  HPD$nodes$color <- color

  ### Process edges - a bit tricky to coordinate!
  ne <- nrow(edge_df)
  edge_df[, 1] <- as.character(edge_df[, 1]) # for use as id
  edge_df[, 2] <- as.character(edge_df[, 2]) # may read in as integers
  HPD$edges$id1 <- rep(NA, ne)
  HPD$edges$id2 <- rep(NA, ne)

  for (n in 1:ne) { # same logic as over in dot2HPD
    pat1 <- paste("\\b", edge_df[n, 1], "\\b", sep = "") # need word boundaries
    # 	print(pat1)
    pat2 <- paste("\\b", edge_df[n, 2], "\\b", sep = "") # to avoid finding fragments
    HPD$edges$id1[n] <- grep(pat1, HPD$nodes$lab)
    HPD$edges$id2[n] <- grep(pat2, HPD$nodes$lab)
  }

  # check if edge data has weights in col 3
  if (ncol(edge_df) > 2) {
    if (is.numeric(edge_df[, 3]) | is.integer(edge_df[, 3])) {
      edge_weight <- edge_df[, 3]
    } else {
      warning("No edge weight column detected. Setting default edge weight to 1")
      edge_weight <- rep(1, ne)
    }
  }

  HPD$edges$weight <- edge_weight
  HPD$edges$color <- rep("gray", ne)
  HPD$nodes <- as.data.frame(HPD$nodes)
  HPD$edges <- as.data.frame(HPD$edges)

  # Add description
  if (is.null(desc)) {
    desc <- "No description provided"
  }
  HPD$desc <- desc

  # Define axis columns
  if (is.null(axis.cols)) {
    axis.cols <- brewer.pal(length(unique(HPD$nodes$axis)), "Set1")
  }
  HPD$axis.cols <- axis.cols

  # Clean up HPD object
  HPD$nodes$axis <- as.integer(HPD$nodes$axis)
  HPD$nodes$size <- as.numeric(HPD$nodes$size)
  HPD$nodes$color <- as.character(HPD$nodes$color)
  HPD$nodes$lab <- as.character(HPD$nodes$lab)
  HPD$nodes$id <- as.integer(HPD$nodes$id)
  HPD$edges$id1 <- as.integer(HPD$edges$id1)
  HPD$edges$id2 <- as.integer(HPD$edges$id2)
  HPD$edges$weight <- as.numeric(HPD$edges$weight)
  HPD$edges$color <- as.character(HPD$edges$color)
  HPD$type <- type
  class(HPD) <- "HivePlotData"

  # Check HPD object
  chkHPD(HPD)
  return(HPD)
}