1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
|
# Plots a graph that visualizes the state transitions and attractor basins. <attractorInfo> is an object
# of class AttractorInfo. This requires the igraph package.
# If <highlightAttractors> is set, attractor edges are drawn bold.
# If <colorBasins> is true, each basin is drawn in a different color.
# Colors can be provided in <colorSet>.
# <layout> specifies the graph layouting function.
# If <piecewise> is true, subgraphs are layouted separately.
# <basin.lty> and <attractor.lty> specify the line types used to draw states in the basins
# and in the attractors (if <highlightAttractor> is set).
# If <plotIt> is not set, only the igraph object is returned, but no graph is plotted.
# ... provides further graphical parameters for the plot.
# Returns an object of class igraph
plotStateGraph <- function(stateGraph,
highlightAttractors = TRUE,
colorBasins = TRUE,
colorSet,
drawLegend = TRUE,
drawLabels = FALSE,
layout = layout.kamada.kawai,
piecewise = FALSE,
basin.lty = 2,
attractor.lty = 1,
plotIt = TRUE,
colorsAlpha = c(colorBasinsNodeAlpha = .3,
colorBasinsEdgeAlpha = .3,
colorAttractorNodeAlpha = 1,
colorAttractorEdgeAlpha = 1),
...)
{
stopifnot(inherits(stateGraph,"AttractorInfo") ||
inherits(stateGraph,"TransitionTable") ||
inherits(stateGraph,"SymbolicSimulation"))
args <- list(...)
if (!is.null(args$attractorInfo))
{
warning("The parameter \"attractorInfo\" is deprecated. Use \"stateGraph\" instead!")
stateGraph <- args$attractorInfo
}
if(is.null(colorsAlpha) | (length(colorsAlpha) != 4)) {
warning("colorsAlpha parameter not properly specified. Parameter will be set to opaque values (1,1,1,1).")
colorsAlpha <- c(1,1,1,1)
}
if (any(colorsAlpha < 0 | colorsAlpha > 1)) {
warning("colorsAlpha parameters are not in range [0,1] - they will be normalized.")
colorsAlpha <- colorsAlpha/sum(colorsAlpha)
}
if (installed.packages()["igraph","Version"] < package_version("0.6"))
bias <- 1
else
bias <- 0
symbolic <- FALSE
if (inherits(stateGraph,"AttractorInfo"))
{
stateGraph <- getTransitionTable(stateGraph)
} else if (inherits(stateGraph,"SymbolicSimulation")) {
symbolic <- TRUE
if (is.null(stateGraph$graph))
stop(paste("This SymbolicSimulation structure does not contain transition table information.",
"Please re-run simulateSymbolicModel() with returnGraph=TRUE!"))
stateGraph <- stateGraph$graph
}
geneCols <- setdiff(colnames(stateGraph),
c("attractorAssignment","transitionsToAttractor"))
numGenes <- (length(geneCols)) / 2
from <- apply(stateGraph[ , 1:numGenes, drop=FALSE], 1, paste, collapse="")
to <- apply(stateGraph[ , ((numGenes+1):(2*numGenes)), drop=FALSE], 1, paste, collapse="")
vertices <- unique(c(from, to))
edges <- data.frame(from, to)
res <- graph.data.frame(edges, vertices = as.data.frame(vertices), directed=TRUE)
res <- set.vertex.attribute(res, "name", value = vertices)
if ("attractorAssignment" %in% colnames(stateGraph))
attractorAssignment <- stateGraph$attractorAssignment
else
{
attractorAssignment <- c()
colorBasins <- FALSE
drawLegend <- FALSE
}
if ("transitionsToAttractor" %in% colnames(stateGraph))
attractorIndices <- to[stateGraph$transitionsToAttractor == 0]
else
{
if (highlightAttractors) {
warning("The parameter \"highlightAttractors\" is set to true although not enough information is available in stateGraph. Highlightning of attractors will be set to FALSE.")
}
attractorIndices <- c()
highlightAttractors <- FALSE
}
# determine nodes and edges that belong to attractors
# set default edge width and line type
res <- set.edge.attribute(res, "width" , value = 0.8)
res <- set.edge.attribute(res, "lty", value = basin.lty)
if (highlightAttractors)
{
attractorEdgeIndices <- which(apply(edges, 1 , function(edge){
return( (edge[1] %in% attractorIndices) & (edge[2] %in% attractorIndices) )
})) - bias
# set different edge width and line type for attractor edges
res <- set.edge.attribute(res, "width", index = attractorEdgeIndices, value = 2)
res <- set.edge.attribute(res, "lty", index = attractorEdgeIndices, value = attractor.lty)
}
if (missing(colorSet))
{
# define default colors
colorSet <- c("blue","green","red","darkgoldenrod","gold","brown","cyan",
"purple","orange","seagreen","tomato","darkgray","chocolate",
"maroon","darkgreen","gray12","blue4","cadetblue","darkgoldenrod4",
"burlywood2")
}
# check for certain graphical parameters in ...
# that have different default values in this plot
if (is.null(args$vertex.size))
args$vertex.size <- 2
if (is.null(args$edge.arrow.mode))
args$edge.arrow.mode <- 2
if (is.null(args$edge.arrow.size))
args$edge.arrow.size <- 0.3
if (is.null(args$vertex.label.cex))
args$vertex.label.cex <- 0.5
if (is.null(args$vertex.label.dist))
args$vertex.label.dist <- 1
attractors <- unique(attractorAssignment)
attractors <- attractors[!is.na(attractors)]
if (colorBasins)
{
res <- set.edge.attribute(res, "color", value = "darkgrey")
for (attractor in attractors)
{
# determine nodes and edges belonging to the basin of <attractor>
attractorGraphIndices <- NULL
basinIndices <- which(attractorAssignment == attractor)
if(!is.null(stateGraph$transitionsToAttractor)) {
attractorGraphIndices <- intersect(basinIndices, which(stateGraph$transitionsToAttractor == 0))
basinIndices <- base::setdiff(basinIndices, attractorGraphIndices)
}
if (!symbolic)
{
# change vertex color
res <- set.vertex.attribute(res, "color", basinIndices - bias,
value = adjustcolor(colorSet[(attractor-1) %% length(colorSet) + 1],
alpha.f = colorsAlpha[1]))
res <- set.vertex.attribute(res, "frame.color", basinIndices - bias,
value = adjustcolor("black",
alpha.f = colorsAlpha[1]))
if(!is.null(attractorGraphIndices)) {
res <- set.vertex.attribute(res, "color", attractorGraphIndices - bias,
value = adjustcolor(colorSet[(attractor-1) %% length(colorSet) + 1],
alpha.f = colorsAlpha[3]))
res <- set.vertex.attribute(res, "frame.color", attractorGraphIndices - bias,
value = adjustcolor("black",
alpha.f = colorsAlpha[3]))
}
if (drawLabels)
res <- set.vertex.attribute(res,"label.color",basinIndices - bias,
value=colorSet[(attractor-1) %% length(colorSet) + 1])
}
# change edge color
res <- set.edge.attribute(res, "color", index = basinIndices - bias,
value = adjustcolor(colorSet[(attractor-1) %% length(colorSet) + 1], alpha.f = colorsAlpha[2]))
if(!is.null(attractorGraphIndices)) {
res <- set.edge.attribute(res, "color", index = attractorGraphIndices - bias,
value = adjustcolor(colorSet[(attractor-1) %% length(colorSet) + 1], alpha.f = colorsAlpha[4]))
}
}
}
if(plotIt)
{
if (drawLabels)
labels <- vertices
else
labels <- NA
if (piecewise)
layout <- piecewise.layout(res, layout)
if (symbolic)
autocurve.edges(res)
do.call("plot",c(list(res),args,"vertex.label"=list(labels), "layout"=list(layout)))
#plot(res,vertex.size=args$vertex.size,layout=layout,
# edge.arrow.mode=args$edge.arrow.mode,
# vertex.label=labels,vertex.label.cex=args$vertex.label.cex,
# vertex.label.dist=args$vertex.label.dist,
# ...)
if (colorBasins & drawLegend)
legend(x="bottomleft",pch=15,ncol=1,
col=colorSet[attractors-1 %% length(colorSet) + 1],
legend = paste("Attractor",seq_along(attractors)),
cex=0.5)
}
return(invisible(res))
}
|
