darken_color <- function(color) {
rgb(t(col2rgb(color)/ 1.2), maxColorValue=255)
}
produce_colors <- function(K) {
colors <- rainbow(K)
substr(colors, start = 1, stop = 7)
}
#' Plot function for S3 class "MixedGraph"
#'
#' @description Plot the graph of MixedGraph object using igraph, cytoscape and cytpscape.js.
#'
#' @method plot MixedGraph
#'
#' @param x is a MixedGraph object.
#' @param method is the related package or lib used in the function. When "igraph", the function will use the R package "igraph". When "cytoscape", the function will use the R package RCy3, the user should start the Cytoscape software before call the function. And when "cytoscape.js", the function will use the lib cytoscape.js.
#' @param weighted is a boolean value, which indicates if we would plot the width of edge according to the weight of edge.
#' @param stability is the stability threshold, when the stability score of the edge is more than it means the coefficient between the two vertices can be trusted.
#' @param out.file is the file name to save the plot of MixedGraph object. The default value is NULL, and the graph will be plotted to the screen.
#' @param ... other arguments for different methods.
#' \itemize{
#' \item{igraph}{the generic arguments for plot.igraph is available.}
#' \item{cytoscape}{layout: the names should be in RCy3::getLayoutNames(CytoscapeWindow), the default layout is "attributes-layout". And you can also modify the layout throungh Cytoscape software.}
#' \item{cytoscape.js}{To be extend}
#' }
#'
#' @examples
#' X <- lapply(1 : 3, function(x){matrix(rnorm(12), nrow = 4)})
#' crf_structure = matrix(c(1, 0, 1, 1, 1, 1, 0, 0, 1), 3, 3)
#' brail_control <- list(B = 5, tau = 0.6)
#' G <- MixedGraph(X, crf_structure, brail_control = brail_control)
#' plot(G, method = "igraph", weighted = TRUE)
#' plot(G, method = "cytoscape.js", out.file = "./docs/cytoscapejs.html")
#'
#' @importFrom graphics plot
#' @import igraph
#' @import grDevices
#' @import htmlwidgets
#' @import RCy3
#' @export
plot.MixedGraph <- function(x, method = c("igraph", "cytoscape", "cytoscape.js"), weighted = FALSE, stability = 0.0, out.file = NULL, ...) {
method <- tolower(method)
method <- match.arg(method)
K <- length(x$data)
size_list <- cumsum(c(1, sapply(x$data, ncol)))
p <- ncol(x$network)
# produce color list
colors <- produce_colors(K)
graph_color <- as.vector(sapply(seq_along(x$data), function(i){
rep(colors[i], ncol(x$data[[i]]))
}))
graph_color <- unlist(graph_color)
# construct the directed network
network <- x$network
indexes <- (x$stability >= stability)
network[!indexes] <- 0
directed_network <- network
sapply(1:K, function(i) {
indexes <- size_list[i] : (size_list[i + 1] - 1)
directed_network[indexes, indexes] <<- 0
})
# construct the undirected network
undirected_network <- network
undirected_network[directed_network!=0] <- 0.0
if (x$rule == "AND") {
undirected_network[!(undirected_network & base::t(undirected_network))] <- 0
}
else {
undirected_network[!(undirected_network | base::t(undirected_network))] <- 0
}
undirected_network <- (undirected_network + base::t(undirected_network)) / 2
# set the ids and get the label names from the input data
ids <- 1 : length(graph_color)
labelnames <- NA
if (!is.null(colnames(x$data[[1]]))) {
labelnames <- as.vector(sapply(x$data, function(x) {
colnames(x)
}))
}
if (is.null(out.file) == FALSE) {
path <- dirname(out.file)
if (file.exists(path) == FALSE) {
dir.create(path)
cat("Create the dir ", path, "\n")
}
}
if (method == "igraph") {
# set the arrow size of directed edges
argv_list <- list(...)
directed_graph <- graph.adjacency(directed_network, weighted = TRUE, mode = "directed")
V(directed_graph)$name <- ids
directed_arrow_size <- 0.3
if ("arrow.size" %in% names(argv_list)) {
directed_arrow_size <- argv_list["arrow.size"]
argv_list["arrow.size"] <- NULL
}
# set the color of undirected edges
undirected_graph <- graph.adjacency(undirected_network, weighted = TRUE, mode = "directed")
V(undirected_graph)$name <- ids
edge_start <- ends(undirected_graph, es=E(undirected_graph), names=F)[,1]
undirected_edge_color <- graph_color[edge_start]
# set the edge width according the edge weight
if(weighted){
E(directed_graph)$width <- 0.5 + abs(E(directed_graph)$weight)
E(undirected_graph)$width <- 0.5 + abs(E(undirected_graph)$weight)
}
argv_list <- c(argv_list, list(vertex.color = graph_color, vertex.label = labelnames,
vertex.size = 30 / as.integer(vcount(directed_graph)/100 + 1) ))
# if user didn't set the layout, set the default layout
if (!"layout" %in% names(argv_list)) {
weight_network <- matrix(0, p, p)
weight_network[directed_network != 0] <- 1
sapply(1:K, function(i) {
indexes <- size_list[i] : (size_list[i + 1] - 1)
weight_network[indexes, indexes] <<- 1})
weight_graph <- graph.adjacency(weight_network, weighted = TRUE)
layout <- layout.fruchterman.reingold(weight_graph, weights=E(weight_graph)$weight)
argv_list <- c(argv_list, list(layout = layout))
}
if(is.null(out.file) == FALSE){
pdf(out.file)
do.call(plot.igraph, c(list(x = directed_graph, edge.arrow.size = directed_arrow_size), argv_list))
do.call(plot.igraph, c(list(x = undirected_graph, add = T, edge.arrow.size = 0, edge.color = undirected_edge_color), argv_list))
dev.off()
cat(paste("Output file: ", out.file, "\n", sep=""))
}
else {
do.call(plot.igraph, c(list(x = directed_graph, edge.arrow.size = directed_arrow_size), argv_list))
do.call(plot.igraph, c(list(x = undirected_graph, add = T, edge.arrow.size = 0, edge.color = undirected_edge_color), argv_list))
}
}
else if (method == "cytoscape") {
undirected_network[lower.tri(undirected_network)] <- 0
mixed_network <- directed_network + undirected_network
mixed_graph <- graph.adjacency(mixed_network, weighted = TRUE, mode = "directed")
g <- igraph.to.graphNEL(mixed_graph)
# set node group
g <- initNodeAttribute (graph = g, attribute.name = 'group',
attribute.type = 'integer',
default.value = 0)
count <- 0
index <- 1
for (node in nodes(g)) {
count <- count + 1
if (count >= size_list[index]) index <- index + 1
graph::nodeData(g, node, 'group') <- index - 1
}
# set edge type attribute
g <- initEdgeAttribute (graph = g, attribute.name = 'edgeType',
attribute.type ='char',
default.value = "undefined")
g <- initEdgeAttribute (graph = g, attribute.name = 'weight',
attribute.type ='numeric',
default.value = 0)
undirected_indexes <- which(undirected_network != 0, arr.ind = T)
for (i in 1 : nrow(undirected_indexes)) {
node <- formatC(undirected_indexes[i,"row"])
group <- graph::nodeData(g, node, 'group')
graph::edgeData(g, from = node, to = formatC(undirected_indexes[i,"col"]), 'edgeType') <- paste("Type", group, sep = "")
}
# display cytoscape windows
cw <- CytoscapeWindow ('test', graph = g, overwriteWindow = TRUE)
displayGraph(cw)
argv_list <- list(...)
if ("layout" %in% names(argv_list)) {
if (!argv_list["layout"] %in% getLayoutNames(cw)) {
stop("The input layout not in getLayoutNames(CytoscapeWindow)!")
}
layout <- argv_list["layout"]
}
else {
layout <- "attributes-layout"
}
layoutNetwork(cw, layout.name = layout)
# set rules
setDefaultNodeShape (cw, 'ELLIPSE')
setDefaultNodeSize (cw, 35)
setDefaultNodeFontSize (cw, 10)
setNodeColorRule(cw, 'group', c(1 : K), colors, mode = 'lookup')
setEdgeTargetArrowRule(cw, 'edgeType', paste('Type', c(1 : K), sep = ""), rep('None', K), default = 'Arrow')
setEdgeTargetArrowColorRule(cw, 'edgeType', paste('Type', c(1 : K), sep = ""), colors, mode = 'lookup')
setEdgeColorRule(cw, 'edgeType', paste('Type', c(1 : K), sep = ""), colors, mode = 'lookup', default.color = '#000000')
if(is.null(out.file) == FALSE) {
if (nchar(out.file) < 4) stop("Out.file should match one of the type c('png', 'pdf', 'svg')")
image_type <- substr(out.file, nchar(out.file) - 2, nchar(out.file))
file_name <- substr(out.file, 1, nchar(out.file) - 4)
match.arg(image_type, c("png", "pdf", "svg"))
redraw (cw)
saveImage(cw, file_name, image.type = image_type)
}
}
else if (method == "cytoscape.js") {
# set node entries
nodes <- data.frame(id = ids, name = labelnames, color = graph_color)
node_entries <- apply(nodes, 1, function(x) {
x[1] = trimws(x[1])
x[2] = trimws(x[2])
list(data = as.list(x))
})
# set edge entries
directed_indexes <- which(directed_network != 0, arr.ind=T)
undirected_network[lower.tri(undirected_network)] <- 0
undirected_indexes <- which(undirected_network != 0, arr.ind=T)
if (weighted) {
edges <- data.frame(source = directed_indexes[,"row"], target = directed_indexes[,"col"],
weight = directed_network[directed_indexes], directed = rep(TRUE, nrow(directed_indexes)))
edges <- rbind(edges, data.frame(source = undirected_indexes[,"row"], target = undirected_indexes[,"col"],
weight = undirected_network[undirected_indexes], directed = rep(FALSE, nrow(undirected_indexes))))
}
else {
edges <- data.frame(source = directed_indexes[,"row"], target = directed_indexes[,"col"],
directed = rep(TRUE, nrow(directed_indexes)))
edges <- rbind(edges, data.frame(source = undirected_indexes[,"row"], target = undirected_indexes[,"col"],
directed = rep(FALSE, nrow(undirected_indexes))))
}
edges_entries <- apply(edges, 1, function(x) {
list(data = as.list(x))
})
cy <- list(nodes = node_entries, edges = edges_entries)
# save file
if(is.null(out.file) == FALSE) {
path <- normalizePath(path)
name <- basename(out.file)
htmlwidgets::saveWidget(Cytoscapejs(cy), file = file.path(path, name), selfcontained = FALSE)
cat(paste("Output file: ", file.path(path, name), "\n", sep=""))
}
else {
Cytoscapejs(cy)
}
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.