diff --git a/DESCRIPTION b/DESCRIPTION
index bb4ba5da2..08ac54f00 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,36 +1,37 @@
Package: TADAShiny
Type: Package
-Title: WQP Data Discovery and Cleaning: First R Shiny App in the TADA (Tools for Automated Data Analysis) Series
+Title: Water Quality Portal Data Discovery and Cleaning: First R Shiny App in the TADA (Tools for Automated Data Analysis) Series
Version: 0.0.0.9000
-Organization: U.S. Environmental Protection Agency
-Authors@R:
- c(person(given = "Cristina",
- family = "Mullin",
- role = c("aut", "cre"),
- email = "mullin.cristina@epa.gov",
- comment = c(ORCID = "0000-0002-0615-6087")),
- person(given = "Trip",
- family = "Hook",
- role = "aut"),
- person(given = "Elise",
- family = "Hinman",
- role = c("aut"),
- email = "hinman.elise@epa.gov"),
- person(given = "Hui",
- family = "Zhou",
- role = c("aut"),
- email = "zhou.hui@epa.gov"),
- person(given = "Shelly",
- family = "Thawley",
- role = "aut"))
-Description: Assists data partners in retrieving, wrangling, quality checking, and preparing data from the Water Quality Portal for subsequent analyses.
+Authors@R: c(
+ person(given = "U.S. Environmental Protection Agency", role = "aut"),
+ person(given = "Cristina",
+ family = "Mullin",
+ role = c("aut", "cre"),
+ email = "mullin.cristina@epa.gov",
+ comment = c(ORCID = "0000-0002-0615-6087")),
+ person(given = "Trip",
+ family = "Hook",
+ role = "aut"),
+ person(given = "Elise",
+ family = "Hinman",
+ role = "aut"),
+ person(given = "Hillary",
+ family = "Marler",
+ role = "aut"),
+ person(given = "Shelly",
+ family = "Thawley",
+ role = "aut"),
+ person(given = "Hui",
+ family = "Zhou",
+ role = "aut")
+ )
+Description: Assists data partners in retrieving, wrangling, quality checking, and harmonizing data from the Water Quality Portal for subsequent analyses.
License: CC0
Copyright: This software is in the public domain because it contains materials
that originally came from the U.S. Environmental Protection Agency.
Imports:
- config,
- golem,
magrittr,
+ golem,
htmltools,
readxl,
writexl,
@@ -54,6 +55,7 @@ Imports:
Remotes:
github::USEPA/TADA
Suggests:
+ config,
testthat,
remotes,
covr,
@@ -73,6 +75,5 @@ Config/testthat/load-all: list(export_all = FALSE, helpers = FALSE)
LazyData: true
URL: https://github.com/USEPA/TADAShiny
BugReports: https://github.com/USEPA/TADAShiny/issues
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
Roxygen: list(markdown = TRUE)
-VignetteBuilder: knitr, rmarkdown
diff --git a/R/app_server.R b/R/app_server.R
index 1f4d1e0fc..8c4e44b93 100644
--- a/R/app_server.R
+++ b/R/app_server.R
@@ -8,7 +8,7 @@
# Below increases the max data upload size from the Shiny default of 5MB per file
# to 30MB for file
options(shiny.maxRequestSize = 30 * 1024^2)
-
+options(warn = 2)
app_server <- function(input, output, session) {
# Your application server logic
tadat <- shiny::reactiveValues() # create a list object that holds reactive values passed between modules
@@ -35,6 +35,7 @@ app_server <- function(input, output, session) {
# switch that indicates when a file is being loaded
tadat$load_progress_file = NA
tadat$save_progress_file = NA
+ tadat$flags_present = FALSE
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
@@ -44,7 +45,7 @@ app_server <- function(input, output, session) {
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. 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."
+ "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) handled/flagged special characters and text in result values and units, 3) harmonized result and depth units to TADA defaults, and 4) 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
@@ -57,27 +58,24 @@ 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)
+ # JCH - is this necessary?
+ #shiny::req(tadat$raw)
tadat$raw$TADAShiny.tab <- input$tabbar
tadat$tab <- input$tabbar
})
+ # JCH - disabling this for now. I think progress files provide this functionality
+ # this observes when the user switches tabs and adds the current tab they're on as a column to their dataset.
+
# switch to tab user left off on when tadat$reup changes, which only happens when someone uploads a workbook with the column "Removed" in it
- shiny::observeEvent(tadat$reup, {
- shiny::showModal(shiny::modalDialog(
- title = "Data Loaded",
- "Your working dataset has been uploaded and the app switched to the tab where you left off."
- ))
- # the switch tab command
- shiny::updateTabsetPanel(session = session, inputId = "tabbar", selected = unique(tadat$raw$tab))
- tadat$reup <- NULL
- })
+ #shiny::observeEvent(tadat$reup, {
+ # shiny::showModal(shiny::modalDialog(
+ # title = "Data Loaded",
+ # "Your working dataset has been uploaded and the app switched to the tab where you left off."
+ # ))
+ # # the switch tab command
+ # shiny::updateTabsetPanel(session = session, inputId = "tabbar", selected = unique(tadat$raw$tab))
+ # tadat$reup <- NULL
+ #})
}
diff --git a/R/mod_TADA_summary.R b/R/mod_TADA_summary.R
index d3578e3a9..2f88ab38b 100644
--- a/R/mod_TADA_summary.R
+++ b/R/mod_TADA_summary.R
@@ -37,10 +37,10 @@ mod_TADA_summary_ui <- function(id) {
"site_clean"
)))),
shiny::fluidRow(column(6, shiny::uiOutput(ns(
- "dwn_all"
+ "dwn_working"
)))),
shiny::fluidRow(column(6, shiny::uiOutput(ns(
- "dwn_ts"
+ "dwn_final"
))))#,
# shiny::fluidRow(column(
# 6,
@@ -169,16 +169,25 @@ mod_TADA_summary_server <- function(id, tadat) {
})
# download dataset button - only appears if there data exists in the app already
- output$dwn_all <- shiny::renderUI({
+ output$dwn_working <- shiny::renderUI({
shiny::req(tadat$raw)
- shiny::downloadButton(ns("download_all"),
+ shiny::downloadButton(ns("download_working"),
"Download Working Dataset (.zip)",
- style = "color: #fff; background-color: #337ab7; border-color: #2e6da4")
+ style = "color: #fff; background-color: #337ab7; border-color: #2e6da4",
+ contentType = "application/zip")
})
- output$download_all <- shiny::downloadHandler(
+ output$dwn_final <- shiny::renderUI({
+ shiny::req(tadat$raw)
+ shiny::downloadButton(ns("download_final"),
+ "Download Final Dataset (.zip)",
+ style = "color: #fff; background-color: #337ab7; border-color: #2e6da4",
+ contentType = "application/zip")
+ })
+
+ output$download_working <- shiny::downloadHandler(
filename = function() {
- paste0(tadat$default_outfile, ".zip")
+ paste0(tadat$default_outfile, "_working.zip")
},
content = function(fname) {
fs <- c()
@@ -197,22 +206,28 @@ mod_TADA_summary_server <- function(id, tadat) {
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)
- # }
- # )
+ output$download_final <- shiny::downloadHandler(
+ filename = function() {
+ paste0(tadat$default_outfile, "_final.zip")
+ },
+ 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)
+
+ # Remove all rows flagged for removal
+ dfs <-
+ list(Data = TADA::TADA_OrderCols(tadat$raw[!tadat$raw$TADA.Remove,]), 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"
+ )
shiny::observeEvent(input$disclaimer, {
shiny::showModal(
diff --git a/R/mod_data_flagging.R b/R/mod_data_flagging.R
index f7b659cfa..a668d3f38 100644
--- a/R/mod_data_flagging.R
+++ b/R/mod_data_flagging.R
@@ -38,7 +38,7 @@ mod_data_flagging_ui <- function(id) {
ns("m2f"),
label = "",
choices = c("feet", "inches", "meters"),
- selected = character(0),
+ selected = "meters",
inline = TRUE
)
))
@@ -54,7 +54,7 @@ mod_data_flagging_server <- function(id, tadat) {
tadat$selected_flags <- character()
tadat$switch_defaults <- prompt_table$Level != "Optional"
switch_disabled <- prompt_table$Level == "Required"
-
+
flagSwitch <- function(len) {
inputs <- character(len)
for (i in seq_len(len)) {
@@ -80,28 +80,25 @@ mod_data_flagging_server <- function(id, tadat) {
unlist(lapply(seq_len(len), function(i) {
value <- input[[paste0(id, i)]]
if (is.null(value)) {
- TRUE
+ FALSE
} else {
value
}
}))
}
-
-
-
# Runs whenever selected flags are changed
shiny::observeEvent(tadat$selected_flags, {
- prefix = "Flag: "
if (!is.null(tadat$removals)) {
- tadat$removals = dplyr::select(tadat$removals,-(dplyr::starts_with(prefix)))
+ tadat$removals = dplyr::select(tadat$removals,-(dplyr::starts_with(flag_prefix)))
}
# Loop through the flags
for (flag in tadat$selected_flags) {
# If not all the values are NA, add the test results to removals
if (!is.null(tadat$removals)) {
if (!all(is.na(values$testResults[flag]))) {
- tadat$removals[paste0(prefix, flag)] = values$testResults[flag]
+ # Problem here?
+ tadat$removals[paste0(flag_prefix, flag)] = values$testResults[flag]
}
}
# If the switch corresponding to this flag isn't on, switch it on
@@ -121,6 +118,69 @@ mod_data_flagging_server <- function(id, tadat) {
}
})
+ # Any time tadat$raw is changed, check to see if the flagging fields are present
+ shiny::observeEvent(tadat$raw, {
+ tadat$flags_present = checkFlagColumns(tadat$raw)
+ })
+
+ shiny::observeEvent(tadat$flags_present, {
+ if (tadat$flags_present) {
+ # A table (raw rows, flags) indicating whether each record passes each test
+ values$testResults <- flagCensus(tadat$raw)
+
+ # The number of records failing each test
+ values$n_fails <- colSums(values$testResults)
+
+ # Runs when any of the flag switches are changed
+ shiny::observe({
+ switch_id = "switch_"
+ tadat$selected_flags = flag_types[shinyValue(switch_id, n_switches)]
+ for (i in which(switch_disabled)) {
+ shinyjs::disable(paste0(switch_id, i))
+ }
+ })
+
+ switchTable <- shiny::reactive({
+ df <- data.frame(
+ Reason = prompts,
+ Results = values$n_fails,
+ Required = levs,
+ Decision = flagSwitch(n_switches)
+ )
+ })
+
+ output$flagTable <- DT::renderDT(
+ shiny::isolate(switchTable()),
+ escape = FALSE,
+ selection = "none",
+ colnames = c(
+ "Flag reason",
+ "Results affected",
+ "Required/Optional",
+ "Switch 'on' to flag for removal"
+ ),
+ rownames = FALSE,
+ options = list(
+ dom = "t",
+ paging = FALSE,
+ ordering = FALSE,
+ preDrawCallback = DT::JS(
+ "function() { Shiny.unbindAll(this.api().table().node()); }"
+ ),
+ drawCallback = DT::JS(
+ "function() { Shiny.bindAll(this.api().table().node()); } "
+ )
+ )
+ )
+
+ shinyjs::enable(selector = '.nav li a[data-value="Filter"]')
+ shinyjs::enable(selector = '.nav li a[data-value="Censored"]')
+ shinyjs::enable(selector = '.nav li a[data-value="Harmonize"]')
+ shinyjs::enable(selector = '.nav li a[data-value="Figures"]')
+ shinyjs::enable(selector = '.nav li a[data-value="Review"]')
+ }
+ })
+
# Runs when the flag button is clicked
shiny::observeEvent(input$runFlags, {
shinybusy::show_modal_spinner(
@@ -129,68 +189,17 @@ mod_data_flagging_server <- function(id, tadat) {
text = "Running flagging functions...",
session = shiny::getDefaultReactiveDomain()
)
-
- # Add flagging columns to raw table, make sure line below is
+
+ # Add flagging columns to raw table, make sure line below is
# not commented out once done with testing
tadat$raw <- applyFlags(tadat$raw, tadat$orgs)
- # write.csv(tadat$raw, "flagged.csv")
- # tadat$raw = utils::read.csv("flagged.csv") # THIS IS TRIPS WORKING FILE FOR TESTING, COMMENT OUT WHEN COMMITTING TO DEVELOP
- # A table (raw rows, flags) indicating whether each record passes each test
- values$testResults <- flagCensus(tadat$raw)
-
- # The number of records failing each test
- values$n_fails <- colSums(values$testResults)
+ #write.csv(tadat$raw, "flagged.csv")
+ #tadat$raw = utils::read.csv("flagged.csv") # THIS IS TRIPS WORKING FILE FOR TESTING, COMMENT OUT WHEN COMMITTING TO DEVELOP
# Remove progress bar and display instructions
shinybusy::remove_modal_spinner(session = shiny::getDefaultReactiveDomain())
- # Runs when any of the flag switches are changed
- shiny::observe({
- switch_id = "switch_"
- tadat$selected_flags = flag_types[shinyValue(switch_id, n_switches)]
- for (i in which(switch_disabled)) {
- shinyjs::disable(paste0(switch_id, i))
- }
- })
-
- switchTable <- shiny::reactive({
- df <- data.frame(
- Reason = prompts,
- Results = values$n_fails,
- Required = levs,
- Decision = flagSwitch(n_switches)
- )
- })
-
- output$flagTable <- DT::renderDT(
- shiny::isolate(switchTable()),
- escape = FALSE,
- selection = "none",
- colnames = c(
- "Flag reason",
- "Results affected",
- "Required/Optional",
- "Switch 'on' to flag for removal"
- ),
- rownames = FALSE,
- options = list(
- dom = "t",
- paging = FALSE,
- ordering = FALSE,
- preDrawCallback = DT::JS(
- "function() { Shiny.unbindAll(this.api().table().node()); }"
- ),
- drawCallback = DT::JS(
- "function() { Shiny.bindAll(this.api().table().node()); } "
- )
- )
- )
- shinyjs::enable(selector = '.nav li a[data-value="Filter"]')
- shinyjs::enable(selector = '.nav li a[data-value="Censored"]')
- shinyjs::enable(selector = '.nav li a[data-value="Harmonize"]')
- shinyjs::enable(selector = '.nav li a[data-value="Figures"]')
- shinyjs::enable(selector = '.nav li a[data-value="Review"]')
})
shiny::observeEvent(tadat$m2f, {
@@ -217,8 +226,10 @@ mod_data_flagging_server <- function(id, tadat) {
text = "Converting depth units to inches...",
session = shiny::getDefaultReactiveDomain()
)
+
tadat$raw <-
TADA::TADA_ConvertDepthUnits(tadat$raw, unit = "in")
+
}
if (input$m2f == "meters") {
shinybusy::show_modal_spinner(
@@ -233,4 +244,4 @@ mod_data_flagging_server <- function(id, tadat) {
shinybusy::remove_modal_spinner(session = shiny::getDefaultReactiveDomain())
})
})
-}
+}
\ No newline at end of file
diff --git a/R/mod_figures.R b/R/mod_figures.R
index d137d66a2..ac47e7f2e 100644
--- a/R/mod_figures.R
+++ b/R/mod_figures.R
@@ -111,7 +111,7 @@ mod_figures_server <- function(id, tadat) {
"TADA.ActivityMediaName",
"ActivityMediaSubdivisionName",
"TADA.ResultSampleFractionText",
- "TADA.MethodSpecificationName",
+ "TADA.MethodSpeciationName",
"TADA.CharacteristicName",
depthcols)
@@ -240,7 +240,7 @@ 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
- req(react$mapdata)
+ shiny::req(react$mapdata)
sites <- c("All sites", unique(react$mapdata$MonitoringLocationIdentifier))
shiny::fluidRow(
htmltools::h3("3. Select Specific Sites (Optional)"),
diff --git a/R/mod_filtering.R b/R/mod_filtering.R
index 51d0b87aa..f3fde9dea 100644
--- a/R/mod_filtering.R
+++ b/R/mod_filtering.R
@@ -3,7 +3,14 @@ mod_filtering_ui <- function(id) {
tagList(
htmltools::HTML("Select field to filter on:
"),
htmltools::HTML(
- "Key columns are listed in the table below, along with the number of unique values present in that field. These counts do not include unique values from results flagged for removal. Click on a field name and a new table will appear below showing the counts associated with each unique value in the selected field."
+ "Fields are listed in the table below, along with the number of unique values present in that field. These counts do not include unique values from results flagged for removal. Click on a field name and a new table will appear below showing the counts associated with each unique value in the selected field."
+ ),
+ shiny::radioButtons(
+ ns("field_sel"),
+ label = "Fields to select from: ",
+ choices = c("key", "most", "all"),
+ selected = "key",
+ inline = TRUE
),
DT::dataTableOutput(ns("filterStep1")),
htmltools::br(),
@@ -61,8 +68,7 @@ mod_filtering_server <- function(id, tadat) {
shinyjs::hide("addExcludes")
# make sure dataset being used to create filters is only REMOVE = FALSE
- shiny::observe({
- shiny::req(tadat$tab)
+ shiny::observeEvent(tadat$tab, {
if (tadat$tab == "Filter") {
# only show unique values from data that have not been flagged for removal
tables$dat <-
@@ -170,6 +176,18 @@ mod_filtering_server <- function(id, tadat) {
}
})
+ shiny::observeEvent(input$field_sel, {
+ tadat$field_sel <- input$field_sel
+ })
+
+ shiny::observeEvent(tadat$field_sel, {
+ shiny::updateRadioButtons(session, "field_sel", selected = tadat$field_sel)
+ if (!is.null(tables$dat)) {
+ tables$filter_fields <-
+ TADA::TADA_FieldCounts(tables$dat, display = tadat$field_sel)
+ }
+ })
+
# reset all filters in bottom table
shiny::observeEvent(input$resetFilters, {
# empty selected table on open
@@ -253,6 +271,7 @@ mod_filtering_server <- function(id, tadat) {
values$locked = field_filters$Filter
names(values$locked) <- field_filters$Field
prefix = "Filter: "
+
# Remove all the filter columns from the removals table (start fresh)
if (!is.null(tadat$removals)) {
tadat$removals <-
@@ -287,13 +306,14 @@ mod_filtering_server <- function(id, tadat) {
tadat$removals[label] <- as.logical(results)
}
}
-
+
# Get counts for the filters
if (!is.null(tables$dat) & nrow(tadat$selected_filters > 0)) {
# Refresh the 'count' field
new_selected_filters <- tadat$selected_filters
new_selected_filters$Count <- NULL
- new_selected_filters <- cbind(new_selected_filters, Count=0)
+ new_selected_filters <-
+ cbind(new_selected_filters, Count = 0)
for (i in 1:nrow(new_selected_filters)) {
row = new_selected_filters[i, ]
values = getValues(tables$dat, row$Field)
@@ -304,7 +324,7 @@ mod_filtering_server <- function(id, tadat) {
}
})
-
+
getValues <- function(.data, field) {
counts <- table(.data[[field]], useNA = "ifany")
if (length(rownames(counts) > 0)) {
@@ -317,5 +337,3 @@ mod_filtering_server <- function(id, tadat) {
}
})
}
-
-
diff --git a/R/mod_harmonize_np.R b/R/mod_harmonize_np.R
index 5c09d7e00..91fdbfdf7 100644
--- a/R/mod_harmonize_np.R
+++ b/R/mod_harmonize_np.R
@@ -38,7 +38,7 @@ mod_harmonize_np_ui <- function(id) {
#'
#' @noRd
mod_harmonize_np_server <- function(id, tadat) {
- moduleServer(id, function(input, output, session) {
+ shiny::moduleServer(id, function(input, output, session) {
ns <- session$ns
# columns needed for harmonization table
cols <- c(
@@ -48,8 +48,8 @@ mod_harmonize_np_server <- function(id, tadat) {
"TADA.ResultSampleFractionText",
"Target.TADA.ResultSampleFractionText",
"TADA.FractionAssumptions",
- "TADA.MethodSpecificationName",
- "Target.TADA.MethodSpecificationName",
+ "TADA.MethodSpeciationName",
+ "Target.TADA.MethodSpeciationName",
"TADA.SpeciationAssumptions",
"Target.TADA.SpeciationConversionFactor",
"TADA.ResultMeasure.MeasureUnitCode",
@@ -64,7 +64,7 @@ mod_harmonize_np_server <- function(id, tadat) {
# when user hits harm go button, runs TADA_GetSynonymRef and makes friendly column names for table.
shiny::observeEvent(input$harm_go, {
ref <- TADA::TADA_GetSynonymRef(tadat$raw[tadat$raw$TADA.Remove == FALSE, ])
- ref <- ref %>% dplyr::arrange(Target.TADA.CharacteristicName, Target.TADA.ResultSampleFractionText, Target.TADA.MethodSpecificationName)
+ ref <- ref %>% dplyr::arrange(Target.TADA.CharacteristicName, Target.TADA.ResultSampleFractionText, Target.TADA.MethodSpeciationName)
colns <- names(ref)
harm$colns <- colns %>% dplyr::recode(
TADA.CharacteristicName = "Characteristic",
@@ -73,8 +73,8 @@ mod_harmonize_np_server <- function(id, tadat) {
TADA.ResultSampleFractionText = "Fraction",
Target.TADA.ResultSampleFractionText = "Target Fraction",
TADA.FractionAssumptions = "Fraction Assumptions",
- TADA.MethodSpecificationName = "Speciation",
- Target.TADA.MethodSpecificationName = "Target Speciation",
+ TADA.MethodSpeciationName = "Speciation",
+ Target.TADA.MethodSpeciationName = "Target Speciation",
TADA.SpeciationAssumptions = "Speciation Assumptions",
Target.TADA.SpeciationConversionFactor = "Speciation Conversion Factor (to AS N or AS P)",
TADA.ResultMeasure.MeasureUnitCode = "Unit",
@@ -110,7 +110,7 @@ mod_harmonize_np_server <- function(id, tadat) {
# user uploaded data
ref <- suppressWarnings(read.csv(input$harm_file$datapath))
if (all(cols %in% names(ref)) & dim(ref)[1] > 0) {
- ref <- ref %>% dplyr::arrange(Target.TADA.CharacteristicName, Target.TADA.ResultSampleFractionText, Target.TADA.MethodSpecificationName)
+ ref <- ref %>% dplyr::arrange(Target.TADA.CharacteristicName, Target.TADA.ResultSampleFractionText, Target.TADA.MethodSpeciationName)
colns <- names(ref)
harm$colns <- colns %>% dplyr::recode(
TADA.CharacteristicName = "Characteristic",
@@ -119,8 +119,8 @@ mod_harmonize_np_server <- function(id, tadat) {
TADA.ResultSampleFractionText = "Fraction",
Target.TADA.ResultSampleFractionText = "Target Fraction",
TADA.FractionAssumptions = "Fraction Assumptions",
- TADA.MethodSpecificationName = "Speciation",
- Target.TADA.MethodSpecificationName = "Target Speciation",
+ TADA.MethodSpeciationName = "Speciation",
+ Target.TADA.MethodSpeciationName = "Target Speciation",
TADA.SpeciationAssumptions = "Speciation Assumptions",
Target.TADA.SpeciationConversionFactor = "Speciation Conversion Factor (to AS N or AS P)",
TADA.ResultMeasure.MeasureUnitCode = "Unit",
@@ -157,7 +157,7 @@ mod_harmonize_np_server <- function(id, tadat) {
selection = "none", rownames = FALSE
) %>%
DT::formatStyle(columns = names(harm$ref), `font-size` = "12px") %>%
- DT::formatStyle(columns = c("TADA.CharacteristicName", "TADA.ResultSampleFractionText", "TADA.MethodSpecificationName", "TADA.ResultMeasure.MeasureUnitCode"), backgroundColor = "#2e6da4", color = "white")
+ DT::formatStyle(columns = c("TADA.CharacteristicName", "TADA.ResultSampleFractionText", "TADA.MethodSpeciationName", "TADA.ResultMeasure.MeasureUnitCode"), backgroundColor = "#2e6da4", color = "white")
})
# apply synonym ref to data when button is pushed
@@ -186,7 +186,7 @@ mod_harmonize_np_server <- function(id, tadat) {
))
})
- output$sum_dwn <- downloadHandler(
+ output$sum_dwn <- shiny::downloadHandler(
filename = function() {
"TADA_NPSummationKey.csv"
},
@@ -222,10 +222,8 @@ mod_harmonize_np_server <- function(id, tadat) {
new_df <- as.data.frame(matrix(FALSE, ncol = ncols, nrow = nrows))
names(new_df) <- names(tadat$removals)
tadat$removals <- plyr::rbind.fill(tadat$removals, new_df)
-
tadat$raw <- plyr::rbind.fill(dat, rem)
tadat$raw <- TADA::TADA_OrderCols(tadat$raw)
-
nitrolen <- length(dat$TADA.NutrientSummation.Flag[dat$TADA.NutrientSummation.Flag %in% c("Nutrient summation from one or more subspecies.")])
phoslen <- length(dat$TADA.NutrientSummation.Flag[dat$TADA.NutrientSummation.Flag %in% c("Nutrient summation from one subspecies.")])
# remove the modal once the dataset has been harmonized
diff --git a/R/mod_overview.R b/R/mod_overview.R
index b8542d166..646c78d9d 100644
--- a/R/mod_overview.R
+++ b/R/mod_overview.R
@@ -71,7 +71,7 @@ mod_overview_server <- function(id, tadat) {
# create dataset for map and histogram using raw data
shiny::observeEvent(tadat$ovgo, {
- req(tadat$raw)
+ shiny::req(tadat$raw)
# create gray text tile info
mapdat$text <- tadat$raw %>%
dplyr::filter(TADA.Remove == FALSE) %>%
@@ -87,6 +87,7 @@ mod_overview_server <- function(id, tadat) {
dplyr::group_by(OrganizationFormalName, OrganizationIdentifier) %>%
dplyr::summarise("Result_Count" = length(unique(ResultIdentifier))) %>%
dplyr::ungroup()
+
tadat$org_table <- orgs %>%
dplyr::arrange(-Result_Count) %>%
dplyr::mutate("Rank" = 1:length(Result_Count))
diff --git a/R/mod_query_data.R b/R/mod_query_data.R
index ebc9bf106..8b6b6b0e3 100644
--- a/R/mod_query_data.R
+++ b/R/mod_query_data.R
@@ -61,7 +61,7 @@ mod_query_data_ui <- function(id) {
shiny::fluidRow(column(
4,
shiny::dateInput(
- ns("startdate"),
+ ns("startDate"),
"Start Date",
format = "yyyy-mm-dd",
startview = "year"
@@ -70,7 +70,7 @@ mod_query_data_ui <- function(id) {
column(
4,
shiny::dateInput(
- ns("enddate"),
+ ns("endDate"),
"End Date",
format = "yyyy-mm-dd",
startview = "year"
@@ -111,7 +111,7 @@ mod_query_data_ui <- function(id) {
column(
4,
shiny::selectizeInput(
- ns("proj"),
+ ns("project"),
"Project(s)",
choices = NULL,
multiple = TRUE
@@ -168,7 +168,7 @@ mod_query_data_ui <- function(id) {
shiny::fluidRow(
htmltools::h3("Option C: Upload dataset"),
htmltools::HTML((
- "Select a file from your computer. This upload feature currently only accepts data in .xls and .xlsx formats.
+ "Upload a dataset from your computer. This upload feature only accepts data in .xls and .xlsx formats.
The file can be a fresh TADA dataset or a working TADA dataset that you are returning to the
app to iterate on. Data must also be formatted in the EPA Water Quality eXchange (WQX) schema to leverage
this tool. You may reach out to the WQX helpdesk at WQX@epa.gov for assistance preparing and submitting your data
@@ -190,9 +190,15 @@ mod_query_data_ui <- function(id) {
htmltools::hr(),
shiny::fluidRow(
- htmltools::h3("Upload Progress File"),
+ htmltools::h3("Optional: Upload Progress File"),
htmltools::HTML((
- "Upload a progress file. These files can be used to automatically parameterize the TADA Shiny app."
+ "Upload a progress file from your computer. This upload feature only accepts data in the .RData format.
+ The TADA Shiny application keeps track of all user selections, and makes a .RData file
+ available for download at any time. If you saved a progress file you generated during a
+ previous use of the TADA Shiny application, then it can be uploaded here and used
+ to automatically parameterize the TADA Shiny app with the same selections. This file can
+ be used to regenerate a dataset with the same decisions as before, or can be used
+ to apply the same user selctions to a new dataset"
)
),
# widget to upload WQP profile or WQX formatted spreadsheet
@@ -218,15 +224,26 @@ mod_query_data_server <- function(id, tadat) {
ns <- session$ns
# read in the excel spreadsheet dataset if this input reactive object is populated via fileInput and define as tadat$raw
- shiny::observe({
- shiny::req(input$file)
+ shiny::observeEvent(input$file,{
+ # a modal that pops up showing it's working on querying the portal
+ shinybusy::show_modal_spinner(
+ spin = "double-bounce",
+ color = "#0071bc",
+ text = "Uploading dataset...",
+ session = shiny::getDefaultReactiveDomain()
+ )
+
# user uploaded data
raw <-
suppressWarnings(readxl::read_excel(input$file$datapath, sheet = 1))
+ raw$TADA.Remove <- NULL
initializeTable(tadat, raw)
if (!is.null(tadat$original_source)){
tadat$original_source <- "Upload"
}
+
+ shinybusy::remove_modal_spinner(session = shiny::getDefaultReactiveDomain())
+
})
# Read the TADA progress file
@@ -238,6 +255,14 @@ mod_query_data_server <- function(id, tadat) {
# if user presses example data button, make tadat$raw the nutrients dataset contained within the TADA package.
shiny::observeEvent(input$example_data_go, {
+ # a modal that pops up showing it's working on querying the portal
+ shinybusy::show_modal_spinner(
+ spin = "double-bounce",
+ color = "#0071bc",
+ text = "Loading example data...",
+ session = shiny::getDefaultReactiveDomain()
+ )
+
tadat$example_data <- input$example_data
if (input$example_data == "Shepherdstown (34k results)") {
raw <- TADA::Data_NCTCShepherdstown_HUC12
@@ -249,6 +274,9 @@ mod_query_data_server <- function(id, tadat) {
raw <- TADA::Data_Nutrients_UT
}
initializeTable(tadat, raw)
+
+ shinybusy::remove_modal_spinner(session = shiny::getDefaultReactiveDomain())
+
})
# this section has widget update commands for the selectizeinputs that have a lot of possible selections - shiny suggested hosting the choices server-side rather than ui-side
@@ -277,7 +305,7 @@ mod_query_data_server <- function(id, tadat) {
choices = c(chars),
server = TRUE)
shiny::updateSelectizeInput(session,
- "proj",
+ "project",
choices = c(projects),
server = TRUE)
shiny::updateSelectizeInput(
@@ -346,10 +374,10 @@ mod_query_data_server <- function(id, tadat) {
} else {
tadat$sampleMedia <- input$media
}
- if (is.null(input$proj)) {
+ if (is.null(input$project)) {
tadat$project <- "null"
} else {
- tadat$project <- input$proj
+ tadat$project <- input$project
}
if (is.null(input$org)) {
tadat$organization <- "null"
@@ -362,17 +390,17 @@ mod_query_data_server <- function(id, tadat) {
tadat$siteid <- input$siteid
# siteid = stringr::str_trim(unlist(strsplit(input$siteids,",")))
}
- if (length(input$enddate) == 0) {
+ if (length(input$endDate) == 0) {
# ensure if date is empty, the query receives a proper input ("null")
- tadat$enddate <- "null"
+ tadat$endDate <- "null"
} else {
- tadat$enddate <- as.character(input$enddate)
+ tadat$endDate <- as.character(input$endDate)
}
- if (length(input$startdate) == 0) {
+ if (length(input$startDate) == 0) {
# ensure if date is empty, the query receives a proper start date. Might want a warning message instead.
- tadat$startdate <- "1800-01-01"
+ tadat$startDate <- "1800-01-01"
} else {
- tadat$startdate <- as.character(input$startdate)
+ tadat$startDate <- as.character(input$startDate)
}
# a modal that pops up showing it's working on querying the portal
shinybusy::show_modal_spinner(
@@ -394,8 +422,8 @@ mod_query_data_server <- function(id, tadat) {
sampleMedia = tadat$sampleMedia,
project = tadat$project,
organization = tadat$organization,
- startDate = tadat$startdate,
- endDate = tadat$enddate,
+ startDate = tadat$startDate,
+ endDate = tadat$endDate,
applyautoclean = TRUE
)
@@ -437,10 +465,10 @@ mod_query_data_server <- function(id, tadat) {
selected = tadat$characteristicName)
shiny::updateSelectizeInput(session, "chargroup", selected = tadat$characteristicType)
shiny::updateSelectizeInput(session, "media", selected = tadat$sampleMedia)
- shiny::updateSelectizeInput(session, "proj", selected = tadat$proj)
+ shiny::updateSelectizeInput(session, "project", selected = tadat$project)
shiny::updateSelectizeInput(session, "org", selected = tadat$organization)
- shiny::updateDateInput(session, "startdate", value = tadat$startDate)
- shiny::updateDateInput(session, "enddate", value = tadat$endDate)
+ shiny::updateDateInput(session, "startDate", value = tadat$startDate)
+ shiny::updateDateInput(session, "endDate", value = tadat$endDate)
}
}
@@ -475,7 +503,6 @@ initializeTable <- function(tadat, raw) {
removals <- data.frame(matrix(nrow = nrow(raw), ncol = 0))
# removals["Media Type"] = ifelse(!raw$TADA.ActivityMediaName%in%c("WATER"),TRUE,raw$Removed)
# removals["Special Characters"] = ifelse(raw$TADA.ResultMeasureValueDataTypes.Flag%in%c("ND or NA","Text","Coerced to NA"),TRUE,raw$Removed)
-
tadat$raw <- raw
tadat$removals <- removals
}
diff --git a/R/mod_review_data.R b/R/mod_review_data.R
index 2401b685e..757296d65 100644
--- a/R/mod_review_data.R
+++ b/R/mod_review_data.R
@@ -43,7 +43,6 @@ mod_review_data_server <- function(id, tadat) {
shiny::observeEvent(input$review_go, {
removals <- tadat$removals
sel <- which(removals == TRUE, arr.ind = TRUE)
- print(length(sel))
# Bombing here
if (length(sel) > 0) {
removals[sel] <- names(removals)[sel[, "col"]]
diff --git a/R/utils.R b/R/utils.R
index 8e0a76f70..145af68a9 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -14,13 +14,13 @@ utils::globalVariables(c(
"group", "groupname", "MonitoringLocationTypeName",
"quantile", "median", "moduleServer",
"Target.TADA.CharacteristicName",
- "Target.TADA.MethodSpecificationName",
+ "Target.TADA.MethodSpeciationName",
"write.csv", "read.csv", "downloadHandler",
"Rank", "Target.TADA.ResultSampleFractionText",
"Field", "characteristicName", "characteristicType",
"countycode", "endDate", "example_data", "huc", "m2f",
"nd_method", "nd_mult", "od_method", "org_table",
- "organization", "original_source", "proj", "sampleMedia",
+ "organization", "original_source", "project", "sampleMedia",
"selected_filters", "selected_flags", "siteType",
"siteid", "startDate", "statecode"
))
diff --git a/R/utils_flag_functions.R b/R/utils_flag_functions.R
index 5ffb40295..262e480bd 100644
--- a/R/utils_flag_functions.R
+++ b/R/utils_flag_functions.R
@@ -3,23 +3,24 @@ prompt_table <- utils::read.csv("inst/flag_prompts.csv")
test_table <- utils::read.csv("inst/flag_tests.csv")
# prompt_table = utils::read.csv(app_sys("flag_prompts.csv"))
# test_table = utils::read.csv(app_sys("flag_tests.csv"))
-prompt_table <- prompt_table[order(prompt_table$Order), ]
+prompt_table <- prompt_table[order(prompt_table$Order),]
prompts <- prompt_table$Prompt
+active_flags = unique(merge(prompt_table, test_table)$columnName)
levs <- prompt_table$Level
n_switches <- length(prompts)
flag_types <- prompt_table$flagType
-
-
+flag_prefix = "Flag: "
flagCensus <- function(raw) {
# JCH - seems like there are NA values here that aren't getting counted right
- tabular_results <- data.frame(matrix(ncol = length(flag_types), nrow = nrow(raw)))
+ tabular_results <-
+ data.frame(matrix(ncol = length(flag_types), nrow = nrow(raw)))
colnames(tabular_results) <- flag_types
-
+
test_table <- subset(test_table, test_table$remove == 1)
for (flag in flag_types) {
flag_count <- 0
- tests <- test_table[test_table$flagType == flag, ]
+ tests <- test_table[test_table$flagType == flag,]
results <- integer(nrow(raw))
if (nrow(tests) > 0) {
for (row in 1:nrow(tests)) {
@@ -30,14 +31,15 @@ flagCensus <- function(raw) {
if (!is.na(test_val)) {
rawt_col <- raw[, test_col]
rawt_col[is.na(rawt_col)] <- "NA"
- test_results <- as.integer(as.logical(rawt_col == test_val))
+ test_results <-
+ as.integer(as.logical(rawt_col == test_val))
} else {
test_results <- as.integer(as.logical(is.na(raw[test_col])))
}
if (tests[row, "keep"]) {
test_results <- !test_results
} else {
-
+
}
results <- results + test_results
}
@@ -47,27 +49,25 @@ flagCensus <- function(raw) {
print(paste0("No tests found for flag ", flag))
}
}
-
+
return(tabular_results)
}
getCounts <- function(sites, removed_records) {
- summary_names <- c(
- "Total in Raw File",
- "Total Removed",
- "Total in Clean File"
- )
-
+ summary_names <- c("Total in Raw File",
+ "Total Removed",
+ "Total in Clean File")
+
# Records
n_raw_records <- length(removed_records)
n_removed_records <- sum(removed_records)
n_clean_records <- n_raw_records - n_removed_records
-
+
# Sites
n_raw_sites <- length(unique(sites))
n_removed_sites <- length(unique(sites[removed_records]))
n_clean_sites <- n_raw_sites - n_removed_sites
-
+
summaryTable <- data.frame(
row.names = summary_names,
Records = c(n_raw_records, n_removed_records, n_clean_records),
@@ -77,24 +77,25 @@ getCounts <- function(sites, removed_records) {
}
# Settings for each flag function in flag page mock up
applyFlags <- function(in_table, orgs) {
+ out <- TADA::TADA_IDCensoredData(in_table)
# Invalid Speciation
- out <- TADA::TADA_FlagSpeciation(in_table, clean = "none")
+ out <- TADA::TADA_FlagSpeciation(out, clean = "none")
# Invalid fraction
out <- TADA::TADA_FlagFraction(out, clean = FALSE)
# Invalid result unit
out <- TADA::TADA_FlagResultUnit(out, clean = "none")
-
+
# QC rep/blank
out <- TADA::TADA_FindQCActivities(out, clean = FALSE)
# Result is flagged as suspect by data submitter
- out <- TADA::TADA_FlagMeasureQualifierCode(out, clean = FALSE)
+ out <- TADA::TADA_FlagMeasureQualifierCode(out, clean = FALSE, define = TRUE)
# Invalid analytical method
out <- TADA::TADA_FlagMethod(out, clean = FALSE)
-
+
# Single org duplicative uploads
out <- TADA::TADA_FindPotentialDuplicatesSingleOrg(out)
@@ -105,11 +106,12 @@ applyFlags <- function(in_table, orgs) {
# QAPP Not Approved - this flag isn't looking for a TADA-created flag column,
# so do not need to run any flag function here. If switched ON, remove all data
# with QAPPApproved == N or NA.
-
+
# No QAPP doc available
if ("ProjectFileUrl" %in% names(out)) {
out <- TADA::TADA_FindQAPPDoc(out, clean = FALSE)
}
+
# Dataset includes depth profile data - no function for this yet
# out <- out
@@ -131,22 +133,19 @@ applyFlags <- function(in_table, orgs) {
flaggedonly = FALSE
)
-
return(out)
}
-checkFlagColumns <- function(dataset){
- # Flags that, as of 11/16/23, aren't being used
- flags_not_required = c("TADA.InvalidCoordinates.Flag", "TADA.SingleOrgDup.Flag")
- flag_cols = setdiff(unique(test_table$columnName), flags_not_required)
- dataset_cols = names(dataset)
- found = intersect(flag_cols, dataset_cols)
- if (length(flag_cols) == length(found)){
- return(TRUE)
- } else {
-
+checkFlagColumns <- function(dataset) {
+ missing <- setdiff(active_flags, names(dataset))
+ found = setdiff(active_flags, missing)
+ if (length(missing) > length(found)) {
return(FALSE)
+ } else {
+ if (length(missing) > 0){
+ print("Missing the following fields that are in the csv files:")
+ print(missing)
+ }
+ return(TRUE)
}
-
-
-}
+}
\ No newline at end of file
diff --git a/R/utils_track_progress.R b/R/utils_track_progress.R
index 037cd6ab6..7b6ab224a 100644
--- a/R/utils_track_progress.R
+++ b/R/utils_track_progress.R
@@ -11,7 +11,7 @@ writeFile <- function(tadat, filename) {
characteristicName = tadat$characteristicName
characteristicType = tadat$characteristicType
sampleMedia = tadat$sampleMedia
- proj = tadat$proj
+ project = tadat$project
organization = tadat$organization
startDate = tadat$startDate
endDate = tadat$endDate
@@ -23,6 +23,7 @@ writeFile <- function(tadat, filename) {
od_method <- tadat$od_method
nd_mult <- tadat$nd_mult
od_mult <- tadat$od_mult
+ field_sel <- tadat$field_sel
save(
original_source,
@@ -36,7 +37,7 @@ writeFile <- function(tadat, filename) {
characteristicName,
characteristicType,
sampleMedia,
- proj,
+ project,
organization,
startDate,
endDate,
@@ -48,6 +49,7 @@ writeFile <- function(tadat, filename) {
od_method,
nd_mult,
od_mult,
+ field_sel,
file = filename
)
@@ -55,9 +57,8 @@ writeFile <- function(tadat, filename) {
readFile <- function(tadat, filename) {
load(filename, verbose = FALSE)
- checkFlagColumns(tadat$raw)
tadat$load_progress_file = filename
-
+
# Confirm compatibility
job_id = job_id
if (!is.null(m2f)) {
@@ -68,8 +69,6 @@ readFile <- function(tadat, filename) {
if (!is.null(selected_flags)) {
tadat$selected_flags = selected_flags
shinyjs::enable(selector = '.nav li a[data-value="Flag"]')
- } else {
- print("No flags selected")
}
# Enable tabs if certain fields are not null
@@ -88,27 +87,29 @@ readFile <- function(tadat, filename) {
tadat$characteristicName = characteristicName
tadat$characteristicType = characteristicType
tadat$sampleMedia = sampleMedia
- tadat$proj = proj
+ tadat$project = project
tadat$organization = organization
tadat$startDate = startDate
tadat$endDate = endDate
tadat$org_table = org_table
- tadat$m2f = m2f
tadat$selected_filters = selected_filters
tadat$nd_method = nd_method
tadat$od_method = od_method
tadat$nd_mult = nd_mult
- tadat$od_mult
+ tadat$od_mult = od_mult
+ tadat$field_sel = field_sel
}
invalidFile <- function(trigger) {
- print("Failure")
+ print("Failure: Invalid File")
print(trigger)
}
writeNarrativeDataFrame <- function(tadat) {
+ # sampleMedia needs to be a single string for this part
+ tadat$sampleMedia = paste(tadat$sampleMedia, collapse=" ")
df <- data.frame(Parameter=character(), Value=character())
df[nrow(df) + 1, ] = c("TADA Shiny Job ID", tadat$job_id)
df[nrow(df) + 1, ] = c("Original data source: ", tadat$original_source)
@@ -141,7 +142,7 @@ writeNarrativeDataFrame <