Nothing
#' 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)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.