R-alpha: Logarithmic scales
Arne Kovac
Arne Kovac <maak@stats.bris.ac.uk>
Sun, 11 May 1997 20:08:32 +0000 (GMT)
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
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-