Merge pull request #593 from ldecicco-USGS/master

Parameter code lookup

R/readNWISpCode.r

@@ -24,6 +24,10 @@
 #' 
 #' paramINFO <- readNWISpCode(c('01075','00060','00931'))
 #' paramINFO <- readNWISpCode(c('01075','00060','00931', NA))
+#' \donttest{
+#' all_codes <- readNWISpCode("all")
+#' 
+#' }
 readNWISpCode <- function(parameterCd){
  
   parameterCd.orig <- parameterCd
@@ -31,50 +35,58 @@ readNWISpCode <- function(parameterCd){
   
   baseURL <- drURL("pCode", Access=pkg.env$access)
   
-  fullURL <- appendDrURL(baseURL,radio_pm_search="param_group",
-                         pm_group="All+--+include+all+parameter+groups",
-                         show="parameter_group_nm",
-                         show="parameter_nm",
-                         show="casrn",
-                         show="srsname",
-                         show="parameter_units",
-                         format="rdb")
+  fullURL <- paste0(baseURL, "fmt=rdb&group_cd=%")
   
   if(any(parameterCd == "all")){
-    parameterData <- importRDB1(fullURL, asDateTime = FALSE)
+    temp_df <- importRDB1(fullURL, asDateTime = FALSE)
+    parameterData <- data.frame(
+      parameter_cd = temp_df$parm_cd, 
+      parameter_group_nm = temp_df$group,
+      parameter_nm = temp_df$parm_nm, 
+      casrn = temp_df$CASRN,
+      srsname = temp_df$SRSName,
+      parameter_units = temp_df$parm_unit,
+      stringsAsFactors = FALSE
+    )
+    attr(parameterData, "url") <- fullURL
   } else {
     pcodeCheck <- all(nchar(parameterCd) == 5) & all(!is.na(suppressWarnings(as.numeric(parameterCd))))
     parameterData <- parameterCdFile[parameterCdFile$parameter_cd %in% parameterCd,]
-  
+    
     if(nrow(parameterData) != length(parameterCd)){
       if(length(parameterCd) == 1){
-        
-        suburl <- appendDrURL(baseURL,radio_pm_search="pm_search",
-                               pm_search=parameterCd,
-                               show="parameter_group_nm",
-                               show="parameter_nm",
-                               show="casrn",
-                               show="srsname",
-                               show="parameter_units",
-                               format="rdb")
-        
-        suburl <- paste0("https://nwis.waterdata.usgs.gov/nwis/pmcodes/pmcodes?radio_pm_search=pm_search",
-                     "&pm_search=", parameterCd,
-                     "&format=rdb", "&show=parameter_group_nm",
-                     "&show=parameter_nm", "&show=casrn",
-                     "&show=srsname", "&show=parameter_units")
-        parameterData <- importRDB1(suburl,asDateTime = FALSE)
+        subURL <- paste0(baseURL, "fmt=rdb&parm_nm_cd=", parameterCd)
+        temp_df <- importRDB1(subURL, asDateTime = FALSE)
+        parameterData <- data.frame(
+          parameter_cd = temp_df$parm_cd, 
+          parameter_group_nm = temp_df$group,
+          parameter_nm = temp_df$parm_nm, 
+          casrn = temp_df$CASRN,
+          srsname = temp_df$SRSName,
+          parameter_units = temp_df$parm_unit,
+          stringsAsFactors = FALSE
+        )
+        attr(parameterData, "url") <- subURL
       } else {
-        
-        fullPcodeDownload <- importRDB1(fullURL)
-        parameterData <- fullPcodeDownload[fullPcodeDownload$parameter_cd %in% parameterCd,]
+        temp_df <- importRDB1(fullURL, asDateTime = FALSE)
+        trim_df <- data.frame(
+          parameter_cd = temp_df$parm_cd, 
+          parameter_group_nm = temp_df$group,
+          parameter_nm = temp_df$parm_nm, 
+          casrn = temp_df$CASRN,
+          srsname = temp_df$SRSName,
+          parameter_units = temp_df$parm_unit,
+          stringsAsFactors = FALSE
+        )
+        parameterData <- trim_df[trim_df$parameter_cd %in% parameterCd,]
+        attr(parameterData, "url") <- fullURL
       }
       
       if(nrow(parameterData) != length(parameterCd)){
         badPcode <- parameterCd[!(parameterCd %in% parameterData$parameter_cd)]
         warning("The following pCodes seem mistyped, and no information was returned: ",paste(badPcode,collapse=","))
       }
-    } 
+    }
   }
   
   if(nrow(parameterData) != sum(is.na(parameterCd.orig))){
@@ -83,5 +95,6 @@ readNWISpCode <- function(parameterCd){
     parameterData <- rbind(parameterData, na.params)
   }
   
+  
   return(parameterData)
 }

R/setAccess.R

@@ -52,7 +52,7 @@ setAccess = function(access="public"){
   pkg.env$qwdata = "https://nwis.waterdata.usgs.gov/nwis/qwdata"
   pkg.env$stat = "https://waterservices.usgs.gov/nwis/stat/"
   pkg.env$useNat = "https://waterdata.usgs.gov/nwis/water_use"
-  pkg.env$pCode = "https://nwis.waterdata.usgs.gov/nwis/pmcodes/pmcodes"
+  pkg.env$pCode = "https://help.waterdata.usgs.gov/code/parameter_cd_query"
   # NOTE: state water use are still in: constructUseURL
 
   pkg.env$Result = "https://www.waterqualitydata.us/data/Result/search"

R/tabbedDataRetrievals.R

@@ -29,7 +29,7 @@ NULL
 
 #' List of USGS parameter codes
 #'
-#' Complete list of USGS parameter codes as of Oct. 13, 2020. 
+#' Complete list of USGS parameter codes as of Dec. 20, 2021. 
 #'
 #' @name parameterCdFile
 #' @return parameterData data frame with information about USGS parameters.
@@ -56,8 +56,8 @@ NULL
 
 #' Data to convert USGS parameter code to characteristic names
 #'
-#' Data pulled from Water Quality Portal on October 13, 2020. The data was pulled from
-#' \url{https://www.waterqualitydata.us/public_srsnames?mimeType=json}.
+#' Data pulled from Water Quality Portal on December 20, 2021. The data was pulled from
+#' \url{https://www.waterqualitydata.us/Codes/public_srsnames/?mimeType=csv}.
 #'
 #' @name pCodeToName
 #' @return pCodeToName data frame with information about USGS parameters and how they

man/pCodeToName.Rd

@@ -24,8 +24,8 @@ last_rev_dt \tab character \tab Latest revision of information\cr
 }
 }
 \description{
-Data pulled from Water Quality Portal on October 13, 2020. The data was pulled from
-\url{https://www.waterqualitydata.us/public_srsnames?mimeType=json}.
+Data pulled from Water Quality Portal on December 20, 2021. The data was pulled from
+\url{https://www.waterqualitydata.us/Codes/public_srsnames/?mimeType=csv}.
 }
 \examples{
 head(pCodeToName[,1:2])

man/parameterCdFile.Rd

@@ -18,7 +18,7 @@ parameter_units \tab character \tab Parameter units\cr
 }
 }
 \description{
-Complete list of USGS parameter codes as of Oct. 13, 2020.
+Complete list of USGS parameter codes as of Dec. 20, 2021.
 }
 \examples{
 head(parameterCdFile[,1:2])

man/readNWISpCode.Rd

@@ -31,6 +31,10 @@ This function gets the data from here: \url{https://nwis.waterdata.usgs.gov/nwis
 
 paramINFO <- readNWISpCode(c('01075','00060','00931'))
 paramINFO <- readNWISpCode(c('01075','00060','00931', NA))
+\donttest{
+all_codes <- readNWISpCode("all")
+
+}
 }
 \seealso{
 \code{\link{importRDB1}}

tests/testthat/tests_userFriendly_fxns.R

@@ -398,5 +398,6 @@ test_that("pCode Stuff", {
   expect_equal(nrow(paramINFO), 4)
   
   paramINFO <- readNWISpCode("all")
-  expect_equal(attr(paramINFO, "url"),"https://nwis.waterdata.usgs.gov/nwis/pmcodes/pmcodes?radio_pm_search=param_group&pm_group=All+--+include+all+parameter+groups&show=parameter_group_nm&show=parameter_nm&show=casrn&show=srsname&show=parameter_units&format=rdb")
+  expect_equal(attr(paramINFO, "url"),
+               "https://help.waterdata.usgs.gov/code/parameter_cd_query?fmt=rdb&group_cd=%")
 })
\ No newline at end of file