... | ... |
@@ -31,81 +31,82 @@ setMethod("plot", "Ragraph", |
31 | 31 |
sub=NULL, cex.sub=NULL, col.sub="black", |
32 | 32 |
drawNode=drawAgNode, xlab, ylab, mai) { |
33 | 33 |
|
34 |
- plot.new() |
|
35 |
- |
|
36 |
- bg <- if ( x@bg != "" ) x@bg else par("bg") |
|
37 |
- fg <- if ( x@fg != "" ) x@fg else par("fg") |
|
38 |
- oldpars <- par(bg = bg, fg = fg) |
|
39 |
- on.exit(par(oldpars), add = TRUE) |
|
40 |
- |
|
41 |
- if (missing(mai)) { |
|
42 |
- mheight <- if(!is.null(main) && nchar(main) > 0) |
|
43 |
- sum(strheight(main, "inches", cex.main)) + 0.3 else 0.1 |
|
44 |
- sheight <- if(!is.null(sub) && nchar(sub) > 0) |
|
45 |
- sum(strheight(main, "inches", cex.sub)) + 0.2 else 0.1 |
|
46 |
- mai <- c(sheight, 0, mheight, 0) |
|
47 |
- } |
|
48 |
- oldpars <- par(mai = mai) |
|
49 |
- on.exit(par(oldpars), add = TRUE) |
|
50 |
- if(!is.null(sub)||!is.null(main)) |
|
51 |
- title(main, sub, cex.main = cex.main, col.main = col.main, |
|
52 |
- cex.sub = cex.sub, col.sub = col.sub) |
|
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 |
- ur <- upRight(boundBox(x)) |
|
59 |
- bl <- botLeft(boundBox(x)) |
|
60 |
- plot.window(xlim = c(getX(bl), getX(ur)), |
|
61 |
- ylim = c(getY(bl), getY(ur)), |
|
62 |
- log = "", asp = NA, ...) |
|
63 |
- |
|
64 |
- if(!missing(xlab) && !missing(ylab)) |
|
65 |
- stop("Arguments 'xlab' and 'ylab' are not handled.") |
|
66 |
- |
|
67 |
- ## determine whether node labels fit into nodes and set "cex" accordingly |
|
68 |
- agn <- AgNode(x) |
|
69 |
- nodeDims <- sapply(agn, function(n) { |
|
70 |
- c(getNodeRW(n)+getNodeLW(n), getNodeHeight(n)) |
|
71 |
- }) |
|
72 |
- strDims <- sapply(agn, function(n) { |
|
73 |
- s <- labelText(txtLabel(n)) |
|
74 |
- if(length(s)==0) { |
|
75 |
- rv <- c(strwidth(" "), strheight(" ")) |
|
76 |
- } else { |
|
77 |
- rv <- c(strwidth(s)*1.1, strheight(s)*1.4) |
|
78 |
- } |
|
79 |
- return(rv) |
|
80 |
- } ) |
|
81 |
- cex <- min(nodeDims / strDims) |
|
82 |
- if(is.finite(cex) && cex > 0 ) { |
|
83 |
- oldpars <- par(cex=cex) |
|
84 |
- on.exit(par(oldpars), add = TRUE) |
|
85 |
- } |
|
86 |
- |
|
87 |
- ## draw |
|
88 |
- if (length(drawNode) == 1) { |
|
89 |
- lapply(agn, drawNode) |
|
90 |
- } else { |
|
91 |
- if (length(drawNode) == length(AgNode(x))) { |
|
92 |
- for (i in seq(along=drawNode)) { |
|
93 |
- drawNode[[i]](agn[[i]]) |
|
94 |
- } |
|
95 |
- } else { |
|
96 |
- stop(paste("Length of the drawNode parameter is ", length(drawNode), |
|
97 |
- ", it must be either length 1 or the number of nodes.", sep="")) |
|
98 |
- } |
|
99 |
- } |
|
100 |
- |
|
101 |
- ## Use the smallest node radius as a means to scale the size of |
|
102 |
- ## the arrowheads -- in INCHES! see man page for "arrows", |
|
103 |
- arrowLen <- par("pin")[1] / diff(par("usr")[1:2]) * min(nodeDims) / pi |
|
104 |
- |
|
105 |
- ## Plot the edges |
|
106 |
- lapply(AgEdge(x), lines, len=arrowLen, edgemode=edgemode, ...) |
|
107 |
- |
|
108 |
- invisible(x) |
|
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) |
|
109 | 110 |
}) |
110 | 111 |
|
111 | 112 |
|
... | ... |
@@ -72,10 +72,7 @@ V <- letters[1:10] |
72 | 72 |
M <- 1:4 |
73 | 73 |
g1 <- randomGraph(V, M, .2) |
74 | 74 |
z <- agopenSimple(g1,name="foo") |
75 |
-if(graphvizVersion() >= "2.10") { |
|
76 |
- ## This example will only run with Graphviz >= 2.10 |
|
77 |
- plot(z, "twopi") |
|
78 |
-} |
|
75 |
+plot(z, "twopi") |
|
79 | 76 |
} |
80 | 77 |
\keyword{graphs} |
81 | 78 |
|
... | ... |
@@ -6,7 +6,7 @@ |
6 | 6 |
perform a libgraph layout on the graph locations. |
7 | 7 |
} |
8 | 8 |
\usage{ |
9 |
-graphLayout(graph, layoutType=graph@layoutType) |
|
9 |
+graphLayout(graph, layoutType=graph@layoutType, size=NULL) |
|
10 | 10 |
} |
11 | 11 |
\arguments{ |
12 | 12 |
\item{graph}{An object of type \code{Ragraph}} |
... | ... |
@@ -28,7 +28,7 @@ graphLayout(graph, layoutType=graph@layoutType) |
28 | 28 |
V <- letters[1:10] |
29 | 29 |
M <- 1:4 |
30 | 30 |
g1 <- randomGraph(V, M, .2) |
31 |
-z <- agopen(g1,"foo",layout=FALSE) |
|
31 |
+z <- agopen(g1, "foo", layout=FALSE) |
|
32 | 32 |
x <- z |
33 | 33 |
a <- graphLayout(z) |
34 | 34 |
} |