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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Oct 2 17:03:11 CEST 2012


Author: mvkorpel
Date: 2012-10-02 17:03:10 +0200 (Tue, 02 Oct 2012)
New Revision: 651

Modified:
   pkg/dplR/ChangeLog
   pkg/dplR/DESCRIPTION
   pkg/dplR/R/corr.rwl.seg.R
   pkg/dplR/man/corr.rwl.seg.Rd
Log:
In corr.rwl.seg(), allow the master series to be built from a second set of tree ring series by using a data.frame 'master' argument


Modified: pkg/dplR/ChangeLog
===================================================================
--- pkg/dplR/ChangeLog	2012-08-30 19:57:20 UTC (rev 650)
+++ pkg/dplR/ChangeLog	2012-10-02 15:03:10 UTC (rev 651)
@@ -22,6 +22,8 @@
 
 - Bug fix: series names were not shown (numbers were shown instead)
 - Bug fix: there were off-by-one errors in the length of the bars
+- New feature: allow the master series to be built from a second set of
+  tree ring series by using a data.frame 'master' argument
 
 File: DESCRIPTION
 ---------------

Modified: pkg/dplR/DESCRIPTION
===================================================================
--- pkg/dplR/DESCRIPTION	2012-08-30 19:57:20 UTC (rev 650)
+++ pkg/dplR/DESCRIPTION	2012-10-02 15:03:10 UTC (rev 651)
@@ -3,7 +3,7 @@
 Type: Package
 Title: Dendrochronology Program Library in R
 Version: 1.5.6
-Date: 2012-08-29
+Date: 2012-10-02
 Authors at R: c(person(c("Andrew", "G."), "Bunn", role = c("aut", "cph",
         "cre", "trl"), email = "andrew.bunn at wwu.edu"), person("Mikko",
         "Korpela", role = c("aut", "cph")), person("Franco", "Biondi",

Modified: pkg/dplR/R/corr.rwl.seg.R
===================================================================
--- pkg/dplR/R/corr.rwl.seg.R	2012-08-30 19:57:20 UTC (rev 650)
+++ pkg/dplR/R/corr.rwl.seg.R	2012-10-02 15:03:10 UTC (rev 651)
@@ -2,7 +2,12 @@
                          prewhiten = TRUE, pcrit=0.05, biweight=TRUE,
                          make.plot = TRUE, label.cex=1,
                          floor.plus1 = FALSE, master = NULL,
-                         master.yrs = as.numeric(names(master)), ...) {
+                         master.yrs = as.numeric(if (is.null(dim(master))) {
+                             names(master)
+                         } else {
+                             rownames(master)
+                         }),
+                         ...) {
 
     ## helper function
     yr.range <- function(x, yr.vec=as.numeric(names(x))) {
@@ -42,20 +47,52 @@
                        nrow = max.yr - min.yr + 1,
                        ncol = nseries,
                        dimnames = list(as.character(yrs), cnames))
-        rwl.tmp <- as.matrix(rwl)
-        for (rname in row.names(rwl)) {
-            rwl2[rname, ] <- rwl.tmp[rname, ]
-        }
+        rwl2[row.names(rwl), ] <- as.matrix(rwl)
         rwl2 <- as.data.frame(rwl2)
     }
 
     ## Pad rwl and master (if present) to same number of years
     if (!is.null(master)) {
+        master.dim <- dim(master)
         min.master.yr <- min(master.yrs)
         max.master.yr <- max(master.yrs)
-        master2 <- rep(NA_real_, max.master.yr - min.master.yr + 1)
-        names(master2) <- min.master.yr : max.master.yr
-        master2[as.character(master.yrs)] <- master
+
+        if (!is.null(master.dim) && length(master.dim) == 2 &&
+            master.dim[2] > 1) {
+            ## A. master is a data.frame or a matrix.  Normalize and
+            ## compute master chronology as a mean of series
+            ## (columns).
+
+            ## Ensure that master has consecutive years in increasing order
+            if (!all(diff(master.yrs) == 1)) {
+                char.yrs <- as.character(min.master.yr : max.master.yr)
+                master.inc <- matrix(NA_real_,
+                                     nrow = max.master.yr - min.master.yr + 1,
+                                     ncol = master.dim[2],
+                                     dimnames = list(char.yrs,
+                                     colnames(master)))
+                master.inc[rownames(master), ] <- as.matrix(master)
+            } else {
+                master.inc <- master
+            }
+
+            ## normalize all series (columns in master matrix)
+            tmp <- normalize1(master.inc, n, prewhiten)
+            master.norm <- tmp$master[, tmp$idx.good, drop=FALSE]
+
+            ## compute master series by normal mean or robust mean
+            if (!biweight) {
+                master2 <- apply(master.norm, 1, exactmean)
+            } else {
+                master2 <- apply(master.norm, 1, tbrm, C=9)
+            }
+        } else {
+            ## B. master is a vector
+            master2 <- rep(NA_real_, max.master.yr - min.master.yr + 1)
+            names(master2) <- as.character(min.master.yr : max.master.yr)
+            master2[as.character(master.yrs)] <- master
+        }
+
         if (min.master.yr < min.yr) {
             n.pad <- min.yr - min.master.yr
             padding <- matrix(NA_real_, n.pad, nseries)
@@ -129,16 +166,10 @@
             master.norm <- rwi[, idx.good & idx.noti, drop=FALSE]
 
             ## compute master series by normal mean or robust mean
-            master2 <- vector(mode="numeric", length=nyrs)
             if (!biweight) {
-                for (j in seq_len(nyrs)) {
-                    master2[j] <- exactmean(master.norm[j, ])
-                }
+                master2 <- apply(master.norm, 1, exactmean)
             } else {
-                ## surprisingly, for loop is faster than apply
-                for (j in seq_len(nyrs)) {
-                    master2[j] <- tbrm(master.norm[j, ], C=9)
-                }
+                master2 <- apply(master.norm, 1, tbrm, C=9)
             }
         }
         series <- rwi[, i]

Modified: pkg/dplR/man/corr.rwl.seg.Rd
===================================================================
--- pkg/dplR/man/corr.rwl.seg.Rd	2012-08-30 19:57:20 UTC (rev 650)
+++ pkg/dplR/man/corr.rwl.seg.Rd	2012-10-02 15:03:10 UTC (rev 651)
@@ -8,7 +8,12 @@
 corr.rwl.seg(rwl, seg.length = 50, bin.floor = 100, n = NULL,
              prewhiten = TRUE, pcrit = 0.05, biweight = TRUE,
              make.plot = TRUE, label.cex = 1, floor.plus1 = FALSE,
-             master = NULL, master.yrs = as.numeric(names(master)),
+             master = NULL,
+             master.yrs = as.numeric(if (is.null(dim(master))) {
+                              names(master)
+                          } else {
+                              rownames(master)
+                          }),
              \dots)
 }
 \arguments{
@@ -35,34 +40,41 @@
   \item{floor.plus1}{ \code{logical} flag.  If \code{TRUE}, one year is
     added to the base location of the first segment (e.g., 1601, 1701,
     1801 \acronym{AD}). }
-  \item{master}{ a \code{numeric} vector.  If not \code{NULL}, the
-    function uses this as the master chronology.  If \code{NULL}, a
-    number of master chronologies, one for each series in
-    \code{\var{rwl}}, is built from \code{\var{rwl}} using the
-    leave-one-out principle. }
+  \item{master}{ \code{NULL}, a \code{numeric} \code{vector} or a
+    \code{matrix}-like object of \code{numeric} values, including a
+    \code{data.frame}.  If \code{NULL}, a number of master chronologies,
+    one for each series in \code{\var{rwl}}, is built from
+    \code{\var{rwl}} using the leave-one-out principle.  If a
+    \code{vector}, the function uses this as the master chronology.  If
+    a \code{matrix} or \code{data.frame}, this object is used for
+    building the master chronology (no leave-one-out). }
   \item{master.yrs}{ a \code{numeric} vector giving the years of
-    \code{\var{series}}.  Defaults to
-    \code{as.numeric(names(\var{master}))}. }
+    \code{\var{series}}.  Defaults to \code{names} or \code{rownames} of 
+    \code{\var{master}} coerced to \code{numeric} type. }
   \item{\dots}{ other arguments passed to plot. }
 }
 \details{
+
   This function calculates correlation serially between each tree-ring
   series and a master chronology built from all the other series in the
   \code{\var{rwl}} object (leave-one-out principle).  Optionally, the
-  user may give a \code{\var{master}} chronology as an argument.  In the
-  latter case, the same master chronology is used for all the series in
-  the \code{\var{rwl}} object.  Correlations are done for each segment
-  of the series where segments are lagged by half the segment length
-  (e.g., 100-year segments would be overlapped by 50-years).  The first
-  segment is placed according to \code{\var{bin.floor}}.  The minimum
-  bin year is calculated as
+  user may give a \code{\var{master}} chronology (a \code{vector}) as an
+  argument.  In the latter case, the same master chronology is used for
+  all the series in the \code{\var{rwl}} object.  The user can also
+  choose to give a \code{\var{master}} \code{data.frame} (series as
+  columns, years as rows), from which a single master chronology is
+  built.
+
+  Correlations are done for each segment of the series where segments
+  are lagged by half the segment length (e.g., 100-year segments would
+  be overlapped by 50-years).  The first segment is placed according to
+  \code{\var{bin.floor}}.  The minimum bin year is calculated as
   \code{ceiling(\var{min.yr}/\var{bin.floor})*\var{bin.floor}} where
   \code{\var{min.yr}} is the first year in either the \code{\var{rwl}}
   object or the user-specified \code{\var{master}} chronology, whichever
   is smaller.  For example if the first year is 626 and
-  \code{\var{bin.floor}} is 100 then the first bin would start in
-  700.  If \code{\var{bin.floor}} is 10 then the first bin would start in
-  630.
+  \code{\var{bin.floor}} is 100 then the first bin would start in 700.
+  If \code{\var{bin.floor}} is 10 then the first bin would start in 630.
 
   Correlations are calculated for the first segment, then the second
   segment and so on.  Correlations are only calculated for segments with



More information about the Dplr-commits mailing list