From e1fea286b57d6d0feae922f6954c7b14181f35b8 Mon Sep 17 00:00:00 2001
From: unknown <ldecicco@usgs.gov>
Date: Wed, 26 Nov 2014 10:58:08 -0600
Subject: [PATCH] Fixing siteInfo bug on large requests.
---
R/importWQP.R | 32 +---------------------
R/readWQPdata.R | 38 ++++++++++++++++++++++++--
R/readWQPqw.r | 52 +++++++++++++++++++++++++++++++++---
R/tabbedDataRetrievals.R | 9 ++++---
man/dataRetrieval-package.Rd | 5 ++--
man/pCodeToName.Rd | 3 ++-
man/parameterCdFile.Rd | 4 ++-
man/readWQPdata.Rd | 1 +
8 files changed, 101 insertions(+), 43 deletions(-)
diff --git a/R/importWQP.R b/R/importWQP.R
index aa74bfae..12a585b3 100644
--- a/R/importWQP.R
+++ b/R/importWQP.R
@@ -121,37 +121,7 @@ importWQP <- function(url, zip=FALSE, tz=""){
if(all(is.na(retval$ActivityEndDateTime))){
retval$ActivityEndDateTime <- NULL
}
-
- siteInfo <- whatWQPsites(siteid=paste(unique(retval$MonitoringLocationIdentifier),collapse=","))
-
- siteInfoCommon <- data.frame(station_nm=siteInfo$MonitoringLocationName,
- agency_cd=siteInfo$OrganizationIdentifier,
- site_no=siteInfo$MonitoringLocationIdentifier,
- dec_lat_va=siteInfo$LatitudeMeasure,
- dec_lon_va=siteInfo$LongitudeMeasure,
- hucCd=siteInfo$HUCEightDigitCode,
- stringsAsFactors=FALSE)
-
- siteInfo <- cbind(siteInfoCommon, siteInfo)
-
-
- variableInfo <- data.frame(characteristicName=retval$CharacteristicName,
- parameterCd=retval$USGSPCode,
- param_units=retval$ResultMeasure.MeasureUnitCode,
- valueType=retval$ResultSampleFractionText,
- stringsAsFactors=FALSE)
- variableInfo <- unique(variableInfo)
-
- if(any(!is.na(variableInfo$parameterCd))){
- pCodeToName <- pCodeToName
- varExtras <- pCodeToName[pCodeToName$parm_cd %in% unique(variableInfo$parameterCd[!is.na(variableInfo$parameterCd)]),]
- names(varExtras)[names(varExtras) == "parm_cd"] <- "parameterCd"
- variableInfo <- merge(variableInfo, varExtras, by="parameterCd")
- }
-
- attr(retval, "siteInfo") <- siteInfo
- attr(retval, "variableInfo") <- variableInfo
-
+
return(retval)
} else {
diff --git a/R/readWQPdata.R b/R/readWQPdata.R
index 6ef6b17c..50b1a52e 100644
--- a/R/readWQPdata.R
+++ b/R/readWQPdata.R
@@ -12,6 +12,7 @@
#' \dontrun{
#' nameToUse <- "pH"
#' pHData <- readWQPdata(siteid="USGS-04024315",characteristicName=nameToUse)
+#' pHDataExpanded <- readWQPdata(bBox="-90.10,42.67,-88.64,43.35",characteristicName=nameToUse)
#' }
readWQPdata <- function(...){
@@ -36,7 +37,40 @@ readWQPdata <- function(...){
urlCall,
"&mimeType=tsv")
- retVal <- importWQP(urlCall,FALSE)
- return(retVal)
+ retval <- importWQP(urlCall,FALSE)
+
+ siteInfo <- whatWQPsites(...)
+
+ siteInfoCommon <- data.frame(station_nm=siteInfo$MonitoringLocationName,
+ agency_cd=siteInfo$OrganizationIdentifier,
+ site_no=siteInfo$MonitoringLocationIdentifier,
+ dec_lat_va=siteInfo$LatitudeMeasure,
+ dec_lon_va=siteInfo$LongitudeMeasure,
+ hucCd=siteInfo$HUCEightDigitCode,
+ stringsAsFactors=FALSE)
+
+ siteInfo <- cbind(siteInfoCommon, siteInfo)
+
+
+ variableInfo <- data.frame(characteristicName=retval$CharacteristicName,
+ parameterCd=retval$USGSPCode,
+ param_units=retval$ResultMeasure.MeasureUnitCode,
+ valueType=retval$ResultSampleFractionText,
+ stringsAsFactors=FALSE)
+ variableInfo <- unique(variableInfo)
+
+ if(any(!is.na(variableInfo$parameterCd))){
+ pCodeToName <- pCodeToName
+ varExtras <- pCodeToName[pCodeToName$parm_cd %in% unique(variableInfo$parameterCd[!is.na(variableInfo$parameterCd)]),]
+ names(varExtras)[names(varExtras) == "parm_cd"] <- "parameterCd"
+ variableInfo <- merge(variableInfo, varExtras, by="parameterCd")
+ }
+
+ attr(retval, "siteInfo") <- siteInfo
+ attr(retval, "variableInfo") <- variableInfo
+ attr(retval, "url") <- urlCall
+ attr(retval, "queryTime") <- Sys.time()
+
+ return(retval)
}
\ No newline at end of file
diff --git a/R/readWQPqw.r b/R/readWQPqw.r
index 1bf84656..c8eba436 100644
--- a/R/readWQPqw.r
+++ b/R/readWQPqw.r
@@ -27,8 +27,54 @@
readWQPqw <- function(siteNumber,parameterCd,startDate="",endDate=""){
url <- constructWQPURL(siteNumber,parameterCd,startDate,endDate)
- retVal <- importWQP(url,TRUE)
- attr(retVal, "url") <- url
- return(retVal)
+ retval <- importWQP(url)
+
+ pcodeCheck <- all(nchar(parameterCd) == 5) & all(!is.na(suppressWarnings(as.numeric(parameterCd))))
+
+ if (nzchar(startDate)){
+ startDate <- format(as.Date(startDate), format="%m-%d-%Y")
+ }
+
+ if (nzchar(endDate)){
+ endDate <- format(as.Date(endDate), format="%m-%d-%Y")
+ }
+
+ if(pcodeCheck){
+ siteInfo <- whatWQPsites(siteid=siteNumber, pCode=parameterCd, startDateLo=startDate, startDateHi=endDate)
+ } else {
+ siteInfo <- whatWQPsites(siteid=siteNumber, characteristicName=parameterCd, startDateLo=startDate, startDateHi=endDate)
+ }
+
+ siteInfoCommon <- data.frame(station_nm=siteInfo$MonitoringLocationName,
+ agency_cd=siteInfo$OrganizationIdentifier,
+ site_no=siteInfo$MonitoringLocationIdentifier,
+ dec_lat_va=siteInfo$LatitudeMeasure,
+ dec_lon_va=siteInfo$LongitudeMeasure,
+ hucCd=siteInfo$HUCEightDigitCode,
+ stringsAsFactors=FALSE)
+
+ siteInfo <- cbind(siteInfoCommon, siteInfo)
+
+
+ variableInfo <- data.frame(characteristicName=retval$CharacteristicName,
+ parameterCd=retval$USGSPCode,
+ param_units=retval$ResultMeasure.MeasureUnitCode,
+ valueType=retval$ResultSampleFractionText,
+ stringsAsFactors=FALSE)
+ variableInfo <- unique(variableInfo)
+
+ if(any(variableInfo$parameterCd != "")){
+ pCodeToName <- pCodeToName
+ varExtras <- pCodeToName[pCodeToName$parm_cd %in% unique(variableInfo$parameterCd[!is.na(variableInfo$parameterCd)]),]
+ names(varExtras)[names(varExtras) == "parm_cd"] <- "parameterCd"
+ variableInfo <- merge(variableInfo, varExtras, by="parameterCd")
+ }
+
+ attr(retval, "siteInfo") <- siteInfo
+ attr(retval, "variableInfo") <- variableInfo
+ attr(retval, "url") <- url
+ attr(retval, "queryTime") <- Sys.time()
+
+ return(retval)
}
diff --git a/R/tabbedDataRetrievals.R b/R/tabbedDataRetrievals.R
index 2e022766..9bfb4c75 100644
--- a/R/tabbedDataRetrievals.R
+++ b/R/tabbedDataRetrievals.R
@@ -19,13 +19,15 @@
#' @name dataRetrieval-package
#' @docType package
#' @author Robert M. Hirsch \email{rhirsch@@usgs.gov}, Laura De Cicco \email{ldecicco@@usgs.gov}
-#' @keywords data, retrieval
+#' @keywords USGS, web services
NULL
#' List of USGS parameter codes
#'
-#' Complete list of USGS parameter codes as of November 7, 2014.
+#' Complete list of USGS parameter codes as of November 7, 2014. The data was pulled from
+#' \url{http://nwis.waterdata.usgs.gov/nwis/pmcodes/pmcodes?radio_pm_search=param_group&pm_group=All+--+include+all+parameter+groups&
+#' format=rdb&show=parameter_group_nm&show=parameter_nm&show=casrn&show=srsname&show=parameter_units}
#'
#' @name parameterCdFile
#' @docType data
@@ -34,7 +36,8 @@ NULL
#' Data to convert USGS parameter code to characteristic names
#'
-#' Data pulled from Water Quality Portal on November 25, 2014.
+#' Data pulled from Water Quality Portal on November 25, 2014. The data was pulled from
+#' \url{http://www.waterqualitydata.us/public_srsnames?mimeType=json}.
#'
#' @name pCodeToName
#' @docType data
diff --git a/man/dataRetrieval-package.Rd b/man/dataRetrieval-package.Rd
index 7bd351b3..4bb467bd 100644
--- a/man/dataRetrieval-package.Rd
+++ b/man/dataRetrieval-package.Rd
@@ -24,6 +24,7 @@ Retrieval functions for USGS and EPA hydrologic and water quality data
\author{
Robert M. Hirsch \email{rhirsch@usgs.gov}, Laura De Cicco \email{ldecicco@usgs.gov}
}
-\keyword{data,}
-\keyword{retrieval}
+\keyword{USGS,}
+\keyword{services}
+\keyword{web}
diff --git a/man/pCodeToName.Rd b/man/pCodeToName.Rd
index e333c6f0..6c52a016 100644
--- a/man/pCodeToName.Rd
+++ b/man/pCodeToName.Rd
@@ -4,7 +4,8 @@
\alias{pCodeToName}
\title{Data to convert USGS parameter code to characteristic names}
\description{
-Data pulled from Water Quality Portal on November 25, 2014.
+Data pulled from Water Quality Portal on November 25, 2014. The data was pulled from
+\url{http://www.waterqualitydata.us/public_srsnames?mimeType=json}.
}
\keyword{USGS}
\keyword{parameterCd}
diff --git a/man/parameterCdFile.Rd b/man/parameterCdFile.Rd
index 532995a6..0a75b055 100644
--- a/man/parameterCdFile.Rd
+++ b/man/parameterCdFile.Rd
@@ -4,7 +4,9 @@
\alias{parameterCdFile}
\title{List of USGS parameter codes}
\description{
-Complete list of USGS parameter codes as of November 7, 2014.
+Complete list of USGS parameter codes as of November 7, 2014. The data was pulled from
+\url{http://nwis.waterdata.usgs.gov/nwis/pmcodes/pmcodes?radio_pm_search=param_group&pm_group=All+--+include+all+parameter+groups&
+format=rdb&show=parameter_group_nm&show=parameter_nm&show=casrn&show=srsname&show=parameter_units}
}
\keyword{USGS}
\keyword{parameterCd}
diff --git a/man/readWQPdata.Rd b/man/readWQPdata.Rd
index 0f20f06c..ac1b780f 100644
--- a/man/readWQPdata.Rd
+++ b/man/readWQPdata.Rd
@@ -23,6 +23,7 @@ because it allows for other agencies rather than the USGS.
\dontrun{
nameToUse <- "pH"
pHData <- readWQPdata(siteid="USGS-04024315",characteristicName=nameToUse)
+pHDataExpanded <- readWQPdata(bBox="-90.10,42.67,-88.64,43.35",characteristicName=nameToUse)
}
}
\keyword{WQP}
--
GitLab