R-alpha: Logarithmic scales -- patch to 'legend'

[Martin Maechler]

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
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-