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

Fixing siteInfo bug on large requests.

parent f5a5b25c
No related branches found
No related tags found
1 merge request!48siteInfo bug fixed in large WQP calls.
......@@ -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 {
......
......@@ -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
......@@ -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)
}
......@@ -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
......
......@@ -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}
......@@ -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}
......
......@@ -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}
......
......@@ -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}
......
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