R-alpha: oops -- 2nd patch to 'legend'

Martin Maechler Martin Maechler <maechler@stat.math.ethz.ch>
Mon, 12 May 97 14:11:38 +0200


This time, I have at least tested it out under quite a few circumstances;
the last patch (a few hours ago) would FAIL in many cases!

--- legend.~1~	Fri Jan 17 03:44:24 1997
+++ legend	Mon May 12 12:07:23 1997
@@ -2,18 +2,23 @@
 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
 			x <- x$x
-		}
+    } else stop("missing y")
 	}
 	if(!is.numeric(x) || !is.numeric(y))
 		stop("non-numeric coordinates")
@@ -39,23 +44,36 @@
 		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
+  xt <- rep(x, n.leg) + xchar
+  yt <- y - (1:n.leg) * ychar
 	if(bty != "n")
 		rect(x, y, x+w, y-h, col=bg)
 	x <- x + xchar
 	if(!missing(fill)) {
-		rect(xt, yt - 0.5 * ybox,
-			xt + xbox, yt + 0.5 * ybox, col=fill)
+    xx <- cbind(xt, xt + xbox)
+    if (xlog) xx <- 10^xx
+    yy <- yt + cbind(rep(-0.5,n.leg), 0.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 <- cbind(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
 	}
+  if (xlog) xt <- 10^xt
+  if (ylog) yt <- 10^yt
 	text(xt, yt, 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
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-