Browse code

Merge pull request #1 from ilia-kats/master

Bugfixes: improve multi-line labels, improve layouting

Kasper Daniel Hansen authored on 14/09/2015 18:05:27
Showing7 changed files

... ...
@@ -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");