Add check.rwl() and enforce rwl class uniformly across public functions

ChangeLog

@@ -1,3 +1,57 @@
+* CHANGES IN dplR VERSION 1.8.0
+
+File: helpers.R, NAMESPACE
+--------------------------
+ - Added check.rwl(), a new exported function that validates an object as
+   a proper rwl. If the input is not already class "rwl", coercion is
+   attempted via as.rwl(): on success a warning is issued; on failure a
+   single informative error is raised that describes both the class
+   problem and the structural reason coercion failed. After class
+   validation, check.rwl() warns about any internal NA values (NAs
+   sandwiched between real values within a series) and names the affected
+   series, directing the user to fill.internal.NA().
+
+File: as.rwl.R
+--------------
+ - Added a check that all columns are numeric. Previously as.rwl() would
+   accept a data.frame with character columns and silently assign the rwl
+   class to an invalid object.
+
+File: bai.in.R, bai.out.R, ccf.series.rwl.R, cms.R, common.interval.R,
+       corr.rwl.seg.R, corr.series.seg.R, detrend.R, i.detrend.R,
+       interseries.cor.R, pointer.R, rcs.R, rwl.stats.R, seg.plot.R,
+       series.rwl.plot.R, spag.plot.R, ssf.R, strip.rwl.R,
+       xdate.floater.R
+-----------------------------------------------------------------------
+ - Replaced ad-hoc rwl validation (bare is.data.frame() checks or
+   warning-only class checks) with check.rwl() at the top of each
+   function, providing uniform, informative validation across all
+   public functions that accept an rwl object.
+
+File: sgc.R, sgc.Rd
+--------------------
+ - Renamed the first argument from x to rwl for consistency with the
+   rest of the package. Updated documentation accordingly.
+
+File: chron.R, chron.Rd
+------------------------
+ - Renamed the first argument from x to rwi to correctly reflect that
+   chron() expects detrended ring-width indices, not raw ring widths.
+   Updated documentation accordingly.
+
+File: chron.ars.R, chron.ars.Rd
+---------------------------------
+ - Renamed the first argument from x to rwi for the same reason as
+   chron(). Inner helper functions (pooledAR, postAR, prewhitenAR,
+   prewhitenARIMA) retain their own local x arguments, which are
+   unchanged. Updated documentation accordingly.
+
+File: tests/testthat/test-check.rwl.R
+--------------------------------------
+ - Added 17 new tests covering check.rwl() and as.rwl(): happy path,
+   coercion with warning, structural failure messages, internal NA
+   detection, and all as.rwl() error conditions.
+
 * CHANGES IN dplR VERSION 1.7.9
 
 File: chron.ars.R

R/chron.R

@@ -1,20 +1,19 @@
 `chron` <-
-    function(x, biweight=TRUE, prewhiten=FALSE, ...)
+    function(rwi, biweight=TRUE, prewhiten=FALSE, ...)
 {
     check.flags(biweight, prewhiten)
-    x <- check.rwl(x)
-    samps <- rowSums(!is.na(x))
+    samps <- rowSums(!is.na(rwi))
     if (!biweight) {
-        std <- rowMeans(x, na.rm=TRUE)
+        std <- rowMeans(rwi, na.rm=TRUE)
     } else {
-        std <- apply(x, 1, tbrm, C=9)
+        std <- apply(rwi, 1, tbrm, C=9)
     }
     if (prewhiten) {
-        x.ar <- apply(x, 2, ar.func, ...)
+        rwi.ar <- apply(rwi, 2, ar.func, ...)
         if (!biweight) {
-            res <- rowMeans(x.ar, na.rm=TRUE)
+            res <- rowMeans(rwi.ar, na.rm=TRUE)
         } else {
-            res <- apply(x.ar, 1, tbrm, C=9)
+            res <- apply(rwi.ar, 1, tbrm, C=9)
         }
         res[is.nan(res)] <- NA
         out <- data.frame(std, res, samps)
@@ -25,7 +24,7 @@
         out <- data.frame(std, samps)
         names(out) <- c("std", "samp.depth")
     }
-    row.names(out) <- row.names(x)
+    row.names(out) <- row.names(rwi)
     class(out) <- c("crn", "data.frame")
     out
 }

R/chron.ars.R

@@ -1,4 +1,4 @@
-`chron.ars` <- function(x, biweight=TRUE, maxLag=10,
+`chron.ars` <- function(rwi, biweight=TRUE, maxLag=10,
                         firstAICmin=TRUE, verbose = TRUE,
                         prewhitenMethod=c("ar.yw","arima.CSS-ML")){
   # helpers
@@ -182,19 +182,17 @@
   prewhitenMethod2 <- match.arg(arg = prewhitenMethod,
                                 choices = known.prewhitenMethods,
                                 several.ok = FALSE)
-  x <- check.rwl(x)
+  samps <- rowSums(!is.na(rwi))
 
-  samps <- rowSums(!is.na(x))
-
   # calc std chronology
   if(!biweight) {
-    stdCrn <- rowMeans(x, na.rm=TRUE)
+    stdCrn <- rowMeans(rwi, na.rm=TRUE)
   } else {
-    stdCrn <- apply(x, 1, tbrm, C=9)
+    stdCrn <- apply(rwi, 1, tbrm, C=9)
   }
-  
+
   ### Get the pooled ACF and AR coefs from the RWI
-  outAR <- pooledAR(x,firstAICmin = firstAICmin, maxLag = maxLag)
+  outAR <- pooledAR(rwi, firstAICmin = firstAICmin, maxLag = maxLag)
   # model order
   p <- outAR$orderOut
   # do some verbose output here
@@ -212,10 +210,10 @@
 
   ###  Prewhiten each RWI series individually using the model order
   if(prewhitenMethod2 == "ar.yw") {
-    RWIclean <- apply(x,2,prewhitenAR,p=p)  
+    RWIclean <- apply(rwi, 2, prewhitenAR, p=p)
   }
   if(prewhitenMethod2 == "arima.CSS-ML") {
-    RWIclean <- apply(x,2,prewhitenARIMA,p=p)  
+    RWIclean <- apply(rwi, 2, prewhitenARIMA, p=p)  
   }
 
 
@@ -257,7 +255,7 @@
 
   out <- data.frame(std=stdCrn,res=resCrn,
                     ars=arsCrn,samp.depth=samps)
-  row.names(out) <- row.names(x)
+  row.names(out) <- row.names(rwi)
   class(out) <- c("crn", "data.frame")
   return(out)
 }

R/helpers.R

@@ -441,9 +441,16 @@ find.internal.na <- function(x) {
 ### Called at the top of every public function that takes rwl.
 check.rwl <- function(rwl) {
   if (!inherits(rwl, "rwl")) {
-    warning("'rwl' is not class \"rwl\". Attempting to coerce.",
+    rwl <- tryCatch(
+      as.rwl(rwl),
+      error = function(e) {
+        stop("'rwl' is not class \"rwl\" and coercion failed: ",
+             conditionMessage(e), call. = FALSE)
+      }
+    )
+    # only reached if coercion succeeded
+    warning("'rwl' is not class \"rwl\". Coerced successfully.",
             call. = FALSE)
-    rwl <- as.rwl(rwl)  # stops with a clear message if structure is wrong
   }
   # Check for internal NAs per series, warn strongly if found
   has.internal.na <- vapply(rwl, function(x) any(find.internal.na(x) != 0),

R/sgc.R

@@ -1,9 +1,9 @@
-`sgc` <- 
-  function(x, overlap = 50, prob = TRUE) 
+`sgc` <-
+  function(rwl, overlap = 50, prob = TRUE)
 {
   # checks class rwl and correct overlap
-  x <- check.rwl(x)
-  if(any(length(overlap)!=1 | !is.numeric(overlap) | 
+  rwl <- check.rwl(rwl)
+  if(any(length(overlap)!=1 | !is.numeric(overlap) |
          overlap%%1!=0 | overlap < 3)){
     stop("'overlap' should be a single integer >=3")
   }
@@ -14,14 +14,14 @@
     stop("'prob' must be either TRUE (the default) or FALSE")
   }
   # function starts here
-  n <- dim(x)[2]
+  n <- dim(rwl)[2]
   sgc_mat <- matrix(NA_real_, nrow = n, ncol = n)
   ssgc_mat <- matrix(NA_real_, nrow = n, ncol = n)
   overlap_n <- matrix(NA_real_, nrow = n, ncol = n)
-  rownames(sgc_mat) <- colnames(sgc_mat) <- names(x)
-  rownames(ssgc_mat) <- colnames(ssgc_mat) <- names(x)
-  rownames(overlap_n) <- colnames(overlap_n) <- names(x)
-  treering_sign <- apply(x, 2, diff)
+  rownames(sgc_mat) <- colnames(sgc_mat) <- names(rwl)
+  rownames(ssgc_mat) <- colnames(ssgc_mat) <- names(rwl)
+  rownames(overlap_n) <- colnames(overlap_n) <- names(rwl)
+  treering_sign <- apply(rwl, 2, diff)
   treering_sign <- sign(treering_sign)
   for (i in 1:n) {
     treering_GC <- abs(treering_sign[,i]-treering_sign)

man/chron.Rd

@@ -8,13 +8,13 @@
   \code{\link{detrend}}.
 }
 \usage{
-chron(x, biweight = TRUE, prewhiten = FALSE, \dots)
+chron(rwi, biweight = TRUE, prewhiten = FALSE, \dots)
 }
 \arguments{
-  \item{x}{a \code{data.frame} of (usually detrended) ring widths with
-    \code{rownames(\var{x})} containing years and \code{colnames(x)}
+  \item{rwi}{a \code{data.frame} of (usually detrended) ring widths with
+    \code{rownames(\var{rwi})} containing years and \code{colnames(rwi)}
     containing each series \acronym{ID} such as produced by
-    \code{\link{read.rwl}}}
+    \code{\link{detrend}}}
   \item{biweight}{\code{logical} flag.  If \acronym{TRUE} then a robust
     mean is calculated using \code{\link{tbrm}.}}
   \item{prewhiten}{\code{logical} flag.  If \acronym{TRUE} each series is

man/chron.ars.Rd

@@ -9,14 +9,14 @@
   \code{\link{detrend}}.
 }
 \usage{
-chron.ars(x, biweight=TRUE, maxLag=10, firstAICmin=TRUE, 
+chron.ars(rwi, biweight=TRUE, maxLag=10, firstAICmin=TRUE,
   verbose=TRUE, prewhitenMethod=c("ar.yw","arima.CSS-ML"))
 }
 \arguments{
-  \item{x}{a \code{data.frame} of (usually detrended) ring widths with
-    \code{rownames(\var{x})} containing years and \code{colnames(x)}
+  \item{rwi}{a \code{data.frame} of (usually detrended) ring widths with
+    \code{rownames(\var{rwi})} containing years and \code{colnames(rwi)}
     containing each series \acronym{ID} such as produced by
-    \code{\link{read.rwl}}}
+    \code{\link{detrend}}}
   \item{biweight}{\code{logical} flag.  If \acronym{TRUE} then a robust
     mean is calculated using \code{\link{tbrm}.}}
   \item{maxLag}{an \code{integer} giving the maximum lag to consider in
@@ -98,7 +98,7 @@ chron.ars(x, biweight=TRUE, maxLag=10, firstAICmin=TRUE,
   \item{samp.depth}{the number of series with non-missing values in
     each year.}
 
-  Row names are the years taken from \code{rownames(x)}.
+  Row names are the years taken from \code{rownames(rwi)}.
 }
 \references{
   Cook, E. R. and Kairiukstis, L. A., editors (1990) \emph{Methods of

man/sgc.Rd

@@ -10,11 +10,11 @@
 }
 
 \usage{
-  sgc(x,overlap = 50, prob = TRUE)
+  sgc(rwl, overlap = 50, prob = TRUE)
 }
 
 \arguments{
-  \item{x}{ a \code{data.frame} of tree-ring data with records in columns, and years as rows. }
+  \item{rwl}{ an \code{rwl} object such as that produced by \code{\link{read.rwl}}. Also accepts a \code{data.frame} with series in columns and years as row names. }
   \item{overlap}{ integer value with minimal length of overlapping growth changes (compared number of tree rings - 1). Comparisons with less overlap are not compared.}
   \item{prob}{if \code{TRUE} then the probability of exceedence of the sgc will be calculated}
 }
@@ -36,7 +36,7 @@
     }
   The matrices can be extracted from the list by selecting the name or the index number. Comparisons are only compared if the overlap is above the set theshold and if no threshold is set, this defaults to 50 years.If no comparison can be compared, \code{NA} is returned.
 
-  To calculate the global sgc of the dataset (assuming \code{x.sgc <- sgc(x)}: \code{mean(x.sgc$sgc_mat, na.rm = TRUE))}. For the global ssgc use: \code{mean(x.sgc$ssgc_mat, na.rm = TRUE)}.
+  To calculate the global sgc of the dataset (assuming \code{x.sgc <- sgc(rwl)}: \code{mean(x.sgc$sgc_mat, na.rm = TRUE))}. For the global ssgc use: \code{mean(x.sgc$ssgc_mat, na.rm = TRUE)}.
 
 }