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

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

Author: mvkorpel
Date: 2014-04-15 12:25:47 +0200 (Tue, 15 Apr 2014)
New Revision: 816

Modified:
   pkg/dplR/DESCRIPTION
   pkg/dplR/R/insert.ring.R
Log:
* insert.ring(): it is now possible to insert a ring before the first
  previously existing ring
* insert.ring() and delete.ring():
  - check for valid argument values
  - ensure that sequences used for indexing are increasing or zero-length


Modified: pkg/dplR/DESCRIPTION
===================================================================
--- pkg/dplR/DESCRIPTION	2014-04-15 04:03:14 UTC (rev 815)
+++ pkg/dplR/DESCRIPTION	2014-04-15 10:25:47 UTC (rev 816)
@@ -3,7 +3,7 @@
 Type: Package
 Title: Dendrochronology Program Library in R
 Version: 1.6.0
-Date: 2014-04-12
+Date: 2014-04-15
 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph",
         "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko",
         "Korpela", role = c("aut", "trl")), person("Franco", "Biondi",

Modified: pkg/dplR/R/insert.ring.R
===================================================================
--- pkg/dplR/R/insert.ring.R	2014-04-15 04:03:14 UTC (rev 815)
+++ pkg/dplR/R/insert.ring.R	2014-04-15 10:25:47 UTC (rev 816)
@@ -1,25 +1,65 @@
-insert.ring <- function(rw.vec,rw.vec.yrs=as.numeric(names(rw.vec)),
-                        year,ring.value=mean(rw.vec,na.rm=TRUE),
-                        fix.last=TRUE){
-  n <- length(rw.vec)
-  first.yr <- rw.vec.yrs[1]
-  last.yr <- rw.vec.yrs[n]
-  year.index <- which(rw.vec.yrs==year)    
-  rw.vec2 <- c(rw.vec[1:year.index],ring.value,rw.vec[(year.index+1):n])
-  if(fix.last) { names(rw.vec2) <- (first.yr-1):last.yr }
-  else { names(rw.vec2) <- first.yr:(last.yr+1) }
-  rw.vec2
+insert.ring <- function(rw.vec, rw.vec.yrs=as.numeric(names(rw.vec)),
+                        year, ring.value=mean(rw.vec,na.rm=TRUE),
+                        fix.last=TRUE) {
+    n <- length(rw.vec)
+    stopifnot(is.numeric(ring.value), length(ring.value) == 1,
+              is.finite(ring.value), ring.value >= 0,
+              is.numeric(year), length(year) == 1, is.finite(year),
+              n > 0, length(rw.vec.yrs) == n,
+              identical(fix.last, TRUE) || identical(fix.last, FALSE))
+    first.yr <- rw.vec.yrs[1]
+    last.yr <- rw.vec.yrs[n]
+    if (!is.finite(first.yr) || !is.finite(last.yr) ||
+        round(first.yr) != first.yr || last.yr - first.yr != n - 1) {
+        ## Basic sanity check, _not_ a full test of consecutive years
+        stop("input data must have consecutive years in increasing order")
+    }
+    if (year == first.yr - 1) {
+        year.index <- 0
+    } else {
+        year.index <- which(rw.vec.yrs == year)
+    }
+    if (length(year.index) == 1) {
+        rw.vec2 <- c(rw.vec[seq_len(year.index)],
+                     ring.value,
+                     rw.vec[seq(from = year.index+1, by = 1,
+                                length.out = n - year.index)])
+        if (fix.last) {
+            names(rw.vec2) <- (first.yr-1):last.yr
+        } else {
+            names(rw.vec2) <- first.yr:(last.yr+1)
+        }
+        rw.vec2
+    } else {
+        stop("invalid 'year': skipping years not allowed")
+    }
 }
 
-delete.ring <- function(rw.vec,rw.vec.yrs=as.numeric(names(rw.vec)),
-                        year,fix.last=TRUE){
-  n <- length(rw.vec)
-  first.yr <- rw.vec.yrs[1]
-  last.yr <- rw.vec.yrs[n]
-  year.index <- which(rw.vec.yrs==year)
-  rw.vec2 <- rw.vec[c(1:(year.index-1),(year.index+1):n)]
-  
-  if(fix.last){ names(rw.vec2) <- (first.yr+1):last.yr }
-  else { names(rw.vec2) <- first.yr:(last.yr-1)}
-  rw.vec2
+delete.ring <- function(rw.vec, rw.vec.yrs=as.numeric(names(rw.vec)),
+                        year, fix.last=TRUE) {
+    n <- length(rw.vec)
+    stopifnot(is.numeric(year), length(year) == 1, is.finite(year),
+              n > 0, length(rw.vec.yrs) == n,
+              identical(fix.last, TRUE) || identical(fix.last, FALSE))
+    first.yr <- rw.vec.yrs[1]
+    last.yr <- rw.vec.yrs[n]
+    if (!is.finite(first.yr) || !is.finite(last.yr) ||
+        round(first.yr) != first.yr || last.yr - first.yr != n - 1) {
+        ## Basic sanity check, _not_ a full test of consecutive years
+        stop("input data must have consecutive years in increasing order")
+    }
+    year.index <- which(rw.vec.yrs == year)
+    if (length(year.index) == 1) {
+        rw.vec2 <- rw.vec[-year.index]
+        if (n > 1) {
+            if (fix.last) {
+                names(rw.vec2) <- (first.yr+1):last.yr
+            } else {
+                names(rw.vec2) <- first.yr:(last.yr-1)
+            }
+        }
+        rw.vec2
+    } else {
+        stop("'year' not present in 'rw.vec.yrs'")
+    }
 }