lwd patches for "contour"
Ben Bolker
bolker@zoo.ufl.edu
Mon, 17 Jan 2000 13:59:13 -0500 (EST)
I found it useful to have contour be able to do line widths ... hope
that the guts haven't changed an enormous amount in the current
development version ... the patches are relatively trivial, mostly going
by analogy with lty and col (although in my ignorance it took me a while
to figure out what UNPROTECT(2) was and why it should be changed to
UNPROTECT(3) ... hope this is useful.
Ben Bolker
*** src/main/names.c.orig Mon Jan 17 11:23:26 2000
--- src/main/names.c Mon Jan 17 11:50:54 2000
***************
*** 644,650 ****
{"identify", do_identify, 0, 11, 6, PP_FUNCALL},
{"strheight", do_strheight, 0, 11, 3, PP_FUNCALL},
{"strwidth", do_strwidth, 0, 11, 3, PP_FUNCALL},
! {"contour", do_contour, 0, 11, 6, PP_FUNCALL},
{"image", do_image, 0, 11, 5, PP_FUNCALL},
{"dend", do_dend, 0, 111, 6, PP_FUNCALL},
{"dend.window", do_dendwindow, 0, 111, 6, PP_FUNCALL},
--- 644,650 ----
{"identify", do_identify, 0, 11, 6, PP_FUNCALL},
{"strheight", do_strheight, 0, 11, 3, PP_FUNCALL},
{"strwidth", do_strwidth, 0, 11, 3, PP_FUNCALL},
! {"contour", do_contour, 0, 11, 7, PP_FUNCALL},
{"image", do_image, 0, 11, 5, PP_FUNCALL},
{"dend", do_dend, 0, 111, 6, PP_FUNCALL},
{"dend.window", do_dendwindow, 0, 111, 6, PP_FUNCALL},
*** src/main/plot3d.c.orig Mon Jan 17 11:08:08 2000
--- src/main/plot3d.c Mon Jan 17 13:47:03 2000
***************
*** 396,408 ****
}
}
! /* contour(x,y,z, levels, col, lty) */
SEXP do_contour(SEXP call, SEXP op, SEXP args, SEXP env)
{
! SEXP oargs, c, x, y, z, col, lty;
! int i, j, nx, ny, nc, ncol, nlty;
int ltysave, colsave;
double atom, zmin, zmax;
char *vmax, *vmax0;
DevDesc *dd = CurrentDevice();
--- 396,409 ----
}
}
! /* contour(x,y,z, levels, col, lty, lwd) */
SEXP do_contour(SEXP call, SEXP op, SEXP args, SEXP env)
{
! SEXP oargs, c, x, y, z, col, lty, lwd;
! int i, j, nx, ny, nc, ncol, nlty, nlwd;
int ltysave, colsave;
+ double lwdsave;
double atom, zmin, zmax;
char *vmax, *vmax0;
DevDesc *dd = CurrentDevice();
***************
*** 439,445 ****
PROTECT(lty = FixupLty(GetPar("lty", args), dd->gp.lty));
nlty = length(lty);
! /* col, lwd and lty vectors here --- FIXME: "lwd" ???? */
if (nx < 2 || ny < 2)
errorcall(call, "insufficient x or y values");
--- 440,447 ----
PROTECT(lty = FixupLty(GetPar("lty", args), dd->gp.lty));
nlty = length(lty);
! PROTECT(lwd = FixupLwd(GetPar("lwd", args), dd->gp.lwd));
! nlwd = length(lwd);
if (nx < 2 || ny < 2)
errorcall(call, "insufficient x or y values");
***************
*** 507,512 ****
--- 509,515 ----
ltysave = dd->gp.lty;
colsave = dd->gp.col;
+ lwdsave = dd->gp.lwd;
GMode(1, dd);
for (i = 0; i < nc; i++) {
vmax = vmaxget();
***************
*** 516,521 ****
--- 519,527 ----
dd->gp.col = INTEGER(col)[i % ncol];
if (dd->gp.col == NA_INTEGER)
dd->gp.col = colsave;
+ dd->gp.lwd = REAL(lwd)[i % nlwd];
+ if (dd->gp.lwd == NA_REAL)
+ dd->gp.lwd = lwdsave;
contour(x, nx, y, ny, z, REAL(c)[i], atom, dd);
vmaxset(vmax);
}
***************
*** 523,529 ****
vmaxset(vmax0);
dd->gp.lty = ltysave;
dd->gp.col = colsave;
! UNPROTECT(2);
/* NOTE: only record operation if no "error" */
/* NOTE: on replay, call == R_NilValue */
if (call != R_NilValue)
--- 529,536 ----
vmaxset(vmax0);
dd->gp.lty = ltysave;
dd->gp.col = colsave;
! dd->gp.lwd = lwdsave;
! UNPROTECT(3);
/* NOTE: only record operation if no "error" */
/* NOTE: on replay, call == R_NilValue */
if (call != R_NilValue)
*** src/library/base/R/contour.R.orig Mon Jan 17 11:12:11 2000
--- src/library/base/R/contour.R Mon Jan 17 11:43:02 2000
***************
*** 6,12 ****
ylim = range(y, finite = TRUE),
zlim = range(z, finite = TRUE),
labcex = 0,
! col = par("fg"), lty = par("lty"), add = FALSE, ...)
{
## labcex is disregarded since we do NOT yet put ANY labels...
if (missing(z)) {
--- 6,12 ----
ylim = range(y, finite = TRUE),
zlim = range(z, finite = TRUE),
labcex = 0,
! col = par("fg"), lty = par("lty"), lwd = par("lwd"), add = FALSE, ...)
{
## labcex is disregarded since we do NOT yet put ANY labels...
if (missing(z)) {
***************
*** 34,40 ****
##- don't lose dim(.)
if (!is.double(z)) storage.mode(z) <- "double"
.Internal(contour(as.double(x), as.double(y), z, as.double(levels),
! col = col, lty = lty))
if (!add) {
axis(1)
axis(2)
--- 34,40 ----
##- don't lose dim(.)
if (!is.double(z)) storage.mode(z) <- "double"
.Internal(contour(as.double(x), as.double(y), z, as.double(levels),
! col = col, lty = lty, lwd = as.double(lwd)))
if (!add) {
axis(1)
axis(2)
*** src/library/base/man/contour.Rd.orig Mon Jan 17 11:13:18 2000
--- src/library/base/man/contour.Rd Mon Jan 17 11:19:05 2000
***************
*** 8,14 ****
ylim = range(y, finite = TRUE),
zlim = range(z, finite = TRUE),
labcex = 0,
! col = par("fg"), lty = par("lty"), add = FALSE, \dots)
}
\alias{contour}
\arguments{
--- 8,14 ----
ylim = range(y, finite = TRUE),
zlim = range(z, finite = TRUE),
labcex = 0,
! col = par("fg"), lty = par("lty"), lwd = par("lwd"), add = FALSE, \dots)
}
\alias{contour}
\arguments{
***************
*** 29,34 ****
--- 29,35 ----
\item{xlim, ylim, zlim}{x-, y- and z-limits for the plot}
\item{col}{color for the lines drawn}
\item{lty}{line type for the lines drawn}
+ \item{lwd}{line width for the lines drawn}
\item{add}{logical. If \code{TRUE}, add to a current plot.}
\item{\dots}{additional graphical parameters (see \code{\link{par}})
and the arguments to \code{\link{title}} may also be supplied.}
***************
*** 36,42 ****
\description{
Draws contour lines for the desired levels.
There is currently no documentation about the algorithm.
! The source code is in \file{\$R\_HOME/src/main/plot.c}.
}
\seealso{
\code{\link{filled.contour}} for ``color-filled'' contours,
--- 37,43 ----
\description{
Draws contour lines for the desired levels.
There is currently no documentation about the algorithm.
! The source code is in \file{\$R\_HOME/src/main/plot3d.c}.
}
\seealso{
\code{\link{filled.contour}} for ``color-filled'' contours,
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
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
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._