More ways to deal with int/site bug.

DOI-USGS · Dec 3, 2015 · 34403cc · 34403cc
1 parent 49bae52
commit 34403cc
Show file tree

Hide file tree

Showing 4 changed files with 34 additions and 15 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -43,6 +43,7 @@ importFrom(lubridate,fast_strptime)
 importFrom(lubridate,parse_date_time)
 importFrom(plyr,rbind.fill.matrix)
 importFrom(readr,col_character)
+importFrom(readr,col_number)
 importFrom(readr,cols)
 importFrom(readr,parse_number)
 importFrom(readr,problems)

diff --git a/R/importRDB1.r b/R/importRDB1.r
@@ -117,31 +117,39 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz=""){
 
   if(convertType){
     readr.data <- suppressWarnings(read_delim(doc, skip = (meta.rows+2),delim="\t",col_names = FALSE))
-    badCols <- problems(readr.data)$col
-    if(length(badCols) > 0){
-      unique.bad.cols <- unique(badCols)
-      readr.data.char <- read_delim(doc, skip = (meta.rows+2),delim="\t",col_names = FALSE, 
-                                    col_types = cols(.default = "c"))
-      readr.data[,unique.bad.cols] <- lapply(readr.data.char[,unique.bad.cols], parse_number)
-
-    }
-
   } else {
     readr.data <- read_delim(doc, skip = (meta.rows+2),delim="\t",col_names = FALSE, col_types = cols(.default = "c"))
   }
 
   names(readr.data) <- header.names
 
   if("site_no" %in% names(readr.data)){
-    if(!is.integer(readr.data$site_no)){
-      if(is.null(readr.data.char)){
+    if(is.integer(readr.data$site_no)){
+      readr.data.char <- read_delim(doc, skip = (meta.rows+2),delim="\t",col_names = FALSE, 
+                                    col_types = cols(.default = "c"))
+      names(readr.data.char) <- header.names
+      readr.data$site_no <- readr.data.char$site_no
+    }
+  }
+
+  badCols <- problems(readr.data)$col
+  if(length(badCols) > 0){
+    unique.bad.cols <- unique(badCols)
+
+    index.col <- as.integer(gsub("X","",unique.bad.cols))
+
+    if(!(all(header.names[index.col] %in% "site_no"))){
+      unique.bad.cols <- unique.bad.cols[!(header.names[index.col] %in% "site_no")]
+      index.col <- as.integer(gsub("X","",unique.bad.cols))
+      unique.bad.cols.names <- header.names[index.col]
+      if(!exists("readr.data.char")){
         readr.data.char <- read_delim(doc, skip = (meta.rows+2),delim="\t",col_names = FALSE, 
                                       col_types = cols(.default = "c"))
       }
-      names(readr.data.char) <- header.names
-      readr.data$site_no <- readr.data.char$site_no
+      readr.data[,unique.bad.cols.names] <- lapply(readr.data.char[,unique.bad.cols], parse_number)
     }
   }
+
   comment(readr.data) <- readr.meta
   readr.data <- as.data.frame(readr.data)
 

diff --git a/R/importWQP.R b/R/importWQP.R
@@ -19,6 +19,7 @@
 #' @import stats
 #' @importFrom readr read_delim
 #' @importFrom readr col_character
+#' @importFrom readr col_number
 #' @importFrom readr cols
 #' @importFrom dplyr mutate_
 #' @importFrom dplyr mutate_each_
@@ -89,15 +90,21 @@ importWQP <- function(obs_url, zip=FALSE, tz=""){
                              col_types = cols(`ActivityStartTime/Time` = col_character(),
                                               `ActivityEndTime/Time` = col_character(),
                                               USGSPCode = col_character(),
-                                              ResultCommentText=col_character()),
+                                              ResultCommentText=col_character(),
+                                              `ActivityDepthHeightMeasure/MeasureValue` = col_number(),
+                                              `DetectionQuantitationLimitMeasure/MeasureValue` = col_number(),
+                                              ResultMeasureValue = col_number()),
                              quote = "", delim = "\t")
         unlink(doc)
       } else {
         retval <- read_delim(obs_url, 
                              col_types = cols(`ActivityStartTime/Time` = col_character(),
                                               `ActivityEndTime/Time` = col_character(),
                                               USGSPCode = col_character(),
-                                              ResultCommentText=col_character()),
+                                              ResultCommentText=col_character(),
+                                              `ActivityDepthHeightMeasure/MeasureValue` = col_number(),
+                                              `DetectionQuantitationLimitMeasure/MeasureValue` = col_number(),
+                                              ResultMeasureValue = col_number()),
                              quote = "", delim = "\t")
       }
     } else {

diff --git a/tests/testthat/tests_general.R b/tests/testthat/tests_general.R
@@ -26,6 +26,9 @@ test_that("General NWIS retrievals working", {
                     "drain_area_va","obs_count_nu"),service="qw")
   expect_is(qwData$startDateTime, "POSIXct")
 
+  url <- "http://waterservices.usgs.gov/nwis/dv/?Access=0&site=09037500&format=rdb&ParameterCd=00060&StatCd=00003&startDT=1985-10-02&endDT=2012-09-06"
+  dv <- importRDB1(url, asDateTime = FALSE)
+
 })