[R] filed plot symbols
ben@zoo.ufl.edu
ben at zoo.ufl.edu
Tue Oct 17 22:42:28 CEST 2000
I looked more closely and found two problems with the current legend():
(1) lines were plotted after points; (2) the "bg" parameter in legend
conflicts with the "bg" parameter in points(). I arbitrarily decided to
make "pt.bg" be the parameter for the background color of the points,
while "bg" was reserved for the legend background itself, but I don't know
whether that's the best way to do it.
Sorry to post the whole thing, but I thought it might be easier for some
folks to save it and source the file rather than patching.
Redoing the graphics model sounds great, but this should be a workaround
for the time being.
"legend" <-
function (x, y, legend, fill, col = "black", lty, lwd, pch, bty = "o",
bg = par("bg"), cex = 1, xjust = 0, yjust = 1, x.intersp = 1, pt.bg = par("bg"),
y.intersp = 1, adj = 0, text.width = NULL, merge = do.lines &&
has.pch, trace = FALSE, ncol = 1, horiz = FALSE)
{
if (is.list(x)) {
if (!missing(y)) {
if (!missing(legend))
stop("`y' and `legend' when `x' is list (need no `y')")
legend <- y
}
y <- x$y
x <- x$x
}
else if (missing(y))
stop("missing y")
if (!is.numeric(x) || !is.numeric(y))
stop("non-numeric coordinates")
if ((nx <- length(x)) <= 0 || nx != length(y) || nx > 2)
stop("invalid coordinate lengths")
xlog <- par("xlog")
ylog <- par("ylog")
rect2 <- function(left, top, dx, dy, ...) {
r <- left + dx
if (xlog) {
left <- 10^left
r <- 10^r
}
b <- top - dy
if (ylog) {
top <- 10^top
b <- 10^b
}
rect(left, top, r, b, ...)
}
segments2 <- function(x1, y1, dx, dy, ...) {
x2 <- x1 + dx
if (xlog) {
x1 <- 10^x1
x2 <- 10^x2
}
y2 <- y1 + dy
if (ylog) {
y1 <- 10^y1
y2 <- 10^y2
}
segments(x1, y1, x2, y2, ...)
}
points2 <- function(x, y, ...) {
if (xlog)
x <- 10^x
if (ylog)
y <- 10^y
points(x, y, ...)
}
text2 <- function(x, y, ...) {
if (xlog)
x <- 10^x
if (ylog)
y <- 10^y
text(x, y, ...)
}
if (trace)
catn <- function(...) do.call("cat", c(lapply(list(...),
formatC), list("\n")))
cin <- par("cin")
Cex <- cex * par("cex")
if (is.null(text.width))
text.width <- max(strwidth(legend, u = "user", cex = cex))
else if (!is.numeric(text.width) || text.width < 0)
stop("text.width must be numeric, >= 0")
xc <- Cex * xinch(cin[1], warn.log = FALSE)
yc <- Cex * yinch(cin[2], warn.log = FALSE)
xchar <- xc
yextra <- yc * (y.intersp - 1)
ychar <- yextra + max(yc, strheight(legend, u = "user", cex = cex))
if (trace)
catn(" xchar=", xchar, "; (yextra,ychar)=", c(yextra,
ychar))
if (!missing(fill)) {
xbox <- xc * 0.8
ybox <- yc * 0.5
dx.fill <- xbox
}
do.lines <- (!missing(lty) && any(lty > 0)) || !missing(lwd)
n.leg <- length(legend)
n.legpercol <- if (horiz) {
if (ncol != 1)
warning(paste("horizontal specification overrides: Number of columns :=",
n.leg))
ncol <- n.leg
1
}
else ceiling(n.leg/ncol)
if (has.pch <- !missing(pch)) {
if (is.character(pch) && nchar(pch[1]) > 1) {
if (length(pch) > 1)
warning("Not using pch[2..] since pch[1] has multiple chars")
np <- nchar(pch[1])
pch <- substr(rep(pch[1], np), 1:np, 1:np)
}
if (!merge)
dx.pch <- x.intersp/2 * xchar
}
x.off <- if (merge)
-0.7
else 0
if (xlog)
x <- log10(x)
if (ylog)
y <- log10(y)
if (nx == 2) {
x <- sort(x)
y <- sort(y)
left <- x[1]
top <- y[2]
w <- diff(x)
h <- diff(y)
w0 <- w/ncol
x <- mean(x)
y <- mean(y)
if (missing(xjust))
xjust <- 0.5
if (missing(yjust))
yjust <- 0.5
}
else {
h <- n.legpercol * ychar + yc
w0 <- text.width + (x.intersp + 1) * xchar
if (!missing(fill))
w0 <- w0 + dx.fill
if (has.pch && !merge)
w0 <- w0 + dx.pch
if (do.lines)
w0 <- w0 + (2 + x.off) * xchar
w <- ncol * w0 + 0.5 * xchar
left <- x - xjust * w
top <- y + (1 - yjust) * h
}
if (bty != "n") {
if (trace)
catn(" rect2(", left, ",", top, ", w=", w, ", h=",
h, "...)", sep = "")
rect2(left, top, dx = w, dy = h, col = bg)
}
xt <- left + xchar + (w0 * rep(0:(ncol - 1), rep(n.legpercol,
ncol)))[1:n.leg]
yt <- top - rep(1:n.legpercol, ncol)[1:n.leg] * ychar
if (!missing(fill)) {
fill <- rep(fill, length.out = n.leg)
rect2(left = xt, top = yt + ybox/2, dx = xbox, dy = ybox,
col = fill)
xt <- xt + dx.fill
}
if (has.pch || do.lines)
col <- rep(col, length.out = n.leg)
if (do.lines) {
ok.l <- if (missing(lty)) {
lty <- 1
TRUE
}
else lty > 0
if (missing(lwd))
lwd <- par("lwd")
lty <- rep(lty, length.out = n.leg)
lwd <- rep(lwd, length.out = n.leg)
if (trace)
catn(" segments2(", xt[ok.l] + x.off * xchar, ",",
yt[ok.l], ", dx=", 2 * xchar, ", dy=0, ...)",
sep = "")
segments2(xt[ok.l] + x.off * xchar, yt[ok.l], dx = 2 *
xchar, dy = 0, lty = lty[ok.l], lwd = lwd[ok.l],
col = col[ok.l])
xt <- xt + (2 + x.off) * xchar
}
if (has.pch) {
pch <- rep(pch, length.out = n.leg)
ok <- is.character(pch) | pch >= 0
x1 <- (if (merge)
xt + 0.2 * xchar
else xt)[ok]
y1 <- yt[ok]
if (trace)
catn(" points2(", x1, ",", y1, ", pch=", pch[ok],
"...)")
points2(x1, y1, pch = pch[ok], col = col[ok], cex = cex, bg= pt.bg)
if (!merge)
xt <- xt + dx.pch
}
xt <- xt + x.intersp * xchar
text2(xt, yt, labels = legend, adj = adj, cex = cex)
invisible(list(rect = list(w = w, h = h, left = left, top = top),
text = list(x = xt, y = yt)))
}
x<-1:10
y1<-x
y2<-x+2
plot(x,y1,pch=21,ylim=range(c(y1,y2)),type="o",lty="solid",bg="white")
points(x,y2,pch=22,type="o",lty="dashed",bg="white")
legend(7,3,legend=c("y1","y2"),pch=c(21,22),lty=c("solid","dashed"),pt.bg="white")
On Wed, 18 Oct 2000, Ross Ihaka wrote:
> On Tue, Oct 17, 2000 at 04:13:51PM +0100, Dermot MacSweeney wrote:
> > As a follow on to Bill's question, if we look at the example which he gives, the
> > legend will have lines going through the empty symbols. If there any way to
> > prevent this aside from the obvious (only use filled symbols in graphs).
>
> The present plotting symbols resulted in a haphazard way. The initial
> few provide compatibility with S, and the filled ones were added as an
> experiment. I think that the filled symbols are a good idea, but
> there needed to be a more systematic implementation (and the ability
> for users to add their own glyphs).
>
> Reworking the graphics is going to be the major focus of what I'm going
> to be doing over this (southern) summer. Plotting symbols will be part
> of this. I want to take a close look at legend/key as well.
>
> One way of not having lines pass through the plotting points is to use
> type="b" (both lines and points).
>
> plot(x, y, type="b", pch=1, lty="11")
>
> or
>
> plot(x, y, type="n")
> points(x, y, pch=1)
> lines(x, y, type="b", pch=" ", lty="11")
>
> This does leave a gap around the symbols which may be not what you want.
>
>
--
318 Carr Hall bolker at zoo.ufl.edu
Zoology Department, University of Florida http://www.zoo.ufl.edu/bolker
Box 118525 (ph) 352-392-5697
Gainesville, FL 32611-8525 (fax) 352-392-3704
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !) To: r-help-request at stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._
More information about the R-help
mailing list