From 521ca4bef1a479eb7bbe3035d6a60148c6bedaaf Mon Sep 17 00:00:00 2001
From: unknown <ldecicco@usgs.gov>
Date: Tue, 11 Nov 2014 16:17:28 -0600
Subject: [PATCH] Changed to readRDB.
---
R/whatNWISData.r | 92 +++++++++++++++++-------------------------------
1 file changed, 32 insertions(+), 60 deletions(-)
diff --git a/R/whatNWISData.r b/R/whatNWISData.r
index 1ef6ec37..8c155734 100644
--- a/R/whatNWISData.r
+++ b/R/whatNWISData.r
@@ -1,13 +1,14 @@
#' USGS data availability
#'
-#' Imports a table of available parameters, period of record, and count.
+#' Imports a table of available parameters, period of record, and count. See \url{http://waterservices.usgs.gov/rest/Site-Service.html}
+#' for more information.
#'
#' @param siteNumbers string vector of USGS site number or multiple sites.
#' @param service vector string. Options are "all", or one or many of "dv"(daily values),
#' "uv","rt", or "iv"(unit values), "qw"(water-quality),"sv"(sites visits),"pk"(peak measurements),
#' "gw"(groundwater levels), "ad" (sites included in USGS Annual Water Data Reports External Link),
#' "aw" (sites monitored by the USGS Active Groundwater Level Network External Link), "id" (historical
-#' instantaneous values), "
+#' instantaneous values)
#' @param parameterCd string vector of valid parameter codes to return. Defaults to "all" which will not perform a filter.
#' @param statCd string vector of all statistic codes to return. Defaults to "all" which will not perform a filter.
#' @keywords data import USGS web service
@@ -48,64 +49,35 @@ whatNWISdata <- function(siteNumbers,service="all",parameterCd="all",statCd="all
urlSitefile <- paste("http://waterservices.usgs.gov/nwis/site/?format=rdb&seriesCatalogOutput=true&sites=",siteNumber,sep = "")
- doc = tryCatch({
- h <- basicHeaderGatherer()
- doc <- getURL(urlSitefile, headerfunction = h$update)
-
- }, warning = function(w) {
- message(paste("URL caused a warning:", urlSitefile))
- message(w)
- }, error = function(e) {
- message(paste("URL does not seem to exist:", urlSitefile))
- message(e)
- return(NA)
- })
+ SiteFile <- importRDB1(urlSitefile, asDateTime = FALSE)
- if(h$value()["Content-Type"] == "text/plain;charset=UTF-8"){
- SiteFile <- read.delim(
- textConnection(doc),
- header = TRUE,
- quote="\"",
- dec=".",
- sep='\t',
- colClasses=c('character'),
- fill = TRUE,
- comment.char="#")
-
- SiteFile <- SiteFile[-1,]
-
- numberColumns <- grep("_va",names(SiteFile))
- SiteFile[,numberColumns] <- sapply(SiteFile[,numberColumns],as.numeric)
-
- intColumns <- grep("_nu",names(SiteFile))
- SiteFile[,intColumns] <- sapply(SiteFile[,intColumns],as.integer)
-
- parameterCds <- unique(SiteFile$parm_cd)
-
- parameterCdFile <- parameterCdFile
-
- parameterCdINFO <- parameterCdFile[parameterCdFile$parameter_cd %in% parameterCds,]
- SiteFile <- merge(SiteFile,parameterCdINFO,by.x="parm_cd" ,by.y="parameter_cd",all=TRUE)
-
-
- if(!("all" %in% service)){
- SiteFile <- SiteFile[SiteFile$data_type_cd %in% service,]
- }
- if(!("all" %in% statCd)){
- SiteFile <- SiteFile[SiteFile$stat_cd %in% statCd,]
- }
- if(!("all" %in% parameterCd)){
- SiteFile <- SiteFile[SiteFile$parm_cd %in% parameterCd,]
- }
-
-
- SiteFile$begin_date <- as.Date(parse_date_time(SiteFile$begin_date, c("Ymd", "mdY", "Y!")))
- SiteFile$end_date <- as.Date(parse_date_time(SiteFile$end_date, c("Ymd", "mdY", "Y!")))
-
- return(SiteFile)
- } else {
- message(paste("URL caused an error:", urlSitefile))
- message("Content-Type=",h$value()["Content-Type"])
- return(NA)
+ headerInfo <- comment(SiteFile)
+
+ parameterCds <- unique(SiteFile$parm_cd)
+
+ parameterCdFile <- parameterCdFile
+
+ parameterCdINFO <- parameterCdFile[parameterCdFile$parameter_cd %in% parameterCds,]
+ SiteFile <- merge(SiteFile,parameterCdINFO,by.x="parm_cd" ,by.y="parameter_cd",all=TRUE)
+
+
+ if(!("all" %in% service)){
+ SiteFile <- SiteFile[SiteFile$data_type_cd %in% service,]
+ }
+ if(!("all" %in% statCd)){
+ SiteFile <- SiteFile[SiteFile$stat_cd %in% statCd,]
}
+ if(!("all" %in% parameterCd)){
+ SiteFile <- SiteFile[SiteFile$parm_cd %in% parameterCd,]
+ }
+
+
+ SiteFile$begin_date <- as.Date(parse_date_time(SiteFile$begin_date, c("Ymd", "mdY", "Y!")))
+ SiteFile$end_date <- as.Date(parse_date_time(SiteFile$end_date, c("Ymd", "mdY", "Y!")))
+
+ comment(SiteFile) <- headerInfo
+ attr(SiteFile, "url") <- urlSitefile
+
+ return(SiteFile)
+
}
--
GitLab