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

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

Author: mvkorpel
Date: 2012-10-03 14:15:09 +0200 (Wed, 03 Oct 2012)
New Revision: 653

Modified:
   pkg/dplR/ChangeLog
   pkg/dplR/DESCRIPTION
   pkg/dplR/R/sea.R
Log:
In sea.R: extra input checks, small optimizations


Modified: pkg/dplR/ChangeLog
===================================================================
--- pkg/dplR/ChangeLog	2012-10-02 15:22:29 UTC (rev 652)
+++ pkg/dplR/ChangeLog	2012-10-03 12:15:09 UTC (rev 653)
@@ -26,9 +26,19 @@
   tree ring series by using a data.frame 'master' argument
 - Replaced some for loops with cleaner vectorized operations or apply().
 
+File: sea.R
+-----------
+
+- Extra input checks (e.g. x must have explicit, non-automatic row-names)
+- Some matrices now have the correct type (numeric instead of logical)
+  right from the beginning
+- Small optimization: a temporary matrix is completely overwritten on
+  every round of a loop, so no need to reinitialize
+- Braces always used in if (else) constructs
+
 File: DESCRIPTION
----------------
-- Changed author and maintainer to Andy Bunn from Andrew G. Bunn to keep parity between 
+-----------------
+- Changed author and maintainer to Andy Bunn from Andrew G. Bunn to keep parity between
   the names and the email address AGB uses to submit to CRAN. This was made at the
   request of Kurt Hornik at CRAN
 

Modified: pkg/dplR/DESCRIPTION
===================================================================
--- pkg/dplR/DESCRIPTION	2012-10-02 15:22:29 UTC (rev 652)
+++ pkg/dplR/DESCRIPTION	2012-10-03 12:15:09 UTC (rev 653)
@@ -3,7 +3,7 @@
 Type: Package
 Title: Dendrochronology Program Library in R
 Version: 1.5.6
-Date: 2012-10-02
+Date: 2012-10-03
 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/sea.R
===================================================================
--- pkg/dplR/R/sea.R	2012-10-02 15:22:29 UTC (rev 652)
+++ pkg/dplR/R/sea.R	2012-10-03 12:15:09 UTC (rev 653)
@@ -1,14 +1,25 @@
 sea <- function(x, key, lag = 5, resample = 1000) {
-    if(!is.data.frame(x))
+    if (!is.data.frame(x)) {
         stop("'x' must be a data.frame")
-    if (dim(x)[2] > 1)                  # remove samp.depth if present
+    }
+    stopifnot(is.numeric(lag), length(lag) == 1, is.finite(lag),
+              lag >= 0, round(lag) == lag)
+    stopifnot(is.numeric(resample), length(resample) == 1, is.finite(resample),
+              resample >= 1, round(resample) == resample)
+    if (ncol(x) >= 1) {                 # remove samp.depth if present
         x.unscaled <- x[1]
-    else
-        x.unscaled <- x
+    } else {
+        stop("'x' must have at least one column")
+    }
+    rnames <- row.names(as.matrix(x.unscaled))
+    if (is.null(rnames)) {
+        stop("'x' must have non-automatic row.names")
+    }
+    rnames <- as.numeric(rnames)
     x.scaled <- data.frame(scale(x.unscaled))
     n <- length(key)
     m <- 2 * lag + 1
-    se.table <- matrix(NA, ncol = m, nrow = n)
+    se.table <- matrix(NA_real_, ncol = m, nrow = n)
     se.unscaled.table <- se.table
     yrs.base <- (-lag):(m - lag - 1)
     seq.n <- seq_len(n)
@@ -19,18 +30,18 @@
     }
     se <- colMeans(se.table, na.rm = TRUE)
     se.unscaled <- colMeans(se.unscaled.table, na.rm = TRUE)
-    re.table <- matrix(NA, ncol = m, nrow = resample)
-    rnames <- as.numeric(row.names(x.scaled))
+    re.table <- matrix(NA_real_, ncol = m, nrow = resample)
+    re.subtable <- matrix(NA_real_, ncol = m, nrow = n)
     for (k in seq_len(resample)) {
-        re.subtable <- matrix(NA, ncol = m, nrow = n)
         rand.key <- sample(rnames, n, replace = TRUE)
-        for (i in seq.n)
+        for (i in seq.n) {
             re.subtable[i, ] <-
                 x.scaled[as.character(rand.key[i] + yrs.base), ]
+        }
         re.table[k, ] <- colMeans(re.subtable, na.rm = TRUE)
     }
     ## calculate significance for each (lagged) year
-    p <- rep(as.numeric(NA), m)
+    p <- rep(NA_real_, m)
     w <- resample
     for (i in seq_len(m)) {
         if (is.na(se[i])) {