Merge pull request #97 from ldecicco-USGS/master

Adding qwdata to readNWISdata

DESCRIPTION

@@ -1,7 +1,8 @@
 Package: dataRetrieval
 Type: Package
 Title: Retrieval Functions for USGS and EPA Hydrologic and Water Quality Data
-Version: 2.1.3
+Version: 2.1.4
+Date: 2015-03-09
 Authors@R: c( person("Robert", "Hirsch", role = c("aut"),
     email = "[email protected]"),
     person("Laura", "DeCicco", role = c("aut","cre"),

NEWS

@@ -1,3 +1,9 @@
+dataRetrieval 2.1.4
+===========
+* Expanded readNWISdata to qw data
+* Improved citation file
+
+
 dataRetrieval 2.1.1
 ===========
 * Removed tests that call external web services, server upgrades have been causing false negative results

R/readNWISdata.r

@@ -4,7 +4,8 @@
 #' Arguments to the function should be based on \url{http://waterservices.usgs.gov} service calls.
 #'
 #' @param service string. Possible values are "iv" (for instantaneous), "dv" (for daily values), "gwlevels" 
-#' (for groundwater levels), and "site" (for site service)
+#' (for groundwater levels), "site" (for site service), and "qw" (water-quality). Note: "qw" calls go to: 
+#' \url{http://nwis.waterdata.usgs.gov/usa/nwis/qwdata} for data requests, and use different call requests schemes. 
 #' @param \dots see \url{http://waterservices.usgs.gov/rest/Site-Service.html#Service} for a complete list of options
 #' @keywords data import NWIS web service
 #' @return A data frame with the following columns:
@@ -53,15 +54,21 @@
 #'                   service="dv", startDate=startDate, endDate=endDate)
 #' siteInfo <- readNWISdata(stateCd="WI", parameterCd="00010",
 #'                   hasDataTypeCd="iv", service="site")
+#' qwData <- readNWISdata(bBox=c(-82.5,41.52,-81,41),startDate=as.Date("2000-01-01"),
+#'                   drain_area_va_min=50, qw_count_nu=50,qw_attributes="expanded",
+#'                   qw_sample_wide="wide",list_of_search_criteria=c("lat_long_bounding_box",
+#'                   "drain_area_va","obs_count_nu"),service="qw")
 #' }
 readNWISdata <- function(service="dv", ...){
 
   matchReturn <- list(...)
 
-  match.arg(service, c("dv","iv","gwlevels","site", "uv"))
+  match.arg(service, c("dv","iv","gwlevels","site", "uv","qw","qwdata"))
 
   if(service == "uv"){
     service <- "iv"
+  } else if (service == "qw"){
+    service <- "qwdata"
   }
 
   if(length(service) > 1){
@@ -75,29 +82,57 @@ readNWISdata <- function(service="dv", ...){
   names(values)[names(values) == "siteNumber"] <- "sites"
   names(values)[names(values) == "siteNumbers"] <- "sites"
 
-  urlCall <- paste(paste(names(values),values,sep="="),collapse="&")
-
   format <- "waterml,1.1"
   baseURL <- "http://waterservices.usgs.gov/nwis/"
 
   if(service == "iv"){
     baseURL <- "http://nwis.waterservices.usgs.gov/nwis/"
+  } else if (service == "qwdata"){
+    baseURL <- "http://nwis.waterdata.usgs.gov/nwis/"
+
+    format <- "rdb"
+
+    names(values)[names(values) == "startDT"] <- "begin_date"
+    names(values)[names(values) == "endDT"] <- "end_date"
+
+    values["rdb_inventory_output"] <- "file"
+    values["TZoutput"] <- "0"
+    values["date_format"] <- "YYYY-MM-DD"
+    values["qw_sample_wide"] <- "wide"
+
+    if("bBox" %in% names(values)){
+      values["nw_longitude_va"] <- as.character(matchReturn$bBox[1])
+      values["nw_latitude_va"] <- as.character(matchReturn$bBox[2])
+      values["se_longitude_va"] <- as.character(matchReturn$bBox[3])
+      values["se_latitude_va"] <- as.character(matchReturn$bBox[4])
+      values["coordinate_format"] <- "decimal_degrees"
+      values <- values[-which("bBox" %in% names(values))] 
+    }
+
   }
 
   if(service == "site"){
     format <- "rdb"
   }
 
+  urlCall <- paste(paste(names(values),values,sep="="),collapse="&")
+
   baseURL <- paste0(baseURL,service,"/?format=",format,"&")
   urlCall <- paste0(baseURL,urlCall)
 
   if(service == "site"){
     retval <- importRDB1(urlCall, asDateTime = FALSE, qw = FALSE)
-  } else {
+  } else if(service != "qwdata") {
     retval <- importWaterML1(urlCall, asDateTime = ("iv" == service))
     if("dv" == service){
       retval$dateTime <- as.POSIXct(retval$dateTime)
     }
+  } else {
+    possibleError <- tryCatch({
+      retval <- importRDB1(urlCall, asDateTime = TRUE, qw = TRUE)
+    }, error = function(e) {
+      stop(e, "with url:", urlCall)
+    })
   }
 
   return(retval)

man/readNWISdata.Rd

@@ -8,7 +8,8 @@ readNWISdata(service = "dv", ...)
 }
 \arguments{
 \item{service}{string. Possible values are "iv" (for instantaneous), "dv" (for daily values), "gwlevels"
-(for groundwater levels), and "site" (for site service)}
+(for groundwater levels), "site" (for site service), and "qw" (water-quality). Note: "qw" calls go to:
+\url{http://nwis.waterdata.usgs.gov/usa/nwis/qwdata} for data requests, and use different call requests schemes.}
 
 \item{\dots}{see \url{http://waterservices.usgs.gov/rest/Site-Service.html#Service} for a complete list of options}
 }
@@ -61,6 +62,10 @@ waterYear <- readNWISdata(bBox=c(-83,36.5,-81,38.5), parameterCd="00010",
                   service="dv", startDate=startDate, endDate=endDate)
 siteInfo <- readNWISdata(stateCd="WI", parameterCd="00010",
                   hasDataTypeCd="iv", service="site")
+qwData <- readNWISdata(bBox=c(-82.5,41.52,-81,41),startDate=as.Date("2000-01-01"),
+                  drain_area_va_min=50, qw_count_nu=50,qw_attributes="expanded",
+                  qw_sample_wide="wide",list_of_search_criteria=c("lat_long_bounding_box",
+                  "drain_area_va","obs_count_nu"),service="qw")
 }
 }
 \seealso{

tests/testthat/tests_general.R

@@ -18,6 +18,13 @@ test_that("General NWIS retrievals working", {
 
   siteInfo <- readNWISdata(stateCd="WI", parameterCd="00010",hasDataTypeCd="iv", 
                            service="site")
+  expect_is(siteInfo$station_nm, "character")
+
+  qwData <- readNWISdata(bBox=c(-82.5,41.52,-81,41),startDate=as.Date("2000-01-01"),
+                   drain_area_va_min=50, qw_count_nu=50,qw_attributes="expanded",
+                    qw_sample_wide="wide",list_of_search_criteria=c("lat_long_bounding_box",
+                    "drain_area_va","obs_count_nu"),service="qw")
+  expect_is(qwData$startDateTime, "POSIXct")
 
 })