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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Dec 13 18:51:53 CET 2018


Author: andybunn
Date: 2018-12-13 18:51:52 +0100 (Thu, 13 Dec 2018)
New Revision: 1138

Modified:
   pkg/dplR/R/ccf.series.rwl.R
   pkg/dplR/R/xskel.ccf.plot.R
Log:
tidying up the ccf changes by adding text to plots.

Modified: pkg/dplR/R/ccf.series.rwl.R
===================================================================
--- pkg/dplR/R/ccf.series.rwl.R	2018-12-12 23:34:51 UTC (rev 1137)
+++ pkg/dplR/R/ccf.series.rwl.R	2018-12-13 17:51:52 UTC (rev 1138)
@@ -5,6 +5,10 @@
                            pcrit = 0.05, lag.max = 5, make.plot = TRUE,
                            floor.plus1 = FALSE, series.x = FALSE, ...) {
 
+    series.x.txt <- ifelse(series.x,
+                           "NB: With series.x = TRUE, postive lags indicate missing rings in series",
+                           "NB: With series.x = FALSE (default), negative lags indicate missing rings in series")
+    cat(series.x.txt)
     ## Handle different types of 'series'
     tmp <- pick.rwl.series(rwl, series, series.yrs)
     rwl2 <- tmp[[1]]
@@ -135,8 +139,13 @@
                        panel.dotplot(x, y, col = col, fill=bg,
                                      pch=21,...)
                    }, ...)
+        if(series.x) { ccf.plot <- update(ccf.plot, sub=series.x.txt) }
+        else { ccf.plot <- update(ccf.plot, sub=series.x.txt) }
         trellis.par.set(strip.background = list(col = "transparent"),
-                        warn = FALSE)
+                        warn = FALSE,
+                        par.sub.text = list(font = 1, cex=0.75,
+                                            just = "left", 
+                                            x = grid::unit(5, "mm")))
         print(ccf.plot)
     }
     res <- list(res.cor,bins)

Modified: pkg/dplR/R/xskel.ccf.plot.R
===================================================================
--- pkg/dplR/R/xskel.ccf.plot.R	2018-12-12 23:34:51 UTC (rev 1137)
+++ pkg/dplR/R/xskel.ccf.plot.R	2018-12-13 17:51:52 UTC (rev 1138)
@@ -1,6 +1,7 @@
 xskel.ccf.plot <- function(rwl,series,series.yrs = as.numeric(names(series)),
          win.start, win.width=50, n = NULL, prewhiten = TRUE,
          biweight = TRUE, series.x = FALSE) {
+  
   ## check to see that win.width is even
   if(as.logical(win.width %% 2)) stop("'win.width' must be even")
   if (win.width > 100) {
@@ -213,11 +214,13 @@
   popViewport(2) # back to bnd
 
   negText <- textGrob(gettext("(Negative)", domain="R-dplR"),
-                      y=unit(-0.5,"lines"),x=unit(3,"native"),
+                      y=unit(0.25,"lines"),x=unit(3,"native"),
                       just = textJust)
   posText <- textGrob(gettext("(Positive)", domain="R-dplR"),
-                      y=unit(-0.5,"lines"),x=unit(9,"native"),
+                      y=unit(0.25,"lines"),x=unit(9,"native"),
                       just = textJust)
+  
+
   for (period in c("early", "late")) {
       if (period == "early") {
           vp1 <- ccf.early.bnd.vp
@@ -255,7 +258,7 @@
   periodPattern <- gettext("Period: %d-%d", domain = "R-dplR")
   agreePattern <- gettext("Skeleton Agreement %s%%", domain = "R-dplR")
 
-  grid.segments(x0=0.5,y0=0,x1=0.5,y1=0.95,
+  grid.segments(x0=0.5,y0=0.05,x1=0.5,y1=0.95,
                 default.units="npc",
                 gp=gpar(lwd=2,lend="butt", col="black"))
   pushViewport(text.bnd.vp) # description
@@ -263,6 +266,7 @@
                         list(period = sprintf(periodPattern,
                              min(first.yrs), max(first.yrs)),
                              corr = early.r))
+  
   grid.text(tmp.txt,y=unit(0.65,"npc"),x=unit(0.25,"npc"),
             just = textJust)
 
@@ -292,6 +296,13 @@
                              agree = sprintf(agreePattern, overall.agree)))
   grid.text(tmp.txt,y=unit(0.5,"npc"),x=unit(0.5,"npc"),
             just = textJust)
+  
+  
   popViewport(2)
-
+  series.x.txt <- ifelse(series.x,
+                         "NB: With series.x = TRUE, postive lags indicate missing rings in series",
+                         "NB: With series.x = FALSE (default), negative lags indicate missing rings in series")
+  grid.text(series.x.txt,y=unit(0.015,"npc"),x=unit(0.5,"npc"),
+            just = textJust)
+  
 }



More information about the Dplr-commits mailing list