[Dplr-commits] r865 - in pkg/dplR: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue May 13 17:10:05 CEST 2014


Author: mvkorpel
Date: 2014-05-13 17:10:04 +0200 (Tue, 13 May 2014)
New Revision: 865

Added:
   pkg/dplR/R/rasterPlot.R
Modified:
   pkg/dplR/ChangeLog
   pkg/dplR/DESCRIPTION
   pkg/dplR/NAMESPACE
   pkg/dplR/R/wavelet.plot.R
   pkg/dplR/man/wavelet.plot.Rd
Log:
Added possibility to do .filled.contour() as a raster image in wavelet.plot()

Modified: pkg/dplR/ChangeLog
===================================================================
--- pkg/dplR/ChangeLog	2014-05-12 18:53:38 UTC (rev 864)
+++ pkg/dplR/ChangeLog	2014-05-13 15:10:04 UTC (rev 865)
@@ -4,13 +4,15 @@
 ---------------
 
 - Added latexify() and latexDate() to export list
+- Import readPNG from png.
 
 File: DESCRIPTION
 -----------------
 
-- New Suggested packages.  These are for document building (see
-  math-dplR.pdf below) and openPDF (math-dplR.pdf is not available through
-  vignette())
+- New Suggested packages: Biobase, dichromat, knitr, tikzDevice.
+  These are for document building (see math-dplR.pdf below) and
+  openPDF (math-dplR.pdf is not available through vignette())
+- New Imported package: png.
 
 File: common.interval.R
 -----------------------
@@ -49,6 +51,13 @@
 
 - build-math-dplR.R is a build script
 
+New file rasterPlot.R
+---------------------
+
+- New function rasterPlot(), internal to the package.  Adds a
+  raster image drawn with low level graphics commands to the current
+  high level plot.
+
 Files: rcompact.c, readloop.c
 -----------------------------
 
@@ -62,6 +71,13 @@
   will speed up otherwise unbearable computation times on some
   systems.
 
+File: wavelet.plot.R
+--------------------
+
+- Added two options to wavelet.plot().
+  'useRaster': draw the filled contours as a raster image? (default 'FALSE')
+  'res': resolution of the filled contours when 'useRaster' is 'TRUE'
+
 * CHANGES IN dplR VERSION 1.6.0
 
 File: TODO

Modified: pkg/dplR/DESCRIPTION
===================================================================
--- pkg/dplR/DESCRIPTION	2014-05-12 18:53:38 UTC (rev 864)
+++ pkg/dplR/DESCRIPTION	2014-05-13 15:10:04 UTC (rev 865)
@@ -3,7 +3,7 @@
 Type: Package
 Title: Dendrochronology Program Library in R
 Version: 1.6.1
-Date: 2014-05-12
+Date: 2014-05-13
 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",
@@ -19,10 +19,10 @@
 Maintainer: Andy Bunn <andy.bunn at wwu.edu>
 Depends: R (>= 2.15.0)
 Imports: gmp (>= 0.5-2), graphics, grDevices, grid, stats, utils,
-        digest (>= 0.2.3), lattice (>= 0.13-6), stringr (>= 0.4), XML
-        (>= 2.1-0)
-Suggests: Biobase, dichromat, foreach, forecast, iterators, knitr,
-        RUnit (>= 0.4.25), tikzDevice, waveslim
+        digest (>= 0.2.3), lattice (>= 0.13-6), png (>= 0.1-1),
+        stringr (>= 0.4), XML (>= 2.1-0)
+Suggests: Biobase, dichromat (>= 1.2-1), foreach, forecast, iterators,
+        knitr, RUnit (>= 0.4.25), tikzDevice, waveslim
 Description: This package contains functions for performing tree-ring
         analyses, IO, and graphics.
 LazyData: no

Modified: pkg/dplR/NAMESPACE
===================================================================
--- pkg/dplR/NAMESPACE	2014-05-12 18:53:38 UTC (rev 864)
+++ pkg/dplR/NAMESPACE	2014-05-13 15:10:04 UTC (rev 865)
@@ -19,6 +19,8 @@
 importFrom(lattice, panel.abline, panel.dotplot, panel.segments,
            trellis.par.set, xyplot)
 
+importFrom(png, readPNG)
+
 importFrom(stringr, str_pad, str_trim)
 
 importFrom(utils, head, installed.packages, read.fwf, tail,

Added: pkg/dplR/R/rasterPlot.R
===================================================================
--- pkg/dplR/R/rasterPlot.R	                        (rev 0)
+++ pkg/dplR/R/rasterPlot.R	2014-05-13 15:10:04 UTC (rev 865)
@@ -0,0 +1,98 @@
+### Add raster elements to the active high-level plot.  The given
+### plotting commands are drawn using a temporary png() device.  The
+### raster image is read into memory and added to the original plot.
+###
+### Written by Mikko Korpela
+###
+### Arguments:
+### x          Low-level plotting commands representing elements to be added
+###            to the current plot. Examples: lines(), points(), text(),
+###            mtext(), .filled.contour()
+### res        Resolution in points per inch.
+###            Estimated useful range: 100 - 300.
+### antialias  antialiasing argument for png(). "none" is preferred for
+###            images. The default value (missing argument) is probably
+###            good for line plots.
+rasterPlot <- function(x, res = 150, antialias) {
+    if (identical(dev.capabilities("rasterImage")[["rasterImage"]], "no")) {
+        stop("device does not support raster images")
+    }
+    if (sum(capabilities(c("cairo", "png", "aqua")), na.rm=TRUE) == 0) {
+        stop("png device unavailable")
+    }
+    ## 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"]]
+    figureWidthHeight <- op[["fin"]]
+    op <- op[!(names(op) %in%
+               c("ask", "bg", "fig", "fin", "mar", "mfcol", "mfg", "mfrow",
+                 "new", "oma", "omd", "omi", "pin", "plt"))]
+    ## Open a png device (raster image) using a temporary file.  Width
+    ## and height are set to match the dimensions of the figure region
+    ## in the original device.  Resolution (points per inch) is the
+    ## argument 'res'.
+    fname <- tempfile(fileext = ".png")
+    if (missing(antialias)) {
+        png(fname, width = figureWidthHeight[1], height = figureWidthHeight[2],
+            units = "in", res = res, bg = "transparent")
+    } else {
+        png(fname, width = figureWidthHeight[1], height = figureWidthHeight[2],
+            units = "in", res = res, bg = "transparent", antialias = antialias)
+    }
+    ## Record things to do on exit (will be removed from list one-by-one)
+    on.exit(dev.off())
+    on.exit(dev.set(curDev), add=TRUE)
+    on.exit(unlink(fname), add=TRUE)
+    devAskNewPage(FALSE)
+    par(mfcol=c(1,1))
+    par(oma=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.
+    par(op)
+    ## Evaluate the plotting commands 'x' in the environment of the
+    ## caller of rasterPlot()
+    pf <- parent.frame()
+    eval(x, pf)
+    on.exit(dev.set(curDev))
+    on.exit(unlink(fname), add=TRUE)
+    ## Close the png device
+    dev.off()
+    on.exit(unlink(fname))
+    ## Return to the original plot (device)
+    dev.set(curDev)
+    ## Read the png image to memory
+    pngData <- readPNG(fname, native=TRUE)
+    on.exit()
+    ## Remove the temporary .png file
+    unlink(fname)
+    ## Limits of the plot region in user coordinates
+    usrLeft <- usr[1]
+    usrRight <- usr[2]
+    usrWidth <- usrRight - usrLeft
+    usrBottom <- usr[3]
+    usrTop <- usr[4]
+    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)
+}

Modified: pkg/dplR/R/wavelet.plot.R
===================================================================
--- pkg/dplR/R/wavelet.plot.R	2014-05-12 18:53:38 UTC (rev 864)
+++ pkg/dplR/R/wavelet.plot.R	2014-05-13 15:10:04 UTC (rev 865)
@@ -7,7 +7,8 @@
              key.lab = parse(text = paste0("\"", gettext("Power"), "\"^2")),
              add.spline = FALSE, f = 0.5, nyrs = NULL,
              crn.col = "black", crn.lwd = 1,coi.col='black',
-             crn.ylim = range(wave.list$y)*1.1, side.by.side = FALSE)
+             crn.ylim = range(wave.list$y)*1.1, side.by.side = FALSE,
+             useRaster = FALSE, res = 150)
 {
 
     ## Wavelet transform variables:
@@ -86,12 +87,29 @@
         plot.window(xlim, ylim, "", xaxs=xaxs, yaxs=yaxs, asp=asp, las=las)
         # note replacement of .Internal(filledcontour(as.double(x),...)
         # with .filled.contour() as of R-2.15.0
-        .filled.contour(as.double(x),
-                        as.double(period2),
-                        z,
-                        as.double(wavelet.levels),
-                        key.cols)
-
+        if (isTRUE(useRaster)) {
+            cl <- quote(.filled.contour(as.double(x),
+                                        as.double(period2),
+                                        z,
+                                        as.double(wavelet.levels),
+                                        key.cols))
+            tryCatch(rasterPlot(cl, res = res, antialias = "none"),
+                     error = function(e) {
+                         warning(e)
+                         message("reverting to useRaster=FALSE")
+                         .filled.contour(as.double(x),
+                                         as.double(period2),
+                                         z,
+                                         as.double(wavelet.levels),
+                                         key.cols)
+                     })
+        } else {
+            .filled.contour(as.double(x),
+                            as.double(period2),
+                            z,
+                            as.double(wavelet.levels),
+                            key.cols)
+        }
         if (add.sig) {
             contour(x, period2, Signif, levels=1, labels=siglvl,
                     drawlabels = FALSE, axes = FALSE,
@@ -155,12 +173,29 @@
         plot.window(xlim, ylim, "", xaxs=xaxs, yaxs=yaxs, asp=asp, las=las)
         # note replacement of .Internal(filledcontour(as.double(x),...)
         # with .filled.contour() as of R-2.15.0
-        .filled.contour(as.double(x),
-                        as.double(period2),
-                        z,
-                        as.double(wavelet.levels),
-                        key.cols)
-
+        if (isTRUE(useRaster)) {
+            cl <- quote(.filled.contour(as.double(x),
+                                        as.double(period2),
+                                        z,
+                                        as.double(wavelet.levels),
+                                        key.cols))
+            tryCatch(rasterPlot(cl, res = res, antialias = "none"),
+                     error = function(e) {
+                         warning(e)
+                         message("reverting to useRaster=FALSE")
+                         .filled.contour(as.double(x),
+                                         as.double(period2),
+                                         z,
+                                         as.double(wavelet.levels),
+                                         key.cols)
+                     })
+        } else {
+            .filled.contour(as.double(x),
+                            as.double(period2),
+                            z,
+                            as.double(wavelet.levels),
+                            key.cols)
+        }
         if (add.sig) {
             contour(x, period2, Signif, levels=1, labels=siglvl,
                     drawlabels = FALSE, axes = FALSE,

Modified: pkg/dplR/man/wavelet.plot.Rd
===================================================================
--- pkg/dplR/man/wavelet.plot.Rd	2014-05-12 18:53:38 UTC (rev 864)
+++ pkg/dplR/man/wavelet.plot.Rd	2014-05-13 15:10:04 UTC (rev 865)
@@ -15,7 +15,8 @@
              key.lab = parse(text=paste0("\"", gettext("Power"), "\"^2")),
              add.spline = FALSE, f = 0.5, nyrs = NULL,
              crn.col = "black", crn.lwd = 1,coi.col='black',
-             crn.ylim = range(wave.list$y)*1.1, side.by.side = FALSE)
+             crn.ylim = range(wave.list$y)*1.1, side.by.side = FALSE,
+             useRaster = FALSE, res = 150)
 }
 \arguments{
   \item{wave.list}{A \code{list}. Output from \code{\link{morlet}}.}
@@ -38,7 +39,17 @@
   \item{coi.col}{Color for the COI if \code{add.coi} is \code{TRUE}.}
   \item{crn.ylim}{Axis limits for the time-series plot.}
   \item{side.by.side}{A \code{logical} flag. Plots will be in one row if
-    \code{TRUE}. }
+    \code{TRUE}.}
+  \item{useRaster}{A \code{logical} flag.  If \code{TRUE}, the filled
+    contours are drawn as a raster image.  Other parts of the plot are
+    not affected.  \code{useRaster=TRUE} can be especially useful when a
+    \code{pdf} device is used: the size and complexity of the
+    \acronym{PDF} file will probably be greatly reduced.  Setting this
+    to \code{TRUE} only has negative effects when used with a bitmap
+    device such as \code{png}.  The default is \code{FALSE}.  }
+  \item{res}{A \code{numeric} vector of length 1.  The resolution
+    (pixels per inch) of the filled contours when \code{useRaster} is
+    \code{TRUE}.}
 }
 \details{
   This produces a plot of a continuous wavelet transform and plots the



More information about the Dplr-commits mailing list