R/adj2HPD.R

Defines functions adj2HPD

Documented in adj2HPD

#' Process an Adjacency Graph into a HivePlotData Object
#' 
#' This function will take an adjacency graph 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 names
#' of the dimensions of \code{M} are used as the node names.  All nodes are
#' given size 1, an id number (\code{1:number of nodes}), are colored black and
#' are assigned to axis 1.  The edges are all gray, and the weight is M[i,j].
#' The user will likely have to manually make some changes 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 will probably need to make some adjustments.
#' See the examples.
#' 
#' @param M A matrix with named dimensions.  The names should be the node
#' names.  Should not be symmetric.  If it is, only the lower triangle is used
#' and a message is given.
#'
#' @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 Bryan A. Hanson, DePauw University. \email{[email protected]@depauw.edu} Vesna
#' Memisevic contributed a fix that limited this function to bipartite networks
#' (changed in v. 0.2-12).
#'
#' @seealso \code{\link{dot2HPD}} and \code{\link{adj2HPD}}
#'
#' @keywords utilities
#'
#' @importFrom RColorBrewer brewer.pal
#'
#' @export adj2HPD
#'
#' @examples
#' 
#' ### Example 1: a bipartite network
#' ### Note: this first example has questionable scientific value!
#' ### The purpose is to show how to troubleshoot and
#' ### manipulate a HivePlotData object.
#' 
#' require(bipartite)
#' data(Safariland) # This is a bipartite network
#' 
#' # You may wish to do ?Safariland or ?Safari for background
#' 
#' hive1 <- adj2HPD(Safariland, desc = "Safariland data set from bipartite")
#' sumHPD(hive1)
#' 
#' # Note that all nodes are one axis with radius 1. Process further:
#' 
#' hive2 <- mineHPD(hive1, option = "rad <- tot.edge.count")
#' sumHPD(hive2)
#' 
#' # All nodes still on 1 axis but degree has been used to set radius
#' 
#' # Process further:
#' 
#' hive3 <- mineHPD(hive2, option = "axis <- source.man.sink")
#' sumHPD(hive3, chk.all = TRUE)
#' 
#' # Note that mineHPD is generating some warnings, telling us
#' # that the first 9 nodes were not assigned to an axis.  Direct
#' # inspection of the data shows that these nodes are insects
#' # that did not visit any of the flowers in this particular study.
#' 
#' # Pretty up a few things, then plot:
#' 
#' hive3$edges$weight <- sqrt(hive3$edges$weight)*0.5
#' hive3$nodes$size <- 0.5
#' plotHive(hive3)
#' 
#' # This is a one-sided hive plot of 2 axes, which results
#' # from the curvature of the splines.  We can manually fix
#' # this by reversing the ends of edges as follows:
#' 
#' for (n in seq(1, length(hive3$edges$id1), by = 2)) {
#' 	a <- hive3$edges$id1[n]
#' 	b <- hive3$edges$id2[n]
#' 	hive3$edges$id1[n] <- b
#' 	hive3$edges$id2[n] <- a
#' 	}
#' 
#' plotHive(hive3)
#' 
#' ### Example 2, a simple random adjacency matrix
#' set.seed(31)
#' nr <- 20
#' nc <- 15
#' M <- matrix(floor(runif(nc*nr, 0, 10)), ncol = nc)
#' colnames(M) <- sample(c(letters, LETTERS), nc, replace = FALSE)
#' rownames(M) <- sample(c(letters, LETTERS), nr, replace = FALSE)
#' hive4 <- adj2HPD(M)
#' sumHPD(hive4)
#' 
adj2HPD <- function(M = NULL, axis.cols = NULL, type = "2D", desc = NULL, ...) {
	
# Function to read adjacency matrices and convert to HPD
# Bryan Hanson, DePauw Univ, December 2011
# Part of HiveR package

# Assumptions/Caveats:
	
	# No checking for whether the type (2D/3D) is actually true/relevant
	# Without outside info, many parameters have to be set arbitrarily 
	# and perhaps changed later.
	
	if (is.null(M)) stop("No adjacency matrix provided")
	if (is.null(dimnames(M))) stop("Adjacency matrix must have named dimensions")
	if (isSymmetric(M)) {
		message("Matrix is symmetric, using only the lower triangle")
		M[upper.tri(M)] <- 0
		}
		
	lab1 <- unlist(dimnames(M)[1])
	lab1 <- as.character(lab1)
	lab2 <- unlist(dimnames(M)[2])
	lab2 <- as.character(lab2)
	d1 <- dim(M)[1]
	d2 <- dim(M)[2]
	
	nn <- length(unique(c(lab1, lab2)))
	size <- rep(1, nn)
	id <- 1:nn
	axis <- rep(1, nn)
	color <- as.character(rep("black", nn))
	radius <- rep(1, nn)

# Set up HPD$nodes

	HPD <- list()
	HPD$nodes$id <- id
	labNames = unique(c(lab1, lab2)) # VM fix v. 0.2-12
	HPD$nodes$lab <- labNames # VM fix v. 0.2-12
	HPD$nodes$axis <- axis
	HPD$nodes$radius <- radius
	HPD$nodes$size <- size
	HPD$nodes$color <- color

# Set up HPD$edges

	id1 <- id2 <- v <- c() # v = value of M[i, j]
	for (i in 1:d1) { 
		for (j in 1:d2) {
			if (!M[i,j] == 0) {
 		       id1 <- c(id1, which(lab1[i] == labNames)) # VM fix v. 0.2-12
		       id2 <- c(id2, which(lab2[j] == labNames)) # VM fix v. 0.2-12
				v <- c(v, M[i,j])
				}
			}	
		}
	
	if (!length(id1) == length(id2)) stop("Something is wrong with the M[i,j] counts")
	ne <- length(id1)
	
	HPD$edges$id1 <- id1
	HPD$edges$id2 <- id2
	HPD$edges$weight <- v
	HPD$edges$color <- rep("gray", ne)
 
# Final clean-up
	
	HPD$nodes <- as.data.frame(HPD$nodes)
	HPD$edges <- as.data.frame(HPD$edges)
	
	if (is.null(desc)) desc <- "No description provided"
	HPD$desc <- desc
	
	if (is.null(axis.cols)) axis.cols <- RColorBrewer::brewer.pal(length(unique(HPD$nodes$axis)), "Set1")
	HPD$axis.cols <- axis.cols
	
	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$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"
	
	chkHPD(HPD)
	
    HPD
	} # The very end!

Try the HiveR package in your browser

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

HiveR documentation built on May 2, 2019, 2:08 a.m.