Adding parameter groups.

R/readNWISqw.r

@@ -4,8 +4,30 @@
 #' A list of parameter codes can be found here: \url{http://nwis.waterdata.usgs.gov/nwis/pmcodes/}
 #' A list of statistic codes can be found here: \url{http://nwis.waterdata.usgs.gov/nwis/help/?read_file=stat&format=table}
 #'
+#' @details Valid parameter code groups are "All," or group codes:
+#'\tabular{ll}{
+#'Code \tab Description\cr
+#'INF \tab Information \cr
+#'PHY \tab Physical \cr
+#'INM \tab Inorganics, Major, Metals (major cations) \cr
+#'INN \tab Inorganics, Major, Non-metals (major anions) \cr
+#'NUT \tab Nutrient \cr
+#'MBI \tab Microbiological \cr
+#'BIO \tab Biological \cr
+#'IMN \tab Inorganics, Minor, Non-metals \cr
+#'IMM \tab Inorganics, Minor, Metals \cr
+#'TOX \tab Toxicity \cr
+#'OPE \tab Organics, pesticide \cr
+#'OPC \tab Organics, PCBs \cr
+#'OOT \tab Organics, other \cr
+#'RAD \tab Radiochemical \cr
+#'SED \tab Sediment \cr
+#'POP \tab Population/community \cr
+#'}
+#'
 #' @param siteNumbers character of USGS site numbers.  This is usually an 8 digit number
-#' @param parameterCd character of USGS parameter code(s).  This is usually an 5 digit number. Can also be "all".
+#' @param parameterCd character that contains the code for a parameter
+#' group, or a character vector of 5-digit parameter codes. See \bold{Details}.
 #' @param startDate character starting date for data retrieval in the form YYYY-MM-DD. Default is "" which indicates
 #' retrieval for the earliest possible record.
 #' @param endDate character ending date for data retrieval in the form YYYY-MM-DD. Default is "" which indicates
@@ -58,14 +80,28 @@
 #'           startDate,endDate,reshape=TRUE)
 #' parameterCd <- "all"
 #' rawNWISall <- readNWISqw(siteNumbers,parameterCd,
-#'           startDate,endDate,reshape=TRUE)
+#'           startDate,endDate)
+#' pgroup <- c("NUT")
+#' rawNWISNutrients <- readNWISqw(siteNumbers,pgroup,
+#'           startDate,endDate)
+#' groups <- c("NUT","OPE")
+#' rawNWISNutOpe <- readNWISqw(siteNumbers,groups,
+#'           startDate,endDate) 
+#' rawNWISOpe <- readNWISqw(siteNumbers,"OPE",
+#'           startDate,endDate) 
 #'          } 
 readNWISqw <- function (siteNumbers,parameterCd,startDate="",endDate="",
                         expanded=TRUE,reshape=FALSE,tz=""){  
   
-  if(any(parameterCd == "all")){
-    siteNumbers <- paste(siteNumbers, collapse=",")
+  pgrp <- c("INF", "PHY", "INM", "INN", "NUT", "MBI", "BIO", "IMM", "IMN", "TOX",
+                           "OPE", "OPC", "OOT", "RAD", "XXX", "SED", "POP")
+  
+  
+  
+
+  if(any(parameterCd == "all") | any(parameterCd == "All") ){
     
+    siteNumbers <- paste(siteNumbers, collapse=",")
     url <- paste0("http://nwis.waterdata.usgs.gov/nwis/qwdata?multiple_site_no=", siteNumbers,
            "&sort_key=site_no&group_key=NONE&inventory_output=0",
            "&begin_date=", startDate, "&end_date=", endDate,
@@ -73,6 +109,16 @@ readNWISqw <- function (siteNumbers,parameterCd,startDate="",endDate="",
            "&radio_parm_cds=all_parm_cds&qw_attributes=0&format=rdb",
            "&qw_sample_wide=0&rdb_qw_attributes=expanded&date_format=YYYY-MM-DD",
            "&rdb_compression=value&list_of_search_criteria=multiple_site_no")
+  } else if (all(parameterCd %in% pgrp)){
+    siteNumbers <- paste(siteNumbers, collapse=",")
+    groups <- paste(parameterCd, collapse=",")
+    url <- paste0("http://nwis.waterdata.usgs.gov/nwis/qwdata?multiple_site_no=", siteNumbers,
+                  "&sort_key=site_no&group_key=NONE&inventory_output=0",
+                  "&begin_date=", startDate, "&end_date=", endDate,
+                  "&TZoutput=0&param_group=", groups,
+                  "&qw_attributes=0&format=rdb",
+                  "&qw_sample_wide=0&rdb_qw_attributes=expanded&date_format=YYYY-MM-DD",
+                  "&rdb_compression=value&list_of_search_criteria=multiple_site_no")
 
   } else {
     url <- constructNWISURL(siteNumbers,
@@ -80,36 +126,40 @@ readNWISqw <- function (siteNumbers,parameterCd,startDate="",endDate="",
                             startDate,
                             endDate,"qw",expanded=expanded)    
   }
+
+
   
   data <- importRDB1(url,asDateTime=TRUE, qw=TRUE, tz = tz)
   originalHeader <- comment(data)
+  parameterCd <- unique(data$parm_cd)
   
-  if(reshape & expanded){
-    columnsToMelt <- c("agency_cd","site_no","sample_dt","sample_tm",
-                       "sample_end_dt","sample_end_tm","sample_start_time_datum_cd","tm_datum_rlbty_cd",
-                       "parm_cd","startDateTime","endDateTime","coll_ent_cd", "medium_cd","project_cd",
-                       "aqfr_cd","tu_id","body_part_id", "hyd_cond_cd", "samp_type_cd",
-                       "hyd_event_cd","sample_lab_cm_tx")
-    columnsToMelt <- columnsToMelt[columnsToMelt %in% names(data)]
-    dataWithPcodes <- data[data$parm_cd != "",]
-    if(sum(data$parm_cd != "") > 0){
-      warning("Data returned without pCodes, will not be included in reshape")
+  if(reshape){
+    if(expanded){
+      columnsToMelt <- c("agency_cd","site_no","sample_dt","sample_tm",
+                         "sample_end_dt","sample_end_tm","sample_start_time_datum_cd","tm_datum_rlbty_cd",
+                         "parm_cd","startDateTime","endDateTime","coll_ent_cd", "medium_cd","project_cd",
+                         "aqfr_cd","tu_id","body_part_id", "hyd_cond_cd", "samp_type_cd",
+                         "hyd_event_cd","sample_lab_cm_tx")
+      columnsToMelt <- columnsToMelt[columnsToMelt %in% names(data)]
+      dataWithPcodes <- data[data$parm_cd != "",]
+      if(sum(data$parm_cd != "") > 0){
+        warning("Some or all data returned without pCodes, those data will not be included in reshape")
+      }
+      longDF <- melt(dataWithPcodes, columnsToMelt)
+      wideDF <- dcast(longDF, ... ~ variable + parm_cd )
+      wideDF[,grep("_va_",names(wideDF))] <- sapply(wideDF[,grep("_va_",names(wideDF))], function(x) as.numeric(x))
+      pCodesReturned <- unique(dataWithPcodes$parm_cd)
+      groupByPCode <- as.vector(sapply(pCodesReturned, function(x) grep(x, names(wideDF)) ))
+      data <- wideDF[,c(1:length(columnsToMelt)-1,groupByPCode)]
+      comment(data) <- originalHeader
+    } else {
+      warning("Reshape can only be used with expanded data. Reshape request will be ignored.")
     }
-    longDF <- melt(dataWithPcodes, columnsToMelt)
-    wideDF <- dcast(longDF, ... ~ variable + parm_cd )
-    wideDF[,grep("_va_",names(wideDF))] <- sapply(wideDF[,grep("_va_",names(wideDF))], function(x) as.numeric(x))
-    pCodesReturned <- unique(dataWithPcodes$parm_cd)
-    groupByPCode <- as.vector(sapply(pCodesReturned, function(x) grep(x, names(wideDF)) ))
-    data <- wideDF[,c(1:length(columnsToMelt)-1,groupByPCode)]
-    comment(data) <- originalHeader
-    
-  }
-  
-  if(reshape & !expanded){
-    warning("Reshape can only be used with expanded data. Reshape request will be ignored.")
   }
+  parameterCd <- parameterCd[parameterCd != ""]
   
   siteInfo <- readNWISsite(siteNumbers)
+  
   varInfo <- readNWISpCode(parameterCd)
   
   attr(data, "siteInfo") <- siteInfo