[Dplr-commits] r1006 - in pkg/dplR: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Nov 8 23:57:30 CET 2015
Author: mvkorpel
Date: 2015-11-08 23:57:30 +0100 (Sun, 08 Nov 2015)
New Revision: 1006
Modified:
pkg/dplR/ChangeLog
pkg/dplR/DESCRIPTION
pkg/dplR/R/rasterPlot.R
pkg/dplR/man/rasterPlot.Rd
Log:
Improvements to rasterPlot()
Modified: pkg/dplR/ChangeLog
===================================================================
--- pkg/dplR/ChangeLog 2015-11-03 22:44:49 UTC (rev 1005)
+++ pkg/dplR/ChangeLog 2015-11-08 22:57:30 UTC (rev 1006)
@@ -1,5 +1,14 @@
* CHANGES IN dplR VERSION 1.6.4
+File: rasterPlot.R
+------------------
+- rasterPlot() now reverts to normal plotting if png device is unavailable or
+ raster images are not supported. Previously an error would be produced.
+- The function now also works if no high level plot exists,
+ i.e. if plot.new() has not been called.
+- png plot is initialized with plot.new() instead of the previous
+ plot(type = "n", ...) arrangement.
+
File: sea.R
-----------
- Updated sea() to return bootstrapped CIs.
Modified: pkg/dplR/DESCRIPTION
===================================================================
--- pkg/dplR/DESCRIPTION 2015-11-03 22:44:49 UTC (rev 1005)
+++ pkg/dplR/DESCRIPTION 2015-11-08 22:57:30 UTC (rev 1006)
@@ -3,7 +3,7 @@
Type: Package
Title: Dendrochronology Program Library in R
Version: 1.6.4
-Date: 2015-11-04
+Date: 2015-11-09
Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph",
"cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko",
"Korpela", role = c("aut", "trl")), person("Franco", "Biondi",
Modified: pkg/dplR/R/rasterPlot.R
===================================================================
--- pkg/dplR/R/rasterPlot.R 2015-11-03 22:44:49 UTC (rev 1005)
+++ pkg/dplR/R/rasterPlot.R 2015-11-08 22:57:30 UTC (rev 1006)
@@ -1,19 +1,83 @@
rasterPlot <- function(expr, res = 150, region=c("plot", "figure"), antialias,
bg = "transparent", interpolate = TRUE, ...) {
+ ## Plotting commands 'expr' will be evaluated in the environment
+ ## of the caller of rasterPlot()
+ pf <- parent.frame()
+ fallback <- FALSE
if (identical(dev.capabilities("rasterImage")[["rasterImage"]], "no")) {
- stop("device does not support raster images")
+ message("device does not support raster images")
+ fallback <- TRUE
}
if (sum(capabilities(c("cairo", "png", "aqua")), na.rm=TRUE) == 0) {
- stop("png device unavailable")
+ message("png device unavailable")
+ fallback <- TRUE
}
region2 <- match.arg(region)
plotRegion <- region2 == "plot"
+ ## Start new plot if one does not exist
+ parnew <- tryCatch(par(new = TRUE), warning = function(...) NULL)
+ op <- NULL
+ marzero <- FALSE
+ if (is.null(parnew)) {
+ if (!plotRegion && !fallback) {
+ plot.new()
+ op <- par(no.readonly = TRUE)
+ par(mar = c(0, 0, 0, 0))
+ marzero <- TRUE
+ }
+ plot.new()
+ parnew <- list(new = FALSE)
+ } else if (!parnew[[1L]]) {
+ par(new = FALSE)
+ }
+ usr <- par("usr")
+ ## Limits of the plot region in user coordinates
+ usrLeft <- usr[1]
+ usrRight <- usr[2]
+ usrBottom <- usr[3]
+ usrTop <- usr[4]
+ figCoord <- function() {
+ usrWidth <- usrRight - usrLeft
+ usrHeight <- usrTop - usrBottom
+ plt <- par("plt")
+ ## Limits of the plot region proportional to the figure region, 0..1
+ pltLeft <- plt[1]
+ pltRight <- plt[2]
+ pltWidth <- pltRight - pltLeft
+ pltBottom <- plt[3]
+ pltTop <- plt[4]
+ pltHeight <- pltTop - pltBottom
+ ## Limits of the figure region in user coordinates
+ figLeft <- usrLeft - pltLeft / pltWidth * usrWidth
+ figRight <- usrRight + (1 - pltRight) / pltWidth * usrWidth
+ figBottom <- usrBottom - pltBottom / pltHeight * usrHeight
+ figTop <- usrTop + (1 - pltTop) / pltHeight * usrHeight
+ return(c(figLeft, figBottom, figRight, figTop))
+ }
+ if (fallback) {
+ message("using fallback: regular plotting")
+ on.exit(par(parnew))
+ parxpd <- par(xpd = !plotRegion)
+ on.exit(par(parxpd), add = TRUE)
+ if (length(bg) != 1 || !is.character(bg) || bg != "transparent") {
+ if (plotRegion) {
+ rect(usrLeft, usrBottom, usrRight, usrTop,
+ col = bg, border = NA)
+ } else {
+ fc <- figCoord()
+ rect(fc[1], fc[2], fc[3], fc[4], col = bg, border = NA)
+ }
+ }
+ par(new = TRUE)
+ eval(expr, pf)
+ return(invisible(NULL))
+ }
## Record number of current device so it can be reactivated later
curDev <- dev.cur()
## Record graphical parameters of the device
- op <- par(no.readonly = TRUE)
- plt <- op[["plt"]]
- usr <- op[["usr"]]
+ if (is.null(op)) {
+ op <- par(no.readonly = TRUE)
+ }
pngWidthHeight <- op[[c(figure="fin", plot="pin")[region2]]]
op <- op[!(names(op) %in%
c("ask", "bg", "fig", "fin", "mar", "mfcol", "mfg", "mfrow",
@@ -41,14 +105,9 @@
if (plotRegion) {
par(mai=rep(0, 4))
}
- ## Dummy plot for initialization
- plot(1, type = "n", xlab = "", ylab = "", axes=FALSE)
- ## Copy graphical parameters from original device to png:
- ## (margins), coordinates of plot region, etc.
+ ## Initialize and copy graphical parameters from original device
+ plot.new()
par(op)
- ## Evaluate the plotting commands 'expr' in the environment of the
- ## caller of rasterPlot()
- pf <- parent.frame()
eval(expr, pf)
on.exit(dev.set(curDev))
on.exit(unlink(fname), add=TRUE)
@@ -62,37 +121,19 @@
on.exit()
## Remove the temporary .png file
unlink(fname)
- ## Limits of the plot region in user coordinates
- usrLeft <- usr[1]
- usrRight <- usr[2]
- usrBottom <- usr[3]
- usrTop <- usr[4]
- if (plotRegion) {
+ if (plotRegion || marzero) {
## Add a raster image to the plot region of the original plot
rasterImage(pngData, xleft = usrLeft, ybottom = usrBottom,
xright = usrRight, ytop = usrTop,
interpolate = interpolate)
} else {
- usrWidth <- usrRight - usrLeft
- usrHeight <- usrTop - usrBottom
- ## Limits of the plot region proportional to the figure region, 0..1
- pltLeft <- plt[1]
- pltRight <- plt[2]
- pltWidth <- pltRight - pltLeft
- pltBottom <- plt[3]
- pltTop <- plt[4]
- pltHeight <- pltTop - pltBottom
- ## Limits of the figure region in user coordinates
- figLeft <- usrLeft - pltLeft / pltWidth * usrWidth
- figRight <- usrRight + (1 - pltRight) / pltWidth * usrWidth
- figBottom <- usrBottom - pltBottom / pltHeight * usrHeight
- figTop <- usrTop + (1 - pltTop) / pltHeight * usrHeight
## Set clipping to figure region, restore at exit
par(xpd = TRUE)
on.exit(par(xpd = op[["xpd"]]))
## Add a raster image to the figure region of the original plot
- rasterImage(pngData, xleft = figLeft, ybottom = figBottom,
- xright = figRight, ytop = figTop,
+ fc <- figCoord()
+ rasterImage(pngData, xleft = fc[1], ybottom = fc[2],
+ xright = fc[3], ytop = fc[4],
interpolate = interpolate)
}
invisible(NULL)
Modified: pkg/dplR/man/rasterPlot.Rd
===================================================================
--- pkg/dplR/man/rasterPlot.Rd 2015-11-03 22:44:49 UTC (rev 1005)
+++ pkg/dplR/man/rasterPlot.Rd 2015-11-08 22:57:30 UTC (rev 1006)
@@ -8,7 +8,7 @@
This function takes plotting commands and uses a temporary
\code{\link{png}} bitmap graphics device to capture their output. The
resulting raster image is drawn in the plot or figure region of the
- active high-level plot.
+ active high-level plot. A new plot is started if one does not exist.
}
\usage{
rasterPlot(expr, res = 150, region = c("plot", "figure"), antialias,
@@ -66,12 +66,13 @@
The call or expression \code{\var{expr}} is evaluated in the
environment of the caller.
- Resizing a graphics device after a call to this function may distort
- the image. For example, circle symbols will become ellipses if the
- width to height ratio is not maintained (see \sQuote{Examples}). This
- is in contrast to a standard plot in a display graphics device,
- e.g. \code{\link{x11}}, where text and symbols maintain their size
- when the device is resized.
+ It is possible that the raster contents will maintain a constant size
+ when the graphics device is resized. If resizing works, however, the
+ image may become distorted. For example, circle symbols will turn
+ into ellipses if the width to height ratio is not maintained (see
+ \sQuote{Examples}). This is in contrast to a standard plot in a
+ display graphics device, e.g. \code{\link{x11}}, where text and
+ symbols maintain their size when the device is resized.
}
\value{
No return value. Used for the side effects.
@@ -87,9 +88,17 @@
The \R build must have a functional \code{\link{png}} device, which
requires one of the following \code{\link{capabilities}}:
\code{"png"}, \code{"aqua"} or \code{"cairo"}.
+
+ If either of these requirements is not met, at least one
+ \code{\link{message}} is generated and the function reverts to regular
+ plotting. The \code{\var{bg}} argument is then handled by drawing a
+ filled rectangle. Also \code{\var{region}} is honored, but the other
+ settings do not apply.
}
\examples{library(graphics)
library(stats)
+
+## Picture with various graphical elements
x <- 1:100
y0 <- quote(sin(pi * x / 20) + x / 100 + rnorm(100, 0, 0.2))
y <- eval(y0)
@@ -107,15 +116,17 @@
X <- seq(usr[1] + xmar, by = xsize / nsteps, length.out = nsteps + 1)
xleft <- X[-(nsteps + 1)]
xright <- X[-1]
-maxrad <- xsize / 3
+pin <- par("pin")
+maxrad <- xsize / 3 * min(1, pin[2] / pin[1])
nrad <- 16
minrad <- maxrad / nrad
Rad <- seq(maxrad, by = (minrad - maxrad) / (nrad - 1), length.out=nrad)
+xmar2 <- xmar + maxrad
+ymar2 <- (xmar2 / xrange) * pin[1] / pin[2] * yrange
expr <- quote({
rect(xleft, usr[4] - 1.5 * ysize, xright, usr[4] - ymar,
col = rainbow(8), border = NA)
- symbols(rep(usr[2] - xmar - maxrad, nrad),
- rep(usr[3] + ymar + maxrad / xrange * yrange, nrad),
+ symbols(rep(usr[2] - xmar2, nrad), rep(usr[3] + ymar2, nrad),
circles = Rad, inches = FALSE, add = TRUE, fg = NA,
bg = gray.colors(nrad + 1, 1, 0)[-1])
points(y)
@@ -126,11 +137,27 @@
axis(1)
axis(2)
+## The same picture with higher resolution but no antialiasing
plot(x, y, type = "n", axes = FALSE, ylab = ylab)
-rasterPlot(expr, antialias = "none", interpolate = FALSE)
+## region = "figure" makes no difference here
+rasterPlot(expr, antialias = "none", interpolate = FALSE,
+ region = "figure")
box()
axis(1)
axis(2)
+
+## A part of plot(1:5) is drawn normally, the rest with rasterPlot.
+## Resize to see stretching.
+op <- par(no.readonly = TRUE)
+par(mar = c(5.1, 4.1, 2.1, 2.1))
+plot(c(1, 3, 5), c(1, 3, 5), axes = FALSE)
+box()
+axis(1)
+axis(4)
+rasterPlot(quote(points(c(2, 4), c(2, 4))), region = "figure")
+rasterPlot(quote(axis(2)), region = "figure")
+rasterPlot(quote(axis(3)), region = "figure")
+par(op)
}
\keyword{ aplot }
\keyword{ utilities }
More information about the Dplr-commits
mailing list