Bugfixes: improve multi-line labels, improve layouting
... | ... |
@@ -4,7 +4,12 @@ setMethod("getPoints", "xyPoint", function(object) c(object@x, object@y)) |
4 | 4 |
setMethod("show", "xyPoint", function(object) |
5 | 5 |
cat(paste("x: ", object@x, ", y: ", object@y, "\n", sep=""))) |
6 | 6 |
|
7 |
-setMethod("labelText", "AgTextLabel", function(object) object@labelText) |
|
7 |
+setMethod("labelText", "AgTextLabel", function(object) { |
|
8 |
+ text <- object@labelText |
|
9 |
+ text <- gsub('\\n', '\n', text, fixed=T) |
|
10 |
+ text <- gsub('\\r', '\r', text, fixed=T) # only these two as per Graphviz lib/common/labels.c:make_simple_label |
|
11 |
+ return(text) |
|
12 |
+}) |
|
8 | 13 |
setMethod("labelColor", "AgTextLabel", function(object) object@labelColor) |
9 | 14 |
setMethod("labelLoc", "AgTextLabel", function(object) object@labelLoc) |
10 | 15 |
setMethod("labelJust", "AgTextLabel", function(object) object@labelJust) |
... | ... |
@@ -1,4 +1,4 @@ |
1 |
-graphLayout <- function(graph, layoutType=graph@layoutType) |
|
1 |
+graphLayout <- function(graph, layoutType=graph@layoutType, size=NULL) |
|
2 | 2 |
{ |
3 | 3 |
if (is(graph,"graph")) |
4 | 4 |
stop("Please use function agopen() for graph objects") |
... | ... |
@@ -6,9 +6,9 @@ graphLayout <- function(graph, layoutType=graph@layoutType) |
6 | 6 |
if (!is(graph,"Ragraph")) |
7 | 7 |
stop("Object is not of class Ragraph") |
8 | 8 |
|
9 |
- if ( graph@layoutType != layoutType || !graph@laidout ) { |
|
9 |
+ if ( graph@layoutType != layoutType || !graph@laidout || !is.null(size)) { |
|
10 | 10 |
graph@layoutType <- layoutType |
11 |
- z <- .Call("Rgraphviz_doLayout", graph, layoutType, |
|
11 |
+ z <- .Call("Rgraphviz_doLayout", graph, layoutType, size, |
|
12 | 12 |
PACKAGE="Rgraphviz"); |
13 | 13 |
} else { |
14 | 14 |
z <- graph |
... | ... |
@@ -12,7 +12,7 @@ setMethod("plot", "graph", |
12 | 12 |
warning("graph has zero nodes; cannot layout\n") |
13 | 13 |
return(invisible(x)) |
14 | 14 |
} |
15 |
- |
|
15 |
+ |
|
16 | 16 |
if (missing(y)) y <- "dot" |
17 | 17 |
|
18 | 18 |
recipEdges <- match.arg(recipEdges) |
... | ... |
@@ -31,17 +31,13 @@ setMethod("plot", "Ragraph", |
31 | 31 |
sub=NULL, cex.sub=NULL, col.sub="black", |
32 | 32 |
drawNode=drawAgNode, xlab, ylab, mai) { |
33 | 33 |
|
34 |
- ## layout graph |
|
35 |
- if ( missing(y) ) y <- x@layoutType |
|
36 |
- x <- graphLayout(x, y) |
|
37 |
- |
|
38 | 34 |
plot.new() |
39 | 35 |
|
40 | 36 |
bg <- if ( x@bg != "" ) x@bg else par("bg") |
41 | 37 |
fg <- if ( x@fg != "" ) x@fg else par("fg") |
42 | 38 |
oldpars <- par(bg = bg, fg = fg) |
43 | 39 |
on.exit(par(oldpars), add = TRUE) |
44 |
- |
|
40 |
+ |
|
45 | 41 |
if (missing(mai)) { |
46 | 42 |
mheight <- if(!is.null(main) && nchar(main) > 0) |
47 | 43 |
sum(strheight(main, "inches", cex.main)) + 0.3 else 0.1 |
... | ... |
@@ -52,18 +48,22 @@ setMethod("plot", "Ragraph", |
52 | 48 |
oldpars <- par(mai = mai) |
53 | 49 |
on.exit(par(oldpars), add = TRUE) |
54 | 50 |
if(!is.null(sub)||!is.null(main)) |
55 |
- title(main, sub, cex.main = cex.main, col.main = col.main, |
|
51 |
+ title(main, sub, cex.main = cex.main, col.main = col.main, |
|
56 | 52 |
cex.sub = cex.sub, col.sub = col.sub) |
57 |
- |
|
53 |
+ |
|
54 |
+ ## layout graph |
|
55 |
+ if ( missing(y) ) y <- x@layoutType |
|
56 |
+ x <- graphLayout(x, y, sprintf("%f,%f", par("pin")[1], par("pin")[2])) |
|
57 |
+ |
|
58 | 58 |
ur <- upRight(boundBox(x)) |
59 | 59 |
bl <- botLeft(boundBox(x)) |
60 | 60 |
plot.window(xlim = c(getX(bl), getX(ur)), |
61 | 61 |
ylim = c(getY(bl), getY(ur)), |
62 | 62 |
log = "", asp = NA, ...) |
63 |
- |
|
63 |
+ |
|
64 | 64 |
if(!missing(xlab) && !missing(ylab)) |
65 | 65 |
stop("Arguments 'xlab' and 'ylab' are not handled.") |
66 |
- |
|
66 |
+ |
|
67 | 67 |
## determine whether node labels fit into nodes and set "cex" accordingly |
68 | 68 |
agn <- AgNode(x) |
69 | 69 |
nodeDims <- sapply(agn, function(n) { |
... | ... |
@@ -83,7 +83,7 @@ setMethod("plot", "Ragraph", |
83 | 83 |
oldpars <- par(cex=cex) |
84 | 84 |
on.exit(par(oldpars), add = TRUE) |
85 | 85 |
} |
86 |
- |
|
86 |
+ |
|
87 | 87 |
## draw |
88 | 88 |
if (length(drawNode) == 1) { |
89 | 89 |
lapply(agn, drawNode) |
... | ... |
@@ -99,12 +99,12 @@ setMethod("plot", "Ragraph", |
99 | 99 |
} |
100 | 100 |
|
101 | 101 |
## Use the smallest node radius as a means to scale the size of |
102 |
- ## the arrowheads -- in INCHES! see man page for "arrows", |
|
102 |
+ ## the arrowheads -- in INCHES! see man page for "arrows", |
|
103 | 103 |
arrowLen <- par("pin")[1] / diff(par("usr")[1:2]) * min(nodeDims) / pi |
104 |
- |
|
104 |
+ |
|
105 | 105 |
## Plot the edges |
106 | 106 |
lapply(AgEdge(x), lines, len=arrowLen, edgemode=edgemode, ...) |
107 |
- |
|
107 |
+ |
|
108 | 108 |
invisible(x) |
109 | 109 |
}) |
110 | 110 |
|
... | ... |
@@ -123,7 +123,7 @@ drawAgNode <- function(node) { |
123 | 123 |
shape <- shape(node) |
124 | 124 |
|
125 | 125 |
## Normal Rgraphviz defaults to circle, but DOT defaults to ellipse |
126 |
- if (shape =="") shape <- "ellipse" |
|
126 |
+ if (shape =="") shape <- "ellipse" |
|
127 | 127 |
|
128 | 128 |
if (fg == "") fg <- "black" |
129 | 129 |
bg <- fillcolor(node) |
... | ... |
@@ -137,8 +137,8 @@ drawAgNode <- function(node) { |
137 | 137 |
"ellipse" = ellipse(x=nodeX, y=nodeY, height=height, width=rad*2, fg=fg, bg=bg), |
138 | 138 |
"box"=, |
139 | 139 |
"rect"=, |
140 |
- "rectangle" = rect(nodeX-lw, nodeY-(height/2), |
|
141 |
- nodeX+rw, nodeY+(height/2), |
|
140 |
+ "rectangle" = rect(nodeX-lw, nodeY-(height/2), |
|
141 |
+ nodeX+rw, nodeY+(height/2), |
|
142 | 142 |
col=bg, border=fg), |
143 | 143 |
"plaintext"= { if (style == "filled") |
144 | 144 |
rect(nodeX-lw, nodeY-(height/2), |
... | ... |
@@ -11,11 +11,13 @@ graphLayout(graph, layoutType=graph@layoutType) |
11 | 11 |
\arguments{ |
12 | 12 |
\item{graph}{An object of type \code{Ragraph}} |
13 | 13 |
\item{layoutType}{layout algorithm to use} |
14 |
+ \item{size}{Size in inches, given as string of the form "width,height". Can be NULL.} |
|
14 | 15 |
} |
15 | 16 |
\details{ |
16 |
- If the graph has already been laid out, this function merely returns |
|
17 |
- its parameter. Otherwise, it will perform a libgraph layout and |
|
18 |
- retrieve the appropriate location information. |
|
17 |
+ If the graph has already been laid out and \code{size} is \code{NULL}, |
|
18 |
+ this function merely returns its parameter. Otherwise, it will perform |
|
19 |
+ a libgraph layout and retrieve the appropriate location information. |
|
20 |
+ If \code{size} is not NULL, the layout will try to match the given size. |
|
19 | 21 |
} |
20 | 22 |
\value{ |
21 | 23 |
A laid out object of type \code{Ragraph}. |
... | ... |
@@ -4,7 +4,7 @@ static const R_CallMethodDef R_CallDef[] = { |
4 | 4 |
{"Rgraphviz_agread", (DL_FUNC)&Rgraphviz_agread, 1}, |
5 | 5 |
{"Rgraphviz_agwrite", (DL_FUNC)&Rgraphviz_agwrite, 2}, |
6 | 6 |
{"Rgraphviz_agopen", (DL_FUNC)&Rgraphviz_agopen, 6}, |
7 |
- {"Rgraphviz_doLayout", (DL_FUNC)&Rgraphviz_doLayout, 2}, |
|
7 |
+ {"Rgraphviz_doLayout", (DL_FUNC)&Rgraphviz_doLayout, 3}, |
|
8 | 8 |
|
9 | 9 |
{"Rgraphviz_graphvizVersion", (DL_FUNC)&Rgraphviz_graphvizVersion, 0}, |
10 | 10 |
{"Rgraphviz_bezier", (DL_FUNC)&Rgraphviz_bezier, 3}, |
... | ... |
@@ -34,7 +34,7 @@ SEXP Rgraphviz_agwrite(SEXP, SEXP); |
34 | 34 |
SEXP Rgraphviz_bezier(SEXP, SEXP, SEXP); |
35 | 35 |
SEXP Rgraphviz_buildNodeList(SEXP, SEXP, SEXP, SEXP); |
36 | 36 |
SEXP Rgraphviz_buildEdgeList(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); |
37 |
-SEXP Rgraphviz_doLayout(SEXP, SEXP); |
|
37 |
+SEXP Rgraphviz_doLayout(SEXP, SEXP, SEXP); |
|
38 | 38 |
SEXP Rgraphviz_graphvizVersion(void); |
39 | 39 |
SEXP Rgraphviz_init(void); |
40 | 40 |
|
... | ... |
@@ -94,9 +94,9 @@ SEXP getEdgeLocs(Agraph_t *g) { |
94 | 94 |
SET_SLOT(curEP, Rf_install("head"), Rgraphviz_ScalarStringOrNull(head->name)); |
95 | 95 |
|
96 | 96 |
/* TODO: clean up the use of attrs: dir, arrowhead, arrowtail. |
97 |
- * the following are for interactive plotting in R-env, not needed |
|
97 |
+ * the following are for interactive plotting in R-env, not needed |
|
98 | 98 |
* for output to files. The existing codes set "dir"-attr, but use |
99 |
- * "arrowhead"/"arrowtail" instead. Quite confusing. |
|
99 |
+ * "arrowhead"/"arrowtail" instead. Quite confusing. |
|
100 | 100 |
*/ |
101 | 101 |
SET_SLOT(curEP, Rf_install("dir"), Rgraphviz_ScalarStringOrNull(agget(edge, "dir"))); |
102 | 102 |
SET_SLOT(curEP, Rf_install("arrowhead"), Rgraphviz_ScalarStringOrNull(agget(edge, "arrowhead"))); |
... | ... |
@@ -116,7 +116,7 @@ SEXP getEdgeLocs(Agraph_t *g) { |
116 | 116 |
if (edge->u.label != NULL) { |
117 | 117 |
PROTECT(curLab = NEW_OBJECT(labClass)); |
118 | 118 |
SET_SLOT(curLab, Rf_install("labelText"), |
119 |
- Rgraphviz_ScalarStringOrNull(ED_label(edge)->u.txt.para->str)); |
|
119 |
+ Rgraphviz_ScalarStringOrNull(ED_label(edge)->text)); |
|
120 | 120 |
/* Get the X/Y location of the label */ |
121 | 121 |
PROTECT(curXY = NEW_OBJECT(xyClass)); |
122 | 122 |
#if GRAPHVIZ_MAJOR == 2 && GRAPHVIZ_MINOR > 20 |
... | ... |
@@ -196,10 +196,10 @@ SEXP getNodeLayouts(Agraph_t *g) { |
196 | 196 |
|
197 | 197 |
PROTECT(curLab = NEW_OBJECT(labClass)); |
198 | 198 |
|
199 |
- if (ND_label(node) == NULL) { |
|
200 |
- } else if (ND_label(node)->u.txt.para != NULL) { |
|
199 |
+ if (ND_label(node) == NULL) { |
|
200 |
+ } else if (ND_label(node)->u.txt.para != NULL) { |
|
201 | 201 |
SET_SLOT(curLab, Rf_install("labelText"), |
202 |
- Rgraphviz_ScalarStringOrNull(ND_label(node)->u.txt.para->str)); |
|
202 |
+ Rgraphviz_ScalarStringOrNull(ND_label(node)->text)); |
|
203 | 203 |
snprintf(tmpString, 2, "%c",ND_label(node)->u.txt.para->just); |
204 | 204 |
SET_SLOT(curLab, Rf_install("labelJust"), Rgraphviz_ScalarStringOrNull(tmpString)); |
205 | 205 |
|
... | ... |
@@ -238,7 +238,7 @@ SEXP getNodeLayouts(Agraph_t *g) { |
238 | 238 |
static char *layouts[] = { "dot", "neato", "twopi", "circo", "fdp"}; |
239 | 239 |
*/ |
240 | 240 |
|
241 |
-SEXP Rgraphviz_doLayout(SEXP graph, SEXP layoutType) { |
|
241 |
+SEXP Rgraphviz_doLayout(SEXP graph, SEXP layoutType, SEXP size) { |
|
242 | 242 |
/* Will perform a Graphviz layout on a graph */ |
243 | 243 |
|
244 | 244 |
Agraph_t *g; |
... | ... |
@@ -249,9 +249,13 @@ SEXP Rgraphviz_doLayout(SEXP graph, SEXP layoutType) { |
249 | 249 |
CHECK_Rgraphviz_graph(slotTmp); |
250 | 250 |
g = R_ExternalPtrAddr(slotTmp); |
251 | 251 |
|
252 |
+ if (size != R_NilValue) { |
|
253 |
+ agsafeset(g, "size", CHAR(STRING_ELT(size, 0)), NULL); |
|
254 |
+ } |
|
255 |
+ |
|
252 | 256 |
/* Call the appropriate Graphviz layout routine */ |
253 | 257 |
gvLayout(gvc, g, CHAR(STRING_ELT(layoutType, 0))); |
254 |
- |
|
258 |
+ |
|
255 | 259 |
/* |
256 | 260 |
if (!isInteger(layoutType)) |
257 | 261 |
error("layoutType must be an integer value"); |