Skip to content

Commit

Permalink
Updates for 5 tickets for December work
Browse files Browse the repository at this point in the history
This contains updates for issues 160, 172, 182, 189, and 192.
  • Loading branch information
JamesBisese committed Jan 14, 2025
1 parent a3521a8 commit 146d72b
Show file tree
Hide file tree
Showing 7 changed files with 137 additions and 89 deletions.
18 changes: 16 additions & 2 deletions R/app_ui.R
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
#' DO NOT REMOVE.
#' @noRd
#'
library(gotop)

# THE BUSINESS STARTS ON line 223 or thereabouts.
css <- "
Expand All @@ -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(
Expand All @@ -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("<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
Expand Down Expand Up @@ -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"))
Expand Down
132 changes: 66 additions & 66 deletions R/mod_TADA_summary.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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)
)
}
Expand Down Expand Up @@ -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())
Expand All @@ -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())
Expand Down
4 changes: 4 additions & 0 deletions R/mod_censored_data.R
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
4 changes: 2 additions & 2 deletions R/mod_data_flagging.R
Original file line number Diff line number Diff line change
Expand Up @@ -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()); }"
),
Expand All @@ -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",
Expand Down
32 changes: 28 additions & 4 deletions R/mod_figures.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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,
Expand All @@ -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")) {
Expand Down
Loading

0 comments on commit 146d72b

Please sign in to comment.