Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Updates for 5 tickets for December work #200

Merged
merged 7 commits into from
Jan 30, 2025
Merged

Updates for 5 tickets for December work #200

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
146d72b
Updates for 5 tickets for December work
JamesBisese Jan 14, 2025
b390f40
update dependencies
cristinamullin Jan 28, 2025
5a3e8c5
try this
cristinamullin Jan 28, 2025
84565e4
troubleshooting check errors
cristinamullin Jan 28, 2025
213bd87
Update testthat.R
cristinamullin Jan 28, 2025
ae493d9
Update DESCRIPTION
cristinamullin Jan 28, 2025
15d864c
fix censored data table
cristinamullin Jan 30, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
9 changes: 5 additions & 4 deletions DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand All @@ -25,7 +24,6 @@ Imports:
shinycssloaders,
DT,
ggplot2,
EPATADA,
shinybusy,
dplyr,
plyr,
Expand All @@ -36,12 +34,15 @@ Imports:
grDevices,
lubridate,
plotly,
shinyjs
shinyjs,
gotop,
EPATADA,
golem,
testthat
Remotes:
github::USEPA/EPATADA
Suggests:
config,
testthat,
remotes,
covr,
rmarkdown,
Expand Down
17 changes: 15 additions & 2 deletions R/app_ui.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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(
Expand All @@ -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
Expand Down Expand Up @@ -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"))
Expand Down
134 changes: 68 additions & 66 deletions R/mod_TADA_summary.R
View file
Open in desktop
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,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())
Expand All @@ -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())
Expand Down
11 changes: 8 additions & 3 deletions R/mod_censored_data.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions R/mod_data_flagging.R
View file
Open in desktop
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, # this adds ordering to the DT
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
View file
Open in desktop
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
Loading