From 42392590649286cb1e5837512d7a746828a12e79 Mon Sep 17 00:00:00 2001 From: Lindsay Carr Date: Thu, 19 May 2016 16:13:35 -0500 Subject: [PATCH 1/2] add HEAD request capability --- DESCRIPTION | 3 +- R/readWQPdata.R | 97 +++++++++++++++++++++------------------ R/readWQPqw.r | 118 +++++++++++++++++++++++++----------------------- 3 files changed, 116 insertions(+), 102 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index dcbf41b..a66d4a3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -30,7 +30,8 @@ Imports: plyr, stats, utils, - dplyr + dplyr, + httr Suggests: xtable, knitr, diff --git a/R/readWQPdata.R b/R/readWQPdata.R index 842e2b7..13d2b54 100644 --- a/R/readWQPdata.R +++ b/R/readWQPdata.R @@ -6,6 +6,7 @@ #' @param \dots see \url{www.waterqualitydata.us/webservices_documentation.jsp} for a complete list of options #' @param zip logical to request data via downloading zip file. Default set to FALSE. The overhead associated with #' downloading and un-zipping only improves performance for large data returns. +#' @param querySummary logical to request the number of sites and results a particular query would return before downloading the data. #' @keywords data import WQP web service #' @return A data frame with at least the following columns: #' \tabular{lll}{ @@ -98,7 +99,7 @@ #' #' #' } -readWQPdata <- function(..., zip=FALSE){ +readWQPdata <- function(..., zip=FALSE, querySummary=FALSE){ matchReturn <- list(...) @@ -155,53 +156,59 @@ readWQPdata <- function(..., zip=FALSE){ if(zip) urlCall <- paste0(urlCall,"&zip=yes") - retval <- importWQP(urlCall,zip=zip, tz=tz) - - if(!all(is.na(retval))){ - siteInfo <- whatWQPsites(...) + if(querySummary){ + queryHEAD <- HEAD(urlCall) + retquery <- headers(queryHEAD) + return(retquery) + } else { + retval <- importWQP(urlCall,zip=zip, tz=tz) - 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, + if(!all(is.na(retval))){ + 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) + + retvalVariableInfo <- retval[,c("CharacteristicName","USGSPCode", + "ResultMeasure.MeasureUnitCode","ResultSampleFractionText")] + retvalVariableInfo <- unique(retvalVariableInfo) + + variableInfo <- data.frame(characteristicName=retval$CharacteristicName, + parameterCd=retval$USGSPCode, + param_units=retval$ResultMeasure.MeasureUnitCode, + valueType=retval$ResultSampleFractionText, stringsAsFactors=FALSE) - - siteInfo <- cbind(siteInfoCommon, siteInfo) - - retvalVariableInfo <- retval[,c("CharacteristicName","USGSPCode", - "ResultMeasure.MeasureUnitCode","ResultSampleFractionText")] - retvalVariableInfo <- unique(retvalVariableInfo) - - variableInfo <- data.frame(characteristicName=retval$CharacteristicName, - parameterCd=retval$USGSPCode, - param_units=retval$ResultMeasure.MeasureUnitCode, - valueType=retval$ResultSampleFractionText, - stringsAsFactors=FALSE) - - if(any(!is.na(variableInfo$parameterCd))){ - pcodes <- unique(variableInfo$parameterCd[!is.na(variableInfo$parameterCd)]) - pcodes <- pcodes["" != pcodes] - paramINFO <- readNWISpCode(pcodes) - names(paramINFO)["parameter_cd" == names(paramINFO)] <- "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", all = TRUE) - variableInfo <- merge(variableInfo, paramINFO, by="parameterCd", all = TRUE) - variableInfo <- unique(variableInfo) + if(any(!is.na(variableInfo$parameterCd))){ + pcodes <- unique(variableInfo$parameterCd[!is.na(variableInfo$parameterCd)]) + pcodes <- pcodes["" != pcodes] + paramINFO <- readNWISpCode(pcodes) + names(paramINFO)["parameter_cd" == names(paramINFO)] <- "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", all = TRUE) + variableInfo <- merge(variableInfo, paramINFO, by="parameterCd", all = TRUE) + variableInfo <- unique(variableInfo) + } + + attr(retval, "siteInfo") <- siteInfo + attr(retval, "variableInfo") <- variableInfo + attr(retval, "url") <- urlCall + attr(retval, "queryTime") <- Sys.time() + + return(retval) + } else { + message("The following url returned no data:\n") + message(urlCall) } - - attr(retval, "siteInfo") <- siteInfo - attr(retval, "variableInfo") <- variableInfo - attr(retval, "url") <- urlCall - attr(retval, "queryTime") <- Sys.time() - - return(retval) - } else { - message("The following url returned no data:\n") - message(urlCall) } } \ No newline at end of file diff --git a/R/readWQPqw.r b/R/readWQPqw.r index 3ca3972..5e15ba6 100644 --- a/R/readWQPqw.r +++ b/R/readWQPqw.r @@ -108,68 +108,74 @@ #' rawPHsites <- readWQPqw(c('USGS-05406450', 'USGS-05427949','WIDNR_WQX-133040'), 'pH','','') #' nwisEx <- readWQPqw('USGS-04024000',c('34247','30234','32104','34220'),'','2012-12-20') #' } -readWQPqw <- function(siteNumbers,parameterCd,startDate="",endDate="",tz=""){ +readWQPqw <- function(siteNumbers,parameterCd,startDate="",endDate="",tz="", querySummary=FALSE){ url <- constructWQPURL(siteNumbers,parameterCd,startDate,endDate) - retval <- importWQP(url, tz = tz) - 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=paste0(siteNumbers,collapse=";"), - pCode=paste0(parameterCd,collapse=";"), - startDateLo=startDate, startDateHi=endDate) + if(querySummary){ + queryHEAD <- HEAD(url) + retquery <- headers(queryHEAD) + return(retquery) } else { - siteInfo <- whatWQPsites(siteid=paste0(siteNumbers,collapse=";"), - characteristicName=URLencode(paste0(parameterCd,collapse=";")), - startDateLo=startDate, startDateHi=endDate) - } + retval <- importWQP(url, tz = tz) - 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 != "")){ - pcodes <- unique(variableInfo$parameterCd[!is.na(variableInfo$parameterCd)]) - pcodes <- pcodes["" != pcodes] - paramINFO <- readNWISpCode(pcodes) - names(paramINFO)["parameter_cd" == names(paramINFO)] <- "parameterCd" + pcodeCheck <- all(nchar(parameterCd) == 5) & all(!is.na(suppressWarnings(as.numeric(parameterCd)))) + + if (nzchar(startDate)){ + startDate <- format(as.Date(startDate), format="%m-%d-%Y") + } - 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", all = TRUE) - variableInfo <- merge(variableInfo, paramINFO, by="parameterCd", all = TRUE) + if (nzchar(endDate)){ + endDate <- format(as.Date(endDate), format="%m-%d-%Y") + } + + if(pcodeCheck){ + siteInfo <- whatWQPsites(siteid=paste0(siteNumbers,collapse=";"), + pCode=paste0(parameterCd,collapse=";"), + startDateLo=startDate, startDateHi=endDate) + } else { + siteInfo <- whatWQPsites(siteid=paste0(siteNumbers,collapse=";"), + characteristicName=URLencode(paste0(parameterCd,collapse=";")), + 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 != "")){ + pcodes <- unique(variableInfo$parameterCd[!is.na(variableInfo$parameterCd)]) + pcodes <- pcodes["" != pcodes] + paramINFO <- readNWISpCode(pcodes) + names(paramINFO)["parameter_cd" == names(paramINFO)] <- "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", all = TRUE) + variableInfo <- merge(variableInfo, paramINFO, by="parameterCd", all = TRUE) + variableInfo <- unique(variableInfo) + } + + attr(retval, "siteInfo") <- siteInfo + attr(retval, "variableInfo") <- variableInfo + attr(retval, "url") <- url + attr(retval, "queryTime") <- Sys.time() + + return(retval) } - - attr(retval, "siteInfo") <- siteInfo - attr(retval, "variableInfo") <- variableInfo - attr(retval, "url") <- url - attr(retval, "queryTime") <- Sys.time() - - return(retval) - } -- GitLab From d639c2e76ec8c172c1cdccb79a1d13a17cc0da7c Mon Sep 17 00:00:00 2001 From: Lindsay Carr Date: Thu, 19 May 2016 16:26:24 -0500 Subject: [PATCH 2/2] tests for head requests --- tests/testthat/tests_general.R | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/tests/testthat/tests_general.R b/tests/testthat/tests_general.R index 9a96686..813c2c8 100644 --- a/tests/testthat/tests_general.R +++ b/tests/testthat/tests_general.R @@ -53,3 +53,18 @@ test_that("General WQP retrievals working", { characteristicType="Nutrient") expect_is(nutrientDaneCounty$ActivityStartDateTime, 'POSIXct') }) + +test_that("WQP head query retrieval working", { + testthat::skip_on_cran() + # testthat::skip_on_cran() + # Bring back when WQP is back + nameToUse <- "pH" + pHDataQueryResults <- readWQPdata(siteid="USGS-04024315", + characteristicName=nameToUse, + querySummary=TRUE) + expect_false(is.null(pHDataQueryResults$`total-site-count`)) + expect_is(pHDataQueryResults$`total-site-count`, 'character') + expect_false(is.null(pHDataQueryResults$`total-result-count`)) + expect_is(pHDataQueryResults$`total-result-count`, 'character') + +}) -- GitLab