Skip to content

Commit

Permalink
Merge pull request #153 from ldecicco-USGS/master
Browse files Browse the repository at this point in the history 
int bug fix
  • Loading branch information
@ldecicco-USGS
ldecicco-USGS committed Dec 4, 2015
2 parents 70234fe + 34403cc commit dfe041e
Show file tree
Hide file tree
Showing 5 changed files with 68 additions and 24 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -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 = "[email protected]"),
person("Laura", "DeCicco", role = c("aut","cre"),
Expand Down
3 changes: 3 additions & 0 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,10 @@ 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)
importFrom(readr,read_delim)
importFrom(readr,read_lines)
importFrom(reshape2,dcast)
Expand Down
55 changes: 43 additions & 12 deletions R/importRDB1.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down Expand Up @@ -116,10 +118,38 @@ 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))
} 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

if("site_no" %in% names(readr.data)){
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"))
}
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)

Expand Down Expand Up @@ -152,7 +182,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){
Expand Down Expand Up @@ -190,7 +220,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),
Expand All @@ -211,14 +241,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)
}
27 changes: 17 additions & 10 deletions R/importWQP.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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_
Expand Down Expand Up @@ -85,20 +86,26 @@ 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"))
ResultCommentText=col_character(),
`ActivityDepthHeightMeasure/MeasureValue` = col_number(),
`DetectionQuantitationLimitMeasure/MeasureValue` = col_number(),
ResultMeasureValue = col_number()),
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"))
ResultCommentText=col_character(),
`ActivityDepthHeightMeasure/MeasureValue` = col_number(),
`DetectionQuantitationLimitMeasure/MeasureValue` = col_number(),
ResultMeasureValue = col_number()),
quote = "", delim = "\t")
}
} else {
stop("Status:", headerInfo['status'], ": ", headerInfo['statusMessage'], "\nFor: ", obs_url)
Expand All @@ -111,20 +118,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")
}

}
Expand Down
3 changes: 3 additions & 0 deletions tests/testthat/tests_general.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)

})


Expand Down

0 comments on commit dfe041e

Please sign in to comment.