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

Progress file functionality #130

Merged
merged 6 commits into from
Nov 22, 2023
Merged

Progress file functionality #130

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
7a65395
adding my stuff back in
triphook Nov 2, 2023
b5a9614
mostly done
triphook Nov 2, 2023
3db6c92
latest
triphook Nov 3, 2023
59d3c9a
zip progress file
triphook Nov 20, 2023
cebb152
address notes
cristinamullin Nov 21, 2023
97d726d
small changes
cristinamullin Nov 22, 2023
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
15 changes: 14 additions & 1 deletion R/app_server.R
View file
Open in desktop
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
Open in desktop
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
Open in desktop
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