R/plot.R
In neurodata/graphstats: Graph Statistics
nan.sum <- function(x) {sum(x, na.rm=TRUE)}
g_legend<-function(a.gplot){
tmp <- ggplot_gtable(ggplot_build(a.gplot))
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
return(legend)
}
#' Graph Heatmap plot
#'
#' A function that plots an igraph object, as a heatmap.
#'
#' @import ggplot2
#' @import igraph
#' @importFrom reshape2 melt
#' @importFrom ggpubr as_ggplot
#' @importFrom grid textGrob
#' @importFrom grid gpar
#' @param g input graph, as an igraph object. See \code{\link[igraph]{graph}} for details.
#' @param title the title for the square plot. Defaults to \code{""}.
#' @param src.label the source label for the graph. Defaults to \code{"Vertex"}.
#' @param tgt.label the target label for the graph. Defaults to \code{"Vertex"}.
#' @param edge.attr the name of the attribute to use for weights. Defaults to \code{NULL}.
#' \itemize{
#' \item{\code{is.null(edge.attr)} plots the graph as a binary adjacency matrix.}
#' \item{\code{is.character(edge.attr)} plot the graph as a weighted adjacency matrix, with edge-weights for \code{E(g)} given by \code{E(g)[[edge.attr]]}.}
#' }
#' @param font.size the default font size for the plot text. Axis/legend text is \code{font.size - 2}. Defaults to \code{NULL}.
#' \itemize{
#' \item{\code{is.null(font.size)} uses the default sizing for all fonts.}
#' \item{\code{!is.null(font.size)} uses \code{font.size} as the font sizing for the plots.}
#' }
#' @param vertex.label an attribute for naming the vertices. Defaults to \code{NULL}.
#' \itemize{
#' \item{\code{vertex.label==FALSE} name the vertices \code{V(g)} sequentially, as 1, 2, ... n.}
#' \item{\code{vertex.label==TRUE} name the vertices \code{V(g)} as \code{V(g)$name}.}
#' }
#' @param vertex.attr an attribute to color vertices. Defaults to \code{FALSE}.
#' \itemize{
#' \item{\code{vertex.attr==FALSE} assumes no grouping of the vertices, and adds no color accordingly.}
#' \item{\code{is.character(vertex.attr)} assumes a grouping of the vertices given for \code{V(g)} by \code{V(G)[[vertex.attr]]}, and groups the vertices in \code{V(g)} into ordered blocks with color-coding.}
#' }
#' @param edge.xfm log-transform the edge-weights. Defaults to \code{FALSE}.
#' \itemize{
#' \item{\code{edge.xfm==FALSE} do not transform the edge-weights.}
#' \item{\code{edge.xfm == "log"} transform the edge values, using the natural-logarithm operation. See `\link[base]{log}` for details. Does not work if there are negative edge-weights.}
#' \item{\code{edge.xfm == "log10"} transform the edge values, using the logarithm-base-10 operation. See `\link[base]{log10}` for details. Does not work if there are negative edge-weights.}
#' }
#' @return the graph/graphs as a plot.
#' @author Eric Bridgeford
#' @export
gs.plot.heatmap <- function(g, title="",src.label="Vertex", tgt.label="Vertex", edge.attr=NULL,
font.size=NULL, vertex.label=FALSE, vertex.attr=FALSE, edge.xfm=FALSE, eps=0.0001,
degree=TRUE) {
# load adjacency matrix as a dense matrix
adj <- as_adjacency_matrix(g, attr=edge.attr, names=vertex.label, type="both", sparse=FALSE)
adj.data <- reshape2::melt(adj) # melt the graph to a data-frame with row and colnames preserved
colnames(adj.data) <- c("Source", "Target", "Weight")
alpha = 1
hist.src <- apply(adj, c(1), nan.sum)
hist.tgt <- apply(adj, c(2), nan.sum)
edge.colors=c("#020202")
if (!is.character(edge.attr)) {
adj.data$Weight <- factor(adj.data$Weight, levels=c(0, 1), ordered=TRUE)
wt.name <- "Connection"
} else {
wt.name <- edge.attr
if (edge.xfm != FALSE) {
if (edge.xfm == "log") {
edge.xfm=log
# set 0-weight edges to far lower than rest of graph
adj.data$Weight <- adj.data$Weight + eps
wt.name = sprintf("log(%s)", wt.name)
} else if (edge.xfm == "log10") {
edge.xfm = log10
# set 0-weight edges to far lower than rest of graph
adj.data$Weight <- adj.data$Weight + eps
wt.name = sprintf("log10(%s)", wt.name)
}
adj.data$Weight <- do.call(edge.xfm, list(adj.data$Weight))
}
}
hist.dat <- rbind(data.frame(Vertex=1:dim(adj)[1], Degree=hist.src/max(hist.src), Type=wt.name, direction="Source"),
data.frame(Vertex=1:dim(adj)[1], Degree=hist.tgt/max(hist.tgt), Type=wt.name, direction="Target"))
thm = list(theme_void(),
guides(fill=FALSE),
theme(plot.margin=unit(rep(0,4), "lines")))
plot.adj <- ggplot(adj.data, aes(x=Source, y=Target, alpha=Weight)) +
geom_tile(fill=edge.colors) +
xlab(src.label) +
ylab(tgt.label) +
ggtitle(title) +
theme_bw() +
theme(rect=element_blank(), panel.grid=element_blank()) +
thm
if (vertex.label) {
plot.adj <- plot.adj + theme(axis.text.x = element_text(angle=60, hjust=1))
}
if (is.character(edge.attr)) {
plot.adj <- plot.adj +
scale_fill_gradientn(colors=edge.colors, name=wt.name) +
guides(alpha=guide_legend(title=wt.name))
} else {
plot.adj <- plot.adj +
scale_fill_manual(values=edge.colors, name=wt.name) +
guides(alpha=guide_legend(title=wt.name))
}
if (degree) {
thm = list(theme_void(),
guides(fill=FALSE),
theme(plot.margin=unit(rep(0,4), "lines"), legend.position=NaN))
top.plot <- ggplot(subset(hist.dat, direction == "Source"), aes(x=Vertex, y=Degree, fill=Type, group=Type)) +
geom_bar(stat = "identity", position="identity", alpha=alpha) +
scale_fill_manual(values=edge.colors) +
thm
right.plot <- ggplot(subset(hist.dat, direction == "Target"), aes(x=Vertex, y=Degree, fill=Type, group=Type)) +
geom_bar(stat = "identity", position="identity", alpha=alpha) +
scale_fill_manual(values=edge.colors) +
coord_flip() +
thm
empty <- ggplot() + geom_blank() + thm
pleg <- g_legend(plot.adj)
widths=c(0.6, 0.2, 0.2)
heights=c(0.2, 0.8)
plot.adj <- as_ggplot(arrangeGrob(grobs=list(top.plot, empty, empty, plot.adj + theme(legend.position=NaN, title=element_blank()), right.plot, pleg), byrow=TRUE,
ncol=3, nrow=2, widths=widths, heights=heights, top=textGrob(title, gp=gpar(cex=1.3)),
left=tgt.label, bottom=src.label))
}
#if (is.character(vertex.attr)) {
# vertices <- colnames(adj)
# jet.colors <- colorRampPalette(c("#00007F", "blue", "#007FFF", "cyan", "#7FFF7F", "yellow", "#FF7F00", "red", "#7F0000"))
# V.gr <- factor(get.vertex.attribute(g, vertex.attr)) # group the vertices by their attribute
# un.vertices <- levels(V.gr)
# attr.colors <- jet.colors(length(un.vertices))
# for (i in 1:length(attr.colors)) {
# vertex.num <- min(which())
# plot.adj <- plot.adj +
# geom_rect()
# }
# plot.adj <- plot.adj +
# geom_tile(data=adj.data, aes(x=Source, y=Target, fill=Fill1), show.legend=TRUE, alpha=0.2) +
# geom_tile(data=adj.data, aes(x=Source, y=Target, fill=Fill2), show.legend=FALSE, alpha=0.2)
#}
return(plot.adj)
}
#' Graph Grid plot
#'
#' A function that plots an igraph object, as a grid, with intensity denoted by the size of dots on the grid.
#'
#' @import ggplot2
#' @import igraph
#' @importFrom reshape2 melt
#' @importFrom gridExtra arrangeGrob
#' @importFrom ggpubr as_ggplot
#' @param g input graph, as an igraph object. See \code{\link[igraph]{graph}} for details.
#' @param title the title for the square plot. Defaults to \code{""}.
#' @param src.label the source label for the graph. Defaults to \code{"Vertex"}.
#' @param tgt.label the target label for the graph. Defaults to \code{"Vertex"}.
#' @param edge.attr the name of the attribute to use for weights. Defaults to \code{NULL}. Can be a list of `edge.attr` if you want to overlay different edge-attributes on the same plot. Supports up to 4 edge-attributes at once.
#' \itemize{
#' \item{\code{is.null(edge.attr)} plots the graph as a binary adjacency matrix.}
#' \item{\code{is.character(edge.attr)} plot the graph as a weighted adjacency matrix, with edge-weights for \code{E(g)} given by \code{E(g)[[edge.attr]]}.}
#' }
#' @param font.size the default font size for the plot text. Axis/legend text is \code{font.size - 2}. Defaults to \code{NULL}.
#' \itemize{
#' \item{\code{is.null(font.size)} uses the default sizing for all fonts.}
#' \item{\code{!is.null(font.size)} uses \code{font.size} as the font sizing for the plots.}
#' }
#' @param vertex.label an attribute for naming the vertices. Defaults to \code{NULL}.
#' \itemize{
#' \item{\code{vertex.label==FALSE} name the vertices \code{V(g)} sequentially, as 1, 2, ... n.}
#' \item{\code{vertex.label==TRUE} name the vertices \code{V(g)} as \code{V(g)$name}.}
#' }
#' @param vertex.attr an attribute to color vertices. Defaults to \code{FALSE}.
#' \itemize{
#' \item{\code{vertex.attr==FALSE} assumes no grouping of the vertices, and adds no color accordingly.}
#' \item{\code{is.character(vertex.attr)} assumes a grouping of the vertices given for \code{V(g)} by \code{V(G)[[vertex.attr]]}, and groups the vertices in \code{V(g)} into ordered blocks with color-coding.}
#' }
#' @param edge.xfm transform the edge-weights. Defaults to \code{FALSE}. Can be a list of `edge.xfm` if you want to overlay different edge-attributes on the same plot in the plot with different transforms for each.
#' \itemize{
#' \item{\code{edge.xfm==FALSE} do not transform the edge-weights.}
#' \item{\code{edge.xfm == "log"} transform the edge values, using the natural-logarithm operation. See \code{\link[base]{log}} for details. Does not work if there are negative edge-weights. Pads with `eps << min(edge-weight)` if there are entries of zero in the graph.}
#' \item{\code{edge.xfm == "log10"} transform the edge values, using the logarithm-base-10 operation. See \code{\link[base]{log10}} for details. Does not work if there are negative edge-weights. Pads with `eps << min(edge-weight)` if there are entries of zero in the graph.}
#' }
#' @param eps if you specify an `edge.xfm` that is logarithmic, indicate the padding that zero entries should receive. Defaults to `.0001`. `eps` should be `<< min(edge-weight)`.
#' @param degree Whether to plot the marginal vertex degrees. Defaults to `FALSE`.
#' @return the graph/graphs as a plot.
#' @author Eric Bridgeford
#' @export
gs.plot.grid <- function(g, title="",src.label="Vertex", tgt.label="Vertex", edge.attr=NULL,
font.size=NULL, vertex.label=FALSE, vertex.attr=FALSE, edge.xfm=FALSE, eps=0.0001,
degree=FALSE) {
if (!is.vector(edge.attr)) {
edge.attr <- list(edge.attr)
}
if (length(edge.xfm) < length(edge.attr)) {
edge.xfm <- rep(edge.xfm[1], min(length(edge.attr)))
}
cvec <- c("#020202", "#f41711", "#94d6c9", "#5f8793")
cvec <- cvec[1:length(edge.attr)]
names(cvec) <- edge.attr
alpha <- 1/length(edge.attr)
plot.dat <- data.frame()
hist.dat <- data.frame()
for (i in 1:length(edge.attr)) {
attr <- edge.attr[[i]]; xfm <- edge.xfm[i]
adj <- as_adjacency_matrix(g, attr=attr, names=vertex.label, type="both", sparse=FALSE)
adj.data <- melt(adj) # melt the graph to a data-frame with row and colnames preserved
colnames(adj.data) <- c("Source", "Target", "Weight")
hist.src <- apply(adj, c(1), nan.sum)
hist.tgt <- apply(adj, c(2), nan.sum)
if (is.null(attr)) {
wt.name = "Connection"
} else {
wt.name <- attr
}
if (xfm != FALSE) {
if (xfm == "log") {
xfm=log
# set 0-weight edges to far lower than rest of graph
adj.data$Weight <- adj.data$Weight + eps
wt.name = sprintf("log(%s)", wt.name)
} else if (edge.xfm == "log10") {
xfm = log10
# set 0-weight edges to far lower than rest of graph
adj.data$Weight <- adj.data$Weight + eps
wt.name = sprintf("log10(%s)", wt.name)
}
adj.data$Weight <- do.call(xfm, list(adj.data$Weight))
}
adj.data <- adj.data[adj.data$Weight != 0,]
if (length(edge.attr) > 1) {
adj.data$Weight <- (adj.data$Weight - min(adj.data$Weight, na.rm=TRUE))/(max(adj.data$Weight, na.rm=TRUE) - min(adj.data$Weight, na.rm=TRUE)) # normalize on 0-1
}
plot.dat <- rbind(plot.dat, cbind(adj.data, Type=wt.name))
hist.dat <- rbind(hist.dat, rbind(data.frame(Vertex=1:dim(adj)[1], Degree=hist.src/max(hist.src), Type=wt.name, direction="Source"),
data.frame(Vertex=1:dim(adj)[1], Degree=hist.tgt/max(hist.tgt), Type=wt.name, direction="Target")))
}
hist.dat$Degree <- as.vector(hist.dat$Degree)
plot.adj <- ggplot(plot.dat, aes(x=Source, y=Target, size=Weight, color=Type, group=Type), alpha=alpha) +
geom_point() +
xlab(src.label) +
ylab(tgt.label) +
ggtitle(title) +
theme_bw() +
theme(rect=element_blank(), panel.grid=element_blank()) +
guides(color=guide_legend(order=2), size=guide_legend(order=1))
plot.adj <- plot.adj + scale_color_manual(values=cvec)
if (vertex.label) {
plot.adj <- plot.adj + theme(axis.text.x = element_text(angle=60, hjust=1))
} else {
plot.adj <- plot.adj +
xlim(1, dim(adj)[1]) +
ylim(1, dim(adj)[1])
}
if (degree) {
thm = list(theme_void(),
guides(fill=FALSE),
theme(plot.margin=unit(rep(0,4), "lines"), legend.position=NaN))
top.plot <- ggplot(subset(hist.dat, direction == "Source"), aes(x=Vertex, y=Degree, fill=Type, color=Type, group=Type)) +
geom_bar(stat = "identity", position="identity", alpha=alpha) +
scale_color_manual(values=cvec) +
scale_fill_manual(values=cvec) +
thm
right.plot <- ggplot(subset(hist.dat, direction == "Target"), aes(x=Vertex, y=Degree, fill=Type, color=Type, group=Type)) +
geom_bar(stat = "identity", position="identity", alpha=alpha) +
scale_color_manual(values=cvec) +
scale_fill_manual(values=cvec) +
coord_flip() +
thm
empty <- ggplot() + geom_blank() + thm
pleg <- g_legend(plot.adj)
widths=c(0.6, 0.2, 0.2)
heights=c(0.2, 0.8)
plot.adj <- as_ggplot(arrangeGrob(grobs=list(top.plot + ggtitle(title), empty, empty, plot.adj + theme(legend.position=NaN) + ggtitle(""), right.plot, pleg), byrow=TRUE,
ncol=3, nrow=2, widths=widths, heights=heights))
}
#if (is.character(vertex.attr)) {
# reorder the vertices so that vertices in same group are together
#}
#if (is.character(vertex.attr)) {
# vertices <- colnames(adj)
# jet.colors <- colorRampPalette(c("#00007F", "blue", "#007FFF", "cyan", "#7FFF7F", "yellow", "#FF7F00", "red", "#7F0000"))
# V.gr <- factor(get.vertex.attribute(g, vertex.attr)) # group the vertices by their attribute
# un.vertices <- levels(V.gr)
# attr.colors <- jet.colors(length(un.vertices))
# for (i in 1:length(attr.colors)) {
# vertex.num <- min(which())
# plot.adj <- plot.adj +
# geom_rect()
# }
# plot.adj <- plot.adj +
# geom_tile(data=adj.data, aes(x=Source, y=Target, fill=Fill1), show.legend=TRUE, alpha=0.2) +
# geom_tile(data=adj.data, aes(x=Source, y=Target, fill=Fill2), show.legend=FALSE, alpha=0.2)
#}
return(plot.adj)
}
#' Graph Grid plot
#'
#' A function that plots an igraph object, as a series of overlapping heatmaps, with intensity denoted by the colorscale of dots on the heatmap.
#'
#' @import ggplot2
#' @import igraph
#' @importFrom reshape2 melt
#' @importFrom gridExtra arrangeGrob
#' @importFrom ggpubr as_ggplot
#' @param g input graph, as an igraph object. See \code{\link[igraph]{graph}} for details.
#' @param title the title for the square plot. Defaults to \code{""}.
#' @param src.label the source label for the graph. Defaults to \code{"Vertex"}.
#' @param tgt.label the target label for the graph. Defaults to \code{"Vertex"}.
#' @param edge.attr the name of the attribute to use for weights. Defaults to \code{NULL}. Can be a list of `edge.attr` if you want to overlay different edge-attributes on the same plot. Supports up to 4 edge-attributes at once.
#' \itemize{
#' \item{\code{is.null(edge.attr)} plots the graph as a binary adjacency matrix.}
#' \item{\code{is.character(edge.attr)} plot the graph as a weighted adjacency matrix, with edge-weights for \code{E(g)} given by \code{E(g)[[edge.attr]]}.}
#' }
#' @param font.size the default font size for the plot text. Axis/legend text is \code{font.size - 2}. Defaults to \code{NULL}.
#' \itemize{
#' \item{\code{is.null(font.size)} uses the default sizing for all fonts.}
#' \item{\code{!is.null(font.size)} uses \code{font.size} as the font sizing for the plots.}
#' }
#' @param vertex.label an attribute for naming the vertices. Defaults to \code{NULL}.
#' \itemize{
#' \item{\code{vertex.label==FALSE} name the vertices \code{V(g)} sequentially, as 1, 2, ... n.}
#' \item{\code{vertex.label==TRUE} name the vertices \code{V(g)} as \code{V(g)$name}.}
#' }
#' @param vertex.attr an attribute to color vertices. Defaults to \code{FALSE}.
#' \itemize{
#' \item{\code{vertex.attr==FALSE} assumes no grouping of the vertices, and adds no color accordingly.}
#' \item{\code{is.character(vertex.attr)} assumes a grouping of the vertices given for \code{V(g)} by \code{V(G)[[vertex.attr]]}, and groups the vertices in \code{V(g)} into ordered blocks with color-coding.}
#' }
#' @param edge.xfm transform the edge-weights. Defaults to \code{FALSE}. Can be a list of `edge.xfm` if you want to overlay different edge-attributes on the same plot in the plot with different transforms for each.
#' \itemize{
#' \item{\code{edge.xfm==FALSE} do not transform the edge-weights.}
#' \item{\code{edge.xfm == "log"} transform the edge values, using the natural-logarithm operation. See \code{\link[base]{log}} for details. Does not work if there are negative edge-weights. Pads with `eps << min(edge-weight)` if there are entries of zero in the graph.}
#' \item{\code{edge.xfm == "log10"} transform the edge values, using the logarithm-base-10 operation. See \code{\link[base]{log10}} for details. Does not work if there are negative edge-weights. Pads with `eps << min(edge-weight)` if there are entries of zero in the graph.}
#' }
#' @param eps if you specify an `edge.xfm` that is logarithmic, indicate the padding that zero entries should receive. Defaults to `.0001`. `eps` should be `<< min(edge-weight)`.
#' @param degree Whether to plot the marginal vertex degrees. Defaults to `FALSE`.
#' @return the graph/graphs as a plot.
#' @author Eric Bridgeford
#' @export
gs.plot.heatmap_overlay <- function(g, title="",src.label="Vertex", tgt.label="Vertex", edge.attr=NULL,
font.size=NULL, vertex.label=FALSE, vertex.attr=FALSE, edge.xfm=FALSE, eps=0.0001,
degree=FALSE) {
if (!is.vector(edge.attr)) {
edge.attr <- list(edge.attr)
}
if (length(edge.xfm) < length(edge.attr)) {
edge.xfm <- rep(edge.xfm[1], min(length(edge.attr)))
}
cvec <- c("#020202", "#f41711", "#94d6c9", "#5f8793")
cvec <- cvec[1:length(edge.attr)]
names(cvec) <- edge.attr
alpha <- 1/(length(edge.attr))
plot.dat <- data.frame()
hist.dat <- data.frame()
for (i in 1:length(edge.attr)) {
attr <- edge.attr[[i]]; xfm <- edge.xfm[i]
adj <- as_adjacency_matrix(g, attr=attr, names=vertex.label, type="both", sparse=FALSE)
adj.data <- melt(adj) # melt the graph to a data-frame with row and colnames preserved
colnames(adj.data) <- c("Source", "Target", "Weight")
hist.src <- apply(adj, c(1), nan.sum)
hist.tgt <- apply(adj, c(2), nan.sum)
if (is.null(attr)) {
wt.name = "Connection"
} else {
wt.name <- attr
}
if (xfm != FALSE) {
if (xfm == "log") {
xfm=log
# set 0-weight edges to far lower than rest of graph
adj.data$Weight <- adj.data$Weight + eps
wt.name = sprintf("log(%s)", wt.name)
} else if (edge.xfm == "log10") {
xfm = log10
# set 0-weight edges to far lower than rest of graph
adj.data$Weight <- adj.data$Weight + eps
wt.name = sprintf("log10(%s)", wt.name)
}
adj.data$Weight <- do.call(xfm, list(adj.data$Weight))
}
adj.data <- adj.data[adj.data$Weight != 0,]
if (length(edge.attr) > 1) {
adj.data$Weight <- (adj.data$Weight - min(adj.data$Weight, na.rm=TRUE))/(max(adj.data$Weight, na.rm=TRUE) - min(adj.data$Weight, na.rm=TRUE)) # normalize on 0-1
}
plot.dat <- rbind(plot.dat, cbind(adj.data, Type=wt.name))
hist.dat <- rbind(hist.dat, rbind(data.frame(Vertex=1:dim(adj)[1], Degree=hist.src/max(hist.src), Type=wt.name, direction="Source"),
data.frame(Vertex=1:dim(adj)[1], Degree=hist.tgt/max(hist.tgt), Type=wt.name, direction="Target")))
}
hist.dat$Degree <- as.vector(hist.dat$Degree)
plot.adj <- ggplot(subset(plot.dat, Type == edge.attr[1]), aes(x=Source, y=Target, fill=Type, alpha=Weight, color=Type, group=Type), alpha=alpha) +
geom_tile() +
xlab(src.label) +
ylab(tgt.label) +
ggtitle(title) +
theme_bw() +
theme(rect=element_blank(), panel.grid=element_blank())
if (length(edge.attr) > 1) {
for (i in 2:length(edge.attr)) {
plot.adj <- plot.adj +
geom_point(data=subset(plot.dat, Type == edge.attr[i]), aes(x=Source, y=Target, size=Weight, fill=Type, color=Type, group=Type), alpha=1)
}
plot.adj <- plot.adj +
scale_size_continuous(range = c(0,2))
}
plot.adj <- plot.adj + scale_color_manual(values=cvec) + scale_fill_manual(values=cvec)
if (vertex.label) {
plot.adj <- plot.adj + theme(axis.text.x = element_text(angle=60, hjust=1))
}
if (degree) {
thm = list(theme_void(),
guides(fill=FALSE),
theme(plot.margin=unit(rep(0,4), "lines"), legend.position=NaN))
top.plot <- ggplot(subset(hist.dat, direction == "Source"), aes(x=Vertex, y=Degree, fill=Type, color=Type, group=Type)) +
geom_bar(stat = "identity", position="identity", alpha=alpha) +
scale_color_manual(values=cvec) +
scale_fill_manual(values=cvec) +
thm
right.plot <- ggplot(subset(hist.dat, direction == "Target"), aes(x=Vertex, y=Degree, fill=Type, color=Type, group=Type)) +
geom_bar(stat = "identity", position="identity", alpha=alpha) +
scale_color_manual(values=cvec) +
scale_fill_manual(values=cvec) +
coord_flip() +
thm
empty <- ggplot() + geom_blank() + thm
pleg <- g_legend(plot.adj)
widths=c(0.6, 0.2, 0.2)
heights=c(0.2, 0.8)
plot.adj <- as_ggplot(arrangeGrob(grobs=list(top.plot + ggtitle(title), empty, empty, plot.adj + theme(legend.position=NaN) + ggtitle(""), right.plot, pleg), byrow=TRUE,
ncol=3, nrow=2, widths=widths, heights=heights))
}
#if (is.character(vertex.attr)) {
# reorder the vertices so that vertices in same group are together
#}
#if (is.character(vertex.attr)) {
# vertices <- colnames(adj)
# jet.colors <- colorRampPalette(c("#00007F", "blue", "#007FFF", "cyan", "#7FFF7F", "yellow", "#FF7F00", "red", "#7F0000"))
# V.gr <- factor(get.vertex.attribute(g, vertex.attr)) # group the vertices by their attribute
# un.vertices <- levels(V.gr)
# attr.colors <- jet.colors(length(un.vertices))
# for (i in 1:length(attr.colors)) {
# vertex.num <- min(which())
# plot.adj <- plot.adj +
# geom_rect()
# }
# plot.adj <- plot.adj +
# geom_tile(data=adj.data, aes(x=Source, y=Target, fill=Fill1), show.legend=TRUE, alpha=0.2) +
# geom_tile(data=adj.data, aes(x=Source, y=Target, fill=Fill2), show.legend=FALSE, alpha=0.2)
#}
return(plot.adj)
}
#' Matrix Pairs Plot
#'
#' A function that plots a matrix as a pairs plot.
#'
#' @import ggplot2
#' @param X input matrix as a 2-d data frame. Should be \code{[n, d]} dimensions for \code{n} points and \code{[d]} dimensions. The points (rows) rows
#' of \code{X} points will be colored according to their \code{rownames} assignment.
#' @param k the maximum number of dimensions you want to plot. Defaults to \code{NULL}, which plots all \code{d} dimensions.
#' @param pt.color the color of the points. Defaults to \code{NULL}, which will not color the points (they will all be black).
#' @param pt.shape the shape of the points. Defaults to \code{NULL}, which will not define a point shape (they will all be circles).
#' @param x.label the x label for the pairs plot. Defaults to \code{""}.
#' @param y.label the y label for the pairs plot. Defaults to \code{""}.
#' @param title the title for the plot. Defaults to \code{""}.
#' @param font.size the default font size for the plot text. Axis/legend text is \code{font.size - 2}. Defaults to \code{NULL}.
#' \itemize{
#' \item{\code{is.null(font.size)} uses the default sizing for all fonts.}
#' \item{\code{!is.null(font.size)} uses \code{font.size} as the font sizing for the plots.}
#' }
#' @return the latent positions as a pairs plot.
#' @author Eric Bridgeford
#' @export
gs.plot.matrix.pairs <- function(X, k=NULL, pt.color=NULL, pt.shape=NULL, x.label="", y.label="", title="", pt.label="Point", font.size=NULL) {
# adapted from https://gastonsanchez.wordpress.com/2012/08/27/scatterplot-matrices-with-ggplot/
makePairs <- function(data) {
colnames(data) <- sapply(1:dim(data)[2], function(i) sprintf("Dimension %d", i))
grid <- expand.grid(x = 1:ncol(data), y = 1:ncol(data))
grid <- subset(grid, x != y)
all <- do.call("rbind", lapply(1:nrow(grid), function(i) {
xcol <- grid[i, "x"]
ycol <- grid[i, "y"]
suppressWarnings(data.frame(xvar = colnames(data)[ycol], yvar = colnames(data)[xcol],
x = data[, xcol], y = data[, ycol], data))
}))
all$xvar <- factor(all$xvar, levels = colnames(data))
all$yvar <- factor(all$yvar, levels = colnames(data))
densities <- do.call("rbind", lapply(1:ncol(data), function(i) {
do.call("rbind", lapply(1:length(unique(pt.color)), function(j) {
data.frame(xvar = colnames(data)[i], yvar = colnames(data)[i], x = data[pt.color == unique(pt.color)[j], i], color=unique(pt.color)[j])
}))
}))
list(all=all, densities=densities)
}
gg1 <- makePairs(X)
# new data frame mega iris
mega_mtx = data.frame(gg1$all)
mega_mtx <- data.frame(gg1$all, color=rep(pt.color, length=nrow(gg1$all)),
shape=rep(pt.shape, length=nrow(gg1$all)))
# pairs plot
pairs <- ggplot(mega_mtx, aes_string(x = "x", y = "y")) +
facet_grid(xvar ~ yvar, scales = "free") +
xlab(x.label) +
ylab(y.label) +
stat_density(aes(x = x, y = ..scaled.. * diff(range(x)) + min(x), color=color),
data = gg1$densities, position = "identity", geom = "line") +
ggtitle(title) +
theme_bw() +
geom_point(aes(color=color, shape=shape), na.rm=TRUE, alpha=1/log10(dim(X)[1]))
return(pairs)
}
neurodata/graphstats documentation built on May 14, 2019, 5:19 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
nan.sum <- function(x) {sum(x, na.rm=TRUE)}
g_legend<-function(a.gplot){
tmp <- ggplot_gtable(ggplot_build(a.gplot))
leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
legend <- tmp$grobs[[leg]]
return(legend)
}
#' Graph Heatmap plot
#'
#' A function that plots an igraph object, as a heatmap.
#'
#' @import ggplot2
#' @import igraph
#' @importFrom reshape2 melt
#' @importFrom ggpubr as_ggplot
#' @importFrom grid textGrob
#' @importFrom grid gpar
#' @param g input graph, as an igraph object. See \code{\link[igraph]{graph}} for details.
#' @param title the title for the square plot. Defaults to \code{""}.
#' @param src.label the source label for the graph. Defaults to \code{"Vertex"}.
#' @param tgt.label the target label for the graph. Defaults to \code{"Vertex"}.
#' @param edge.attr the name of the attribute to use for weights. Defaults to \code{NULL}.
#' \itemize{
#' \item{\code{is.null(edge.attr)} plots the graph as a binary adjacency matrix.}
#' \item{\code{is.character(edge.attr)} plot the graph as a weighted adjacency matrix, with edge-weights for \code{E(g)} given by \code{E(g)[[edge.attr]]}.}
#' }
#' @param font.size the default font size for the plot text. Axis/legend text is \code{font.size - 2}. Defaults to \code{NULL}.
#' \itemize{
#' \item{\code{is.null(font.size)} uses the default sizing for all fonts.}
#' \item{\code{!is.null(font.size)} uses \code{font.size} as the font sizing for the plots.}
#' }
#' @param vertex.label an attribute for naming the vertices. Defaults to \code{NULL}.
#' \itemize{
#' \item{\code{vertex.label==FALSE} name the vertices \code{V(g)} sequentially, as 1, 2, ... n.}
#' \item{\code{vertex.label==TRUE} name the vertices \code{V(g)} as \code{V(g)$name}.}
#' }
#' @param vertex.attr an attribute to color vertices. Defaults to \code{FALSE}.
#' \itemize{
#' \item{\code{vertex.attr==FALSE} assumes no grouping of the vertices, and adds no color accordingly.}
#' \item{\code{is.character(vertex.attr)} assumes a grouping of the vertices given for \code{V(g)} by \code{V(G)[[vertex.attr]]}, and groups the vertices in \code{V(g)} into ordered blocks with color-coding.}
#' }
#' @param edge.xfm log-transform the edge-weights. Defaults to \code{FALSE}.
#' \itemize{
#' \item{\code{edge.xfm==FALSE} do not transform the edge-weights.}
#' \item{\code{edge.xfm == "log"} transform the edge values, using the natural-logarithm operation. See `\link[base]{log}` for details. Does not work if there are negative edge-weights.}
#' \item{\code{edge.xfm == "log10"} transform the edge values, using the logarithm-base-10 operation. See `\link[base]{log10}` for details. Does not work if there are negative edge-weights.}
#' }
#' @return the graph/graphs as a plot.
#' @author Eric Bridgeford
#' @export
gs.plot.heatmap <- function(g, title="",src.label="Vertex", tgt.label="Vertex", edge.attr=NULL,
font.size=NULL, vertex.label=FALSE, vertex.attr=FALSE, edge.xfm=FALSE, eps=0.0001,
degree=TRUE) {
# load adjacency matrix as a dense matrix
adj <- as_adjacency_matrix(g, attr=edge.attr, names=vertex.label, type="both", sparse=FALSE)
adj.data <- reshape2::melt(adj) # melt the graph to a data-frame with row and colnames preserved
colnames(adj.data) <- c("Source", "Target", "Weight")
alpha = 1
hist.src <- apply(adj, c(1), nan.sum)
hist.tgt <- apply(adj, c(2), nan.sum)
edge.colors=c("#020202")
if (!is.character(edge.attr)) {
adj.data$Weight <- factor(adj.data$Weight, levels=c(0, 1), ordered=TRUE)
wt.name <- "Connection"
} else {
wt.name <- edge.attr
if (edge.xfm != FALSE) {
if (edge.xfm == "log") {
edge.xfm=log
# set 0-weight edges to far lower than rest of graph
adj.data$Weight <- adj.data$Weight + eps
wt.name = sprintf("log(%s)", wt.name)
} else if (edge.xfm == "log10") {
edge.xfm = log10
# set 0-weight edges to far lower than rest of graph
adj.data$Weight <- adj.data$Weight + eps
wt.name = sprintf("log10(%s)", wt.name)
}
adj.data$Weight <- do.call(edge.xfm, list(adj.data$Weight))
}
}
hist.dat <- rbind(data.frame(Vertex=1:dim(adj)[1], Degree=hist.src/max(hist.src), Type=wt.name, direction="Source"),
data.frame(Vertex=1:dim(adj)[1], Degree=hist.tgt/max(hist.tgt), Type=wt.name, direction="Target"))
thm = list(theme_void(),
guides(fill=FALSE),
theme(plot.margin=unit(rep(0,4), "lines")))
plot.adj <- ggplot(adj.data, aes(x=Source, y=Target, alpha=Weight)) +
geom_tile(fill=edge.colors) +
xlab(src.label) +
ylab(tgt.label) +
ggtitle(title) +
theme_bw() +
theme(rect=element_blank(), panel.grid=element_blank()) +
thm
if (vertex.label) {
plot.adj <- plot.adj + theme(axis.text.x = element_text(angle=60, hjust=1))
}
if (is.character(edge.attr)) {
plot.adj <- plot.adj +
scale_fill_gradientn(colors=edge.colors, name=wt.name) +
guides(alpha=guide_legend(title=wt.name))
} else {
plot.adj <- plot.adj +
scale_fill_manual(values=edge.colors, name=wt.name) +
guides(alpha=guide_legend(title=wt.name))
}
if (degree) {
thm = list(theme_void(),
guides(fill=FALSE),
theme(plot.margin=unit(rep(0,4), "lines"), legend.position=NaN))
top.plot <- ggplot(subset(hist.dat, direction == "Source"), aes(x=Vertex, y=Degree, fill=Type, group=Type)) +
geom_bar(stat = "identity", position="identity", alpha=alpha) +
scale_fill_manual(values=edge.colors) +
thm
right.plot <- ggplot(subset(hist.dat, direction == "Target"), aes(x=Vertex, y=Degree, fill=Type, group=Type)) +
geom_bar(stat = "identity", position="identity", alpha=alpha) +
scale_fill_manual(values=edge.colors) +
coord_flip() +
thm
empty <- ggplot() + geom_blank() + thm
pleg <- g_legend(plot.adj)
widths=c(0.6, 0.2, 0.2)
heights=c(0.2, 0.8)
plot.adj <- as_ggplot(arrangeGrob(grobs=list(top.plot, empty, empty, plot.adj + theme(legend.position=NaN, title=element_blank()), right.plot, pleg), byrow=TRUE,
ncol=3, nrow=2, widths=widths, heights=heights, top=textGrob(title, gp=gpar(cex=1.3)),
left=tgt.label, bottom=src.label))
}
#if (is.character(vertex.attr)) {
# vertices <- colnames(adj)
# jet.colors <- colorRampPalette(c("#00007F", "blue", "#007FFF", "cyan", "#7FFF7F", "yellow", "#FF7F00", "red", "#7F0000"))
# V.gr <- factor(get.vertex.attribute(g, vertex.attr)) # group the vertices by their attribute
# un.vertices <- levels(V.gr)
# attr.colors <- jet.colors(length(un.vertices))
# for (i in 1:length(attr.colors)) {
# vertex.num <- min(which())
# plot.adj <- plot.adj +
# geom_rect()
# }
# plot.adj <- plot.adj +
# geom_tile(data=adj.data, aes(x=Source, y=Target, fill=Fill1), show.legend=TRUE, alpha=0.2) +
# geom_tile(data=adj.data, aes(x=Source, y=Target, fill=Fill2), show.legend=FALSE, alpha=0.2)
#}
return(plot.adj)
}
#' Graph Grid plot
#'
#' A function that plots an igraph object, as a grid, with intensity denoted by the size of dots on the grid.
#'
#' @import ggplot2
#' @import igraph
#' @importFrom reshape2 melt
#' @importFrom gridExtra arrangeGrob
#' @importFrom ggpubr as_ggplot
#' @param g input graph, as an igraph object. See \code{\link[igraph]{graph}} for details.
#' @param title the title for the square plot. Defaults to \code{""}.
#' @param src.label the source label for the graph. Defaults to \code{"Vertex"}.
#' @param tgt.label the target label for the graph. Defaults to \code{"Vertex"}.
#' @param edge.attr the name of the attribute to use for weights. Defaults to \code{NULL}. Can be a list of `edge.attr` if you want to overlay different edge-attributes on the same plot. Supports up to 4 edge-attributes at once.
#' \itemize{
#' \item{\code{is.null(edge.attr)} plots the graph as a binary adjacency matrix.}
#' \item{\code{is.character(edge.attr)} plot the graph as a weighted adjacency matrix, with edge-weights for \code{E(g)} given by \code{E(g)[[edge.attr]]}.}
#' }
#' @param font.size the default font size for the plot text. Axis/legend text is \code{font.size - 2}. Defaults to \code{NULL}.
#' \itemize{
#' \item{\code{is.null(font.size)} uses the default sizing for all fonts.}
#' \item{\code{!is.null(font.size)} uses \code{font.size} as the font sizing for the plots.}
#' }
#' @param vertex.label an attribute for naming the vertices. Defaults to \code{NULL}.
#' \itemize{
#' \item{\code{vertex.label==FALSE} name the vertices \code{V(g)} sequentially, as 1, 2, ... n.}
#' \item{\code{vertex.label==TRUE} name the vertices \code{V(g)} as \code{V(g)$name}.}
#' }
#' @param vertex.attr an attribute to color vertices. Defaults to \code{FALSE}.
#' \itemize{
#' \item{\code{vertex.attr==FALSE} assumes no grouping of the vertices, and adds no color accordingly.}
#' \item{\code{is.character(vertex.attr)} assumes a grouping of the vertices given for \code{V(g)} by \code{V(G)[[vertex.attr]]}, and groups the vertices in \code{V(g)} into ordered blocks with color-coding.}
#' }
#' @param edge.xfm transform the edge-weights. Defaults to \code{FALSE}. Can be a list of `edge.xfm` if you want to overlay different edge-attributes on the same plot in the plot with different transforms for each.
#' \itemize{
#' \item{\code{edge.xfm==FALSE} do not transform the edge-weights.}
#' \item{\code{edge.xfm == "log"} transform the edge values, using the natural-logarithm operation. See \code{\link[base]{log}} for details. Does not work if there are negative edge-weights. Pads with `eps << min(edge-weight)` if there are entries of zero in the graph.}
#' \item{\code{edge.xfm == "log10"} transform the edge values, using the logarithm-base-10 operation. See \code{\link[base]{log10}} for details. Does not work if there are negative edge-weights. Pads with `eps << min(edge-weight)` if there are entries of zero in the graph.}
#' }
#' @param eps if you specify an `edge.xfm` that is logarithmic, indicate the padding that zero entries should receive. Defaults to `.0001`. `eps` should be `<< min(edge-weight)`.
#' @param degree Whether to plot the marginal vertex degrees. Defaults to `FALSE`.
#' @return the graph/graphs as a plot.
#' @author Eric Bridgeford
#' @export
gs.plot.grid <- function(g, title="",src.label="Vertex", tgt.label="Vertex", edge.attr=NULL,
font.size=NULL, vertex.label=FALSE, vertex.attr=FALSE, edge.xfm=FALSE, eps=0.0001,
degree=FALSE) {
if (!is.vector(edge.attr)) {
edge.attr <- list(edge.attr)
}
if (length(edge.xfm) < length(edge.attr)) {
edge.xfm <- rep(edge.xfm[1], min(length(edge.attr)))
}
cvec <- c("#020202", "#f41711", "#94d6c9", "#5f8793")
cvec <- cvec[1:length(edge.attr)]
names(cvec) <- edge.attr
alpha <- 1/length(edge.attr)
plot.dat <- data.frame()
hist.dat <- data.frame()
for (i in 1:length(edge.attr)) {
attr <- edge.attr[[i]]; xfm <- edge.xfm[i]
adj <- as_adjacency_matrix(g, attr=attr, names=vertex.label, type="both", sparse=FALSE)
adj.data <- melt(adj) # melt the graph to a data-frame with row and colnames preserved
colnames(adj.data) <- c("Source", "Target", "Weight")
hist.src <- apply(adj, c(1), nan.sum)
hist.tgt <- apply(adj, c(2), nan.sum)
if (is.null(attr)) {
wt.name = "Connection"
} else {
wt.name <- attr
}
if (xfm != FALSE) {
if (xfm == "log") {
xfm=log
# set 0-weight edges to far lower than rest of graph
adj.data$Weight <- adj.data$Weight + eps
wt.name = sprintf("log(%s)", wt.name)
} else if (edge.xfm == "log10") {
xfm = log10
# set 0-weight edges to far lower than rest of graph
adj.data$Weight <- adj.data$Weight + eps
wt.name = sprintf("log10(%s)", wt.name)
}
adj.data$Weight <- do.call(xfm, list(adj.data$Weight))
}
adj.data <- adj.data[adj.data$Weight != 0,]
if (length(edge.attr) > 1) {
adj.data$Weight <- (adj.data$Weight - min(adj.data$Weight, na.rm=TRUE))/(max(adj.data$Weight, na.rm=TRUE) - min(adj.data$Weight, na.rm=TRUE)) # normalize on 0-1
}
plot.dat <- rbind(plot.dat, cbind(adj.data, Type=wt.name))
hist.dat <- rbind(hist.dat, rbind(data.frame(Vertex=1:dim(adj)[1], Degree=hist.src/max(hist.src), Type=wt.name, direction="Source"),
data.frame(Vertex=1:dim(adj)[1], Degree=hist.tgt/max(hist.tgt), Type=wt.name, direction="Target")))
}
hist.dat$Degree <- as.vector(hist.dat$Degree)
plot.adj <- ggplot(plot.dat, aes(x=Source, y=Target, size=Weight, color=Type, group=Type), alpha=alpha) +
geom_point() +
xlab(src.label) +
ylab(tgt.label) +
ggtitle(title) +
theme_bw() +
theme(rect=element_blank(), panel.grid=element_blank()) +
guides(color=guide_legend(order=2), size=guide_legend(order=1))
plot.adj <- plot.adj + scale_color_manual(values=cvec)
if (vertex.label) {
plot.adj <- plot.adj + theme(axis.text.x = element_text(angle=60, hjust=1))
} else {
plot.adj <- plot.adj +
xlim(1, dim(adj)[1]) +
ylim(1, dim(adj)[1])
}
if (degree) {
thm = list(theme_void(),
guides(fill=FALSE),
theme(plot.margin=unit(rep(0,4), "lines"), legend.position=NaN))
top.plot <- ggplot(subset(hist.dat, direction == "Source"), aes(x=Vertex, y=Degree, fill=Type, color=Type, group=Type)) +
geom_bar(stat = "identity", position="identity", alpha=alpha) +
scale_color_manual(values=cvec) +
scale_fill_manual(values=cvec) +
thm
right.plot <- ggplot(subset(hist.dat, direction == "Target"), aes(x=Vertex, y=Degree, fill=Type, color=Type, group=Type)) +
geom_bar(stat = "identity", position="identity", alpha=alpha) +
scale_color_manual(values=cvec) +
scale_fill_manual(values=cvec) +
coord_flip() +
thm
empty <- ggplot() + geom_blank() + thm
pleg <- g_legend(plot.adj)
widths=c(0.6, 0.2, 0.2)
heights=c(0.2, 0.8)
plot.adj <- as_ggplot(arrangeGrob(grobs=list(top.plot + ggtitle(title), empty, empty, plot.adj + theme(legend.position=NaN) + ggtitle(""), right.plot, pleg), byrow=TRUE,
ncol=3, nrow=2, widths=widths, heights=heights))
}
#if (is.character(vertex.attr)) {
# reorder the vertices so that vertices in same group are together
#}
#if (is.character(vertex.attr)) {
# vertices <- colnames(adj)
# jet.colors <- colorRampPalette(c("#00007F", "blue", "#007FFF", "cyan", "#7FFF7F", "yellow", "#FF7F00", "red", "#7F0000"))
# V.gr <- factor(get.vertex.attribute(g, vertex.attr)) # group the vertices by their attribute
# un.vertices <- levels(V.gr)
# attr.colors <- jet.colors(length(un.vertices))
# for (i in 1:length(attr.colors)) {
# vertex.num <- min(which())
# plot.adj <- plot.adj +
# geom_rect()
# }
# plot.adj <- plot.adj +
# geom_tile(data=adj.data, aes(x=Source, y=Target, fill=Fill1), show.legend=TRUE, alpha=0.2) +
# geom_tile(data=adj.data, aes(x=Source, y=Target, fill=Fill2), show.legend=FALSE, alpha=0.2)
#}
return(plot.adj)
}
#' Graph Grid plot
#'
#' A function that plots an igraph object, as a series of overlapping heatmaps, with intensity denoted by the colorscale of dots on the heatmap.
#'
#' @import ggplot2
#' @import igraph
#' @importFrom reshape2 melt
#' @importFrom gridExtra arrangeGrob
#' @importFrom ggpubr as_ggplot
#' @param g input graph, as an igraph object. See \code{\link[igraph]{graph}} for details.
#' @param title the title for the square plot. Defaults to \code{""}.
#' @param src.label the source label for the graph. Defaults to \code{"Vertex"}.
#' @param tgt.label the target label for the graph. Defaults to \code{"Vertex"}.
#' @param edge.attr the name of the attribute to use for weights. Defaults to \code{NULL}. Can be a list of `edge.attr` if you want to overlay different edge-attributes on the same plot. Supports up to 4 edge-attributes at once.
#' \itemize{
#' \item{\code{is.null(edge.attr)} plots the graph as a binary adjacency matrix.}
#' \item{\code{is.character(edge.attr)} plot the graph as a weighted adjacency matrix, with edge-weights for \code{E(g)} given by \code{E(g)[[edge.attr]]}.}
#' }
#' @param font.size the default font size for the plot text. Axis/legend text is \code{font.size - 2}. Defaults to \code{NULL}.
#' \itemize{
#' \item{\code{is.null(font.size)} uses the default sizing for all fonts.}
#' \item{\code{!is.null(font.size)} uses \code{font.size} as the font sizing for the plots.}
#' }
#' @param vertex.label an attribute for naming the vertices. Defaults to \code{NULL}.
#' \itemize{
#' \item{\code{vertex.label==FALSE} name the vertices \code{V(g)} sequentially, as 1, 2, ... n.}
#' \item{\code{vertex.label==TRUE} name the vertices \code{V(g)} as \code{V(g)$name}.}
#' }
#' @param vertex.attr an attribute to color vertices. Defaults to \code{FALSE}.
#' \itemize{
#' \item{\code{vertex.attr==FALSE} assumes no grouping of the vertices, and adds no color accordingly.}
#' \item{\code{is.character(vertex.attr)} assumes a grouping of the vertices given for \code{V(g)} by \code{V(G)[[vertex.attr]]}, and groups the vertices in \code{V(g)} into ordered blocks with color-coding.}
#' }
#' @param edge.xfm transform the edge-weights. Defaults to \code{FALSE}. Can be a list of `edge.xfm` if you want to overlay different edge-attributes on the same plot in the plot with different transforms for each.
#' \itemize{
#' \item{\code{edge.xfm==FALSE} do not transform the edge-weights.}
#' \item{\code{edge.xfm == "log"} transform the edge values, using the natural-logarithm operation. See \code{\link[base]{log}} for details. Does not work if there are negative edge-weights. Pads with `eps << min(edge-weight)` if there are entries of zero in the graph.}
#' \item{\code{edge.xfm == "log10"} transform the edge values, using the logarithm-base-10 operation. See \code{\link[base]{log10}} for details. Does not work if there are negative edge-weights. Pads with `eps << min(edge-weight)` if there are entries of zero in the graph.}
#' }
#' @param eps if you specify an `edge.xfm` that is logarithmic, indicate the padding that zero entries should receive. Defaults to `.0001`. `eps` should be `<< min(edge-weight)`.
#' @param degree Whether to plot the marginal vertex degrees. Defaults to `FALSE`.
#' @return the graph/graphs as a plot.
#' @author Eric Bridgeford
#' @export
gs.plot.heatmap_overlay <- function(g, title="",src.label="Vertex", tgt.label="Vertex", edge.attr=NULL,
font.size=NULL, vertex.label=FALSE, vertex.attr=FALSE, edge.xfm=FALSE, eps=0.0001,
degree=FALSE) {
if (!is.vector(edge.attr)) {
edge.attr <- list(edge.attr)
}
if (length(edge.xfm) < length(edge.attr)) {
edge.xfm <- rep(edge.xfm[1], min(length(edge.attr)))
}
cvec <- c("#020202", "#f41711", "#94d6c9", "#5f8793")
cvec <- cvec[1:length(edge.attr)]
names(cvec) <- edge.attr
alpha <- 1/(length(edge.attr))
plot.dat <- data.frame()
hist.dat <- data.frame()
for (i in 1:length(edge.attr)) {
attr <- edge.attr[[i]]; xfm <- edge.xfm[i]
adj <- as_adjacency_matrix(g, attr=attr, names=vertex.label, type="both", sparse=FALSE)
adj.data <- melt(adj) # melt the graph to a data-frame with row and colnames preserved
colnames(adj.data) <- c("Source", "Target", "Weight")
hist.src <- apply(adj, c(1), nan.sum)
hist.tgt <- apply(adj, c(2), nan.sum)
if (is.null(attr)) {
wt.name = "Connection"
} else {
wt.name <- attr
}
if (xfm != FALSE) {
if (xfm == "log") {
xfm=log
# set 0-weight edges to far lower than rest of graph
adj.data$Weight <- adj.data$Weight + eps
wt.name = sprintf("log(%s)", wt.name)
} else if (edge.xfm == "log10") {
xfm = log10
# set 0-weight edges to far lower than rest of graph
adj.data$Weight <- adj.data$Weight + eps
wt.name = sprintf("log10(%s)", wt.name)
}
adj.data$Weight <- do.call(xfm, list(adj.data$Weight))
}
adj.data <- adj.data[adj.data$Weight != 0,]
if (length(edge.attr) > 1) {
adj.data$Weight <- (adj.data$Weight - min(adj.data$Weight, na.rm=TRUE))/(max(adj.data$Weight, na.rm=TRUE) - min(adj.data$Weight, na.rm=TRUE)) # normalize on 0-1
}
plot.dat <- rbind(plot.dat, cbind(adj.data, Type=wt.name))
hist.dat <- rbind(hist.dat, rbind(data.frame(Vertex=1:dim(adj)[1], Degree=hist.src/max(hist.src), Type=wt.name, direction="Source"),
data.frame(Vertex=1:dim(adj)[1], Degree=hist.tgt/max(hist.tgt), Type=wt.name, direction="Target")))
}
hist.dat$Degree <- as.vector(hist.dat$Degree)
plot.adj <- ggplot(subset(plot.dat, Type == edge.attr[1]), aes(x=Source, y=Target, fill=Type, alpha=Weight, color=Type, group=Type), alpha=alpha) +
geom_tile() +
xlab(src.label) +
ylab(tgt.label) +
ggtitle(title) +
theme_bw() +
theme(rect=element_blank(), panel.grid=element_blank())
if (length(edge.attr) > 1) {
for (i in 2:length(edge.attr)) {
plot.adj <- plot.adj +
geom_point(data=subset(plot.dat, Type == edge.attr[i]), aes(x=Source, y=Target, size=Weight, fill=Type, color=Type, group=Type), alpha=1)
}
plot.adj <- plot.adj +
scale_size_continuous(range = c(0,2))
}
plot.adj <- plot.adj + scale_color_manual(values=cvec) + scale_fill_manual(values=cvec)
if (vertex.label) {
plot.adj <- plot.adj + theme(axis.text.x = element_text(angle=60, hjust=1))
}
if (degree) {
thm = list(theme_void(),
guides(fill=FALSE),
theme(plot.margin=unit(rep(0,4), "lines"), legend.position=NaN))
top.plot <- ggplot(subset(hist.dat, direction == "Source"), aes(x=Vertex, y=Degree, fill=Type, color=Type, group=Type)) +
geom_bar(stat = "identity", position="identity", alpha=alpha) +
scale_color_manual(values=cvec) +
scale_fill_manual(values=cvec) +
thm
right.plot <- ggplot(subset(hist.dat, direction == "Target"), aes(x=Vertex, y=Degree, fill=Type, color=Type, group=Type)) +
geom_bar(stat = "identity", position="identity", alpha=alpha) +
scale_color_manual(values=cvec) +
scale_fill_manual(values=cvec) +
coord_flip() +
thm
empty <- ggplot() + geom_blank() + thm
pleg <- g_legend(plot.adj)
widths=c(0.6, 0.2, 0.2)
heights=c(0.2, 0.8)
plot.adj <- as_ggplot(arrangeGrob(grobs=list(top.plot + ggtitle(title), empty, empty, plot.adj + theme(legend.position=NaN) + ggtitle(""), right.plot, pleg), byrow=TRUE,
ncol=3, nrow=2, widths=widths, heights=heights))
}
#if (is.character(vertex.attr)) {
# reorder the vertices so that vertices in same group are together
#}
#if (is.character(vertex.attr)) {
# vertices <- colnames(adj)
# jet.colors <- colorRampPalette(c("#00007F", "blue", "#007FFF", "cyan", "#7FFF7F", "yellow", "#FF7F00", "red", "#7F0000"))
# V.gr <- factor(get.vertex.attribute(g, vertex.attr)) # group the vertices by their attribute
# un.vertices <- levels(V.gr)
# attr.colors <- jet.colors(length(un.vertices))
# for (i in 1:length(attr.colors)) {
# vertex.num <- min(which())
# plot.adj <- plot.adj +
# geom_rect()
# }
# plot.adj <- plot.adj +
# geom_tile(data=adj.data, aes(x=Source, y=Target, fill=Fill1), show.legend=TRUE, alpha=0.2) +
# geom_tile(data=adj.data, aes(x=Source, y=Target, fill=Fill2), show.legend=FALSE, alpha=0.2)
#}
return(plot.adj)
}
#' Matrix Pairs Plot
#'
#' A function that plots a matrix as a pairs plot.
#'
#' @import ggplot2
#' @param X input matrix as a 2-d data frame. Should be \code{[n, d]} dimensions for \code{n} points and \code{[d]} dimensions. The points (rows) rows
#' of \code{X} points will be colored according to their \code{rownames} assignment.
#' @param k the maximum number of dimensions you want to plot. Defaults to \code{NULL}, which plots all \code{d} dimensions.
#' @param pt.color the color of the points. Defaults to \code{NULL}, which will not color the points (they will all be black).
#' @param pt.shape the shape of the points. Defaults to \code{NULL}, which will not define a point shape (they will all be circles).
#' @param x.label the x label for the pairs plot. Defaults to \code{""}.
#' @param y.label the y label for the pairs plot. Defaults to \code{""}.
#' @param title the title for the plot. Defaults to \code{""}.
#' @param font.size the default font size for the plot text. Axis/legend text is \code{font.size - 2}. Defaults to \code{NULL}.
#' \itemize{
#' \item{\code{is.null(font.size)} uses the default sizing for all fonts.}
#' \item{\code{!is.null(font.size)} uses \code{font.size} as the font sizing for the plots.}
#' }
#' @return the latent positions as a pairs plot.
#' @author Eric Bridgeford
#' @export
gs.plot.matrix.pairs <- function(X, k=NULL, pt.color=NULL, pt.shape=NULL, x.label="", y.label="", title="", pt.label="Point", font.size=NULL) {
# adapted from https://gastonsanchez.wordpress.com/2012/08/27/scatterplot-matrices-with-ggplot/
makePairs <- function(data) {
colnames(data) <- sapply(1:dim(data)[2], function(i) sprintf("Dimension %d", i))
grid <- expand.grid(x = 1:ncol(data), y = 1:ncol(data))
grid <- subset(grid, x != y)
all <- do.call("rbind", lapply(1:nrow(grid), function(i) {
xcol <- grid[i, "x"]
ycol <- grid[i, "y"]
suppressWarnings(data.frame(xvar = colnames(data)[ycol], yvar = colnames(data)[xcol],
x = data[, xcol], y = data[, ycol], data))
}))
all$xvar <- factor(all$xvar, levels = colnames(data))
all$yvar <- factor(all$yvar, levels = colnames(data))
densities <- do.call("rbind", lapply(1:ncol(data), function(i) {
do.call("rbind", lapply(1:length(unique(pt.color)), function(j) {
data.frame(xvar = colnames(data)[i], yvar = colnames(data)[i], x = data[pt.color == unique(pt.color)[j], i], color=unique(pt.color)[j])
}))
}))
list(all=all, densities=densities)
}
gg1 <- makePairs(X)
# new data frame mega iris
mega_mtx = data.frame(gg1$all)
mega_mtx <- data.frame(gg1$all, color=rep(pt.color, length=nrow(gg1$all)),
shape=rep(pt.shape, length=nrow(gg1$all)))
# pairs plot
pairs <- ggplot(mega_mtx, aes_string(x = "x", y = "y")) +
facet_grid(xvar ~ yvar, scales = "free") +
xlab(x.label) +
ylab(y.label) +
stat_density(aes(x = x, y = ..scaled.. * diff(range(x)) + min(x), color=color),
data = gg1$densities, position = "identity", geom = "line") +
ggtitle(title) +
theme_bw() +
geom_point(aes(color=color, shape=shape), na.rm=TRUE, alpha=1/log10(dim(X)[1]))
return(pairs)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.