Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Maintenance scheduled for Thursday, May 26th at 15:00 MST. Expected downtime <1 hour.
Open sidebar
Water
dataRetrieval
Commits
dfe041e8
Commit
dfe041e8
authored
Dec 04, 2015
by
Laura A DeCicco
Browse files
Merge pull request #153 from ldecicco-USGS/master
int bug fix
parents
70234feb
34403cc8
Changes
5
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-1
1-25
Version: 2.4.
2
Date: 2015-1
2-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
)
})
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment