Here are another three problems with logarithmic scales:
1) segments() does not work with logarithmic scales. I suggest to change
lines 962-973 in "plot.c":
for (i = 0; i < n; i++) {
if (FINITE(xt(x0[i%nx0])) && FINITE(yt(y0[i%ny0]))
&& FINITE(xt(x1[i%nx1])) && FINITE(yt(y1[i%ny1]))) {
GP->col = INTEGER(col)[i % ncol];
if(GP->col == NA_INTEGER) GP->col = colsave;
GP->lty = INTEGER(lty)[i % nlty];
GStartPath();
GMoveTo(XMAP(xt(x0[i % nx0])), YMAP(yt(y0[i % ny0])));
GLineTo(XMAP(xt(x1[i % nx1])), YMAP(yt(y1[i % ny1])));
GEndPath();
}
}
2) rect() does not work either. Unfortunately, do_rect() in "plot.c"
overrides the yt() function... What about this (lines 983-1031):
SEXP do_rect(SEXP call, SEXP op, SEXP args, SEXP env)
{
SEXP sxl, sxr, syb, sys, col, lty, border;
double *xl, *xr, *yb, *ys;
int i, n, nxl, nxr, nyb, nys;
int ncol, nlty, nborder;
int colsave, ltysave;
GCheckState();
if(length(args) < 4) errorcall(call, "too few arguments\n");
xypoints(call, args, &n);
sxl = CAR(args); nxl = length(sxl); args = CDR(args);
syb = CAR(args); nyb = length(syb); args = CDR(args);
sxr = CAR(args); nxr = length(sxr); args = CDR(args);
sys = CAR(args); nys = length(sys); args = CDR(args);
PROTECT(col = FixupCol(GetPar("col", args)));
ncol = LENGTH(col);
PROTECT(border = FixupCol(GetPar("border", args)));
nborder = LENGTH(border);
PROTECT(lty = FixupLty(GetPar("lty", args)));
nlty = length(lty);
xl = REAL(sxl);
xr = REAL(sxr);
yb = REAL(syb);
ys = REAL(sys);
ltysave = GP->lty;
colsave = GP->col;
GMode(1);
for (i = 0; i < n; i++) {
if (FINITE(xt(xl[i%nxl])) && FINITE(yt(yb[i%nyb]))
&& FINITE(xt(xr[i%nxr])) && FINITE(yt(ys[i%nys])))
GRect(XMAP(xt(xl[i % nxl])), YMAP(yt(yb[i % nyb])),
XMAP(xt(xr[i % nxr])), YMAP(yt(ys[i % nys])),
INTEGER(col)[i % ncol],
INTEGER(border)[i % nborder]);
}
GMode(0);
GP->col = colsave;
GP->lty = ltysave;
UNPROTECT(3);
return R_NilValue;
}
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, ...)
{
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
if (missing(y)) {
if (is.list(x)) {
y <- x$y
x <- x$x
}
}
if (!is.numeric(x) || !is.numeric(y))
stop("non-numeric coordinates")
if (length(x) <= 0 || length(x) != length(y))
stop("differing coordinate lengths")
if (length(x) != 1) {
x <- mean(x)
y <- mean(y)
xjust <- 0.5
yjust <- 0.5
}
if (!missing(fill)) {
w <- w + xchar + xbox
}
if (!missing(pch)) {
if (is.character(pch) && nchar(pch) > 1) {
np <- nchar(pch)
pch <- substr(rep(pch[1], np), 1:np,
1:np)
}
w <- w + 1.5 * xchar
}
if (!missing(lty))
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") {
if (xlog) {
x1 <- 10^x
x2 <- 10^(x + w)
}
else {
x1 <- x
x2 <- x + w
}
if (ylog) {
y1 <- 10^y
y2 <- 10^(y - h)
}
else {
y1 <- y
y2 <- y - h
}
rect(x1, y1, x2, y2, col = bg)
}
x <- x + xchar
if (!missing(fill)) {
if (xlog) {
x1 <- 10^xt
x2 <- 10^(xt + xbox)
}
else {
x1 <- xt
x2 <- xt + xbox
}
if (ylog) {
y1 <- 10^(yt - 0.5 * ybox)
y2 <- 10^(yt + 0.5 * ybox)
}
else {
y1 <- yt - 0.5 * ybox
y2 <- yt + 0.5 * ybox
}
rect(xt, yt - 0.5 * ybox, xt + xbox, yt + 0.5 *
ybox, col = fill)
xt <- xt + xbox + xchar
}
if (!missing(pch)) {
if (xlog)
x1 <- 10^(xt + 0.25 * xchar)
else x1 <- xt + 0.25 * xchar
if (ylog)
y1 <- 10^yt
else y1 <- yt
points(x1, y1, pch, col = col)
xt <- xt + 1.5 * xchar
}
if (!missing(lty)) {
if (xlog) {
x1 <- 10^xt
x2 <- 10^(xt + 2 * xchar)
}
else {
x1 <- xt
x2 <- xt + 2 * xchar
}
if (ylog)
y1 <- 10^yt
else y1 <- yt
segments(x1, y1, x2, y1, lty = lty, col = col)
xt <- xt + 3 * xchar
}
if (xlog)
x1 <- 10^xt
else x1 <- xt
if (ylog)
y1 <- 10^yt
else y1 <- yt
text(x1, y1, text = legend, adj = c(0, 0.35))
}
Arne
--
Arne Kovac
School of Mathematics Phone: +44 (0117) 942 7551
University of Bristol A.Kovac@bristol.ac.uk
University Walk, Bristol, BS8 1TW, U.K. http://www.stats.bris.ac.uk/~maak
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
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
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
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 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Martin Maechler
1997-May-12 08:39 UTC
R-alpha: fixing dhyper.c: another less important typo
Line 30 should be changed from if (NR <= 0 || NR <= 0 || n <= 0 || n > N) to ^-- typo: "R" should be "B" if (NR < 0 || NB < 0 || n < 0 || n > N) (NR==0 or NB == 0 should not be a DOMAIN_ERROR) =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- 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 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-