From f4b88d06971fab699cb7ac4924757c7260ea02c5 Mon Sep 17 00:00:00 2001 From: Laura DeCicco Date: Thu, 3 Dec 2015 14:36:14 -0600 Subject: [PATCH 1/5] Bug fix. --- DESCRIPTION | 4 ++-- R/importRDB1.r | 32 ++++++++++++++++++++------------ 2 files changed, 22 insertions(+), 14 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 300ae41a..9ca3b054 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: dataRetrieval Type: Package Title: Retrieval Functions for USGS and EPA Hydrologic and Water Quality Data -Version: 2.4.1 -Date: 2015-11-25 +Version: 2.4.2 +Date: 2015-12-03 Authors@R: c( person("Robert", "Hirsch", role = c("aut"), email = "rhirsch@usgs.gov"), person("Laura", "DeCicco", role = c("aut","cre"), diff --git a/R/importRDB1.r b/R/importRDB1.r index 6b990931..a6a00a48 100644 --- a/R/importRDB1.r +++ b/R/importRDB1.r @@ -115,8 +115,15 @@ 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 <- suppressWarnings(read_delim(doc, skip = (meta.rows+2),delim="\t",col_names = FALSE, col_types = cols(.default = "c"))) + readr.data <- read_delim(doc, skip = (meta.rows+2),delim="\t",col_names = FALSE, col_types = cols(.default = "c")) } names(readr.data) <- header.names @@ -152,7 +159,7 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz=""){ if("tz_cd" %in% header.names){ date.time.cols <- which(sapply(readr.data, function(x) inherits(x, "POSIXct"))) - readr.data <- convertTZ(readr.data,"tz_cd",date.time.cols,tz) + readr.data <- convertTZ(readr.data,"tz_cd",date.time.cols,tz, flip.cols=FALSE) } if("sample_start_time_datum_cd" %in% header.names){ @@ -190,7 +197,7 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz=""){ } -convertTZ <- function(df, tz.name, date.time.cols, tz){ +convertTZ <- function(df, tz.name, date.time.cols, tz, flip.cols=TRUE){ offsetLibrary <- data.frame(offset=c(5, 4, 6, 5, 7, 6, 8, 7, 9, 8, 10, 10, 0, 0), code=c("EST","EDT","CST","CDT","MST","MDT","PST","PDT","AKST","AKDT","HAST","HST","", NA), @@ -211,14 +218,15 @@ convertTZ <- function(df, tz.name, date.time.cols, tz){ df[!is.na(df[,date.time.cols]),tz.name] <- "UTC" } - reported.col <- which(names(df) %in% paste0(tz.name,"_reported")) - orig.col <- which(names(df) %in% tz.name) - - new.order <- 1:ncol(df) - new.order[orig.col] <- reported.col - new.order[reported.col] <- orig.col - - df <- df[,new.order] - + if(flip.cols){ + reported.col <- which(names(df) %in% paste0(tz.name,"_reported")) + orig.col <- which(names(df) %in% tz.name) + + new.order <- 1:ncol(df) + new.order[orig.col] <- reported.col + new.order[reported.col] <- orig.col + + df <- df[,new.order] + } return(df) } From 4515e9b376300410a55d8112961a424a1a4c1c7d Mon Sep 17 00:00:00 2001 From: Laura DeCicco Date: Thu, 3 Dec 2015 14:49:19 -0600 Subject: [PATCH 2/5] un-suppressed the warnings. --- R/importWQP.R | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/R/importWQP.R b/R/importWQP.R index c636c735..48a058bd 100644 --- a/R/importWQP.R +++ b/R/importWQP.R @@ -85,20 +85,20 @@ importWQP <- function(obs_url, zip=FALSE, tz=""){ } ) doc <- unzip(temp) - retval <- suppressWarnings(read_delim(doc, + retval <- read_delim(doc, col_types = cols(`ActivityStartTime/Time` = col_character(), `ActivityEndTime/Time` = col_character(), USGSPCode = col_character(), ResultCommentText=col_character()), - quote = "", delim = "\t")) + quote = "", delim = "\t") unlink(doc) } else { - retval <- suppressWarnings(read_delim(obs_url, + retval <- read_delim(obs_url, col_types = cols(`ActivityStartTime/Time` = col_character(), `ActivityEndTime/Time` = col_character(), USGSPCode = col_character(), ResultCommentText=col_character()), - quote = "", delim = "\t")) + quote = "", delim = "\t") } } else { stop("Status:", headerInfo['status'], ": ", headerInfo['statusMessage'], "\nFor: ", obs_url) @@ -111,20 +111,20 @@ importWQP <- function(obs_url, zip=FALSE, tz=""){ if(zip){ doc <- unzip(obs_url) - retval <- suppressWarnings(read_delim(obs_url, + retval <- read_delim(obs_url, col_types = cols(`ActivityStartTime/Time` = col_character(), `ActivityEndTime/Time` = col_character(), USGSPCode = col_character(), ResultCommentText=col_character()), - quote = "", delim = "\t")) + quote = "", delim = "\t") unlink(doc) } else { - retval <- suppressWarnings(read_delim(obs_url, + retval <- read_delim(obs_url, col_types = cols(`ActivityStartTime/Time` = col_character(), `ActivityEndTime/Time` = col_character(), USGSPCode = col_character(), ResultCommentText=col_character()), - quote = "", delim = "\t")) + quote = "", delim = "\t") } } From 8e4c4bb90f4e2ea2335c385ea5f9b3077fffdffd Mon Sep 17 00:00:00 2001 From: Laura DeCicco Date: Thu, 3 Dec 2015 14:52:22 -0600 Subject: [PATCH 3/5] Added more imports. --- NAMESPACE | 2 ++ R/importRDB1.r | 2 ++ 2 files changed, 4 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index ea565e36..eb75d072 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -44,6 +44,8 @@ importFrom(lubridate,parse_date_time) importFrom(plyr,rbind.fill.matrix) importFrom(readr,col_character) importFrom(readr,cols) +importFrom(readr,parse_number) +importFrom(readr,problems) importFrom(readr,read_delim) importFrom(readr,read_lines) importFrom(reshape2,dcast) diff --git a/R/importRDB1.r b/R/importRDB1.r index a6a00a48..b239082b 100644 --- a/R/importRDB1.r +++ b/R/importRDB1.r @@ -47,6 +47,8 @@ #' @importFrom dplyr left_join #' @importFrom readr read_lines #' @importFrom readr read_delim +#' @importFrom readr problems +#' @importFrom readr parse_number #' @examples #' siteNumber <- "02177000" #' startDate <- "2012-09-01" From 49bae52d0a56c0be51967868fe5376816063abbf Mon Sep 17 00:00:00 2001 From: Laura DeCicco Date: Thu, 3 Dec 2015 15:20:13 -0600 Subject: [PATCH 4/5] site_no hand holding. --- R/importRDB1.r | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/R/importRDB1.r b/R/importRDB1.r index b239082b..1f9c95bc 100644 --- a/R/importRDB1.r +++ b/R/importRDB1.r @@ -123,12 +123,25 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz=""){ 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)){ + 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 + } + } comment(readr.data) <- readr.meta readr.data <- as.data.frame(readr.data) From 34403cc89cc988f928602161a169892b63393f33 Mon Sep 17 00:00:00 2001 From: Laura DeCicco Date: Thu, 3 Dec 2015 16:50:17 -0600 Subject: [PATCH 5/5] More ways to deal with int/site bug. --- NAMESPACE | 1 + R/importRDB1.r | 34 +++++++++++++++++++++------------- R/importWQP.R | 11 +++++++++-- tests/testthat/tests_general.R | 3 +++ 4 files changed, 34 insertions(+), 15 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index eb75d072..e8644fff 100644 --- 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 index 1f9c95bc..57f7561c 100644 --- a/R/importRDB1.r +++ b/R/importRDB1.r @@ -117,15 +117,6 @@ 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")) } @@ -133,15 +124,32 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz=""){ 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 index 48a058bd..9153722a 100644 --- 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,7 +90,10 @@ 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 { @@ -97,7 +101,10 @@ 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") } } else { diff --git a/tests/testthat/tests_general.R b/tests/testthat/tests_general.R index 8f3f9924..779de72d 100644 --- 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) + })