Merge pull request #200 from USEPA/december_work

Updates for 5 tickets for December work
USEPA · Jan 30, 2025 · 30a2bca · 30a2bca
2 parents a3521a8 + 15d864c
commit 30a2bca
Show file tree

Hide file tree

Showing 9 changed files with 151 additions and 101 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -15,7 +15,6 @@ Copyright: This software is in the public domain because it contains materials
     that originally came from the U.S. Environmental Protection Agency.
 Imports: 
     magrittr,
-    golem,
     htmltools,
     readxl,
     writexl,
@@ -25,7 +24,6 @@ Imports:
     shinycssloaders,
     DT,
     ggplot2,
-    EPATADA, 
     shinybusy, 
     dplyr, 
     plyr,
@@ -36,12 +34,15 @@ Imports:
     grDevices,
     lubridate,
     plotly, 
-    shinyjs
+    shinyjs,
+    gotop,
+    EPATADA,
+    golem,
+    testthat
 Remotes: 
     github::USEPA/EPATADA
 Suggests: 
     config,
-    testthat,
     remotes,
     covr,
     rmarkdown, 

diff --git a/R/app_ui.R b/R/app_ui.R
@@ -12,7 +12,13 @@ css <- "
   color: #333 !important;
   cursor: not-allowed !important;
   border-color: #F5F5F5 !important;
-}"
+}
+
+.row {
+    margin-right: 0px;
+    margin-left: 0px;
+}
+"
 
 app_ui <- function(request) {
   tagList(
@@ -24,7 +30,13 @@ app_ui <- function(request) {
     # Your application UI logic
     shiny::fluidPage(
       tags$html(class = "no-js", lang = "en"),
-
+      # standardized Go to Top button appears on lower-right corner when window is scrolled down 100 pixels
+      gotop::use_gotop(  # add it inside the ui
+        src = "fas fa-chevron-circle-up", # css class from Font Awesome
+        opacity = 0.8, # transparency
+        width = 60, # size
+        appear = 100 # number of pixels before appearance
+      ), # ), 
       # 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
@@ -82,6 +94,7 @@ app_ui <- function(request) {
         )
       ),
       htmltools::hr(),
+      # adds 'TADA Working Summary and download buttons above the app footer
       mod_TADA_summary_ui("TADA_summary_1"),
       # adds epa footer html
       shiny::includeHTML(app_sys("app/www/footer.html"))

diff --git a/R/mod_TADA_summary.R b/R/mod_TADA_summary.R
@@ -12,60 +12,33 @@
 mod_TADA_summary_ui <- function(id) {
   ns <- NS(id)
   tagList(shiny::fluidRow(
-    column(
-      4,
-      style = "padding-left:20px",
-      shiny::wellPanel(
-        htmltools::h3("TADA Working Summary"),
-        shiny::fluidRow(htmltools::h5(shiny::textOutput(ns(
-          "rec_tot"
-        )))),
-        shiny::fluidRow(htmltools::h5(shiny::textOutput(ns(
-          "rec_rem"
-        )))),
-        shiny::fluidRow(htmltools::h5(shiny::textOutput(ns(
-          "rec_clean"
-        )))),
-        htmltools::hr(),
-        shiny::fluidRow(htmltools::h5(shiny::textOutput(ns(
-          "site_tot"
-        )))),
-        shiny::fluidRow(htmltools::h5(shiny::textOutput(ns(
-          "site_rem"
-        )))),
-        shiny::fluidRow(htmltools::h5(shiny::textOutput(ns(
-          "site_clean"
-        )))),
-        shiny::fluidRow(column(6, shiny::uiOutput(ns(
-          "dwn_working"
-        )))),
-        shiny::fluidRow(column(6, shiny::uiOutput(ns(
-          "dwn_final"
-        )))) # ,
-        # shiny::fluidRow(column(
-        #   6,
-        #   shiny::fileInput(
-        #     ns("up_ts"),
-        #     "",
-        #     multiple = TRUE,
-        #     accept = ".Rdata",
-        #     width = "100%"
-        #   )
-        # ))
-      ),
-      shiny::fluidRow(column(
-        2, shiny::actionButton(ns("disclaimer"), "DISCLAIMER")
-      )),
-      htmltools::br(),
-      htmltools::br()
-    ),
-    # ,
-    # column(4,
-    #        shiny::wellPanel(
-    #          htmltools::h3("Removed Record Summary"),
-    #          DT::DTOutput(ns("removal_summary"))
-    #        ))
-  ))
+    column(6, style = "padding-left:20px",
+      shiny::wellPanel(htmltools::h3("TADA Working Summary"),
+
+        shiny::fluidRow(
+          column(6, htmltools::h5(shiny::textOutput(ns("rec_tot")))),
+          column(6, htmltools::h5(shiny::textOutput(ns("site_tot"))))
+        ),
+        shiny::fluidRow(
+          column(6, htmltools::h5(shiny::textOutput(ns("rec_rem")))),
+          column(6, htmltools::h5(shiny::textOutput(ns("site_rem"))))
+        ),
+        shiny::fluidRow(
+          column(6, htmltools::h5(shiny::textOutput(ns("rec_clean")))),
+          column(6, htmltools::h5(shiny::textOutput(ns("site_clean"))))
+        ),
+        htmltools::hr(style = "margin-top: 0px !important;"),
+
+        # buttons for downloading.
+        shiny::fluidRow(
+          column(6, shiny::uiOutput(ns("dwn_working"))),
+          column(6, shiny::uiOutput(ns("dwn_final")))
+        ),
+        shiny::fluidRow(
+          column(2, shiny::actionButton(ns("disclaimer"), "DISCLAIMER"))
+        )
+      )
+  )))
 }
 
 #' TADA_summary Server Functions
@@ -95,6 +68,10 @@ mod_TADA_summary_server <- function(id, tadat) {
         length(unique(tadat$raw$MonitoringLocationIdentifier[!tadat$raw$MonitoringLocationIdentifier %in%
           clean_sites]))
       summary_things$removals <- sort_removals(tadat$removals)
+
+      # enable the Download buttons
+      shinyjs::enable("download_working")
+      shinyjs::enable("download_final")
     })
     summary_things$removals <- data.frame(matrix(
       ncol = 2,
@@ -124,21 +101,21 @@ mod_TADA_summary_server <- function(id, tadat) {
     # summary text = total records removed
     output$rec_rem <- shiny::renderText({
       if (is.null(tadat$raw)) {
-        "Total Results Flagged for Removal: 0"
+        "Results Flagged for Removal: 0"
       } else {
         paste0(
-          "Total Results Flagged for Removal: ",
+          "Results Flagged for Removal: ",
           scales::comma(summary_things$rem_rec)
         )
       }
     })
     # summary text = total records in clean
     output$rec_clean <- shiny::renderText({
       if (is.null(tadat$raw)) {
-        "Total Results Retained: 0"
+        "Results Retained: 0"
       } else {
         paste0(
-          "Total Results Retained: ",
+          "Results Retained: ",
           scales::comma(summary_things$clean_rec)
         )
       }
@@ -176,30 +153,48 @@ mod_TADA_summary_server <- function(id, tadat) {
       }
     })
 
-    # download dataset button - only appears if there data exists in the app already
+    # Download ... Dataset button - only appears if there data exists in the app already
     output$dwn_working <- shiny::renderUI({
-      shiny::req(tadat$raw)
-      shiny::downloadButton(ns("download_working"),
+      shiny::req(tadat$ready_for_download)
+      shinyjs::disabled(shiny::downloadButton(ns("download_working"),
         "Download Working Dataset (.zip)",
         style = "color: #fff; background-color: #337ab7; border-color: #2e6da4; margin-bottom: 10px;",
         contentType = "application/zip"
-      )
+      ))
     })
 
     output$dwn_final <- shiny::renderUI({
-      shiny::req(tadat$raw)
-      shiny::downloadButton(ns("download_final"),
+      shiny::req(tadat$ready_for_download)
+      shinyjs::disabled(shiny::downloadButton(ns("download_final"),
         "Download Final Dataset (.zip)",
-        style = "color: #fff; background-color: #337ab7; border-color: #2e6da4",
+        style = "color: #fff; background-color: #337ab7; border-color: #2e6da4; margin-bottom: 10px;",
         contentType = "application/zip"
-      )
+      ))
     })
 
+      output$new_dwn_working <- shiny::renderUI({
+        shiny::req(tadat$raw)
+        shiny::actionButton(
+            ns("new_download_working"), 
+            "FOOBAR Download Working Dataset (.zip)", shiny::icon("download"),
+            style = "color: #fff; background-color: #337ab7; border-color: #2e6da4; margin-bottom: 10px;")
+      })
+
+    # Used a spinner to stop the user from hitting download multiple times
+    # Freezes the whole app while the file is downloading
     output$download_working <- shiny::downloadHandler(
       filename = function() {
         paste0(tadat$default_outfile, "_working.zip")
       },
       content = function(fname) {
+        shinybusy::show_modal_spinner(
+          spin = "double-bounce",
+          color = "#0071bc",
+          text = "Downloading Working Dataset...",
+          session = shiny::getDefaultReactiveDomain()
+        )
+        on.exit(shinybusy::remove_modal_spinner(session = shiny::getDefaultReactiveDomain()))
+
         fs <- c()
         tmpdir <- tempdir()
         setwd(tempdir())
@@ -225,6 +220,13 @@ mod_TADA_summary_server <- function(id, tadat) {
         paste0(tadat$default_outfile, "_final.zip")
       },
       content = function(fname) {
+        shinybusy::show_modal_spinner(
+          spin = "double-bounce",
+          color = "#0071bc",
+          text = "Downloading Final Dataset...",
+          session = shiny::getDefaultReactiveDomain()
+        )
+        on.exit(shinybusy::remove_modal_spinner(session = shiny::getDefaultReactiveDomain()))
         fs <- c()
         tmpdir <- tempdir()
         setwd(tempdir())

diff --git a/R/mod_censored_data.R b/R/mod_censored_data.R
@@ -313,6 +313,12 @@ mod_censored_data_server <- function(id, tadat) {
           "TADA.ResultMeasureValue",
           "TADA.ResultMeasure.MeasureUnitCode"
         )]
+
+      # COMMENT out for now to discuss later
+      # this does not work as is... the idea is to select just the rows where 
+      # limit has been changed because others are not really relevant.  Right?
+      # dat <- dat %>% dplyr::filter(DetectionQuantitationLimitMeasure.MeasureValue != TADA.ResultMeasureValue)
+
       dat <-
         dat %>% dplyr::rename(
           "Original Detection Limit Value" = DetectionQuantitationLimitMeasure.MeasureValue,
@@ -322,8 +328,7 @@ mod_censored_data_server <- function(id, tadat) {
         )
 
       # create censored data table
-      censdat$exdat <-
-        dat[1:10, ] # just show the first 10 records so user can see what happened to data
+      censdat$exdat <- dat # [1:10, ] # just show the first 10 records so user can see what happened to data
 
       shinybusy::remove_modal_spinner(session = shiny::getDefaultReactiveDomain())
       tadat$censor_applied <- TRUE
@@ -375,7 +380,7 @@ mod_censored_data_server <- function(id, tadat) {
           dom = "Blftipr", #"t",#cm updated to match harmonization table on 12/26/24
           scrollX = TRUE,
           pageLength = 10
-          #searching = FALSE #cm updated to TRUE on 12/26/24
+          #searching = FALSE #cm updated to TRUE (default) on 12/26/24
         ),
         selection = "none",
         rownames = FALSE

diff --git a/R/mod_data_flagging.R b/R/mod_data_flagging.R
@@ -168,7 +168,7 @@ mod_data_flagging_server <- function(id, tadat) {
           options = list(
             dom = "t",
             paging = FALSE,
-            ordering = FALSE,
+            ordering = TRUE, # this adds ordering to the DT
             preDrawCallback = DT::JS(
               "function() { Shiny.unbindAll(this.api().table().node()); }"
             ),
@@ -186,7 +186,7 @@ mod_data_flagging_server <- function(id, tadat) {
       }
     })
 
-    # Runs when the flag button is clicked
+    # Runs when the flag button (tab 3. Flag, button 'Run Tests') is clicked
     shiny::observeEvent(input$runFlags, {
       shinybusy::show_modal_spinner(
         spin = "double-bounce",

diff --git a/R/mod_figures.R b/R/mod_figures.R
@@ -152,7 +152,11 @@ mod_figures_server <- function(id, tadat) {
 
     shiny::observe({
       shiny::req(react$dat)
-      shiny::updateSelectizeInput(session, "mapplotgroup", choices = unique(react$dat$groupname), selected = unique(react$dat$groupname)[1], server = TRUE)
+      shiny::updateSelectizeInput(session, 
+                                  "mapplotgroup", 
+                                  choices = unique(react$dat$groupname), 
+                                  selected = unique(react$dat$groupname)[1], 
+                                  server = TRUE)
     })
 
     # event observer that creates all reactive objects needed for map and plots following button push
@@ -243,14 +247,24 @@ mod_figures_server <- function(id, tadat) {
     # select sites whose data to display in plots
     output$selsites <- shiny::renderUI({ # this companion to the uiOutput in the UI appears when react$done exists
       shiny::req(react$mapdata)
-      sites <- c("All sites", unique(react$mapdata$MonitoringLocationIdentifier))
+
+      # the list of 'sites' is managed in the server function (below)
       shiny::fluidRow(
         htmltools::h3("3. Select Specific Sites (Optional)"),
-        htmltools::HTML(paste0("Use the drop down to pick the sites you'd like to include in the plots below and then click 'Generate Plots'. Defaults to all sites in the dataset. <B>NOTE:</B> Currently, the single-characteristic scatterplot, histogram, and boxplot show the first characteristic from the drop down above the map: <B>", react$groups[1], "</B>.")),
+        htmltools::HTML(paste0("Use the drop down to pick the sites you'd like to include 
+                               in the plots below and then click 'Generate Plots'. 
+                               Defaults to all sites in the dataset. 
+                               <B>NOTE:</B> Currently, the single-characteristic scatterplot, 
+                               histogram, and boxplot show the first characteristic from the 
+                               drop down above the map: <B>", react$groups[1], "</B>.")),
         htmltools::br(),
         column(
           6, # column containing drop down menu for all grouping column combinations
-          shiny::selectizeInput(ns("selsites1"), "Select sites", choices = sites, selected = sites[1], multiple = TRUE, width = "100%")
+          shiny::selectizeInput(ns("selsites1"), 
+                                "Select sites", 
+                                choices = NULL, 
+                                multiple = TRUE, 
+                                width = "100%")
         ),
         column(
           1,
@@ -261,6 +275,16 @@ mod_figures_server <- function(id, tadat) {
       )
     })
 
+    # this is 'server-side' processing of the options for the 'Select Specific Sites' widget
+    shiny::observe({
+      shiny::req(react$mapdata)
+      shiny::updateSelectizeInput(session, 
+                                  "selsites1", 
+                                  choices = c("All sites", unique(react$mapdata$MonitoringLocationIdentifier)), 
+                                  selected = c("All sites", unique(react$mapdata$MonitoringLocationIdentifier))[1], 
+                                  server = TRUE)
+    })
+
     # when the Go button is pushed to generate plots, this ensures the plot data is filtered to the selected sites (or all sites)
     shiny::observeEvent(input$selsitesgo, {
       if (all(input$selsites1 == "All sites")) {