Skip to content
Snippets Groups Projects
Commit f4b88d06 authored by Laura A DeCicco's avatar Laura A DeCicco
Browse files

Bug fix.

parent 37355886
No related branches found
No related tags found
1 merge request!153int bug fix
Package: dataRetrieval Package: dataRetrieval
Type: Package Type: Package
Title: Retrieval Functions for USGS and EPA Hydrologic and Water Quality Data Title: Retrieval Functions for USGS and EPA Hydrologic and Water Quality Data
Version: 2.4.1 Version: 2.4.2
Date: 2015-11-25 Date: 2015-12-03
Authors@R: c( person("Robert", "Hirsch", role = c("aut"), Authors@R: c( person("Robert", "Hirsch", role = c("aut"),
email = "rhirsch@usgs.gov"), email = "rhirsch@usgs.gov"),
person("Laura", "DeCicco", role = c("aut","cre"), person("Laura", "DeCicco", role = c("aut","cre"),
......
...@@ -115,8 +115,15 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz=""){ ...@@ -115,8 +115,15 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz=""){
if(convertType){ if(convertType){
readr.data <- suppressWarnings(read_delim(doc, skip = (meta.rows+2),delim="\t",col_names = FALSE)) 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 { } 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 names(readr.data) <- header.names
...@@ -152,7 +159,7 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz=""){ ...@@ -152,7 +159,7 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz=""){
if("tz_cd" %in% header.names){ if("tz_cd" %in% header.names){
date.time.cols <- which(sapply(readr.data, function(x) inherits(x, "POSIXct"))) 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){ if("sample_start_time_datum_cd" %in% header.names){
...@@ -190,7 +197,7 @@ importRDB1 <- function(obs_url, asDateTime=TRUE, convertType = TRUE, tz=""){ ...@@ -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), 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), 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){ ...@@ -211,14 +218,15 @@ convertTZ <- function(df, tz.name, date.time.cols, tz){
df[!is.na(df[,date.time.cols]),tz.name] <- "UTC" df[!is.na(df[,date.time.cols]),tz.name] <- "UTC"
} }
reported.col <- which(names(df) %in% paste0(tz.name,"_reported")) if(flip.cols){
orig.col <- which(names(df) %in% tz.name) 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 <- 1:ncol(df)
new.order[reported.col] <- orig.col new.order[orig.col] <- reported.col
new.order[reported.col] <- orig.col
df <- df[,new.order]
df <- df[,new.order]
}
return(df) return(df)
} }
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment