Skip to content

Commit

Permalink
Merge pull request #130 from USEPA/trip_merge
Browse files Browse the repository at this point in the history 
Progress file functionality
  • Loading branch information
@cristinamullin
cristinamullin authored Nov 22, 2023
2 parents 8dbc1bf + f71cb5b commit 5cffb0f
Show file tree
Hide file tree
Showing 13 changed files with 1,183 additions and 363 deletions.
15 changes: 14 additions & 1 deletion R/app_server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,12 +32,19 @@ app_server <- function(input, output, session) {
shinyjs::disable(selector = '.nav li a[data-value="Figures"]')
shinyjs::disable(selector = '.nav li a[data-value="Review"]')

# switch that indicates when a file is being loaded
tadat$load_progress_file = NA
tadat$save_progress_file = NA
job_id = paste0("ts", format(Sys.time(), "%y%m%d%H%M%S"))
tadat$default_outfile = paste0("tada_output_", job_id)
tadat$job_id = job_id

# switch to overview tab when tadat$new changes and provide user with window letting them know how many records were automatically flagged for removal upon upload
# move this to query_data?
shiny::observeEvent(tadat$new, {
shiny::showModal(shiny::modalDialog(
title = "Data Loaded",
"Your data were successfully loaded into the app and are displayed on the Overview tab. See summary information about your dataset in the gray box at the bottom of the app."
"Your data were successfully loaded into the app and are displayed on the Overview tab. The following data wrangling steps were performed automatically when data was loaded: 1) created TADA versions of a subset of columns for editing (originals are retained), 2) removed exact duplicates, 3) handled/flagged special characters and text in result values and units, 4) identified detection limit data and copied limit value to result value if blank, 5) harmonized result and depth units to TADA defaults, and 6) replaced retired characteristic names with current names. See summary information about your dataset in the gray box at the bottom of the app."
))
shiny::updateTabsetPanel(session = session, inputId = "tabbar", selected = "Overview")
tadat$new <- NULL
Expand All @@ -50,6 +57,12 @@ app_server <- function(input, output, session) {
}
})

# Update the default switches if a progress file is uploaded.
shiny::observeEvent(tadat$selected_flags, {
switch_defaults = tadat$selected_flags
})


# this observes when the user switches tabs and adds the current tab they're on as a column to their dataset.
shiny::observe({
shiny::req(tadat$raw)
Expand Down
1 change: 1 addition & 0 deletions R/golem_utils_ui.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -230,6 +230,7 @@ with_red_star <- function(text) {
#' @examples
#' rep_br(5)
#' @importFrom shiny HTML

rep_br <- function(times = 1) {
HTML(rep("<br/>", times = times))
}
Expand Down
145 changes: 95 additions & 50 deletions R/mod_TADA_summary.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,9 +38,24 @@ mod_TADA_summary_ui <- function(id) {
)))),
shiny::fluidRow(column(6, shiny::uiOutput(ns(
"dwn_all"
))))
)))),
shiny::fluidRow(column(6, shiny::uiOutput(ns(
"dwn_ts"
))))#,
# shiny::fluidRow(column(
# 6,
# shiny::fileInput(
# ns("up_ts"),
# "",
# multiple = TRUE,
# accept = ".Rdata",
# width = "100%"
# )
# ))
),
shiny::fluidRow(column(2, shiny::actionButton(ns("disclaimer"), "DISCLAIMER"))),
shiny::fluidRow(column(
2, shiny::actionButton(ns("disclaimer"), "DISCLAIMER")
)),
htmltools::br(),
htmltools::br()
),
Expand All @@ -60,28 +75,33 @@ mod_TADA_summary_server <- function(id, tadat) {
shiny::moduleServer(id, function(input, output, session) {
ns <- session$ns
# reactive list to hold reactive objects specific to this module
summary_things <- shiny::reactiveValues()

summary_things = shiny::reactiveValues()


# calculate the stats needed to fill the summary box
shiny::observe({
shiny::req(tadat$raw)
summary_things$rem_rec <- length(tadat$raw$ResultIdentifier[tadat$raw$TADA.Remove ==
TRUE])
summary_things$clean_rec <- length(tadat$raw$ResultIdentifier[tadat$raw$TADA.Remove ==
FALSE])
clean_sites <- unique(tadat$raw$MonitoringLocationIdentifier[tadat$raw$TADA.Remove ==
FALSE])
summary_things$rem_rec <-
length(tadat$raw$ResultIdentifier[tadat$raw$TADA.Remove ==
TRUE])
summary_things$clean_rec <-
length(tadat$raw$ResultIdentifier[tadat$raw$TADA.Remove ==
FALSE])
clean_sites <-
unique(tadat$raw$MonitoringLocationIdentifier[tadat$raw$TADA.Remove ==
FALSE])
summary_things$clean_site <- length(clean_sites)
summary_things$rem_site <- length(unique(tadat$raw$MonitoringLocationIdentifier[!tadat$raw$MonitoringLocationIdentifier %in%
clean_sites]))
summary_things$rem_site <-
length(unique(tadat$raw$MonitoringLocationIdentifier[!tadat$raw$MonitoringLocationIdentifier %in%
clean_sites]))
summary_things$removals <- sort_removals(tadat$removals)
})
summary_things$removals <- data.frame(matrix(
ncol = 2,
nrow = 0,
dimnames = list(NULL, c("Reason", "Count"))
))

# output$removal_summary = DT::renderDataTable(
# summary_things$removals,
# escape = FALSE,
Expand All @@ -92,7 +112,7 @@ mod_TADA_summary_server <- function(id, tadat) {
# language = list(zeroRecords = "No records removed")
# )
# )

# summary text = total records
output$rec_tot <- shiny::renderText({
if (is.null(tadat$raw)) {
Expand All @@ -106,21 +126,17 @@ mod_TADA_summary_server <- function(id, tadat) {
if (is.null(tadat$raw)) {
"Total Results Flagged for Removal: 0"
} else {
paste0(
"Total Results Flagged for Removal: ",
scales::comma(summary_things$rem_rec)
)
paste0("Total 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"
} else {
paste0(
"Total Results Retained: ",
scales::comma(summary_things$clean_rec)
)
paste0("Total Results Retained: ",
scales::comma(summary_things$clean_rec))
}
})
# summary text = total sites
Expand All @@ -138,47 +154,73 @@ mod_TADA_summary_server <- function(id, tadat) {
if (is.null(tadat$raw)) {
"Total Sites Flagged for Removal: 0"
} else {
paste0(
"Total Sites Flagged for Removal: ",
scales::comma(summary_things$rem_site)
)
paste0("Total Sites Flagged for Removal: ",
scales::comma(summary_things$rem_site))
}
})
# summary text = total sites in clean file
output$site_clean <- shiny::renderText({
if (is.null(tadat$raw)) {
"Total Sites Retained: 0"
} else {
paste0(
"Total Sites Retained: ",
scales::comma(summary_things$clean_site)
)
paste0("Total Sites Retained: ",
scales::comma(summary_things$clean_site))
}
})

# download dataset button - only appears if there exists data in the app already
# download dataset button - only appears if there data exists in the app already
output$dwn_all <- shiny::renderUI({
shiny::req(tadat$raw)
shiny::downloadButton(ns("download_all"),
"Download Working Dataset (.xlsx)",
style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"
)
"Download Working Dataset (.zip)",
style = "color: #fff; background-color: #337ab7; border-color: #2e6da4")
})

output$download_all <- shiny::downloadHandler(
filename = function() {
paste("TADAShiny_datadownload_", tadat$tab, ".xlsx", sep = "")
paste0(tadat$default_outfile, ".zip")
},
content = function(file) {
writexl::write_xlsx(TADA::TADA_OrderCols(tadat$raw), path = file)
}
content = function(fname) {
fs <- c()
tmpdir <- tempdir()
setwd(tempdir())
datafile_name = paste0(tadat$default_outfile, ".xlsx")
progress_file_name = paste0(tadat$default_outfile, "_prog.RData")
desc <- writeNarrativeDataFrame(tadat)
dfs <-
list(Data = TADA::TADA_OrderCols(tadat$raw), Parameterization = desc)
writeFile(tadat, progress_file_name)
writexl::write_xlsx(dfs, path = datafile_name)
utils::zip(zipfile = fname,
files = c(datafile_name, progress_file_name))
},
contentType = "application/zip"
)


# # Download TADA progress file
# output$dwn_ts = shiny::renderUI({
# shiny::req(tadat$raw)
# shiny::downloadButton(ns("download_ts_file"),
# "Download Progress File (.Rdata)",
# style = "color: #fff; background-color: #337ab7; border-color: #2e6da4")
# })

# output$download_ts_file = shiny::downloadHandler(
# filename = function() {
# paste0(tadat$job_id, '.Rdata')
# },
# content = function(file) {
# writeFile(tadat, file)
# }
# )

shiny::observeEvent(input$disclaimer, {
shiny::showModal(shiny::modalDialog(
title = "Disclaimer",
"This United States Environmental Protection Agency (EPA) GitHub project code is provided on an 'as is' basis and the user assumes responsibility for its use. EPA has relinquished control of the information and no longer has responsibility to protect the integrity, confidentiality, or availability of the information. Any reference to specific commercial products, processes, or services by service mark, trademark, manufacturer, or otherwise, does not constitute or imply their endorsement, recommendation or favoring by EPA. The EPA seal and logo shall not be used in any manner to imply endorsement of any commercial product or activity by EPA or the United States Government."
))
shiny::showModal(
shiny::modalDialog(
title = "Disclaimer",
"This United States Environmental Protection Agency (EPA) GitHub project code is provided on an 'as is' basis and the user assumes responsibility for its use. EPA has relinquished control of the information and no longer has responsibility to protect the integrity, confidentiality, or availability of the information. Any reference to specific commercial products, processes, or services by service mark, trademark, manufacturer, or otherwise, does not constitute or imply their endorsement, recommendation or favoring by EPA. The EPA seal and logo shall not be used in any manner to imply endorsement of any commercial product or activity by EPA or the United States Government."
)
)
})
})
}
Expand All @@ -194,23 +236,26 @@ sort_removals <- function(removal_table) {
))
colnames(results) <- prefixes
results[is.na(results)] <- FALSE

for (prefix in prefixes) {
active_cols <- fields[dplyr::starts_with(prefix, vars = fields)]
if (length(active_cols) > 0) {
results[prefix] <- apply(dplyr::select(removal_table, active_cols), 1, any)
results[prefix] <-
apply(dplyr::select(removal_table, active_cols), 1, any)
}
}
totals <- rowSums(results)
results["Flag only"] <- ((totals == 1) & results$Flag)
results["Flag and Filter"] <- (results$Flag & results$Filter)
results["Filter only"] <- ((totals == 1) & results$Filter)
results <- dplyr::select(results, -intersect(prefixes, colnames(results)))
results <-
dplyr::select(results,-intersect(prefixes, colnames(results)))
results$Many <- rowSums(results) > 2
results$Retained <- !apply(results, 1, any)
counts <- colSums(results)
counts <- data.frame(Reason = names(counts), Count = as.vector(counts))
counts <- counts[(counts$Count > 0), ]
counts <-
data.frame(Reason = names(counts), Count = as.vector(counts))
counts <- counts[(counts$Count > 0),]
return(counts)
}
}
Expand Down
Loading

0 comments on commit 5cffb0f

Please sign in to comment.