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

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

Author: mvkorpel
Date: 2014-05-15 19:03:50 +0200 (Thu, 15 May 2014)
New Revision: 877

Modified:
   pkg/dplR/NAMESPACE
   pkg/dplR/R/xskel.ccf.plot.R
   pkg/dplR/R/xskel.plot.R
Log:
Speedup due to use of vectorized grid.rect(). Also dev.hold() and dev.flush().

Modified: pkg/dplR/NAMESPACE
===================================================================
--- pkg/dplR/NAMESPACE	2014-05-15 16:11:48 UTC (rev 876)
+++ pkg/dplR/NAMESPACE	2014-05-15 17:03:50 UTC (rev 877)
@@ -9,7 +9,7 @@
 
 importFrom(gmp, as.bigq, as.bigz, chooseZ, is.bigq)
 
-importFrom(grDevices, rainbow)
+importFrom(grDevices, dev.hold, dev.flush, rainbow)
 
 importFrom(grid, gpar, grid.lines, grid.newpage, grid.polygon,
            grid.segments, grid.text, pushViewport, seekViewport, unit,

Modified: pkg/dplR/R/xskel.ccf.plot.R
===================================================================
--- pkg/dplR/R/xskel.ccf.plot.R	2014-05-15 16:11:48 UTC (rev 876)
+++ pkg/dplR/R/xskel.ccf.plot.R	2014-05-15 17:03:50 UTC (rev 877)
@@ -157,6 +157,8 @@
 
 
   ## actual plotting
+  dev.hold()
+  on.exit(dev.flush())
   pushViewport(bnd.vp) # inside margins
   pushViewport(skel.bnd.vp) # inside skel
   pushViewport(skel.region.vp) # inside margins
@@ -166,20 +168,12 @@
              gp = gpar(col=col1light, lineend = "square",
                        linejoin = "round"))
   ## rw plot
-  master.tmp <- master*-2
-  for(i in 1:length(yrs)){
-    xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5)
-    yy <- c(0,0,master.tmp[i],master.tmp[i])
-    grid.polygon(xx,yy,default.units="native",
-                 gp=gpar(fill=col1light,col=col1dark))
-  }
-  series.tmp <- series*2
-  for(i in 1:length(yrs)){
-    xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5)
-    yy <- c(0,0,series.tmp[i],series.tmp[i])
-    grid.polygon(xx,yy,default.units="native",
-                 gp=gpar(fill=col1light,col=col1dark))
-  }
+  grid.rect(x = yrs, y = 0, width = 1, height = 2 * master,
+            hjust = 0.5, vjust = 1, default.units = "native",
+            gp=gpar(fill=col1light,col=col1dark))
+  grid.rect(x = yrs, y = 0, width = 1, height = 2 * series,
+            hjust = 0.5, vjust = 0, default.units = "native",
+            gp=gpar(fill=col1light,col=col1dark))
 
   ## master
   grid.segments(x0=master.yrs.sig,y0=0,

Modified: pkg/dplR/R/xskel.plot.R
===================================================================
--- pkg/dplR/R/xskel.plot.R	2014-05-15 16:11:48 UTC (rev 876)
+++ pkg/dplR/R/xskel.plot.R	2014-05-15 17:03:50 UTC (rev 877)
@@ -91,6 +91,8 @@
                              name = "overall.txt.vp")
 
   ## actual plotting
+  dev.hold()
+  on.exit(dev.flush())
   pushViewport(bnd.vp) # inside margins
   pushViewport(skel.bnd.vp) # inside skel
   pushViewport(skel.region.vp) # inside margins
@@ -100,20 +102,12 @@
              gp = gpar(col=col1light, lineend = "square",
                        linejoin = "round"))
   ## rw plot
-  master.tmp <- master*-2
-  for(i in 1:length(yrs)){
-    xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5)
-    yy <- c(0,0,master.tmp[i],master.tmp[i])
-    grid.polygon(xx,yy,default.units="native",
-                 gp=gpar(fill=col1light,col=col1dark))
-  }
-  series.tmp <- series*2
-  for(i in 1:length(yrs)){
-    xx <- c(yrs[i]+0.5,yrs[i]-0.5,yrs[i]-0.5,yrs[i]+0.5)
-    yy <- c(0,0,series.tmp[i],series.tmp[i])
-    grid.polygon(xx,yy,default.units="native",
-                 gp=gpar(fill=col1light,col=col1dark))
-  }
+  grid.rect(x = yrs, y = 0, width = 1, height = 2 * master,
+            hjust = 0.5, vjust = 1, default.units = "native",
+            gp=gpar(fill=col1light,col=col1dark))
+  grid.rect(x = yrs, y = 0, width = 1, height = 2 * series,
+            hjust = 0.5, vjust = 0, default.units = "native",
+            gp=gpar(fill=col1light,col=col1dark))
 
   ## master
   grid.segments(x0=master.yrs.sig,y0=0,