Browse code

Merge conflicts

Kasper Daniel Hansen authored on 24/04/2019 15:09:19
Showing10 changed files

... ...
@@ -2,7 +2,7 @@ Package: Rgraphviz
2 2
 Title: Provides plotting capabilities for R graph objects
3 3
 Description: Interfaces R with the AT and T graphviz library for
4 4
         plotting R graph objects from the graph package.
5
-Version: 2.13.1
5
+Version: 2.27.0
6 6
 Authors@R: c(person(c("Kasper", "Daniel"), "Hansen", role = c("cre", "aut"),
7 7
                     email = "kasperdanielhansen@gmail.com"),
8 8
              person("Jeff", "Gentry", role = "aut"),
... ...
@@ -21,11 +21,7 @@ Imports: stats4,
21 21
 	 grDevices
22 22
 Suggests: RUnit,
23 23
 	  BiocGenerics,
24
-	  knitr,
25
-	  rmarkdown,
26
-	  BiocStyle,
27 24
 	  XML
28
-VignetteBuilder: knitr
29 25
 SystemRequirements: optionally Graphviz (>= 2.16)
30 26
 GraphvizDetails: Graphviz 2.28.0
31 27
 License: EPL
... ...
@@ -46,4 +42,3 @@ Collate: AllGenerics.R
46 42
 	 writers.R
47 43
 	 zzz.R
48 44
 biocViews: GraphAndNetwork, Visualization
49
-URL: https://github.com/kasperdanielhansen/Rgraphviz
... ...
@@ -4,12 +4,7 @@ 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) {
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
-})
7
+setMethod("labelText", "AgTextLabel", function(object) object@labelText)
13 8
 setMethod("labelColor", "AgTextLabel", function(object) object@labelColor)
14 9
 setMethod("labelLoc", "AgTextLabel", function(object) object@labelLoc)
15 10
 setMethod("labelJust", "AgTextLabel", function(object) object@labelJust)
... ...
@@ -1,4 +1,4 @@
1
-graphLayout <- function(graph, layoutType=graph@layoutType, size=NULL)
1
+graphLayout <- function(graph, layoutType=graph@layoutType)
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, size=NULL)
6 6
     if (!is(graph,"Ragraph"))
7 7
         stop("Object is not of class Ragraph")
8 8
 
9
-    if ( graph@layoutType != layoutType || !graph@laidout || !is.null(size)) {
9
+    if ( graph@layoutType != layoutType || !graph@laidout ) {
10 10
         graph@layoutType <- layoutType
11
-        z <- .Call("Rgraphviz_doLayout", graph, layoutType, size,
11
+        z <- .Call("Rgraphviz_doLayout", graph, layoutType,
12 12
                    PACKAGE="Rgraphviz");
13 13
     } else {
14 14
         z <- graph
... ...
@@ -12,7 +12,6 @@ setMethod("plot", "graph",
12 12
         warning("graph has zero nodes; cannot layout\n")
13 13
         return(invisible(x))
14 14
     }
15
-
16 15
     if (missing(y)) y <- "dot"
17 16
 
18 17
     recipEdges <- match.arg(recipEdges)
... ...
@@ -30,83 +29,81 @@ setMethod("plot", "Ragraph",
30 29
            main=NULL, cex.main=NULL, col.main="black",
31 30
            sub=NULL, cex.sub=NULL, col.sub="black",
32 31
            drawNode=drawAgNode, xlab, ylab, mai) {
33
-
34
-    if ( missing(y) ) y <- x@layoutType
35
-    x <- graphLayout(x, y, sprintf("%f,%f", par("pin")[1], par("pin")[2]))
36
-    
37
-    plot.new()
38
-    
39
-    bg <- if ( x@bg != "" ) x@bg else par("bg")
40
-    fg <- if ( x@fg != "" ) x@fg else par("fg")
41
-    oldpars <- par(bg = bg, fg = fg)
42
-    on.exit(par(oldpars), add = TRUE)
43
-    
44
-    if (missing(mai)) {
45
-        mheight <- if(!is.null(main) && nchar(main) > 0)
46
-            sum(strheight(main, "inches", cex.main)) + 0.3 else 0.1
47
-        sheight <- if(!is.null(sub) && nchar(sub) > 0)
48
-            sum(strheight(main, "inches", cex.sub)) + 0.2 else 0.1
49
-        mai <- c(sheight, 0, mheight, 0)
50
-    }
51
-    oldpars <- par(mai = mai)
52
-    on.exit(par(oldpars), add = TRUE)
53
-    if(!is.null(sub)||!is.null(main))
54
-        title(main, sub, cex.main = cex.main, col.main = col.main,
55
-              cex.sub = cex.sub, col.sub = col.sub)
56
-    
57
-    ## layout graph
58
-    
59
-    ur <- upRight(boundBox(x))
60
-    bl <- botLeft(boundBox(x))
61
-    plot.window(xlim = c(getX(bl), getX(ur)),
62
-                ylim = c(getY(bl), getY(ur)),
63
-                log = "", asp = NA, ...)
64
-    
65
-    if(!missing(xlab) && !missing(ylab))
66
-        stop("Arguments 'xlab' and 'ylab' are not handled.")
67
-    
68
-    ## determine whether node labels fit into nodes and set "cex" accordingly
69
-    agn <- AgNode(x)
70
-    nodeDims <- sapply(agn, function(n) {
71
-        c(getNodeRW(n)+getNodeLW(n), getNodeHeight(n))
72
-    })
73
-    strDims  <- sapply(agn, function(n) {
74
-        s  <- labelText(txtLabel(n))
75
-        if(length(s)==0) {
76
-            rv <- c(strwidth(" "), strheight(" "))
77
-        } else {
78
-            rv <- c(strwidth(s)*1.1, strheight(s)*1.4)
79
-        }
80
-        return(rv)
81
-    } )
82
-    cex <- min(nodeDims / strDims)
83
-    if(is.finite(cex) && cex > 0 ) {
84
-        oldpars <- par(cex=cex)
85
-        on.exit(par(oldpars), add = TRUE)
86
-    }
87
-    
88
-    ## draw
89
-    if (length(drawNode) == 1) {
90
-        lapply(agn, drawNode)
91
-    } else {
92
-        if (length(drawNode) == length(AgNode(x))) {
93
-            for (i in seq(along=drawNode)) {
94
-                drawNode[[i]](agn[[i]])
95
-            }
96
-        } else {
97
-            stop(paste("Length of the drawNode parameter is ", length(drawNode),
98
-                       ", it must be either length 1 or the number of nodes.", sep=""))
99
-        }
100
-    }
101
-    
102
-    ## Use the smallest node radius as a means to scale the size of
103
-    ## the arrowheads -- in INCHES! see man page for "arrows",
104
-    arrowLen <- par("pin")[1] / diff(par("usr")[1:2]) * min(nodeDims) / pi
105
-    
106
-    ## Plot the edges
107
-    lapply(AgEdge(x), lines, len=arrowLen, edgemode=edgemode, ...)
108
-    
109
-    invisible(x)
32
+      ## layout graph
33
+      if ( missing(y) ) y <- x@layoutType
34
+      x <- graphLayout(x, y)
35
+
36
+      plot.new()
37
+
38
+      bg <- if ( x@bg != "" ) x@bg else par("bg")
39
+      fg <- if ( x@fg != "" ) x@fg else par("fg")
40
+      oldpars <- par(bg = bg, fg = fg)
41
+      on.exit(par(oldpars), add = TRUE)
42
+      
43
+      if (missing(mai)) {
44
+          mheight <- if(!is.null(main) && nchar(main) > 0)
45
+              sum(strheight(main, "inches", cex.main)) + 0.3 else 0.1
46
+          sheight <- if(!is.null(sub) && nchar(sub) > 0)
47
+              sum(strheight(main, "inches", cex.sub)) + 0.2 else 0.1
48
+          mai <- c(sheight, 0, mheight, 0)
49
+      }
50
+      oldpars <- par(mai = mai)
51
+      on.exit(par(oldpars), add = TRUE)
52
+      if(!is.null(sub)||!is.null(main))
53
+          title(main, sub, cex.main = cex.main, col.main = col.main, 
54
+                cex.sub = cex.sub, col.sub = col.sub)
55
+      
56
+      ur <- upRight(boundBox(x))
57
+      bl <- botLeft(boundBox(x))
58
+      plot.window(xlim = c(getX(bl), getX(ur)),
59
+                  ylim = c(getY(bl), getY(ur)),
60
+                  log = "", asp = NA, ...)
61
+      
62
+      if(!missing(xlab) && !missing(ylab))
63
+          stop("Arguments 'xlab' and 'ylab' are not handled.")
64
+      
65
+      ## determine whether node labels fit into nodes and set "cex" accordingly
66
+      agn <- AgNode(x)
67
+      nodeDims <- sapply(agn, function(n) {
68
+          c(getNodeRW(n)+getNodeLW(n), getNodeHeight(n))
69
+      })
70
+      strDims  <- sapply(agn, function(n) {
71
+          s  <- labelText(txtLabel(n))
72
+          if(length(s)==0) {
73
+              rv <- c(strwidth(" "), strheight(" "))
74
+          } else {
75
+              rv <- c(strwidth(s)*1.1, strheight(s)*1.4)
76
+          }
77
+          return(rv)
78
+      } )
79
+      cex <- min(nodeDims / strDims)
80
+      if(is.finite(cex) && cex > 0 ) {
81
+          oldpars <- par(cex=cex)
82
+          on.exit(par(oldpars), add = TRUE)
83
+      }
84
+      
85
+      ## draw
86
+      if (length(drawNode) == 1) {
87
+          lapply(agn, drawNode)
88
+      } else {
89
+          if (length(drawNode) == length(AgNode(x))) {
90
+              for (i in seq(along=drawNode)) {
91
+                  drawNode[[i]](agn[[i]])
92
+              }
93
+          } else {
94
+              stop(paste("Length of the drawNode parameter is ", length(drawNode),
95
+                         ", it must be either length 1 or the number of nodes.", sep=""))
96
+          }
97
+      }
98
+
99
+      ## Use the smallest node radius as a means to scale the size of
100
+      ## the arrowheads -- in INCHES! see man page for "arrows", 
101
+      arrowLen <- par("pin")[1] / diff(par("usr")[1:2]) * min(nodeDims) / pi
102
+      
103
+      ## Plot the edges
104
+      lapply(AgEdge(x), lines, len=arrowLen, edgemode=edgemode, ...)
105
+      
106
+      invisible(x)
110 107
 })
111 108
 
112 109
 
... ...
@@ -124,7 +121,7 @@ drawAgNode <- function(node) {
124 121
   shape <- shape(node)
125 122
 
126 123
   ## Normal Rgraphviz defaults to circle, but DOT defaults to ellipse
127
-  if (shape =="") shape <- "ellipse"
124
+  if (shape =="") shape <- "ellipse" 
128 125
 
129 126
   if (fg == "") fg <- "black"
130 127
   bg <- fillcolor(node)
... ...
@@ -138,8 +135,8 @@ drawAgNode <- function(node) {
138 135
          "ellipse"   = ellipse(x=nodeX, y=nodeY, height=height, width=rad*2, fg=fg, bg=bg),
139 136
          "box"=,
140 137
          "rect"=,
141
-         "rectangle" = rect(nodeX-lw, nodeY-(height/2),
142
-			    nodeX+rw, nodeY+(height/2),
138
+         "rectangle" = rect(nodeX-lw, nodeY-(height/2), 
139
+			    nodeX+rw, nodeY+(height/2), 
143 140
 			    col=bg, border=fg),
144 141
          "plaintext"= { if (style == "filled")
145 142
                           rect(nodeX-lw, nodeY-(height/2),
... ...
@@ -3,8 +3,9 @@
3 3
 This is the developer version of Bioconductor package [Rgraphviz](http://bioconductor.org/packages/devel/bioc/html/Rgraphviz.html).  Install in R as:
4 4
 
5 5
 ```r
6
-source('http://bioconductor.org/biocLite.R')
7
-biocLite('Rgraphviz')
6
+if (!requireNamespace("BiocManager", quietly=TRUE))
7
+    install.packages("BiocManager")
8
+BiocManager::install('Rgraphviz')
8 9
 ```
9 10
 
10 11
 # Additional installation tips
... ...
@@ -72,7 +72,10 @@ V <- letters[1:10]
72 72
 M <- 1:4
73 73
 g1 <- randomGraph(V, M, .2)
74 74
 z <- agopenSimple(g1,name="foo")
75
-plot(z, "twopi")
75
+if(graphvizVersion() >= "2.10") {
76
+  ## This example will only run with Graphviz >= 2.10
77
+  plot(z, "twopi")
78
+}
76 79
 }
77 80
 \keyword{graphs}
78 81
 
... ...
@@ -6,18 +6,16 @@
6 6
   perform a libgraph layout on the graph locations.
7 7
 }
8 8
 \usage{
9
-graphLayout(graph, layoutType=graph@layoutType, size=NULL)
9
+graphLayout(graph, layoutType=graph@layoutType)
10 10
 }
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.}
15 14
 }
16 15
 \details{
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.
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.
21 19
 }
22 20
 \value{
23 21
   A laid out object of type \code{Ragraph}.
... ...
@@ -28,7 +26,7 @@ graphLayout(graph, layoutType=graph@layoutType, size=NULL)
28 26
 V <- letters[1:10]
29 27
 M <- 1:4
30 28
 g1 <- randomGraph(V, M, .2)
31
-z <- agopen(g1, "foo", layout=FALSE)
29
+z <- agopen(g1,"foo",layout=FALSE)
32 30
 x <- z
33 31
 a <- graphLayout(z)
34 32
 }
... ...
@@ -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, 3},
7
+             {"Rgraphviz_doLayout", (DL_FUNC)&Rgraphviz_doLayout, 2},
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, SEXP);
37
+SEXP Rgraphviz_doLayout(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)->text));
119
+                         Rgraphviz_ScalarStringOrNull(ED_label(edge)->u.txt.para->str));
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)->text));
202
+                     Rgraphviz_ScalarStringOrNull(ND_label(node)->u.txt.para->str));
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, SEXP size) {
241
+SEXP Rgraphviz_doLayout(SEXP graph, SEXP layoutType) {
242 242
     /* Will perform a Graphviz layout on a graph */
243 243
 
244 244
     Agraph_t *g;
... ...
@@ -249,13 +249,12 @@ SEXP Rgraphviz_doLayout(SEXP graph, SEXP layoutType, SEXP size) {
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
-
256 252
     /* Call the appropriate Graphviz layout routine */
257 253
     gvLayout(gvc, g, CHAR(STRING_ELT(layoutType, 0)));
258 254
 
255
+    /* Call the appropriate Graphviz layout routine */
256
+    gvLayout(gvc, g, CHAR(STRING_ELT(layoutType, 0)));
257
+    
259 258
     /*
260 259
     if (!isInteger(layoutType))
261 260
         error("layoutType must be an integer value");