From 146d72b0e152a13d6fdaf59ca1595ec3a44537a0 Mon Sep 17 00:00:00 2001 From: James Bisese Date: Tue, 14 Jan 2025 16:37:42 -0700 Subject: [PATCH] Updates for 5 tickets for December work This contains updates for issues 160, 172, 182, 189, and 192. --- R/app_ui.R | 18 +++++- R/mod_TADA_summary.R | 132 +++++++++++++++++++-------------------- R/mod_censored_data.R | 4 ++ R/mod_data_flagging.R | 4 +- R/mod_figures.R | 32 ++++++++-- R/mod_query_data.R | 23 ++++--- inst/app/www/footer.html | 13 ++-- 7 files changed, 137 insertions(+), 89 deletions(-) diff --git a/R/app_ui.R b/R/app_ui.R index 6f13b0034..c08742b25 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -4,6 +4,7 @@ #' DO NOT REMOVE. #' @noRd #' +library(gotop) # THE BUSINESS STARTS ON line 223 or thereabouts. css <- " @@ -12,7 +13,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 +31,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 + 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("
EPA development environment: The # content on this page is not production ready. This site is being used @@ -82,6 +95,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 index 0a61ebcca..68bb96640 100644 --- 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,10 +101,10 @@ 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) ) } @@ -135,10 +112,10 @@ mod_TADA_summary_server <- function(id, tadat) { # 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,46 @@ 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;") + }) + 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 +218,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 index 7b9b20a60..7051b1672 100644 --- a/R/mod_censored_data.R +++ b/R/mod_censored_data.R @@ -313,6 +313,10 @@ mod_censored_data_server <- function(id, tadat) { "TADA.ResultMeasureValue", "TADA.ResultMeasure.MeasureUnitCode" )] + + # I want to select just the rows where the detection limit has been changed. Else they are not really relevant. Right? + dat <- dat %>% filter(DetectionQuantitationLimitMeasure.MeasureValue != TADA.ResultMeasureValue) + dat <- dat %>% dplyr::rename( "Original Detection Limit Value" = DetectionQuantitationLimitMeasure.MeasureValue, diff --git a/R/mod_data_flagging.R b/R/mod_data_flagging.R index 62669f2aa..3667e16f5 100644 --- 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, 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 index ed33f42b0..d3d1205dd 100644 --- 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. NOTE: Currently, the single-characteristic scatterplot, histogram, and boxplot show the first characteristic from the drop down above the map: ", react$groups[1], ".")), + 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. + NOTE: Currently, the single-characteristic scatterplot, + histogram, and boxplot show the first characteristic from the + drop down above the map: ", react$groups[1], ".")), 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")) { diff --git a/R/mod_query_data.R b/R/mod_query_data.R index cd1a84b13..8e694560d 100644 --- a/R/mod_query_data.R +++ b/R/mod_query_data.R @@ -276,10 +276,9 @@ mod_query_data_server <- function(id, tadat) { paste0("tada_template", ".xlsx") }, content = function(file) { - # format csv. contentType = "text/csv" + ## format csv. contentType = "text/csv" # write.csv(template_data(), file) - # browser() - # format excel (xlsx) + ## format excel (xlsx) d = template_data() writexl::write_xlsx(d, path = file) }, @@ -296,11 +295,11 @@ mod_query_data_server <- function(id, tadat) { # read in the excel spreadsheet dataset if this input reactive object is populated via fileInput and define as tadat$raw shiny::observeEvent(input$file, { - # a modal that pops up showing it's working on querying the portal + # a modal that pops up showing it's working on uploading the dataset from the users file shinybusy::show_modal_spinner( spin = "double-bounce", color = "#0071bc", - text = "Uploading dataset...", + text = "Uploading dataset from excel file ...", session = shiny::getDefaultReactiveDomain() ) @@ -320,6 +319,10 @@ mod_query_data_server <- function(id, tadat) { # other steps to prepare data for app raw$TADA.Remove <- NULL initializeTable(tadat, raw) + + # this needs to run to create additional QA fields + tadat$raw <- EPATADA::TADA_AutoClean(tadat$raw) + if (!is.null(tadat$original_source)) { tadat$original_source <- "Upload" } @@ -429,7 +432,6 @@ mod_query_data_server <- function(id, tadat) { # remove the modal once the dataset has been pulled shinybusy::remove_modal_spinner(session = shiny::getDefaultReactiveDomain()) - # this event observer is triggered when the user hits the "Query Now" button, and then runs the TADAdataRetrieval function shiny::observeEvent(input$querynow, { tadat$original_source <- "Query" @@ -540,7 +542,8 @@ mod_query_data_server <- function(id, tadat) { shinybusy::remove_modal_spinner(session = shiny::getDefaultReactiveDomain()) # show a modal dialog box when tadat$raw is empty and the query didn't return any records. - # but if tadat$raw isn't empty, perform some initial QC of data that aren't media type water or have NA Resultvalue and no detection limit data + # but if tadat$raw isn't empty, perform some initial QC of data that aren't media type water + # or have NA Resultvalue and no detection limit data if (dim(raw)[1] < 1) { shiny::showModal( shiny::modalDialog( @@ -595,8 +598,7 @@ initializeTable <- function(tadat, raw) { shinyjs::enable(selector = '.nav li a[data-value="Figures"]') shinyjs::enable(selector = '.nav li a[data-value="Review"]') } else { - tadat$new <- - TRUE # this is used to determine if the app should go to the overview page first - only for datasets that are new to TADAShiny + tadat$new <- TRUE # this is used to determine if the app should go to the overview page first - only for datasets that are new to TADAShiny tadat$ovgo <- TRUE # load data into overview page shinyjs::enable(selector = '.nav li a[data-value="Overview"]') shinyjs::enable(selector = '.nav li a[data-value="Flag"]') @@ -608,6 +610,9 @@ initializeTable <- function(tadat, raw) { removals <- data.frame(matrix(nrow = nrow(raw), ncol = 0)) tadat$raw <- raw tadat$removals <- removals + + # display the download buttons + tadat$ready_for_download <- TRUE } diff --git a/inst/app/www/footer.html b/inst/app/www/footer.html index ccec8e4d9..2ea9572f8 100644 --- a/inst/app/www/footer.html +++ b/inst/app/www/footer.html @@ -162,10 +162,11 @@

Follow.

- - - + + + + - - - \ No newline at end of file + + + \ No newline at end of file