Browse code

Re-layout the graph to the current plotting region when plotting.

This eliminates the problem with edges going inside circular nodes (which
was due to the fact that symbols always takes the x axis units for radii,
which problematic for non-square plotting regions) and makes working with
fontsizes easier.

Ilia Kats authored on 28/04/2014 17:29:53
Showing6 changed files

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