Merge pull request #165 from USEPA/8-23-24-cm

Production release
USEPA · Sep 25, 2024 · b716e69 · b716e69
2 parents 0dda5c1 + 3fe4e55
commit b716e69
Show file tree

Hide file tree

Showing 7 changed files with 104 additions and 46 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -43,8 +43,7 @@ Imports:
     grDevices,
     lubridate,
     plotly, 
-    shinyjs, 
-    lwgeom
+    shinyjs
 Remotes: 
     github::USEPA/EPATADA
 Suggests: 
@@ -67,5 +66,5 @@ Config/testthat/load-all: list(export_all = FALSE, helpers = FALSE)
 LazyData: true
 URL: https://github.com/USEPA/TADAShiny
 BugReports: https://github.com/USEPA/TADAShiny/issues
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Roxygen: list(markdown = TRUE)
diff --git a/R/app_ui.R b/R/app_ui.R
@@ -24,10 +24,13 @@ app_ui <- function(request) {
     # Your application UI logic
     shiny::fluidPage(
       tags$html(class = "no-js", lang = "en"),
-      HTML("<div id='eq-disclaimer-banner' class='padding-1 text-center text-white bg-secondary-dark'><strong>EPA development environment:</strong> The
-      content on this page is not production ready. This site is being used
-      for <strong>development</strong> and/or <strong>testing</strong> purposes
-      only.</div>"),
+
+      # adds development banner
+      # HTML("<div id='eq-disclaimer-banner' class='padding-1 text-center text-white bg-secondary-dark'><strong>EPA development environment:</strong> The
+      # content on this page is not production ready. This site is being used
+      # for <strong>development</strong> and/or <strong>testing</strong> purposes
+      # only.</div>"),
+
       # adds epa header html from here: https://www.epa.gov/themes/epa_theme/pattern-lab/patterns/pages-standalone-template/pages-standalone-template.rendered.html
       shiny::includeHTML(app_sys("app/www/header.html")),
       shinyjs::useShinyjs(),

diff --git a/R/mod_query_data.R b/R/mod_query_data.R
@@ -12,7 +12,18 @@
 
 load("inst/extdata/statecodes_df.Rdata")
 load("inst/extdata/query_choices.Rdata")
-# Last run by EDH on 08/25/23
+
+# new (2024-05-23) list for new Country/Ocean(s) Query the Water Quality Portal option. Not included in saved query_choices file
+library(jsonlite)
+library(dplyr)
+countrycode_url <- 'https://www.waterqualitydata.us/Codes/countrycode?mimeType=json'
+countryocean_source <- fromJSON(txt=countrycode_url)
+countryocean_source <- countryocean_source$codes %>% select(-one_of('providers'))
+countryocean_source <- countryocean_source[order(countryocean_source$desc),]
+countryocean_choices <- countryocean_source$value
+names(countryocean_choices) <- countryocean_source$desc
+
+# # Last run by CAM on 09/16/24
 # county = readr::read_tsv(url("https://www2.census.gov/geo/docs/reference/codes/files/national_county.txt"), col_names = FALSE)
 # county = county%>%tidyr::separate(X1,into = c("STUSAB","STATE","COUNTY","COUNTY_NAME","COUNTY_ID"), sep=",")
 # orgs = unique(utils::read.csv(url("https://cdx.epa.gov/wqx/download/DomainValues/Organization.CSV"))$ID)
@@ -21,9 +32,9 @@ load("inst/extdata/query_choices.Rdata")
 # media = c(unique(utils::read.csv(url("https://cdx.epa.gov/wqx/download/DomainValues/ActivityMedia.CSV"))$Name),"water","Biological Tissue","No media")
 # # sitetype = unique(utils::read.csv(url("https://cdx.epa.gov/wqx/download/DomainValues/MonitoringLocationType.CSV"))$Name)
 # sitetype = c("Aggregate groundwater use","Aggregate surface-water-use","Aggregate water-use establishment","Atmosphere","Estuary","Facility","Glacier","Lake, Reservoir, Impoundment","Land","Not Assigned","Ocean","Spring","Stream","Subsurface","Well","Wetland")
-# projects = unique(data.table::fread("https://www.waterqualitydata.us/data/Project/search?mimeType=csv&zip=no&providers=NWIS&providers=STEWARDS&providers=STORET")$ProjectIdentifier)
-# mlids = unique(data.table::fread("https://www.waterqualitydata.us/data/Station/search?mimeType=csv&zip=no&providers=NWIS&providers=STEWARDS&providers=STORET")$MonitoringLocationIdentifier)
-# save(orgs, chars, chargroup, media, county, sitetype, projects, mlids, file = "inst/extdata/query_choices.Rdata")
+# projects = unique(data.table::fread("https://www.waterqualitydata.us/data/Project/search?mimeType=csv&zip=no&providers=NWIS&providers=STORET")$ProjectIdentifier)
+# mlids = unique(data.table::fread("https://www.waterqualitydata.us/data/Station/search?mimeType=csv&zip=no")$MonitoringLocationIdentifier)
+# save(orgs, chars, chargroup, media, county, sitetype, projects, mlids2, file = "inst/extdata/query_choices.Rdata")
 
 mod_query_data_ui <- function(id) {
   ns <- NS(id)
@@ -90,23 +101,27 @@ mod_query_data_ui <- function(id) {
         shiny::textInput(ns("huc"), "Hydrologic Unit", placeholder = "e.g. 020700100103")
       )
     ),
-    shiny::fluidRow(column(
-      4,
-      shiny::selectizeInput(
-        ns("siteid"),
-        "Monitoring Location ID(s)",
-        choices = NULL,
-        multiple = TRUE
-      )
-    )),
-    htmltools::h4("Metadata Filters"),
+    shiny::fluidRow(
+      column(4,
+             shiny::selectizeInput(ns("siteid"),
+             "Monitoring Location ID(s)",
+             choices = NULL,
+             multiple = TRUE)),
+      column(4, 
+             shiny::selectizeInput(ns("countryocean"),
+             "Country/Ocean(s)", 
+             choices = NULL, 
+             multiple = TRUE))
+    ),
+    htmltools::h4("Metadata Filters"),   
     shiny::fluidRow(
       column(
         4,
         shiny::selectizeInput(
           ns("org"),
           "Organization(s)",
           choices = NULL,
+          options = list(placeholder = "Start typing or use drop down menu"),
           multiple = TRUE
         )
       ),
@@ -116,6 +131,7 @@ mod_query_data_ui <- function(id) {
           ns("project"),
           "Project(s)",
           choices = NULL,
+          options = list(placeholder = "Start typing or use drop down menu"),
           multiple = TRUE
         )
       ),
@@ -125,6 +141,7 @@ mod_query_data_ui <- function(id) {
           ns("type"),
           "Site Type(s)",
           choices = c(sitetype),
+          options = list(placeholder = "Start typing or use drop down menu"),
           multiple = TRUE
         )
       )
@@ -147,18 +164,34 @@ mod_query_data_ui <- function(id) {
           multiple = TRUE
         )
       ),
-      column(
-        4,
-        shiny::selectizeInput(ns("chargroup"), "Characteristic Group", choices = NULL)
-      ),
       column(
         4,
         shiny::selectizeInput(
           ns("characteristic"),
           "Characteristic(s)",
           choices = NULL,
+          options = list(placeholder = "Start typing or use drop down menu"),
           multiple = TRUE
         )
+      ),
+      column(
+        4,
+        shiny::selectizeInput(
+          ns("chargroup"), 
+          "Characteristic Group", 
+          choices = NULL,
+          options = list(placeholder = "Start typing or use drop down menu"),
+          multiple = TRUE
+          )
+      )
+    ),
+    shiny::fluidRow(
+      column(
+             4,
+             shiny::checkboxGroupInput(ns("providers"), 
+             "Data Source", 
+             c("NWIS (USGS)" = "NWIS", "WQX (EPA)" = "STORET"), 
+             selected = c("NWIS", "STORET"))
       )
     ),
     shiny::fluidRow(column(
@@ -295,8 +328,9 @@ mod_query_data_server <- function(id, tadat) {
       session,
       "chargroup",
       choices = c(chargroup),
-      selected = character(0),
-      options = list(placeholder = ""),
+      # selected = character(0),
+      # options = list(placeholder = ""),
+      options = list(placeholder = "Start typing or use drop down menu"),
       server = TRUE
     )
     shiny::updateSelectizeInput(session,
@@ -307,15 +341,25 @@ mod_query_data_server <- function(id, tadat) {
     shiny::updateSelectizeInput(session,
       "project",
       choices = c(projects),
+      options = list(placeholder = "Start typing or use drop down menu"),
       server = TRUE
     )
     shiny::updateSelectizeInput(
       session,
       "siteid",
-      choices = c(mlids),
+      choices = c(mlids2),
+      options = list(placeholder = "Start typing or use drop down menu"),
+      server = TRUE
+    )
+    shiny::updateSelectizeInput(
+      session,
+      "countryocean",
+      choices = countryocean_choices,
+      selected = character(0),
       options = list(placeholder = "Start typing or use drop down menu"),
       server = TRUE
     )
+
 
     # this observes when the user inputs a state into the drop down and subsets the choices for counties to only those counties within that state.
     shiny::observeEvent(input$state, {
@@ -352,17 +396,33 @@ mod_query_data_server <- function(id, tadat) {
       } else {
         tadat$countycode <- input$county
       }
+      # this is an overloaded field which can be 2-character Country or Ocean
+      if (is.null(input$countryocean)) {
+        tadat$countrycode <- "null"
+      } else {
+        tadat$countrycode <- input$countryocean
+      }
+      if (is.null(input$providers)) {
+        tadat$providers <- "null"
+      } else {
+        tadat$providers <- input$providers
+      }
       if (input$huc == "") {
         tadat$huc <- "null"
       } else {
         tadat$huc <- input$huc
       }
+      if (is.null(input$siteid)) {
+        tadat$siteid <- "null"
+      } else {
+        tadat$siteid <- input$siteid
+      }
       if (is.null(input$type)) {
         tadat$siteType <- "null"
       } else {
         tadat$siteType <- input$type
       }
-      if (input$chargroup == "") {
+      if (is.null(input$chargroup)) {
         tadat$characteristicType <- "null"
       } else {
         tadat$characteristicType <- input$chargroup
@@ -380,19 +440,14 @@ mod_query_data_server <- function(id, tadat) {
       if (is.null(input$project)) {
         tadat$project <- "null"
       } else {
-        tadat$project <- input$project
+        tadat$project <- paste(input$project, collapse = ",")
       }
       if (is.null(input$org)) {
         tadat$organization <- "null"
       } else {
         tadat$organization <- input$org
       }
-      if (is.null(input$siteid)) {
-        tadat$siteid <- "null"
-      } else {
-        tadat$siteid <- input$siteid
-        # siteid = stringr::str_trim(unlist(strsplit(input$siteids,",")))
-      }
+
       if (length(input$endDate) == 0) {
         # ensure if date is empty, the query receives a proper input ("null")
         tadat$endDate <- "null"
@@ -417,6 +472,7 @@ mod_query_data_server <- function(id, tadat) {
       raw <- EPATADA::TADA_DataRetrieval(
         statecode = tadat$statecode,
         countycode = tadat$countycode,
+        countrycode = tadat$countrycode,
         huc = tadat$huc,
         siteid = tadat$siteid,
         siteType = tadat$siteType,
@@ -427,6 +483,7 @@ mod_query_data_server <- function(id, tadat) {
         organization = tadat$organization,
         startDate = tadat$startDate,
         endDate = tadat$endDate,
+        providers = tadat$providers,
         applyautoclean = TRUE
       )
 
@@ -463,10 +520,7 @@ mod_query_data_server <- function(id, tadat) {
           shiny::updateTextInput(session, "huc")
           shiny::updateSelectizeInput(session, "siteid", selected = tadat$siteid)
           shiny::updateSelectizeInput(session, "type", selected = tadat$siteType)
-          shiny::updateSelectizeInput(session,
-            "characteristic",
-            selected = tadat$characteristicName
-          )
+          shiny::updateSelectizeInput(session, "characteristic", selected = tadat$characteristicName)
           shiny::updateSelectizeInput(session, "chargroup", selected = tadat$characteristicType)
           shiny::updateSelectizeInput(session, "media", selected = tadat$sampleMedia)
           shiny::updateSelectizeInput(session, "project", selected = tadat$project)

diff --git a/R/utils_flag_functions.R b/R/utils_flag_functions.R
@@ -114,11 +114,10 @@ applyFlags <- function(in_table, orgs) {
     out <- EPATADA::TADA_FindQAPPDoc(out, clean = FALSE)
   }
 
-  # Dataset includes depth profile data - no function for this yet
-  # out <- out
-
-  # Aggregated continuous data
-  # out <- EPATADA::TADA_FlagContinuousData(out, clean = FALSE, flaggedonly = FALSE)
+  # Continuous data
+  out <- EPATADA::TADA_FlagContinuousData(out, clean = FALSE, 
+                                          flaggedonly = FALSE, 
+                                          time_difference = 4)
 
   # Above WQX Upper Threshold
   out <- EPATADA::TADA_FlagAboveThreshold(out, clean = FALSE)

diff --git a/inst/extdata/query_choices.Rdata b/inst/extdata/query_choices.Rdata
diff --git a/inst/flag_prompts.csv b/inst/flag_prompts.csv
@@ -1,5 +1,5 @@
 Order,Level,Prompt,flagType
-1,Required,Result value is not numeric or NA and no detection limit value is provided (see TADA.ResultMeasureValueDataTypes.Flag),Result value is not numeric or NA and no detection limit value is provided
+1,Required,Result value is not numeric (text) OR result value is NA and no detection limit value is provided (see TADA.ResultMeasureValueDataTypes.Flag),Result value is not numeric or NA and no detection limit value is provided
 2,Required,Result value is not numeric or NA and the detection limit value cannot be interpreted because there is a conflict between the detection condition text and detection limit type provided by the data submitter [or the detection limit type is not in WQX domain tables (USGS/NWIS-specific)] (see TADA.CensoredData.Flag),Result value is not numeric or NA and the detection limit value cannot be interpreted because there is a conflict between the detection condition text and detection limit type provided by the data submitter [or the detection limit type is not in WQX domain tables (USGS/NWIS-specific)]
 3,Recommended,Suspect characteristic and speciation combination (see TADA.MethodSpeciation.Flag),Suspect characteristic and speciation combination
 4,Recommended,Suspect characteristic and fraction combination (see TADA.SampleFraction.Flag),Suspect characteristic and fraction combination
@@ -15,3 +15,4 @@ Order,Level,Prompt,flagType
 14,Optional,"Result value(s) below the national threshold for a given characteristic, possibly indicating non-sensical value(s) (see TADA.ResultValueBelowLowerThreshold.Flag)","Result value(s) below the national lower threshold for a given characteristic, possibly indicating non-sensical value(s)"
 15,Optional,Coordinates are outside of the United States (see TADA.InvalidCoordinates.Flag),Coordinates are outside of the United States
 16,Optional,Coordinates are imprecise (less than three decimal digits) (see TADA.InvalidCoordinates.Flag),Coordinates are imprecise (less than three decimal digits)
+17,Optional,Metadata indicates result values are less than 4 hours apart and are likely from continuous monitoring probes (sensors). Continuous data may (or may not) be suitable for integration with discrete water quality data for analyses.,Continuous results
diff --git a/inst/flag_tests.csv b/inst/flag_tests.csv
@@ -77,3 +77,5 @@ Suspect characteristic and fraction combination,TADA.SampleFraction.Flag,Accepte
 Suspect characteristic and fraction combination,TADA.SampleFraction.Flag,Rejected,0,1
 Metadata indicates duplicative uploads of the same results within a single organization,TADA.SingleOrgDup.Flag,Duplicate,0,1
 Metadata indicates duplicative uploads of the same results within a single organization,TADA.SingleOrgDup.Flag,Unique,0,0
+Continuous results,TADA.ContinuousData.Flag,Continuous,0,1
+Continuous results,TADA.ContinuousData.Flag,Discrete,0,0