[Dplr-commits] r868 - pkg/dplR/R

[noreply at r-forge.r-project.org]

Author: mvkorpel
Date: 2014-05-13 23:47:33 +0200 (Tue, 13 May 2014)
New Revision: 868

Modified:
   pkg/dplR/R/rasterPlot.R
Log:
Optimization: in most cases it should be enough to add a raster image to the plot region.  This is now the default in rasterPlot().

Modified: pkg/dplR/R/rasterPlot.R
===================================================================
--- pkg/dplR/R/rasterPlot.R	2014-05-13 17:54:15 UTC (rev 867)
+++ pkg/dplR/R/rasterPlot.R	2014-05-13 21:47:33 UTC (rev 868)
@@ -10,36 +10,42 @@
 ###            mtext(), .filled.contour()
 ### res        Resolution in points per inch.
 ###            Estimated useful range: 100 - 300.
+### region     Draw in the plot region or the figure region?
+###            The figure region contains the plot region and margins.
+###            Plotting in the outer margin is not supported.
 ### 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) {
+rasterPlot <- function(x, res = 150, region=c("plot", "figure"), 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")
     }
+    region2 <- match.arg(region)
+    plotRegion <- region2 == "plot"
     ## 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"]]
+    pngWidthHeight <- op[[c(figure="fin", plot="pin")[region2]]]
     op <- op[!(names(op) %in%
                c("ask", "bg", "fig", "fin", "mar", "mfcol", "mfg", "mfrow",
-                 "new", "oma", "omd", "omi", "pin", "plt"))]
+                 "new", "oma", "omd", "omi", "pin", "plt",
+                 if (plotRegion) "mai"))]
     ## 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],
+        png(fname, width = pngWidthHeight[1], height = pngWidthHeight[2],
             units = "in", res = res, bg = "transparent")
     } else {
-        png(fname, width = figureWidthHeight[1], height = figureWidthHeight[2],
+        png(fname, width = pngWidthHeight[1], height = pngWidthHeight[2],
             units = "in", res = res, bg = "transparent", antialias = antialias)
     }
     ## Record things to do on exit (will be removed from list one-by-one)
@@ -48,11 +54,14 @@
     on.exit(unlink(fname), add=TRUE)
     devAskNewPage(FALSE)
     par(mfcol=c(1,1))
-    par(oma=rep(0, 4))
+    par(omi=rep(0, 4))
+    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.
+    ## (margins), coordinates of plot region, etc.
     par(op)
     ## Evaluate the plotting commands 'x' in the environment of the
     ## caller of rasterPlot()
@@ -73,26 +82,32 @@
     ## 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)
+    if (plotRegion) {
+        ## Add a raster image to the plot region of the original plot
+        rasterImage(pngData, xleft = usrLeft, ybottom = usrBottom,
+                    xright = usrRight, ytop = usrTop)
+    } 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)
+    }
 }