R-alpha: Logarithmic scales -- patch to 'legend'
Martin Maechler
Martin Maechler <maechler@stat.math.ethz.ch>
Mon, 12 May 97 10:03:50 +0200
Arne, thank you for your very useful bug findings and fixing.
Your first two "patches" to plot.c are really ok.
In your
>> 3) The legend() function needs changes as well. I attach my
>> quick hack below, but I think there are better solutions... :-)
>>
>> legend <-
>> function (x, y, legend, fill, col = "black", lty, pch, bty = "o",
>> bg = par("bg"), xjust = 0, yjust = 1, ...)
>> .....
there was one typo in the ``if(!missing(fill))'' clause, you assigned
x1,..y2, but then did not use them.
Below I fixed this and found a way to make the whole if(xlog) / (ylog)
things a little more concise.
This is a patch against "plain 0.49" , $RHOME/src/library/base/funs/ :
--- legend.~1~ Fri Jan 17 03:44:24 1997
+++ legend Mon May 12 09:42:25 1997
@@ -2,13 +2,18 @@
function(x, y, legend, fill, col="black", lty, pch, bty="o", bg=par("bg"),
xjust=0, yjust=1, ...)
{
+ xlog <- par("xlog")
+ ylog <- par("ylog")
+ if (xlog) x <- log10(x)
+ if (ylog) y <- log10(y)
xchar <- xinch(par("cin")[1])
ychar <- yinch(par("cin")[2]) * 1.2
xbox <- xinch(par("cin")[2] * 0.8)
ybox <- yinch(par("cin")[2] * 0.8)
yline <- 2*xchar
w <- 2 * xchar + max(strwidth(legend))
- h <- (length(legend)+1)*ychar
+ n.leg <- length(legend)
+ h <- (n.leg + 1) * ychar
if(missing(y)) {
if(is.list(x)) {
y <- x$y
@@ -39,23 +44,43 @@
w <- w + 3 * xchar
x <- x - xjust * w
y <- y + (1 - yjust) * h
- xt <- rep(x, length(legend)) + xchar
- yt <- y - (1:length(legend)) * ychar
- if(bty != "n")
- rect(x, y, x+w, y-h, col=bg)
+ xt <- rep(x, n.leg) + xchar
+ yt <- y - (1:n.leg) * ychar
+ if (bty != "n") {
+ xx <- c(x,x+w)
+ if (xlog) xx <- 10^xx
+ yy <- c(y,y-h)
+ if (ylog) yy <- 10^yy
+ rect(xx[1], yy[1], xx[2], yy[2], col = bg)
+ }
x <- x + xchar
if(!missing(fill)) {
- rect(xt, yt - 0.5 * ybox,
- xt + xbox, yt + 0.5 * ybox, col=fill)
+ xx <- c(xt,xt+xbox)
+ if (xlog) xx <- 10^xx
+ yy <- yt + c(-.5,.5) * ybox
+ if (ylog) yy <- 10^yy
+ rect(xx[1], yy[1], xx[2], yy[2], col = fill)
xt <- xt + xbox + xchar
}
if(!missing(pch)) {
- points(xt + 0.25 * xchar, yt, pch, col=col)
+ x1 <- xt + 0.25 * xchar
+ if (xlog) x1 <- 10^x1
+ y1 <- yt
+ if (ylog) y1 <- 10^y1
+ points(x1, y1, pch, col = col)
xt <- xt + 1.5 * xchar
}
if(!missing(lty)) {
- segments(xt, yt, xt + 2 * xchar, yt, lty=lty, col=col)
+ xx <- c(xt, xt + 2 * xchar)
+ if (xlog) xx <- 10^xx
+ y1 <- yt
+ if (ylog) y1 <- 10^y1
+ segments(xx[1], y1, xx[2], y1, lty = lty, col = col)
xt <- xt + 3 * xchar
}
- text(xt, yt, text=legend, adj=c(0, 0.35))
+ x1 <- xt
+ y1 <- yt
+ if (xlog) x1 <- 10^x1
+ if (ylog) y1 <- 10^y1
+ text(x1, y1, text = legend, adj = c(0, 0.35))
}
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
r-devel 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-devel-request@stat.math.ethz.ch
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-