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

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

Author: mvkorpel
Date: 2015-05-04 13:52:37 +0200 (Mon, 04 May 2015)
New Revision: 982

Modified:
   pkg/dplR/ChangeLog
   pkg/dplR/DESCRIPTION
   pkg/dplR/R/helpers.R
Log:
Robustness tweaks in helper functions

Modified: pkg/dplR/ChangeLog
===================================================================
--- pkg/dplR/ChangeLog	2015-04-30 11:43:52 UTC (rev 981)
+++ pkg/dplR/ChangeLog	2015-05-04 11:52:37 UTC (rev 982)
@@ -59,6 +59,16 @@
 - Increased performance by using sparse matrices from the Matrix
   package.
 
+File: helpers.R
+---------------
+
+- Internal function fix.names() now checks its 'mapping.fname'
+  argument more thoroughly. This makes write.compact() and
+  write.tucson() more robust against unusual values of that
+  argument: wrong type, "bytes" encoding, zero length or NA.
+- Internal function vecMatched does not care if nzchar() starts
+  returning NA some day.
+
 File: latexify.R
 ----------------
 

Modified: pkg/dplR/DESCRIPTION
===================================================================
--- pkg/dplR/DESCRIPTION	2015-04-30 11:43:52 UTC (rev 981)
+++ pkg/dplR/DESCRIPTION	2015-05-04 11:52:37 UTC (rev 982)
@@ -3,7 +3,7 @@
 Type: Package
 Title: Dendrochronology Program Library in R
 Version: 1.6.3
-Date: 2015-04-30
+Date: 2015-05-04
 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/helpers.R
===================================================================
--- pkg/dplR/R/helpers.R	2015-04-30 11:43:52 UTC (rev 981)
+++ pkg/dplR/R/helpers.R	2015-05-04 11:52:37 UTC (rev 982)
@@ -184,6 +184,12 @@
 ### cases. The output vector keeps the names of the input vector.
 fix.names <- function(x, limit=NULL, mapping.fname="", mapping.append=FALSE,
                       basic.charset=TRUE) {
+    fn <- mapping.fname
+    if (!is.character(fn) || is.na(fn[1]) || Encoding(fn[1]) == "bytes") {
+        fn <- ""
+    } else {
+        fn <- fn[1]
+    }
     write.map <- FALSE
     n.x <- length(x)
     x.cut <- x
@@ -193,7 +199,7 @@
         idx.bad <- grep(bad.chars, x.cut, perl=TRUE)
         if (length(idx.bad) > 0) {
             warning("characters outside a-z, A-Z, 0-9 present: renaming series")
-            if (nzchar(mapping.fname)) {
+            if (nzchar(fn)) {
                 write.map <- TRUE
             }
             rename.flag[idx.bad] <- TRUE
@@ -205,7 +211,7 @@
         over.limit <- nchar(x.cut) > limit
         if (any(over.limit)) {
             warning("some names are too long: renaming series")
-            if (nzchar(mapping.fname)) {
+            if (nzchar(fn)) {
                 write.map <- TRUE
             }
             rename.flag[over.limit] <- TRUE
@@ -221,7 +227,7 @@
         y <- x.cut
     } else {
         warning("duplicate names present: renaming series")
-        if (nzchar(mapping.fname)) {
+        if (nzchar(fn)) {
             write.map <- TRUE
         }
 
@@ -276,10 +282,10 @@
         }
     }
     if (write.map) {
-        if (mapping.append && file.exists(mapping.fname)) {
-            map.file <- file(mapping.fname, "a")
+        if (mapping.append && file.exists(fn)) {
+            map.file <- file(fn, "a")
         } else {
-            map.file <- file(mapping.fname, "w")
+            map.file <- file(fn, "w")
         }
         for (i in which(rename.flag)) {
             if (x[i] != y[i]) {
@@ -376,7 +382,8 @@
         if (nNA == 0) {
             y[matches] <- x
         } else {
-            flagBad <- nzchar(xNames[isNA])
+            xNA <- xNames[isNA]
+            flagBad <- is.na(xNA) | nzchar(xNA)
             if (any(flagBad)) {
                 stop(gettextf("unknown element(s): %s",
                               paste(xNames[isNA][flagBad],collapse=", ")))