Skip to content
GitLab
Commit dfe041e8 authored by Laura A DeCicco's avatar Laura A DeCicco
Browse files

Merge pull request #153 from ldecicco-USGS/master 

int bug fix
parents 70234feb 34403cc8
Hide whitespace changes
Inline Side-by-side
DESCRIPTION
View file @ dfe041e8
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"),
......
NAMESPACE
View file @ dfe041e8
......@@ -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)
......
R/importRDB1.r
View file @ dfe041e8
......@@ -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"
......@@ -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)
......@@ -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){
......@@ -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),
......@@ -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)
}
R/importWQP.R
View file @ dfe041e8
......@@ -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_
......@@ -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)
......@@ -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")
}
}
......
tests/testthat/tests_general.R
View file @ dfe041e8
......@@ -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)
})
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment