#
# This file is part of the CNO software
#
# Copyright (c) 2011-2012 - EMBL - European Bioinformatics Institute
#
# File author(s): CNO developers (cno-dev@ebi.ac.uk)
#
# Distributed under the GPLv3 License.
# See accompanying file LICENSE.txt or copy at
# http://www.gnu.org/licenses/gpl-3.0.html
#
# CNO website: http://www.cellnopt.org
#
##############################################################################
# $Id$
plotModel <- function(model, CNOlist=NULL, bString=NULL, indexIntegr=NULL,
signals=NULL, stimuli=NULL, inhibitors=NULL, NCNO=NULL, compressed=NULL,
output="STDOUT", filename=NULL,graphvizParams=list(), show=TRUE, remove_dot=TRUE,removeEmptyAnds=TRUE){
# Quick example:
# ---------------
# filename = "ToyPKNMMB.sif"
# g = plotModel(model, cnolist=cnolist)
# # g$graph contains the model transformed into a graph object
# user parameters to refine the layout, color, ...
if (is.null(graphvizParams$arrowsize)==TRUE) {
graphvizParams$arrowsize=2
}
if (is.null(graphvizParams$size)==TRUE) {
graphvizParams$size="15,15"
}
if (is.null(graphvizParams$fontsize)==TRUE) {
graphvizParams$fontsize=22
}
if (is.null(graphvizParams$edgecolor)==TRUE) {
graphvizParams$edgecolor="black"
}
if (is.null(graphvizParams$nodeLabels)==TRUE) {
graphvizParams$nodeLabels=NULL
}
if (is.null(graphvizParams$nodeWidth)==TRUE) {
graphvizParams$nodeWidth=2
}
if (is.null(graphvizParams$nodeHeight)==TRUE) {
graphvizParams$nodeHeight=1
}
if (is.null(graphvizParams$viewEmptyEdges)==TRUE) {
graphvizParams$viewEmptyEdges = TRUE
}
# mode must be before andWidth and andHeight
if (is.null(graphvizParams$mode)==TRUE) {
graphvizParams$mode = "sbgn"
}
if (graphvizParams$mode %in% c("sbgn", "classic") == FALSE){
stop("mode must be in 'classic' or 'sbgn'")
}
if (is.null(graphvizParams$andWidth)==TRUE) {
if (graphvizParams$mode == "classic"){
graphvizParams$andWidth = 0.2
}
if (graphvizParams$mode == "sbgn"){
graphvizParams$andWidth = 0.5
}
}
if (is.null(graphvizParams$andHeight)==TRUE) {
if (graphvizParams$mode == "classic"){
graphvizParams$andHeight = 0.2
}
if (graphvizParams$mode == "sbgn"){
graphvizParams$andHeight = 0.5
}
}
# Some required library to build the graph and plot the results using
# graphviz. -already loaded by Depends fiels of Description
# library(Rgraphviz)
# library(RBGL)
# Set the output filename
if (is.null(filename)){
filename="model"
output_dot = "model.dot"
}
else{
output_dot = paste(filename, ".dot", sep="")
}
# Set the image format if any
if (output %in% c("STDOUT", "PDF", "PNG", "SVG") != TRUE){
stop("wrong output format.Must be in PDF, PNG, SVG")
}
else{
if (output=="PDF"){
pdf(paste(filename, ".pdf", sep=""))
}
else if (output=="PNG"){
png(paste(filename, ".png", sep=""))
}
else if (output=="SVG"){
svg(paste(filename, ".svg", sep=""), pointsize=22, width=10, height=10)
}
}
# If the cnolist is a NULL, nothing to do
if (is.null(CNOlist)==TRUE){
cnolist = NULL
} else { # if not a CNOlist, try to convert it
if (!is(CNOlist,"CNOlist")){
cnolist = CellNOptR::CNOlist(CNOlist)
} else{
cnolist = CNOlist
}
}
# TODO: The following piece of code should be made modular
# Input data. If the model is a character, we guess that the user provided
# the MODEL filename (sif format) that we can read directly.
if (typeof(model) == "character"){
raw = read.table(model) # read the PKN data
# build the unique vertices from the column 1 and 3 of the SIF file
vertices = unique(c(as.character(raw$V1), as.character(raw$V3)))
v1 = raw$V1 # alias to vertices in column 1
v2 = raw$V3 # alias to vertices in column 2
edges = raw$V2 # alias to the edges
if (is.null(bString)){# default is only 1 so all edges are accepted
BStimes<-rep(1,length(edges))
}else{
BStimes<-bString
}
Integr<-rep(0,length(edges)) #
}
# otherwise, the user probably provided the model already read by readSIF
# in which case, and gates must be extracted from strings such as
# "node1+node2=node3"
# This block is the tricky part of the function. Change with care.
else if (typeof(model)=="list" && any("namesSpecies" == names(model))){
if (length(bString)!=length(model$reacID) & is.null(bString)==FALSE){
stop(paste("If the bString argument is provided it must have the same",
" length as model$reacID. ", "The model has ", length(model$reacID),
" edges whereas the bitstring has a length of ", length(bString), sep=""))
}
# namesSpecies == names(model) try to check if model resemble the output of readSIF ?
# ideally we should have a type.
# build the unique vertices from the nameSpecies
vertices = model$namesSpecies
# now, we need to split the reaction to get back the different edges
mysplit = function(x){strsplit(x, "=")}
reacs = mysplit(model$reacID) # separate the reactions into left and right parts
tmp <- unlist(mysplit(model$reacID))
reacs = t(matrix(unlist(mysplit(model$reacID)), ncol=length(tmp)/2)) # reordering
# Use the bString and indexIntegr input arguments to build up
if (is.null(bString)){# default is only 1 so all edges are accepted
optimBStimes<-rep(1,dim(reacs)[1])
}else{
optimBStimes<-bString
}
optIntegr<-rep(0,length(optimBStimes))
if (is.null(indexIntegr)==FALSE){
optIntegr[indexIntegr]<-1
}
# finally, build the v1, v2 and edges
BStimes<-vector()
Integr<-vector()
CountReac<-1
CountAnds<-1
mysplit2 = function(x){strsplit(x, "+", fixed=TRUE)}
v1<-vector()
v2<-vector()
edges<-vector()
for (i in 1:dim(reacs)[1]){
inputs<-unlist(strsplit(reacs[i,1],"+", fixed=TRUE))
if (length(inputs)==1){
v1[CountReac] = reacs[i,1]
edges[CountReac] = 1
v2[CountReac] = reacs[i,2]
if (length(grep("!", v1))){
v1[CountReac] = sub("!", "", v1[CountReac])
edges[CountReac] = -1
}
BStimes[CountReac]<-optimBStimes[i]
Integr[CountReac]<-optIntegr[i]
CountReac<-CountReac+1
}else{
for (j in seq_along(inputs)){
v1[CountReac]<-inputs[j]
edges[CountReac] = 1
v2[CountReac]<-paste("and",CountAnds,sep="")
if (length(grep("!", v1[CountReac]))){
v1[CountReac] = sub("!", "", v1[CountReac])
edges[CountReac] = -1
}
BStimes[CountReac]<-optimBStimes[i]
Integr[CountReac]<-optIntegr[i]
CountReac<-CountReac+1
}
v1[CountReac]<-paste("and",CountAnds,sep="")
edges[CountReac] = 1
v2[CountReac] = reacs[i,2]
BStimes[CountReac]<-optimBStimes[i]
Integr[CountReac]<-optIntegr[i]
CountReac<-CountReac+1
vertices<-c(vertices,paste("and",CountAnds,sep=""))
CountAnds<-CountAnds+1
}
}
}
if (is.null(cnolist) == FALSE){ # if a cnolist is provided, fill
# signals/stimulis/inhitors
stimuli <- colnames(cnolist@stimuli)
signals <- colnames(cnolist@signals[[1]])
inhibitors <- colnames(cnolist@inhibitors)
}
# check that the signal and stimuli are indeed in the list of vertices
# otherwise they will be failures later.
if (all(signals %in% vertices)==FALSE){
msg = signals[signals %in% vertices == FALSE]
print("Those signals were not found in the vertices: ")
print(msg)
vertices = union(vertices,signals) # add it here to avoid failures in create_layout()
}
# build the edges. IGraph does not use names for the vertices but ids
# that starts at zero. Let us build a data.frame to store the correspondence
# between the ids and names.
l = length(vertices) - 1
# build the graph
g <- new("graphNEL", nodes=vertices, edgemode="directed")
weights = rep(1, length(v1)) # for now, the weights are to 1.
for (i in 1:length(v1)){
g <- addEdge(as.character(v1[i]), as.character(v2[i]), g, weights[i])
}
# The graph is now built. We can proceed with node and edge attributes for
# the output files
recipEdges="distinct" # an edge A->B does not overlap with B->A
# --------------------------------------- Build the node and edges attributes list
nodeAttrs = createNodeAttrs(g, vertices, stimuli, signals, inhibitors, NCNO,
compressed, graphvizParams)
res = createEdgeAttrs(v1, v2, edges, BStimes, Integr,
user_edgecolor=graphvizParams$edgecolor,
view_empty_edge=graphvizParams$viewEmptyEdges,removeEmptyAnds=removeEmptyAnds)
# an alias
edgeAttrs = res$edgeAttrs
# createEdge returns the edgeAttrs and a list of edges that correspond to a
# bistring element that is zero. In such case, the edge is useless and can
# be removed.
toremove = res$toremove
for (x in toremove){
y = unlist(strsplit(x, "~"))
g = removeEdge(y[1], y[2], g)
}
# Some nodes are now connected to no other nodes. These nodes can be
# removed. In principle, this is only "and" nodes.
orphans = nodes(g)[(degree(g)$inDegree + degree(g)$outDegree) ==0]
for (x in orphans){
if (x %in% stimuli == FALSE & x %in% inhibitors == FALSE & x %in% signals == FALSE){
g = removeNode(x, g)
# What was returned by createEdgeAttrs in now obsolet and need some cleanup
f<-function(y){return(x %in% strsplit(y, "~", fixed=TRUE)[[1]])}
indices = lapply(names(edgeAttrs$color), f) == TRUE
edgeAttrs$color[indices] <-NULL
edgeAttrs$label[indices] <-NULL
edgeAttrs$lty[indices] <-NULL
edgeAttrs$arrowhead[indices] <-NULL
edgeAttrs$penwidth[indices] <-NULL
}
}
# we must rebuild the edges attributes
# --------------------------- the ranks computation for the layout
clusters = create_layout(g, signals, stimuli)
# ------------------------------ general attributes
# for some obscure reasons, must set style="filled" right her even though it
# is then overwritten by nodesAttrs$style later on otherwise the output.dot
# does not contain any style option
# size does not seem to work in Rgraphviz version 1.32 wait and see for new version.
fontsize=graphvizParams$fontsize
attrs <- list(
node=list(fontsize=fontsize,fontname="Helvetica",style="filled,bold"),
edge=list(style="solid",penwidth=1,weight="1.0",arrowsize=graphvizParams$arrowsize,minlen=3),
graph=list(splines=TRUE,size=graphvizParams$size,bgcolor="white",ratio="fill",pad="0.5,0.5",dpi=72)
)
copyg <- g
# current version of Rgraphviz (1.32 feb 2012) does not handle edgewidth
# properly. A
if (installed.packages()[,"Version"]["Rgraphviz"] <= "1.33.0"){
#nodeAttrs$lty = "solid"
print("plotModel: please upgrade to Rgraphviz >1.33.0 for best output")
nodelty = "solid"
savedEdgeAttrs = edgeAttrs$color
edgeAttrs$color = NULL
}
else{
nodelty=nodeAttrs$lty
}
# Set the node Rendering in Rgraphviz
nodeRenderAttrs <- setNodeRenderInfo(nodeAttrs, list(lwd=2, lty=nodelty,
cex=0.4, fontsize=fontsize, fixedsize=FALSE))
nodeRenderInfo(g) <- nodeRenderAttrs
# the arrowhead "normal" is buggy in Rgraphviz version 1.32 so switch to
# "open" for now. However, the dot output keeps using the normal arrow.
arrowhead2 = edgeAttrs$arrowhead
#arrowhead2[arrowhead2=="normal"] = "open"
# this statement must set recipEdges before calling edgeRenderInfo
# otherwise feedback loops are not shown properly.
graphRenderInfo(g) <- list(recipEdges=recipEdges)
edgeRenderAttrs <- setEdgeRenderInfo(edgeAttrs,
list(arrowhead=arrowhead2, head=v2, tail=v1,
lwd=3, lty="solid"))
edgeRenderInfo(g) <- edgeRenderAttrs
# Set the edge Rendering in Rgraphviz
# edgeRenderInfo(g) <- list(
# col=edgeAttrs$color,
# arrowhead=arrowhead2,
# head=v2,
# tail=v1,
# label=edgeAttrs$label,
# lwd=3,
# lty="solid" #this fails in some cases even with version >=1.33.1
# )
# hack for version of Rgraphviz 1.32. Set back the edgeAttr for the dot
# output
if (installed.packages()[,"Version"]["Rgraphviz"] <= "1.33.0"){
edgeAttrs$color = savedEdgeAttrs
}
if (is.null(clusters)==TRUE){
# finally, the layout for a R plot
if (show==TRUE){
x <- layoutGraph(g,layoutType="dot",recipEdges=recipEdges,attrs=attrs)
renderGraph(x)
nodeRenderInfo(x) <- nodeRenderAttrs
}
#edgeRenderInfo(x) <- edgeRenderAttrs
edgeAttrs$lty=NULL # why ?
toDot(copyg, output_dot, nodeAttrs=nodeAttrs,edgeAttrs=edgeAttrs,attrs=attrs, recipEdges=recipEdges)
# bug introduced in Rgraphviz 1.34 that set node attributes border.lwd
# and border.color that are not understood by dot. Best solution is to
# change Rgraphviz but large latency so we can change the written files
# afterwards to change the dot file itself
clean_dot(output_dot)
}
else{
# finally, the layout for a R plot
#attrs$node = nodeRenderInfo(g)
#attrs$edge = edgeRenderInfo(g)
if (show==TRUE){
x <- layoutGraph(g,layoutType="dot",subGList=clusters,recipEdges=recipEdges,attrs=attrs)
# known bug in Rgraphviz: renderInfo should be called again after the
# layout otherwise some attributes are lost in the renderGraph (e.g.,
# color)
# note that rendering is now made on x variable (not g)
nodeRenderInfo(x) <- nodeRenderAttrs
edgeRenderInfo(x) <- edgeRenderAttrs
renderGraph(x)
}
# and save into dot file.
toDot(copyg, output_dot, nodeAttrs=nodeAttrs, subGList=clusters,
attrs=attrs, recipEdges=recipEdges, edgeAttrs=edgeAttrs)
# bug introduced in Rgraphviz 1.34 that set node attributes border.lwd
# and border.color that are not understood by dot. Best solution is to
# change Rgraphviz but large latency so we can change the written files
# afterwards to change the dot file itself
#
# dot files can be read in Cytoscape but subgraphs produce an error.
# MAke sure to remove them before visualisation.
clean_dot(output_dot)
}
if (output != "STDOUT"){dev.off()}
if (remove_dot==TRUE){file.remove(output_dot)}
output = list(graph=g, attrs=attrs, nodeAttrs=nodeAttrs, edgeAttrs=edgeAttrs,clusters=clusters, v1=v1, v2=v2, edges=edges)
}
# if a cnolist, or at least signals/stimuli, then we can create ranking for the
# layout
create_layout <- function(g, signals, stimuli){
# this algo will tell us the distance between vertices
# distMatrix columns contains the distance from a vertex to the others
distMatrix <- floyd.warshall.all.pairs.sp(g)
#distMatrix <- johnson.all.pairs.sp(g)
distMatrix[is.infinite(distMatrix) == TRUE] <- -Inf # convert -Inf to be able to grep numbers
# if signals provided by the user is empty, let us find ourself the nodes
# with input degrees set to zero:
if (is.null(stimuli)==TRUE){
stimuli = nodes(g)[degree(g)$inDegree==0]
}
# we will need to know the sinks, which are defined by an outDegree equal to
# zero. Yet, if signals are already provided, we want to restrict the sinks
# to this subsets.
if (is.null(signals)==TRUE){
sinks <- nodes(g)[degree(g)$outDegree == 0]
}
else{
sinks <- signals[degree(g, signals)$outDegree == 0]
}
# compute max rank for each column
ranks <- apply(distMatrix, 2, max)
mrank = max(ranks, na.rm=TRUE)-1 # -1 because we already know the sinks
if (mrank == -Inf){
print("Issue while computing max rank. Skipping the clustering step");
return (NULL)
}
clusters <- list()
if (mrank >= 1){ # otherwise, nothing to do.
# for each different rank select the names of the column to create a
# cluster
for (rank in 1:mrank){ # starts at 1 although ranks starts at 0.
# However, 0 corresponds to the source that are
# known already
# nodes found for a particular rank may contain a sink, that should
# be removed
# some ranks might not contain any nodes (rank is derived from shortest distance.) -- then we skip for next.
nodes2keep = NULL
nodes <- names(ranks[which(ranks==rank)])
if(length(nodes)==0) next()
for (n in nodes){
if (any(n==sinks) == FALSE){ nodes2keep <- c(nodes2keep, n)}
}
if(length(nodes2keep)==0) next()
# may fail sometimes
tryCatch({
thisCluster <- subGraph(nodes2keep, g)
thisGraph <-list(graph=thisCluster,cluster=FALSE,attrs=c(rank="same"))
clusters[[length(clusters)+1]] = thisGraph},
error=function(e){
#print(rank)
print("warning: clustering in the layout failed. carry on...")})
}
}
# first the stimulis
tryCatch(
{
tryCatch({
clusterSource <- subGraph(stimuli, g);
clusterSource<-list(graph=clusterSource,cluster=FALSE,attrs=c(rank="source"))},
error=function(e){
print("error during clustering in subGraph(stimuli, g)? Does the stimuli from your MIDAS are present in the model?"); print(stimuli)
})
tryCatch(
{clusters[[length(clusters)+1]] = clusterSource},
error=function(e){print("error in clusters2. should never be here")}
)
},
error=function(e){print("warning: clustering the source/stimuli failed. carry on...")}
)
# then the signals keeping only those with outDegree==0
tryCatch(
{
clusterSink <- subGraph(sinks, g)
clusterSink <- list(graph=clusterSink, cluster=FALSE, attrs=c(rank="sink"))
tryCatch(
{clusters[[length(clusters)+1]] = clusterSink},
error=function(e){print("error in clusters3. should never be here")}
)
}, error=function(e){print("warning: clustering the sink failed. carry on...")}
)
return(clusters)
}
# Create the node attributes and save in a list to be used either by the
# plot function of the nodeRenderInfo function.
createNodeAttrs <- function(g, vertices, stimuli, signals, inhibitors, NCNO,
compressed, graphvizParams){
nodeLabels = graphvizParams$nodeLabels
nodeWidth = graphvizParams$nodeWidth
nodeHeight = graphvizParams$nodeHeight
andHeight = graphvizParams$andHeight
andWidth = graphvizParams$andWidth
mode = graphvizParams$mode
# ----------------------------------------------- Build the node attributes list
fillcolor <- list()
color <- list()
style <- list() # the style of what is inside the node.
lty <- list() #style of the contour node
height <-list()
label <- list()
width <- list()
fixedsize <- list()
shape <- list()
# default. Must be filled in case no signals/stimulis/cnolist are provided
# Default node attributes
for (s in vertices){
color[s] <- "black" # color edge
fillcolor[s] <- "white" # fill color
style[s] <- "filled,bold"
lty[s] <- "solid"
label[s] <- s
height[s] <- nodeHeight
width[s] <- nodeWidth
fixedsize[s] <- FALSE
shape[s] <- "rectangle"
}
# user can provide a list of labels for the nodes. Usuful to show attributes
# of a node.
if (is.null(nodeLabels)==FALSE){
names(nodeLabels)<-vertices
if (length(nodeLabels)!=length(vertices)){
stop("if nodeLabels provided, it must be of same size as vertices")
}
else{
for (s in vertices){
label[s] = nodeLabels[s]
}
}
}
# The stimulis node
for (s in stimuli){
fillcolor[s] <- "olivedrab3";
color[s] <- "olivedrab3";
style[s] <- "filled"
color[s] <- "black";
}
# The signal nodes
for (s in signals){ #must be before the inhibitors to allow bicolors
fillcolor[s] <- "lightblue";
color[s] <-"lightblue";
color[s] <- "black";
}
# The inhibitor node, that may also belong to the signal category.
for (s in inhibitors){
if (length(grep(s, signals))>=1){
#fillcolor[s] <- "SkyBlue2"
shape[s]="ellipse"
style[s] <- "filled,bold"
color[s] <-"orangered"
} else {
if (length(grep(s, stimuli))>=1){
#fillcolor[s] <- "SkyBlue2"
shape[s]="ellipse"
style[s] <- "filled,bold"
color[s] <-"orangered"
}
else{
fillcolor[s] <- "orangered";
color[s] <-"orangered";
color[s] <- "black";
}
}
}
# The compressed nodes
for (s in compressed){
fillcolor[s] <- "white";
color[s] <- "black";
style[s] <- "dashed,bold";
lty[s]="dashed";
}
# The NCNO node
for (s in NCNO){
fillcolor[s] <- "white";
color[s] <- "grey";
fillcolor[s] = "grey"
}
# the and gate nodes
for (s in vertices){
if (length(grep("^and", s))>=1){
color[s] = "black"
if (mode=="sbgn"){
fillcolor[s] = "white"
label[s] = "and"
} else{
fillcolor[s] = "black"
label[s] = ""
}
width[s]=andWidth
height[s]=andHeight
fixedsize[s]=FALSE
shape[s]="circle"
if (degree(g)$inDegree[s]==3){
#fillcolor[s] = "blue"
if (mode=="classic"){
shape[s]="triangle"
}
width[s]=andWidth
height[s]=andHeight
}
if (degree(g)$inDegree[s]==4){
#fillcolor[s] = "blue"
if (mode=="classic"){
shape[s]="rectangle"
}
width[s]=andWidth
height[s]=andHeight
}
}
}
nodeAttrs <- list(fillcolor=fillcolor, color=color, label=label, width=width, height=height,
style=style, lty=lty, fixedsize=fixedsize, shape=shape)
return(nodeAttrs)
}
# Create the node attributes and save in a list to be used either by the
# plot function of the edgeRenderInfo function.
createEdgeAttrs <- function(v1, v2, edges, BStimes ,Integr, user_edgecolor,
view_empty_edge=TRUE,removeEmptyAnds=TRUE){
edgewidth_c = 3 # default edge width
# The edge attributes
arrowhead <- list()
edgecolor <- list()
edgewidth <- list()
label <- list()
toremove <- list()
lty <- list() # not used yet.
for (i in 1:length(edges)){
edgename = paste(v1[i], "~", v2[i], sep="")
edgewidth[edgename] = edgewidth_c # default edgewidth
label[edgename] = "" # no label on the edge by default
lty[edgename] = "solid"
edgecolor[edgename] = "black" # set a default (useless but safe)
if (edges[i] == 1){
arrowhead[edgename] <- "normal"
edgecolor[edgename] <- user_edgecolor
if (Integr[i]==1){edgecolor[edgename] <- "purple"}
}
else if (edges[i] == -1){
arrowhead[edgename] <- "tee"
edgecolor[edgename] <- "red"
if (Integr[i]==1){edgecolor[edgename] <- "purple"}
}
else{
arrowhead[edgename] <- "normal"
edgecolor[edgename] <- "blue"
}
# BStimes contains the bitstring. color the edges according to its value
v = (BStimes[i]*100)%/%1
# width of the edges
if (v != 100){
# first, let us build the color
if (edgecolor[edgename] == 'red'){
# if red, go from red to light pink color according to v value
if (view_empty_edge==TRUE){
print("showing red link even if empty")
color = rgb(1,1-(max(20,v)/100),1-(max(20,v)/100))
}
else{
color = rgb(1,1-v/100,1-v/100)
}
}
else if (edgecolor[edgename] == 'black'){
# if black, go from grey dark to grey light color according to v value
if (view_empty_edge==TRUE){
color = paste("grey", as.character(100.-max(20,v)), sep="")
}
else{
color = paste("grey", as.character(100.-v), sep="")
}
}
else{
# otherwise, just keep the color identical and only add label
color = edgecolor[edgename]
}
# now, we fill the fields with color and width
if (v == 0){
edgewidth[edgename] = edgewidth_c*(10./100)
edgecolor[edgename] = color
if(removeEmptyAnds){# and gates that have no link are removed.
if (length(grep("and", edgename))>=1){
toremove <- append(toremove, edgename)
}
}
}
else{
edgecolor[edgename] = color
edgewidth[edgename] = edgewidth_c*(v/100)
if (v!=0){
label[edgename] = as.character(v)
}else{label[edgename]="0"}
}
}
else {
#already set at the beginning of the loop: width = edgewidth_c
}
}
edgeAttrs <- list(color=edgecolor,arrowhead=arrowhead,
penwidth=edgewidth,label=label, lty=lty)
return(list(toremove=toremove, edgeAttrs=edgeAttrs))
}
clean_dot <- function(filename)
{
savedata = readLines(filename)
data = savedata
for (i in 1:length(data)){
data[i] = sub("border.lwd=1,", "", data[i])
data[i] = sub("border.color=black", "", data[i])
}
# if died, need to save back the "savedata"
# otherwise, we can overwrite model.dot
tryCatch(write(data, file=filename), error=function(e){print("Could not scan the dot file for cleaning (border.lwd and border.color). "); })
}
# Create the list of attributes for the nodes
setNodeRenderInfo <- function(nodeAttrs, extraAttrs)
{
attrs <- list(
fill=nodeAttrs$fillcolor,
col=nodeAttrs$color,
style=nodeAttrs$style,
lty=extraAttrs$lty,
lwd=extraAttrs$lwd,
label=nodeAttrs$label,
shape=nodeAttrs$shape,
cex=extraAttrs$cex,
fontsize=extraAttrs$fontsize,
iwidth=nodeAttrs$width,
iheight=nodeAttrs$height,
fixedsize=extraAttrs$fixedsize)
return(attrs)
}
# Create the list of attributes for the edges
setEdgeRenderInfo <- function(edgeAttrs, extraAttrs)
{
attrs <- list(
col=edgeAttrs$color,
arrowhead=extraAttrs$arrowhead,
head=extraAttrs$v2,
tail=extraAttrs$v1,
label=edgeAttrs$label,
lwd=extraAttrs$lwd,
lty=extraAttrs$lty #this fails in some cases even with version >=1.33.1
)
return(attrs)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.