USEPA · cristinamullin · Jun 18, 2025 · Jan 15, 2025 · Jan 17, 2025 · Jan 21, 2025
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -76,7 +76,7 @@ Imports:
     igraph,
     jsonlite, 
     openxlsx,
-    rATTAINS,
+    rExpertQuery,
     DT,
     dataRetrieval,
     dbscan,
@@ -105,6 +105,7 @@ Suggests:
     remotes
 Remotes:
     DOI-USGS/dataRetrieval@develop,
+    USEPA/rExpertQuery@develop,
     USEPA/StreamCatTools@master
 VignetteBuilder: knitr, rmarkdown
 Language: en-US

diff --git a/NAMESPACE b/NAMESPACE
@@ -46,6 +46,7 @@ export(TADA_GetATTAINS)
 export(TADA_GetATTAINSAUSiteCrosswalk)
 export(TADA_GetATTAINSOrgIDsRef)
 export(TADA_GetATTAINSParamUseOrgRef)
+export(TADA_GetATTAINSParameterWQPCharRef)
 export(TADA_GetActivityTypeRef)
 export(TADA_GetCharacteristicRef)
 export(TADA_GetDetCondRef)

diff --git a/R/ATTAINSCrosswalks.R b/R/ATTAINSCrosswalks.R
diff --git a/R/ATTAINSRefTables.R b/R/ATTAINSRefTables.R
@@ -1,3 +1,69 @@
+# Used to store cached ATTAINSOrgIDsRef Reference Table
+ATTAINSParameterWQPCharRef_Cached <- NULL
+
+#' ATTAINS Parameter and WQP Characteristic Exact Match Reference Table
+#'
+#' Function downloads and returns the newest available crosswalk of exact
+#' matches between ATTAINS.ParameterName and TADA.CharacteristicName.
+#'
+#' This function caches the table after it has been called once
+#' so subsequent calls will be faster.
+#'
+#' @return Updated sysdata.rda with updated ATTAINSParameterWQPCharRef object
+#'
+#' @export
+TADA_GetATTAINSParameterWQPCharRef <- function() {
+  # If there is a cached table available return it
+  if (!is.null(ATTAINSParameterWQPCharRef_Cached)) {
+    return(ATTAINSParameterWQPCharRef_Cached)
+  }
+
+  # Try to download up-to-date raw data
+  raw.data <- tryCatch(
+    {
+      # get data from ATTAINS
+      attainsParamRef <- data.frame(rExpertQuery::EQ_DomainValues("param_name")[, "name"])
+
+      WQXCharRef <- utils::read.csv(system.file("extdata", "WQXCharacteristicRef.csv", package = "EPATADA"))
+
+      WQXCharRef$CharacteristicName <- toupper(WQXCharRef$CharacteristicName)
+
+      matches <- intersect(WQXCharRef$CharacteristicName, attainsParamRef$name)
+
+      attainsWQXRef <- WQXCharRef %>%
+        dplyr::inner_join(attainsParamRef, by = c("CharacteristicName" = "name")) %>%
+        dplyr::mutate(ATTAINS.ParameterName = CharacteristicName) %>%
+        # Hard code bind E.coli as we know this is a match
+        dplyr::bind_rows(c(CharacteristicName = "ESCHERICHIA COLI", Char_Flag = "Accepted", ATTAINS.ParameterName = "ESCHERICHIA COLI (E. COLI)")) %>%
+        dplyr::distinct()
+    },
+    error = function(err) {
+      NULL
+    }
+  )
+
+  # If the download failed fall back to internal data (and report it)
+  if (is.null(raw.data)) {
+    message("Downloading latest ATTAINS and WQP Char Ref Table failed!")
+    message("Falling back to (possibly outdated) internal file.")
+    return(utils::read.csv(system.file("extdata", "ATTAINSParameterWQPCharRef.csv", package = "EPATADA")))
+  }
+
+  ATTAINSParameterWQPCharRef <- raw.data %>%
+    dplyr::distinct()
+
+  # Save updated table in cache
+  ATTAINSParameterWQPCharRef_Cached <- ATTAINSParameterWQPCharRef
+
+  ATTAINSParameterWQPCharRef
+}
+
+# Update  ATTAINS Organization Identifier Reference Table
+# (for internal use only)
+TADA_UpdateATTAINSParameterWQPCharRef <- function() {
+  utils::write.csv(TADA_GetATTAINSParameterWQPCharRef(), file = "inst/extdata/ATTAINSParameterWQPCharRef.csv", row.names = FALSE)
+}
+
 # Used to store cached ATTAINSOrgIDsRef Reference Table
 ATTAINSOrgIDsRef_Cached <- NULL
 
@@ -12,7 +78,6 @@ ATTAINSOrgIDsRef_Cached <- NULL
 #' @return Updated sysdata.rda with updated ATTAINSOrgIDsRef object
 #'
 #' @export
-
 TADA_GetATTAINSOrgIDsRef <- function() {
   # If there is a cached table available return it
   if (!is.null(ATTAINSOrgIDsRef_Cached)) {
@@ -24,7 +89,7 @@ TADA_GetATTAINSOrgIDsRef <- function() {
   raw.data <- tryCatch(
     {
       # get data from ATTAINS
-      rATTAINS::domain_values(domain_name = "OrgName")
+      rExpertQuery::EQ_DomainValues("org_id")
     },
     error = function(err) {
       NULL
@@ -49,13 +114,10 @@ TADA_GetATTAINSOrgIDsRef <- function() {
 
 # Update  ATTAINS Organization Identifier Reference Table
 # (for internal use only)
-
 TADA_UpdateATTAINSOrgIDsRef <- function() {
   utils::write.csv(TADA_GetATTAINSOrgIDsRef(), file = "inst/extdata/ATTAINSOrgIDsRef.csv", row.names = FALSE)
 }
 
-
-
 # Used to store cached ATTAINSParamUseOrg Reference Table
 ATTAINSParamUseOrgRef_Cached <- NULL
 
@@ -65,64 +127,84 @@ ATTAINSParamUseOrgRef_Cached <- NULL
 #' reference dataframe which includes all parameters and uses
 #' listed as a cause by ATTAINS organizations in previous assessments.
 #' This dataframe is used in TADA_CreateParamRef() and
-#' TADA_CreateUseParamRef() as the basis for the pulling in prior ATTAINS
+#' TADA_CreateUseParamRef() as the basis for pulling in prior ATTAINS
 #' parameter names and use names by organization name. This helps to filter
 #' selections in the Excel drop down menu.
 #'
 #' @return Dataframe including ATTAINS parameters and uses for each organization.
 #'
 #' @export
 #'
-
 TADA_GetATTAINSParamUseOrgRef <- function() {
-  # # If there is a cached table available return it
-  # if (!is.null(ATTAINSParamUseOrgRef_Cached)) {
-  #   return(ATTAINSParamUseOrgRef_Cached)
-  # }
-  #
-  # # Try to download up-to-date raw data
-  #
-  # raw.data <- tryCatch(
-  #   {
-  #     # reads rATTAINS domain value
-  #     org_id <- rATTAINS::domain_values("OrgName")[[3]]
-  #     all.data <- list()
-  #
-  #     for(i in 1:length(org_id)){
-  #       all.data[[i]] <- rATTAINS::assessments(organization_id = org_id[i])[[2]]
-  #     }
-  #
-  #     all.data2 <- dplyr::bind_rows(all.data, .id = "column_label")
-  #   },
-  #   error = function(err) {
-  #     NULL
-  #   }
-  # )
-  #
-  # # remove intermediate variables
-  # rm(org_id, all.data, all.data2)
-  #
-  # # If the download failed fall back to internal data (and report it)
-  # if (is.null(raw.data)) {
-  #   message("Downloading latest ATTAINSParamUseOrg Reference Table failed!")
-  #   message("Falling back to (possibly outdated) internal file.")
-  #   return(utils::read.csv(system.file("extdata", "ATTAINSParamUseEntityRef.csv", package = "EPATADA")))
-  # }
-  #
-  # # Creates and formats the ATTAINSParamUseOrg ref table containing parameters by use name for each org
-  # use_attainments <- raw.data %>% tidyr::unnest(c(use_attainments), names_sep = ".")
-  # use_parameters <- use_attainments %>% tidyr::unnest(c(parameters), names_sep = ".")
-  #
-  # ATTAINSParamUseOrgRef <- use_parameters %>%
-  #   dplyr::select(organization_identifier, organization_name, organization_type_text,
-  #                 use_attainments.use_name, parameters.parameter_name) %>%
-  #   dplyr::distinct()
-  #
-  # # remove intermediate variables
-  # rm(use_attainments, use_parameters)
-  #
-
-  ATTAINSParamUseOrgRef <- utils::read.csv(system.file("extdata", "ATTAINSParamUseEntityRef.csv", package = "EPATADA"))
+  # If there is a cached table available return it
+  if (!is.null(ATTAINSParamUseOrgRef_Cached)) {
+    return(ATTAINSParamUseOrgRef_Cached)
+  }
+
+  # Try to download up-to-date raw data
+  raw.data <- tryCatch(
+    {
+      # reads rExpertQuery domain value
+      org_id <- rExpertQuery::EQ_DomainValues("org_id")[[3]]
+      all.data <- list()
+
+      for (i in 1:length(org_id)) {
+        skip_to_next <- FALSE
+
+        tryCatch(
+          all.data[[i]] <- rExpertQuery::EQ_Assessments(
+            org_id = org_id[i],
+            api_key = "lfzVzpwIlKS1O4l1QmbOLUeTzxyql4QdbHVR5Yf5"
+          )[, c(5, 6, 4, 17, 29)],
+          error = function(e) {
+            skip_to_next <<- TRUE
+          }
+        )
+
+        if (skip_to_next) {
+          next
+        }
+      }
+
+      all.data2 <- lapply(
+        all.data,
+        function(x) {
+          if (!is.null(x)) {
+            x <- x %>%
+              dplyr::distinct() %>%
+              dplyr::mutate_at(dplyr::vars(organizationId), as.character)
+          } else {
+            NULL
+          }
+        }
+      )
+
+      all.data3 <- all.data2 %>%
+        dplyr::bind_rows(.id = "column_label") %>%
+        dplyr::select(
+          ATTAINS.OrganizationIdentifier = organizationId,
+          ATTAINS.OrganizationName = organizationName,
+          ATTAINS.OrganizationType = organizationType,
+          ATTAINS.ParameterName = parameterName,
+          ATTAINS.UseName = useName
+        )
+    },
+    error = function(err) {
+      NULL
+    }
+  )
+
+  # remove intermediate variables
+  rm(all.data, all.data2, all.data3, i, skip_to_next)
+
+  # If the download failed fall back to internal data (and report it)
+  if (is.null(raw.data)) {
+    message("Downloading latest ATTAINSParamUseOrg Reference Table failed!")
+    message("Falling back to (possibly outdated) internal file.")
+    return(utils::read.csv(system.file("extdata", "ATTAINSParamUseEntityRef.csv", package = "EPATADA")))
+  }
+
+  ATTAINSParamUseOrgRef <- raw.data
 
   # Save updated table in cache
   ATTAINSParamUseOrgRef_Cached <- ATTAINSParamUseOrgRef
@@ -133,7 +215,6 @@ TADA_GetATTAINSParamUseOrgRef <- function() {
 
 # Update ATTAINSParamUseOrg Reference Table internal file
 # (for internal use only)
-
 TADA_UpdateATTAINSParamUseOrgRef <- function() {
   utils::write.csv(TADA_GetATTAINSParamUseOrgRef(), file = "inst/extdata/ATTAINSParamUseEntityRef.csv", row.names = FALSE)
 }
diff --git a/R/CriteriaComparison.R b/R/CriteriaComparison.R
@@ -1,6 +1,7 @@
-#' Create Reference Data Frame to Pair Characteristic Results For Use in Numeric Criteria Equations (UNDER ACTIVE DEVELOPMENT)
+#' Create Reference Data Frame to Pair Characteristic Results For Use in
+#' Numeric Criteria Equations (UNDER ACTIVE DEVELOPMENT)
 #'
-#' This function creates a data frame that shows all combinations of TADA.CharacteristicName,
+#' This function creates a data frame that shows all combinations of
 #' TADA.CharacteristicName, TADA.ResultMeasure.MeasureUnitCode, TADA.MethodSpeciationName,
 #' and TADA.ResultSampleFractionText for commonly paired characteristics (such as pH, temperature,
 #' hardness, salinity, and chloride).

diff --git a/R/ExampleData.R b/R/ExampleData.R
@@ -57,32 +57,6 @@ NULL
 #' @format A dataframe with 117124 rows and 166 variables
 NULL
 
-#' Data_NCTCShepherdstown_HUC12
-#'
-#' Original pull:
-#' Data_NCTCShepherdstown_HUC12 = TADA_DataRetrieval(
-#'   startDate = "2020-03-14",
-#'   endDate = "null",
-#'   countycode = "null",
-#'   huc = "02070004",
-#'   siteid = "null",
-#'   siteType = "null",
-#'   characteristicName = "null",
-#'   characteristicType = "null",
-#'   sampleMedia = "null",
-#'   statecode = "null",
-#'   organization = "null",
-#'   project = "null",
-#'   applyautoclean = TRUE
-#' )
-#'
-#' @docType data
-#' @keywords dataframe
-#' @name Data_NCTCShepherdstown_HUC12
-#' @usage data(Data_NCTCShepherdstown_HUC12)
-#' @format A dataframe with 39236 rows and 151 variables
-NULL
-
 #' Data_R5_TADAPackageDemo
 #'
 #' Original pull:

diff --git a/R/Figures.R b/R/Figures.R
@@ -399,12 +399,10 @@ TADA_Histogram <- function(.data, id_cols = c("TADA.ComparableDataIdentifier"))
 #' \dontrun{
 #' # Load example dataframe:
 #' data(Data_Nutrients_UT)
-#' data(Data_NCTCShepherdstown_HUC12)
 #' data(Data_6Tribes_5y_Harmonized)
 #'
 #' # Create maps:
 #' TADA_OverviewMap(Data_Nutrients_UT)
-#' TADA_OverviewMap(Data_NCTCShepherdstown_HUC12)
 #' TADA_OverviewMap(Data_6Tribes_5y_Harmonized)
 #' }
 #'
@@ -592,12 +590,10 @@ TADA_OverviewMap <- function(.data) {
 #' \dontrun{
 #' # Load example dataframe:
 #' data(Data_Nutrients_UT)
-#' data(Data_NCTCShepherdstown_HUC12)
 #' data(Data_6Tribes_5y_Harmonized)
 #'
 #' # Create maps:
 #' TADA_FlaggedSitesMap(Data_Nutrients_UT)
-#' TADA_FlaggedSitesMap(Data_NCTCShepherdstown_HUC12)
 #' TADA_FlaggedSitesMap(Data_6Tribes_5y_Harmonized)
 #' }
 #'
@@ -663,7 +659,6 @@ TADA_FlaggedSitesMap <- function(.data) {
 #'
 #' # Create maps:
 #' TADA_FlaggedSitesMap(Data_Nutrients_UT)
-#' TADA_FlaggedSitesMap(Data_NCTCShepherdstown_HUC12)
 #' TADA_FlaggedSitesMap(Data_6Tribes_5y_Harmonized)
 #' }
 #'

diff --git a/R/ResultFlagsDependent.R b/R/ResultFlagsDependent.R
@@ -680,10 +680,10 @@ TADA_FindQCActivities <- function(.data, clean = FALSE, flaggedonly = FALSE) {
 #'
 #' @examples
 #' # Load example dataset:
-#' data(Data_NCTCShepherdstown_HUC12)
+#' data(Data_Nutrients_UT)
 #'
 #' # Run TADA_FindQCActivities to add TADA.ActivityType.Flag column:
-#' df <- TADA_FindQCActivities(Data_NCTCShepherdstown_HUC12)
+#' df <- TADA_FindQCActivities(Data_Nutrients_UT)
 #'
 #' # Find pairs for all data flagged as "QC_replicate" in the TADA.ActivityType.Flag column:
 #' df_all_pairs <- TADA_PairReplicates(df)