diff --git a/.devcontainer/Shiny/devcontainer.json b/.devcontainer/Shiny/devcontainer.json
index 8bd8f9ea3..2c93b7540 100644
--- a/.devcontainer/Shiny/devcontainer.json
+++ b/.devcontainer/Shiny/devcontainer.json
@@ -3,7 +3,7 @@
"image": "ghcr.io/rocker-org/devcontainer/geospatial:4",
"features": {
"ghcr.io/rocker-org/devcontainer-features/r-packages:1": {
- "packages": "github::USEPA/TADA,config,golem,readxl,writexl,leaflet,shiny,shinyWidgets,shinyjs,shinycssloaders,DT,ggplot2,shinybusy,dplyr,plyr,tidyr,scales,forcats,RColorBrewer,lubridate,plotly",
+ "packages": "github::USEPA/EPATADA,config,golem,readxl,writexl,leaflet,shiny,shinyWidgets,shinyjs,shinycssloaders,DT,ggplot2,shinybusy,dplyr,plyr,tidyr,scales,forcats,RColorBrewer,lubridate,plotly",
"installSystemRequirements": true
}
},
diff --git a/.devcontainer/devcontainer.json b/.devcontainer/devcontainer.json
index b41a9370a..d110d1af7 100644
--- a/.devcontainer/devcontainer.json
+++ b/.devcontainer/devcontainer.json
@@ -8,7 +8,7 @@
"image": "ghcr.io/rocker-org/devcontainer/geospatial:4",
"features": {
"ghcr.io/rocker-org/devcontainer-features/r-packages:1": {
- "packages": "github::USEPA/TADA,config,golem,readxl,writexl,leaflet,shiny,shinyWidgets,shinyjs,shinycssloaders,DT,ggplot2,shinybusy,dplyr,plyr,tidyr,scales,forcats,RColorBrewer,lubridate,plotly",
+ "packages": "github::USEPA/EPATADA,config,golem,readxl,writexl,leaflet,shiny,shinyWidgets,shinyjs,shinycssloaders,DT,ggplot2,shinybusy,dplyr,plyr,tidyr,scales,forcats,RColorBrewer,lubridate,plotly",
"installSystemRequirements": true
}
},
diff --git a/.github/ISSUE_TEMPLATE/bug_report.md b/.github/ISSUE_TEMPLATE/bug_report.md
index 3dfd7bcf1..fff3c7d6c 100644
--- a/.github/ISSUE_TEMPLATE/bug_report.md
+++ b/.github/ISSUE_TEMPLATE/bug_report.md
@@ -49,10 +49,18 @@ Add any other context about the problem here.
**Reminders for TADA contributors addressing this issue**
-New features should include all of the following work:
+Bug fixes should include the following work:
-- [ ] Create the function/code.
+- [ ] Create or edit the code.
-- [ ] Document all code using comments to describe what is does.
+- [ ] Document all code using line/inline and/or multi-line/block comments
+ to describe what is does.
-- [ ] Create tests.
+- [ ] Create or edit tests in tests/testthat folder to help prevent and/or
+ troubleshoot potential future issues.
+
+- [ ] If your code edits impact other functionality in the shiny
+ app, ensure those are updated as well.
+
+- [ ] Run styler::style_pkg(), devtools::document(), and devtools::check()
+ and address any new notes or issues before creating a pull request.
diff --git a/.github/ISSUE_TEMPLATE/feature_request.md b/.github/ISSUE_TEMPLATE/feature_request.md
index d98b79c0a..f9d96aac7 100644
--- a/.github/ISSUE_TEMPLATE/feature_request.md
+++ b/.github/ISSUE_TEMPLATE/feature_request.md
@@ -35,10 +35,18 @@ Add any other context or screenshots about the feature request here.
**Reminders for TADA contributors addressing this issue**
-New features should include all of the following work:
+New features and/or edits should include the following work:
-- [ ] Create the function/code.
+- [ ] Create or edit the code.
-- [ ] Document all code using comments to describe what is does.
+- [ ] Document all code using line/inline and/or multi-line/block comments
+ to describe what is does.
-- [ ] Create tests.
+- [ ] Create or edit tests in tests/testthat folder to help prevent and/or
+ troubleshoot potential future issues.
+
+- [ ] If your code edits impact other functionality in the shiny
+ app, ensure those are updated as well.
+
+- [ ] Run styler::style_pkg(), devtools::document(), and devtools::check()
+ and address any new notes or issues before creating a pull request.
diff --git a/DESCRIPTION b/DESCRIPTION
index 08ac54f00..5a1d780fd 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -14,15 +14,6 @@ Authors@R: c(
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.
@@ -41,7 +32,7 @@ Imports:
shinycssloaders,
DT,
ggplot2,
- TADA,
+ EPATADA,
shinybusy,
dplyr,
plyr,
@@ -53,7 +44,7 @@ Imports:
lubridate,
plotly
Remotes:
- github::USEPA/TADA
+ github::USEPA/EPATADA
Suggests:
config,
testthat,
diff --git a/R/app_server.R b/R/app_server.R
index 8c4e44b93..08de6b8fa 100644
--- a/R/app_server.R
+++ b/R/app_server.R
@@ -33,13 +33,13 @@ app_server <- function(input, output, session) {
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
- 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
-
+ 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
+
# 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, {
@@ -60,16 +60,16 @@ app_server <- function(input, output, session) {
shiny::observe({
# JCH - is this necessary?
- #shiny::req(tadat$raw)
+ # 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::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."
@@ -77,5 +77,5 @@ app_server <- function(input, output, session) {
# # the switch tab command
# shiny::updateTabsetPanel(session = session, inputId = "tabbar", selected = unique(tadat$raw$tab))
# tadat$reup <- NULL
- #})
+ # })
}
diff --git a/R/app_ui.R b/R/app_ui.R
index b39d79513..66c9629a4 100644
--- a/R/app_ui.R
+++ b/R/app_ui.R
@@ -17,7 +17,7 @@ css <- "
app_ui <- function(request) {
tagList(
# Leave this function for adding external resources
- # This function automatically incorporates the epa styles.css file included
+ # This function automatically incorporates the epa styles.css file included
# in the www folder. Downloaded from https://www.epa.gov/web-policies-and-procedures/web-standards-look-and-feel-template
# styles.css hosted locally in this app includes a fix (for compatibility with leaflet and plotly)
golem_add_external_resources(),
@@ -80,7 +80,7 @@ app_ui <- function(request) {
),
htmltools::hr(),
mod_TADA_summary_ui("TADA_summary_1"),
- # adds epa footer html
+ # adds epa footer html
shiny::includeHTML(app_sys("app/www/footer.html"))
)
)
diff --git a/R/mod_TADA_summary.R b/R/mod_TADA_summary.R
index 2f88ab38b..5f8127e59 100644
--- a/R/mod_TADA_summary.R
+++ b/R/mod_TADA_summary.R
@@ -41,7 +41,7 @@ mod_TADA_summary_ui <- function(id) {
)))),
shiny::fluidRow(column(6, shiny::uiOutput(ns(
"dwn_final"
- ))))#,
+ )))) # ,
# shiny::fluidRow(column(
# 6,
# shiny::fileInput(
@@ -75,25 +75,25 @@ 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])
+ TRUE])
summary_things$clean_rec <-
length(tadat$raw$ResultIdentifier[tadat$raw$TADA.Remove ==
- FALSE])
+ FALSE])
clean_sites <-
unique(tadat$raw$MonitoringLocationIdentifier[tadat$raw$TADA.Remove ==
- FALSE])
+ FALSE])
summary_things$clean_site <- length(clean_sites)
summary_things$rem_site <-
length(unique(tadat$raw$MonitoringLocationIdentifier[!tadat$raw$MonitoringLocationIdentifier %in%
- clean_sites]))
+ clean_sites]))
summary_things$removals <- sort_removals(tadat$removals)
})
summary_things$removals <- data.frame(matrix(
@@ -101,7 +101,7 @@ mod_TADA_summary_server <- function(id, tadat) {
nrow = 0,
dimnames = list(NULL, c("Reason", "Count"))
))
-
+
# output$removal_summary = DT::renderDataTable(
# summary_things$removals,
# escape = FALSE,
@@ -112,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)) {
@@ -126,8 +126,10 @@ 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
@@ -135,8 +137,10 @@ mod_TADA_summary_server <- function(id, tadat) {
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
@@ -154,8 +158,10 @@ 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
@@ -163,28 +169,32 @@ mod_TADA_summary_server <- function(id, tadat) {
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 data exists in the app already
output$dwn_working <- shiny::renderUI({
shiny::req(tadat$raw)
shiny::downloadButton(ns("download_working"),
- "Download Working Dataset (.zip)",
- style = "color: #fff; background-color: #337ab7; border-color: #2e6da4",
- contentType = "application/zip")
+ "Download Working Dataset (.zip)",
+ style = "color: #fff; background-color: #337ab7; border-color: #2e6da4",
+ contentType = "application/zip"
+ )
})
-
+
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")
+ "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, "_working.zip")
@@ -193,19 +203,21 @@ mod_TADA_summary_server <- function(id, tadat) {
fs <- c()
tmpdir <- tempdir()
setwd(tempdir())
- datafile_name = paste0(tadat$default_outfile, ".xlsx")
- progress_file_name = paste0(tadat$default_outfile, "_prog.RData")
+ 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)
+ list(Data = EPATADA::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))
+ utils::zip(
+ zipfile = fname,
+ files = c(datafile_name, progress_file_name)
+ )
},
contentType = "application/zip"
)
-
+
output$download_final <- shiny::downloadHandler(
filename = function() {
paste0(tadat$default_outfile, "_final.zip")
@@ -214,21 +226,23 @@ mod_TADA_summary_server <- function(id, tadat) {
fs <- c()
tmpdir <- tempdir()
setwd(tempdir())
- datafile_name = paste0(tadat$default_outfile, ".xlsx")
- progress_file_name = paste0(tadat$default_outfile, "_prog.RData")
+ 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)
+ list(Data = EPATADA::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))
+ utils::zip(
+ zipfile = fname,
+ files = c(datafile_name, progress_file_name)
+ )
},
contentType = "application/zip"
)
-
+
shiny::observeEvent(input$disclaimer, {
shiny::showModal(
shiny::modalDialog(
@@ -251,7 +265,7 @@ 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) {
@@ -264,13 +278,13 @@ sort_removals <- function(removal_table) {
results["Flag and Filter"] <- (results$Flag & results$Filter)
results["Filter only"] <- ((totals == 1) & results$Filter)
results <-
- dplyr::select(results,-intersect(prefixes, colnames(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 <- counts[(counts$Count > 0), ]
return(counts)
}
}
diff --git a/R/mod_censored_data.R b/R/mod_censored_data.R
index 5081b6cc3..effba1214 100644
--- a/R/mod_censored_data.R
+++ b/R/mod_censored_data.R
@@ -9,9 +9,11 @@
#' @importFrom shiny NS tagList
nd_method_options <-
- c("Multiply detection limit by x",
+ c(
+ "Multiply detection limit by x",
"Random number between 0 and detection limit",
- "No change")
+ "No change"
+ )
od_method_options <- c("Multiply detection limit by x", "No change")
mod_censored_data_ui <- function(id) {
@@ -97,12 +99,12 @@ mod_censored_data_ui <- function(id) {
mod_censored_data_server <- function(id, tadat) {
shiny::moduleServer(id, function(input, output, session) {
ns <- session$ns
-
+
# initialize dropdown values
-
+
# reactive values specific to this module
censdat <- shiny::reactiveValues()
-
+
# update dataset when on censored data page
shiny::observeEvent(tadat$tab, {
shiny::req(tadat$raw)
@@ -119,7 +121,7 @@ mod_censored_data_server <- function(id, tadat) {
subset(tadat$raw, tadat$raw$TADA.Remove == FALSE) # however, this reactive object has all of the data that were not previously removed and do not have ambiguous detection limit data. This is the "clean" dataset
}
})
-
+
# pie chart showing breakdown of censored/uncensored data passed through idCensoredData function
output$id_censplot <- shiny::renderPlot({
shiny::req(censdat$dat)
@@ -127,15 +129,19 @@ mod_censored_data_server <- function(id, tadat) {
dplyr::group_by(TADA.CensoredData.Flag) %>%
dplyr::summarise(num = length(ResultIdentifier))
piedat$Label <-
- paste0(piedat$TADA.CensoredData.Flag,
- " - ",
- scales::comma(piedat$num),
- " results")
+ paste0(
+ piedat$TADA.CensoredData.Flag,
+ " - ",
+ scales::comma(piedat$num),
+ " results"
+ )
# Basic piechart
ggplot2::ggplot(piedat, ggplot2::aes(x = "", y = num, fill = Label)) +
- ggplot2::geom_bar(stat = "identity",
- width = 1,
- color = "white") +
+ ggplot2::geom_bar(
+ stat = "identity",
+ width = 1,
+ color = "white"
+ ) +
ggplot2::labs(title = "Number of Results per Censored Data Category") +
ggplot2::coord_polar("y", start = 0) +
ggplot2::scale_fill_brewer(palette = "Dark2") +
@@ -147,75 +153,79 @@ mod_censored_data_server <- function(id, tadat) {
) #+
# ggplot2::geom_text(ggplot2::aes(label = scales::comma(num)), color = "white", size=6,position = ggplot2::position_stack(vjust = 0.5))
})
-
-
+
+
# this adds the multiplier numeric input next to the method selection if the nd method selected is to mult det limit by x
-
+
output$nd_mult <- shiny::renderUI({
- init_val = tadat$nd_mult
- if (is.null(init_val)){
- init_val = 0.5
+ init_val <- tadat$nd_mult
+ if (is.null(init_val)) {
+ init_val <- 0.5
}
if (input$nd_method == nd_method_options[1]) {
shiny::numericInput(ns("nd_mult"),
- "Multiplier (x)",
- value = init_val,
- min = 0)
+ "Multiplier (x)",
+ value = init_val,
+ min = 0
+ )
}
})
-
+
# this adds the multiplier numeric input next to the method selection if the od method selected is to mult det limit by x
output$od_mult <- shiny::renderUI({
- init_val = tadat$od_mult
- if (is.null(init_val)){
- init_val = 0.5
+ init_val <- tadat$od_mult
+ if (is.null(init_val)) {
+ init_val <- 0.5
}
if (input$od_method == od_method_options[1]) {
shiny::numericInput(ns("od_mult"),
- "Multiplier (x)",
- value = init_val,
- min = 0)
+ "Multiplier (x)",
+ value = init_val,
+ min = 0
+ )
}
})
-
-
+
+
# initialize global variables for saving/loading
-
- tadat$censor_applied = FALSE
-
+
+ tadat$censor_applied <- FALSE
+
shiny::observeEvent(tadat$load_progress_file, {
if (!is.na(tadat$load_progress_file)) {
shiny::updateSelectizeInput(session,
- "nd_method",
- choices = nd_method_options,
- selected = tadat$nd_method)
+ "nd_method",
+ choices = nd_method_options,
+ selected = tadat$nd_method
+ )
shiny::updateSelectizeInput(session,
- "od_method",
- choices = od_method_options,
- selected = tadat$od_method)
+ "od_method",
+ choices = od_method_options,
+ selected = tadat$od_method
+ )
shiny::updateNumericInput(session, "nd_mult", value = tadat$nd_mult)
shiny::updateNumericInput(session, "od_mult", value = tadat$od_mult)
}
})
-
+
# Make this part more concise?
shiny::observeEvent(input$nd_method, {
- tadat$nd_method = input$nd_method
+ tadat$nd_method <- input$nd_method
})
-
+
shiny::observeEvent(input$nd_mult, {
- tadat$nd_mult = input$nd_mult
+ tadat$nd_mult <- input$nd_mult
})
-
+
shiny::observeEvent(input$od_method, {
- tadat$od_method = input$od_method
+ tadat$od_method <- input$od_method
})
-
+
shiny::observeEvent(input$od_mult, {
- tadat$od_mult = input$od_mult
- })
-
-
+ tadat$od_mult <- input$od_mult
+ })
+
+
# Button to apply the simple methods to the nd and od results in the dataset.
shiny::observeEvent(input$apply_methods, {
shinybusy::show_modal_spinner(
@@ -245,7 +255,7 @@ mod_censored_data_server <- function(id, tadat) {
od_multiplier <- input$od_mult
}
good <-
- TADA::TADA_SimpleCensoredMethods(
+ EPATADA::TADA_SimpleCensoredMethods(
good,
nd_method = trans$actual[trans$input == input$nd_method],
nd_multiplier = nd_multiplier,
@@ -254,12 +264,14 @@ mod_censored_data_server <- function(id, tadat) {
)
tadat$raw <-
plyr::rbind.fill(removed, good) # stitch good and removed datasets back together in tadat$raw
- tadat$raw <- TADA::TADA_OrderCols(tadat$raw)
-
+ tadat$raw <- EPATADA::TADA_OrderCols(tadat$raw)
+
# create dataset displayed in table below
dat <-
- subset(good,
- good$TADA.CensoredData.Flag %in% c("Non-Detect", "Over-Detect"))
+ subset(
+ good,
+ good$TADA.CensoredData.Flag %in% c("Non-Detect", "Over-Detect")
+ )
dat <-
dat[, c(
"ResultIdentifier",
@@ -279,15 +291,15 @@ mod_censored_data_server <- function(id, tadat) {
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
+ tadat$censor_applied <- TRUE
})
-
+
# this button appears after someone has applied the OD/ND methods, in case they want to undo and try another method instead
output$undo_methods <- shiny::renderUI({
shiny::req(censdat$exdat)
shiny::actionButton(ns("undo_methods"), "Undo Method Application", style = "color: #fff; background-color: #337ab7; border-color: #2e6da4")
})
-
+
# executes the undo if undo methods button is pressed.
shiny::observeEvent(input$undo_methods, {
censdat$exdat <- NULL # reset exdat
@@ -300,9 +312,9 @@ mod_censored_data_server <- function(id, tadat) {
tadat$raw$TADA.ResultMeasureValueDataTypes.Flag[tadat$raw$TADA.ResultMeasureValueDataTypes.Flag == "Result Value/Unit Estimated from Detection Limit"] <-
"Result Value/Unit Copied from Detection Limit" # reset data types flag to what it was before simpleCensoredMethods function run
tadat$raw <- tadat$raw %>% dplyr::select(-TADA.CensoredMethod)
- tadat$censor_applied = FALSE
+ tadat$censor_applied <- FALSE
})
-
+
# creates a nice table showing an example of how censored data were changed.
output$see_det <- DT::renderDT({
shiny::req(censdat$exdat)
@@ -318,7 +330,7 @@ mod_censored_data_server <- function(id, tadat) {
rownames = FALSE
)
})
-
+
# from the clean dataset, get all of the column names someone might want to group by when summarizing their data for use in more advanced censored data methods.
output$cens_groups <- shiny::renderUI({
shiny::req(censdat$dat)
@@ -345,11 +357,11 @@ mod_censored_data_server <- function(id, tadat) {
multiple = TRUE
)
})
-
+
# runs the summary function when cens button is pushed following group selection
shiny::observeEvent(input$cens_sumbutton, {
summary <-
- TADA::TADA_Stats(censdat$dat, group_cols = input$cens_groups)
+ EPATADA::TADA_Stats(censdat$dat, group_cols = input$cens_groups)
censdat$summary <-
summary[, !names(summary) %in% c(
"UpperFence",
@@ -368,7 +380,7 @@ mod_censored_data_server <- function(id, tadat) {
"Percentile_98th"
)]
})
-
+
# creates summary table complete with csv button in case someone wants to
# download the summary table
output$cens_sumtable <- DT::renderDT({
diff --git a/R/mod_data_flagging.R b/R/mod_data_flagging.R
index a668d3f38..62669f2aa 100644
--- a/R/mod_data_flagging.R
+++ b/R/mod_data_flagging.R
@@ -12,8 +12,10 @@
mod_data_flagging_ui <- function(id) {
ns <- NS(id)
tagList(
- tags$div(style = "display: none;",
- shinyWidgets::prettySwitch("dummy", label = NULL)),
+ tags$div(
+ style = "display: none;",
+ shinyWidgets::prettySwitch("dummy", label = NULL)
+ ),
htmltools::h3("Flag data for potential issues"),
htmltools::HTML(
"Click the button below to run a series of tests that check for quality control issues or data formats not compatible with TADA. When the tests are finished running, a table will appear below. Each row describes an evaluation test, reports the number of results affected, and contains a switch users may toggle on/off to decide whether to flag results for removal. However, evaluation tests marked as Required have permanently 'ON' light blue switches that cannot be changed. Recommended tests are automatically switched 'ON' (darker blue), and Optional tests are automatically switched 'OFF' (gray)."
@@ -22,8 +24,9 @@ mod_data_flagging_ui <- function(id) {
shiny::fluidRow(column(
3,
shiny::actionButton(ns("runFlags"),
- "Run Tests",
- style = "color: #fff; background-color: #337ab7; border-color: #2e6da4")
+ "Run Tests",
+ style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"
+ )
)),
htmltools::div(style = "margin-bottom:10px"),
DT::DTOutput(ns("flagTable")),
@@ -54,7 +57,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)) {
@@ -70,12 +73,12 @@ mod_data_flagging_server <- function(id, tadat) {
)
)
} else {
- inputs[i] = "n/a"
+ inputs[i] <- "n/a"
}
}
inputs
}
-
+
shinyValue <- function(id, len) {
unlist(lapply(seq_len(len), function(i) {
value <- input[[paste0(id, i)]]
@@ -86,11 +89,11 @@ mod_data_flagging_server <- function(id, tadat) {
}
}))
}
-
+
# Runs whenever selected flags are changed
shiny::observeEvent(tadat$selected_flags, {
if (!is.null(tadat$removals)) {
- tadat$removals = dplyr::select(tadat$removals,-(dplyr::starts_with(flag_prefix)))
+ tadat$removals <- dplyr::select(tadat$removals, -(dplyr::starts_with(flag_prefix)))
}
# Loop through the flags
for (flag in tadat$selected_flags) {
@@ -98,48 +101,50 @@ mod_data_flagging_server <- function(id, tadat) {
if (!is.null(tadat$removals)) {
if (!all(is.na(values$testResults[flag]))) {
# Problem here?
- tadat$removals[paste0(flag_prefix, flag)] = values$testResults[flag]
+ tadat$removals[paste0(flag_prefix, flag)] <- values$testResults[flag]
}
}
# If the switch corresponding to this flag isn't on, switch it on
# Checking a random switch to make sure they've been initialized
- pos = match(flag, prompts)
- tadat$switch_defaults[pos] = TRUE
+ pos <- match(flag, prompts)
+ tadat$switch_defaults[pos] <- TRUE
if (!is.null(input[[paste0("switch_", pos)]])) {
- switch_name = paste0("switch_", pos)
+ switch_name <- paste0("switch_", pos)
if (is.na(pos)) {
invalidFile("flagging")
} else if (!isTRUE(input[[switch_name]])) {
# Turn the switch on if it isn't already
- shinyWidgets::updatePrettySwitch(inputId = switch_name,
- value = TRUE)
+ shinyWidgets::updatePrettySwitch(
+ inputId = switch_name,
+ value = TRUE
+ )
}
}
}
})
-
+
# 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)
+ 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)]
+ 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,
@@ -148,7 +153,7 @@ mod_data_flagging_server <- function(id, tadat) {
Decision = flagSwitch(n_switches)
)
})
-
+
output$flagTable <- DT::renderDT(
shiny::isolate(switchTable()),
escape = FALSE,
@@ -172,7 +177,7 @@ mod_data_flagging_server <- function(id, tadat) {
)
)
)
-
+
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"]')
@@ -180,7 +185,7 @@ mod_data_flagging_server <- function(id, tadat) {
shinyjs::enable(selector = '.nav li a[data-value="Review"]')
}
})
-
+
# Runs when the flag button is clicked
shiny::observeEvent(input$runFlags, {
shinybusy::show_modal_spinner(
@@ -189,23 +194,22 @@ 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
# 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
-
+
+ # 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())
-
})
-
+
shiny::observeEvent(tadat$m2f, {
shiny::updateRadioButtons(session, "m2f", selected = tadat$m2f)
})
-
+
shiny::observeEvent(input$m2f, {
tadat$m2f <- input$m2f
shiny::req(tadat$raw)
@@ -217,7 +221,7 @@ mod_data_flagging_server <- function(id, tadat) {
session = shiny::getDefaultReactiveDomain()
)
tadat$raw <-
- TADA::TADA_ConvertDepthUnits(tadat$raw, unit = "ft")
+ EPATADA::TADA_ConvertDepthUnits(tadat$raw, unit = "ft")
}
if (input$m2f == "inches") {
shinybusy::show_modal_spinner(
@@ -226,10 +230,9 @@ 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")
-
+ EPATADA::TADA_ConvertDepthUnits(tadat$raw, unit = "in")
}
if (input$m2f == "meters") {
shinybusy::show_modal_spinner(
@@ -239,9 +242,9 @@ mod_data_flagging_server <- function(id, tadat) {
session = shiny::getDefaultReactiveDomain()
)
tadat$raw <-
- TADA::TADA_ConvertDepthUnits(tadat$raw, unit = "m")
+ EPATADA::TADA_ConvertDepthUnits(tadat$raw, unit = "m")
}
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 ac47e7f2e..ed33f42b0 100644
--- a/R/mod_figures.R
+++ b/R/mod_figures.R
@@ -94,26 +94,28 @@ mod_figures_server <- function(id, tadat) {
depthcols <- names(tadat$raw)[grepl("DepthHeightMeasure", names(tadat$raw))]
depthcols <- depthcols[grepl("TADA.", depthcols)]
# This must include all columns needed for plots, include those only needed for the hover features
- selcols <- c("TADA.ComparableDataIdentifier",
- "OrganizationFormalName",
- "ResultIdentifier",
- "groupname",
- "MonitoringLocationIdentifier",
- "MonitoringLocationName",
- "MonitoringLocationTypeName",
- "TADA.LatitudeMeasure",
- "TADA.LongitudeMeasure",
- "TADA.ResultMeasureValue",
- "TADA.ResultMeasure.MeasureUnitCode",
- "ActivityRelativeDepthName",
- "ActivityStartDate",
- "ActivityStartDateTime",
- "TADA.ActivityMediaName",
- "ActivityMediaSubdivisionName",
- "TADA.ResultSampleFractionText",
- "TADA.MethodSpeciationName",
- "TADA.CharacteristicName",
- depthcols)
+ selcols <- c(
+ "TADA.ComparableDataIdentifier",
+ "OrganizationFormalName",
+ "ResultIdentifier",
+ "groupname",
+ "MonitoringLocationIdentifier",
+ "MonitoringLocationName",
+ "MonitoringLocationTypeName",
+ "TADA.LatitudeMeasure",
+ "TADA.LongitudeMeasure",
+ "TADA.ResultMeasureValue",
+ "TADA.ResultMeasure.MeasureUnitCode",
+ "ActivityRelativeDepthName",
+ "ActivityStartDate",
+ "ActivityStartDateTime",
+ "TADA.ActivityMediaName",
+ "ActivityMediaSubdivisionName",
+ "TADA.ResultSampleFractionText",
+ "TADA.MethodSpeciationName",
+ "TADA.CharacteristicName",
+ depthcols
+ )
react$dat <- tadat$raw %>%
dplyr::filter(TADA.Remove == FALSE, !is.na(TADA.ResultMeasureValue)) %>%
@@ -310,7 +312,7 @@ mod_figures_server <- function(id, tadat) {
# plotly scatter plot
output$scatter <- plotly::renderPlotly({
shiny::req(react$plotdata)
- suppressWarnings(TADA::TADA_Scatterplot(subset(react$plotdata, react$plotdata$groupname == react$groups[1]), id_cols = "groupname")) %>%
+ suppressWarnings(EPATADA::TADA_Scatterplot(subset(react$plotdata, react$plotdata$groupname == react$groups[1]), id_cols = "groupname")) %>%
plotly::layout(shapes = list(
hline(y = input$benchmark1, color = "red"),
hline(y = input$benchmark2, color = "orange")
@@ -320,13 +322,13 @@ mod_figures_server <- function(id, tadat) {
# plotly boxplot
output$boxplot <- plotly::renderPlotly({
shiny::req(react$plotdata)
- suppressWarnings(TADA::TADA_Boxplot(subset(react$plotdata, react$plotdata$groupname == react$groups[1]), id_cols = "groupname"))
+ suppressWarnings(EPATADA::TADA_Boxplot(subset(react$plotdata, react$plotdata$groupname == react$groups[1]), id_cols = "groupname"))
})
# plotly histogram
output$histogram <- plotly::renderPlotly({
shiny::req(react$plotdata)
- suppressWarnings(TADA::TADA_Histogram(subset(react$plotdata, react$plotdata$groupname == react$groups[1]), id_cols = "groupname"))
+ suppressWarnings(EPATADA::TADA_Histogram(subset(react$plotdata, react$plotdata$groupname == react$groups[1]), id_cols = "groupname"))
})
# dynamically show/hide two-char scatter
@@ -343,10 +345,11 @@ mod_figures_server <- function(id, tadat) {
output$scatter2 <- plotly::renderPlotly({
shiny::req(react$plotdata)
if (length(unique(react$plotdata$groupname)) > 1) {
- suppressWarnings(TADA::TADA_TwoCharacteristicScatterplot
- (react$plotdata,
- id_cols = "groupname",
- groups = unique(react$plotdata$groupname)))
+ suppressWarnings(EPATADA::TADA_TwoCharacteristicScatterplot
+ (react$plotdata,
+ id_cols = "groupname",
+ groups = unique(react$plotdata$groupname)
+ ))
}
})
})
diff --git a/R/mod_filtering.R b/R/mod_filtering.R
index f3fde9dea..5feaba156 100644
--- a/R/mod_filtering.R
+++ b/R/mod_filtering.R
@@ -21,13 +21,15 @@ mod_filtering_ui <- function(id) {
column(
3,
shiny::actionButton(ns("addOnlys"), "Include Only Selected Values",
- style = "color: #fff; background-color: #337ab7; border-color: #2e6da4")
+ style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"
+ )
),
column(
3,
shiny::actionButton(ns("addExcludes"),
- "Exclude Selected Values",
- style = "color: #fff; background-color: #337ab7; border-color: #2e6da4")
+ "Exclude Selected Values",
+ style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"
+ )
)
),
htmltools::br(),
@@ -42,14 +44,16 @@ mod_filtering_ui <- function(id) {
column(
3,
shiny::actionButton(ns("removeFilters"),
- "Reset Selected Filters",
- style = "color: #fff; background-color: #337ab7; border-color: #2e6da4")
+ "Reset Selected Filters",
+ style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"
+ )
),
column(
3,
shiny::actionButton(ns("resetFilters"),
- "Reset All Filters",
- style = "color: #fff; background-color: #337ab7; border-color: #2e6da4")
+ "Reset All Filters",
+ style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"
+ )
)
)
)
@@ -66,7 +70,7 @@ mod_filtering_server <- function(id, tadat) {
values$selected_field <- NULL
shinyjs::hide("addOnlys")
shinyjs::hide("addExcludes")
-
+
# make sure dataset being used to create filters is only REMOVE = FALSE
shiny::observeEvent(tadat$tab, {
if (tadat$tab == "Filter") {
@@ -74,10 +78,10 @@ mod_filtering_server <- function(id, tadat) {
tables$dat <-
subset(tadat$raw, tadat$raw$TADA.Remove == FALSE)
tables$filter_fields <-
- TADA::TADA_FieldCounts(tables$dat, display = "key")
+ EPATADA::TADA_FieldCounts(tables$dat, display = "key")
}
})
-
+
# First data table with key columns
output$filterStep1 <- DT::renderDT(
tables$filter_fields,
@@ -90,12 +94,12 @@ mod_filtering_server <- function(id, tadat) {
paging = FALSE
)
)
-
+
# When key column selected, get unique values for that column
shiny::observeEvent(input$filterStep1_rows_selected, {
# Get the name of the selected field
values$selected_field <-
- tables$filter_fields[input$filterStep1_rows_selected,]$Field
+ tables$filter_fields[input$filterStep1_rows_selected, ]$Field
applyLocks()
tables$filter_values <-
data.frame(getValues(tables$dat, values$selected_field))
@@ -110,8 +114,8 @@ mod_filtering_server <- function(id, tadat) {
shinyjs::show("addOnlys")
shinyjs::show("addExcludes")
})
-
-
+
+
# show unique values for selected column
output$filterStep2 <- DT::renderDT(
tables$filter_values,
@@ -123,7 +127,7 @@ mod_filtering_server <- function(id, tadat) {
pageLength = dim(tables$filter_values)[1]
)
)
-
+
# empty selected table on open
tadat$selected_filters <-
data.frame(matrix(
@@ -132,9 +136,9 @@ mod_filtering_server <- function(id, tadat) {
nrow = 0,
dimnames = list(NULL, c("Field", "Value", "Filter")) # count
))
-
+
# selected table at bottom
- output$selectedFilters = DT::renderDT(
+ output$selectedFilters <- DT::renderDT(
tadat$selected_filters,
escape = FALSE,
selection = "multiple",
@@ -145,7 +149,7 @@ mod_filtering_server <- function(id, tadat) {
language = list(zeroRecords = "No filters selected")
)
)
-
+
# what happens when you click "Include Only Selected Values"
shiny::observeEvent(input$addOnlys, {
if (is.null(input$filterStep2_rows_selected)) {
@@ -160,7 +164,7 @@ mod_filtering_server <- function(id, tadat) {
selectFilters("Keep only")
}
})
-
+
# what happens when you click "Exclude Selected Values"
shiny::observeEvent(input$addExcludes, {
if (is.null(input$filterStep2_rows_selected)) {
@@ -175,19 +179,19 @@ mod_filtering_server <- function(id, tadat) {
selectFilters("Exclude")
}
})
-
+
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)
+ EPATADA::TADA_FieldCounts(tables$dat, display = tadat$field_sel)
}
})
-
+
# reset all filters in bottom table
shiny::observeEvent(input$resetFilters, {
# empty selected table on open
@@ -198,7 +202,7 @@ mod_filtering_server <- function(id, tadat) {
dimnames = list(NULL, c("Field", "Value", "Filter", "Count"))
))
})
-
+
# reset selected filters in bottom table
shiny::observeEvent(input$removeFilters, {
if (is.null(input$selectedFilters_rows_selected)) {
@@ -208,11 +212,11 @@ mod_filtering_server <- function(id, tadat) {
"You must select (by clicking on) the filter(s) you'd like to remove from the applied filters table."
)
)
- } else{
- tadat$selected_filters = tadat$selected_filters[-input$selectedFilters_rows_selected,]
+ } else {
+ tadat$selected_filters <- tadat$selected_filters[-input$selectedFilters_rows_selected, ]
}
})
-
+
# Called whenever a "Include" or "Exclude" button is clicked
selectFilters <- function(Filter) {
# Locks the value of the selected field to "Include" or "Exclude"
@@ -224,11 +228,11 @@ mod_filtering_server <- function(id, tadat) {
Count <- rep(0, length(rows))
new_rows <- data.frame(Field, Value, Filter, Count)
# Adds the newly selected field/vals to the Selected table
- tadat$selected_filters = rbind(tadat$selected_filters, new_rows)
- tadat$selected_filters =
+ tadat$selected_filters <- rbind(tadat$selected_filters, new_rows)
+ tadat$selected_filters <-
tadat$selected_filters %>% dplyr::distinct(Field, Value, .keep_all = TRUE)
}
-
+
#####
# These functions are used to lock fields to "Include or Exclude"
# This is necessary because including ONLY certain values from a field
@@ -238,7 +242,7 @@ mod_filtering_server <- function(id, tadat) {
intersect(names(values$locked), unique(tables$selected$Field))
values$locked <- values$locked[still_present]
})
-
+
applyLocks <- function() {
if (!is.null(values$selected_field)) {
active_lock <- values$locked[values$selected_field]
@@ -256,40 +260,39 @@ mod_filtering_server <- function(id, tadat) {
shinyjs::disable("addOnlys")
shinyjs::disable("addExcludes")
}
-
}
-
+
shiny::observeEvent(values$locked, {
applyLocks()
})
#####
-
+
# This gets run whenever a change in selected filters happens
shiny::observeEvent(tadat$selected_filters, {
# Apply field locks
- field_filters = dplyr::distinct(tadat$selected_filters, Field, Filter)
- values$locked = field_filters$Filter
+ field_filters <- dplyr::distinct(tadat$selected_filters, Field, Filter)
+ values$locked <- field_filters$Filter
names(values$locked) <- field_filters$Field
- prefix = "Filter: "
-
+ prefix <- "Filter: "
+
# Remove all the filter columns from the removals table (start fresh)
if (!is.null(tadat$removals)) {
tadat$removals <-
- dplyr::select(tadat$removals,-(dplyr::starts_with(prefix)))
+ dplyr::select(tadat$removals, -(dplyr::starts_with(prefix)))
}
-
+
# Only proceed if filters have been selected
if (!(is.null(tadat$raw)) &
- (nrow(tadat$selected_filters) > 0)) {
+ (nrow(tadat$selected_filters) > 0)) {
# Since filters have been added, enable the ability to reset them
shinyjs::enable("resetFilters")
shinyjs::enable("removeFilters")
-
+
# Loop through the filters field-by-field
for (active_field in unique(tadat$selected_filters$Field)) {
filter_type <- values$locked[active_field]
field_filters <-
- tadat$selected_filters[tadat$selected_filters == active_field,]
+ tadat$selected_filters[tadat$selected_filters == active_field, ]
results <- rep(FALSE, nrow(tadat$raw))
for (row in 1:nrow(field_filters)) {
sel <- (tadat$raw[[active_field]] == field_filters[row, "Value"])
@@ -306,7 +309,7 @@ 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
@@ -315,16 +318,16 @@ mod_filtering_server <- function(id, tadat) {
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)
- new_selected_filters[i, "Count"] =
+ row <- new_selected_filters[i, ]
+ values <- getValues(tables$dat, row$Field)
+ new_selected_filters[i, "Count"] <-
sum(values[(values$Value == row$Value), "Count"], na.rm = TRUE)
}
- tadat$selected_filters = new_selected_filters
+ tadat$selected_filters <- new_selected_filters
}
})
-
-
+
+
getValues <- function(.data, field) {
counts <- table(.data[[field]], useNA = "ifany")
if (length(rownames(counts) > 0)) {
diff --git a/R/mod_harmonize_np.R b/R/mod_harmonize_np.R
index 86290788c..03e35de94 100644
--- a/R/mod_harmonize_np.R
+++ b/R/mod_harmonize_np.R
@@ -27,7 +27,7 @@ mod_harmonize_np_ui <- function(id) {
htmltools::h3("2. Total Nitrogen and Phosphorus Summation"),
htmltools::p("Data generators commonly analyze for several nutrient subspecies that, when added together, can be used to estimate a total nitrogen or phosphorus value. TADA uses the logic provided in ECHO's ", htmltools::a("Nurient Aggregation", href = "https://echo.epa.gov/trends/loading-tool/resources/nutrient-aggregation"), " page to rank and sum subspecies for a given day, location, depth, activity media subdivision, and unit. Total Nitrogen and Total Phosphorus values are added as new results in the dataset. Users may view the nutrient aggregation reference sheet by clicking 'See Summation Reference'. Once data are harmonized, the user may then summarize total N and P.", htmltools::strong("NOTE: "), "When two or more measurements of the same substance occur on the same day at the same location, the function uses the maximum of the group of values to calculate a total nutrient value."),
shiny::fluidRow(
- column(3, htmltools::div(style = "margin-top:20px"), shiny::downloadButton(ns("sum_dwn"), "See Summation Reference", style = "color: #fff; background-color: #337ab7; border-color: #2e6da4")),
+ column(3, htmltools::div(style = "margin-top:20px"), shiny::downloadButton(ns("sum_dwn"), "See Summation Reference (.csv)", style = "color: #fff; background-color: #337ab7; border-color: #2e6da4")),
column(3, htmltools::div(style = "margin-top:20px"), shiny::uiOutput(ns("sum_apply")))
),
htmltools::br()
@@ -52,9 +52,9 @@ mod_harmonize_np_server <- function(id, tadat) {
"Target.TADA.MethodSpeciationName",
"TADA.SpeciationAssumptions",
"Target.TADA.SpeciationConversionFactor",
- #"TADA.ResultMeasure.MeasureUnitCode", #no longer in harmonization template
- #"Target.TADA.ResultMeasure.MeasureUnitCode", #no longer in harmonization template
- #"Target.TADA.UnitConversionFactor", #no longer in harmonization template
+ # "TADA.ResultMeasure.MeasureUnitCode", #no longer in harmonization template
+ # "Target.TADA.ResultMeasure.MeasureUnitCode", #no longer in harmonization template
+ # "Target.TADA.UnitConversionFactor", #no longer in harmonization template
"HarmonizationGroup"
)
@@ -63,7 +63,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 <- EPATADA::TADA_GetSynonymRef(tadat$raw[tadat$raw$TADA.Remove == FALSE, ])
ref <- ref %>% dplyr::arrange(Target.TADA.CharacteristicName, Target.TADA.ResultSampleFractionText, Target.TADA.MethodSpeciationName)
colns <- names(ref)
harm$colns <- colns %>% dplyr::recode(
@@ -90,7 +90,7 @@ mod_harmonize_np_server <- function(id, tadat) {
output$harm_dwn <- shiny::renderUI({
shiny::req(harm$ref)
if (dim(harm$ref)[1] > 1) {
- shiny::downloadButton(ns("harm_dwn1"), "Download Synonym Table", style = "color: #fff; background-color: #337ab7; border-color: #2e6da4")
+ shiny::downloadButton(ns("harm_dwn1"), "Download Synonym Table (.csv)", style = "color: #fff; background-color: #337ab7; border-color: #2e6da4")
}
})
@@ -172,9 +172,9 @@ mod_harmonize_np_server <- function(id, tadat) {
dat <- subset(tadat$raw, tadat$raw$TADA.Remove == FALSE)
rem <- subset(tadat$raw, tadat$raw$TADA.Remove == TRUE)
- dat <- TADA::TADA_HarmonizeSynonyms(dat, ref = harm$ref)
+ dat <- EPATADA::TADA_HarmonizeSynonyms(dat, ref = harm$ref)
tadat$raw <- plyr::rbind.fill(dat, rem)
- tadat$raw <- TADA::TADA_OrderCols(tadat$raw)
+ tadat$raw <- EPATADA::TADA_OrderCols(tadat$raw)
# remove the modal once the dataset has been harmonized
shinybusy::remove_modal_spinner(session = shiny::getDefaultReactiveDomain())
@@ -191,7 +191,7 @@ mod_harmonize_np_server <- function(id, tadat) {
"TADA_NPSummationKey.csv"
},
content = function(file) {
- write.csv(TADA::TADA_GetNutrientSummationRef(), file, row.names = FALSE)
+ write.csv(EPATADA::TADA_GetNutrientSummationRef(), file, row.names = FALSE)
}
)
@@ -212,7 +212,7 @@ mod_harmonize_np_server <- function(id, tadat) {
dat <- subset(tadat$raw, tadat$raw$TADA.Remove == FALSE)
rem <- subset(tadat$raw, tadat$raw$TADA.Remove == TRUE)
- dat <- TADA::TADA_CalculateTotalNP(dat, daily_agg = "max")
+ dat <- EPATADA::TADA_CalculateTotalNP(dat, daily_agg = "max")
dat$TADA.Remove[is.na(dat$TADA.Remove)] <- FALSE
# add new measurements to tadat$removals, all equal FALSE
@@ -223,7 +223,7 @@ mod_harmonize_np_server <- function(id, tadat) {
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)
+ tadat$raw <- EPATADA::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 646c78d9d..8c34feedf 100644
--- a/R/mod_overview.R
+++ b/R/mod_overview.R
@@ -54,7 +54,8 @@ mod_overview_ui <- function(id) {
),
htmltools::div(style = "margin-bottom:10px"),
shiny::fluidRow(column(12, DT::DTOutput(
- ns("overview_orgtable"), height = "500px"
+ ns("overview_orgtable"),
+ height = "500px"
)))
)
}
@@ -65,10 +66,10 @@ mod_overview_ui <- function(id) {
mod_overview_server <- function(id, tadat) {
shiny::moduleServer(id, function(input, output, session) {
ns <- session$ns
-
+
# this a reactive list created to hold all the reactive objects specific to this module.
mapdat <- shiny::reactiveValues()
-
+
# create dataset for map and histogram using raw data
shiny::observeEvent(tadat$ovgo, {
shiny::req(tadat$raw)
@@ -122,7 +123,7 @@ mod_overview_server <- function(id, tadat) {
tadat$orgs <- tadat$org_table$OrganizationIdentifier
}
})
-
+
# this widget produces the text at the top of the page describing record, site, and org numbers in dataset
output$overview_totals <- shiny::renderText({
shiny::req(mapdat$text)
@@ -142,28 +143,30 @@ mod_overview_server <- function(id, tadat) {
" unique organization(s)."
)
})
-
+
# the leaflet map
output$overview_map <- leaflet::renderLeaflet({
shiny::req(mapdat$text)
- TADA::TADA_OverviewMap(tadat$raw[tadat$raw$TADA.Remove == FALSE,])
+ EPATADA::TADA_OverviewMap(tadat$raw[tadat$raw$TADA.Remove == FALSE, ])
})
-
+
# histogram showing results collected over time.
output$overview_hist <- shiny::renderPlot({
shiny::req(mapdat$text)
ggplot2::ggplot(data = mapdat$text, ggplot2::aes(x = as.Date(ActivityStartDate, format = "%Y-%m-%d"))) +
- ggplot2::geom_histogram(color = "black",
- fill = "#005ea2",
- binwidth = 7) +
+ ggplot2::geom_histogram(
+ color = "black",
+ fill = "#005ea2",
+ binwidth = 7
+ ) +
ggplot2::labs(title = "Results collected per week over date range queried", x = "Time", y = "Result Count") +
ggplot2::theme_classic(base_size = 16)
})
-
+
# organization numbers table, the editable part allows user to change only the third column (rankings)
# https://yihui.shinyapps.io/DT-edit/
output$overview_orgtable <- DT::renderDT(
- tadat$org_table[,!names(tadat$org_table) %in% c("OrganizationIdentifier")],
+ tadat$org_table[, !names(tadat$org_table) %in% c("OrganizationIdentifier")],
editable = list(target = "column", disable = list(columns = c(0, 1))),
colnames = c(
"Organization Name",
@@ -180,43 +183,47 @@ mod_overview_server <- function(id, tadat) {
rownames = FALSE,
selection = "none"
)
-
+
shiny::observeEvent(input$overview_orgtable_cell_edit, {
- org_rank <-
- data.frame(
- OrganizationIdentifier = tadat$org_table$OrganizationIdentifier,
- Rank = as.numeric(input$overview_orgtable_cell_edit$value)
- ) %>% dplyr::arrange(Rank)
- tadat$org_table <- tadat$org_table %>%
- dplyr::select(-Rank) %>%
- dplyr::left_join(org_rank) %>%
- dplyr::arrange(Rank)
- # tadat$org_table = orgs %>% dplyr::arrange(-Result_Count) %>% dplyr::mutate("Rank" = 1:length(Result_Count))
- tadat$orgs <- org_rank$OrganizationIdentifier
+ org_rank <-
+ data.frame(
+ OrganizationIdentifier = tadat$org_table$OrganizationIdentifier,
+ Rank = as.numeric(input$overview_orgtable_cell_edit$value)
+ ) %>% dplyr::arrange(Rank)
+ tadat$org_table <- tadat$org_table %>%
+ dplyr::select(-Rank) %>%
+ dplyr::left_join(org_rank) %>%
+ dplyr::arrange(Rank)
+ # tadat$org_table = orgs %>% dplyr::arrange(-Result_Count) %>% dplyr::mutate("Rank" = 1:length(Result_Count))
+ tadat$orgs <- org_rank$OrganizationIdentifier
})
-
+
# characteristics bar chart showing top characteristics by result number in dataset
output$overview_barchar <- shiny::renderPlot({
shiny::req(mapdat$chars)
- ggplot2::ggplot(mapdat$chars,
- ggplot2::aes(x = TADA.Chars, y = Result_Count)) +
- ggplot2::geom_bar(stat = "identity",
- fill = "#005ea2",
- color = "black") +
- ggplot2::labs(title = "Results per Characteristic", x = "", y = "Results Count") +
+ ggplot2::ggplot(
+ mapdat$chars,
+ ggplot2::aes(x = Result_Count, y = TADA.Chars)
+ ) +
+ ggplot2::geom_bar(
+ stat = "identity",
+ fill = "#005ea2",
+ color = "black"
+ ) +
+ ggplot2::labs(title = "Results per Characteristic", x = "Results Count", y = "") +
ggplot2::theme_classic(base_size = 16) +
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1)) +
ggplot2::geom_text(
ggplot2::aes(
- x = TADA.Chars,
- y = Result_Count + (0.07 * max(Result_Count)),
+ x = Result_Count + (0.07 * max(Result_Count)),
+ y = TADA.Chars,
label = Result_Count
),
size = 5,
color = "black"
- ) #+
+ )
})
-
+
shiny::observeEvent(input$refresh_overview, {
shiny::req(mapdat$text)
tadat$ovgo <- TRUE
diff --git a/R/mod_query_data.R b/R/mod_query_data.R
index 159a3f670..2e8855cc8 100644
--- a/R/mod_query_data.R
+++ b/R/mod_query_data.R
@@ -58,24 +58,26 @@ mod_query_data_ui <- function(id) {
htmltools::br(),
# styling several fluid rows with columns to hold the input drop down widgets
htmltools::h4("Date Range"),
- shiny::fluidRow(column(
- 4,
- shiny::dateInput(
- ns("startDate"),
- "Start Date",
- format = "yyyy-mm-dd",
- startview = "year"
+ shiny::fluidRow(
+ column(
+ 4,
+ shiny::dateInput(
+ ns("startDate"),
+ "Start Date",
+ format = "yyyy-mm-dd",
+ startview = "year"
+ )
+ ),
+ column(
+ 4,
+ shiny::dateInput(
+ ns("endDate"),
+ "End Date",
+ format = "yyyy-mm-dd",
+ startview = "year"
+ )
)
),
- column(
- 4,
- shiny::dateInput(
- ns("endDate"),
- "End Date",
- format = "yyyy-mm-dd",
- startview = "year"
- )
- )),
htmltools::h4("Location Information"),
shiny::fluidRow(
column(4, shiny::selectizeInput(ns("state"), "State", choices = NULL)),
@@ -162,7 +164,8 @@ mod_query_data_ui <- function(id) {
shiny::fluidRow(column(
4,
shiny::actionButton(ns("querynow"), "Run Query", shiny::icon("cloud"),
- style = "color: #fff; background-color: #337ab7; border-color: #2e6da4")
+ style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"
+ )
)),
htmltools::hr(),
shiny::fluidRow(
@@ -173,8 +176,7 @@ mod_query_data_ui <- function(id) {
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
to the WQP through EPA's WQX."
- )
- ),
+ )),
# widget to upload WQP profile or WQX formatted spreadsheet
column(
9,
@@ -187,20 +189,18 @@ mod_query_data_ui <- function(id) {
)
)
),
-
htmltools::hr(),
shiny::fluidRow(
htmltools::h3("Optional: Upload Progress File"),
htmltools::HTML((
"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
+ 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 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
column(
9,
@@ -222,9 +222,9 @@ mod_query_data_ui <- function(id) {
mod_query_data_server <- function(id, tadat) {
shiny::moduleServer(id, function(input, output, session) {
ns <- session$ns
-
+
# read in the excel spreadsheet dataset if this input reactive object is populated via fileInput and define as tadat$raw
- shiny::observeEvent(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",
@@ -232,27 +232,26 @@ mod_query_data_server <- function(id, tadat) {
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)){
+ if (!is.null(tadat$original_source)) {
tadat$original_source <- "Upload"
}
-
+
shinybusy::remove_modal_spinner(session = shiny::getDefaultReactiveDomain())
-
})
-
+
# Read the TADA progress file
shiny::observe({
shiny::req(input$progress_file)
# user uploaded data
readFile(tadat, input$progress_file$datapath)
})
-
+
# 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
@@ -262,23 +261,22 @@ mod_query_data_server <- function(id, tadat) {
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
+ raw <- EPATADA::Data_NCTCShepherdstown_HUC12
}
if (input$example_data == "Tribal (132k results)") {
- raw <- TADA::Data_6Tribes_5y
+ raw <- EPATADA::Data_6Tribes_5y
}
if (input$example_data == "Nutrients Utah (15k results)") {
- raw <- TADA::Data_Nutrients_UT
+ raw <- EPATADA::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
shiny::updateSelectizeInput(
session,
@@ -289,9 +287,10 @@ mod_query_data_server <- function(id, tadat) {
server = TRUE
)
shiny::updateSelectizeInput(session,
- "org",
- choices = c(orgs),
- server = TRUE)
+ "org",
+ choices = c(orgs),
+ server = TRUE
+ )
shiny::updateSelectizeInput(
session,
"chargroup",
@@ -301,13 +300,15 @@ mod_query_data_server <- function(id, tadat) {
server = TRUE
)
shiny::updateSelectizeInput(session,
- "characteristic",
- choices = c(chars),
- server = TRUE)
+ "characteristic",
+ choices = c(chars),
+ server = TRUE
+ )
shiny::updateSelectizeInput(session,
- "project",
- choices = c(projects),
- server = TRUE)
+ "project",
+ choices = c(projects),
+ server = TRUE
+ )
shiny::updateSelectizeInput(
session,
"siteid",
@@ -315,7 +316,7 @@ mod_query_data_server <- function(id, tadat) {
options = list(placeholder = "Start typing or use drop down menu"),
server = TRUE
)
-
+
# this observes when the user inputs a state into the drop down and subsets the choices for counties to only those counties within that state.
shiny::observeEvent(input$state, {
state_counties <- subset(county, county$STUSAB == input$state)
@@ -324,16 +325,18 @@ mod_query_data_server <- function(id, tadat) {
"county",
choices = c(unique(state_counties$COUNTY_NAME)),
selected = character(0),
- options = list(placeholder = "Select county",
- maxItems = 1),
+ options = list(
+ placeholder = "Select county",
+ maxItems = 1
+ ),
server = TRUE
)
})
-
+
# remove the modal once the dataset has been pulled
shinybusy::remove_modal_spinner(session = shiny::getDefaultReactiveDomain())
-
-
+
+
# this event observer is triggered when the user hits the "Query Now" button, and then runs the TADAdataRetrieval function
shiny::observeEvent(input$querynow, {
tadat$original_source <- "Query"
@@ -409,9 +412,9 @@ mod_query_data_server <- function(id, tadat) {
text = "Querying WQP database...",
session = shiny::getDefaultReactiveDomain()
)
-
+
# storing the output of TADAdataRetrieval with the user's input choices as a reactive object named "raw" in the tadat list.
- raw <- TADA::TADA_DataRetrieval(
+ raw <- EPATADA::TADA_DataRetrieval(
statecode = tadat$statecode,
countycode = tadat$countycode,
huc = tadat$huc,
@@ -426,10 +429,10 @@ mod_query_data_server <- function(id, tadat) {
endDate = tadat$endDate,
applyautoclean = TRUE
)
-
+
# remove the modal once the dataset has been pulled
shinybusy::remove_modal_spinner(session = shiny::getDefaultReactiveDomain())
-
+
# show a modal dialog box when tadat$raw is empty and the query didn't return any records.
# but if tadat$raw isn't empty, perform some initial QC of data that aren't media type water or have NA Resultvalue and no detection limit data
if (dim(raw)[1] < 1) {
@@ -443,12 +446,12 @@ mod_query_data_server <- function(id, tadat) {
initializeTable(tadat, raw)
}
})
-
+
# Update the run parameters if example data is selected
shiny::observeEvent(input$example_data_go, {
tadat$original_source <- "Example"
})
-
+
# Populate the boxes if a progress file is loaded
shiny::observeEvent(tadat$load_progress_file, {
if (!is.na(tadat$load_progress_file)) {
@@ -461,8 +464,9 @@ mod_query_data_server <- function(id, tadat) {
shiny::updateSelectizeInput(session, "siteid", selected = tadat$siteid)
shiny::updateSelectizeInput(session, "type", selected = tadat$siteType)
shiny::updateSelectizeInput(session,
- "characteristic",
- selected = tadat$characteristicName)
+ "characteristic",
+ selected = tadat$characteristicName
+ )
shiny::updateSelectizeInput(session, "chargroup", selected = tadat$characteristicType)
shiny::updateSelectizeInput(session, "media", selected = tadat$sampleMedia)
shiny::updateSelectizeInput(session, "project", selected = tadat$project)
@@ -471,9 +475,7 @@ mod_query_data_server <- function(id, tadat) {
shiny::updateDateInput(session, "endDate", value = tadat$endDate)
}
}
-
})
-
})
}
@@ -499,7 +501,7 @@ initializeTable <- function(tadat, raw) {
# Set flagging column to FALSE
raw$TADA.Remove <- FALSE
}
-
+
removals <- data.frame(matrix(nrow = nrow(raw), ncol = 0))
tadat$raw <- raw
tadat$removals <- removals
diff --git a/R/mod_review_data.R b/R/mod_review_data.R
index 757296d65..143126400 100644
--- a/R/mod_review_data.R
+++ b/R/mod_review_data.R
@@ -37,9 +37,9 @@ mod_review_data_ui <- function(id) {
mod_review_data_server <- function(id, tadat) {
shiny::moduleServer(id, function(input, output, session) {
ns <- session$ns
-
+
review_things <- shiny::reactiveValues()
-
+
shiny::observeEvent(input$review_go, {
removals <- tadat$removals
sel <- which(removals == TRUE, arr.ind = TRUE)
@@ -47,14 +47,16 @@ mod_review_data_server <- function(id, tadat) {
if (length(sel) > 0) {
removals[sel] <- names(removals)[sel[, "col"]]
removals[removals == FALSE] <- ""
- tadat$raw$TADA.RemovalReason <- apply(removals, 1,
- function(row) {
- paste(row[nzchar(row)], collapse = ", ")
- })
+ tadat$raw$TADA.RemovalReason <- apply(
+ removals, 1,
+ function(row) {
+ paste(row[nzchar(row)], collapse = ", ")
+ }
+ )
} else {
tadat$raw$TADA.RemovalReason <- NA
}
-
+
# data for bar chart - this is real rough
step_rems <- sort_removals(tadat$removals)
total <- dim(tadat$raw)[1]
@@ -66,7 +68,7 @@ mod_review_data_server <- function(id, tadat) {
ifelse(length(step_rems$Count[step_rems$Reason %in% "Filter only"]) > 0, step_rems$Count[step_rems$Reason %in% "Filter only"], 0)
mrfl <- total - flag - filtflag
mrfi <- mrfl - filter
-
+
step_rems_plot <-
data.frame(
Step = c(
@@ -86,60 +88,67 @@ mod_review_data_server <- function(id, tadat) {
)
)
review_things$step_rems_plot <- step_rems_plot
-
+
# data for pie chart
rem_reas <-
- data.frame(Reason = names(tadat$removals),
- Count = apply(tadat$removals, 2, sum))
+ data.frame(
+ Reason = names(tadat$removals),
+ Count = apply(tadat$removals, 2, sum)
+ )
rem_reas <- subset(rem_reas, rem_reas$Count > 0)
if (nrow(rem_reas) > 0) {
review_things$rem_reas <- rem_reas
- } else{
+ } else {
review_things$rem_reas <- data.frame(Reason = "No Removals", Count = 1)
}
})
-
+
# characteristics bar chart showing top characteristics by result number in dataset
output$review_barchar <- shiny::renderPlot({
shiny::req(review_things$step_rems_plot)
- ggplot2::ggplot(review_things$step_rems_plot,
- ggplot2::aes(x = Step, y = Count)) +
- ggplot2::geom_bar(stat = "identity",
- fill = "#005ea2",
- color = "black") +
- ggplot2::labs(title = "Results Retained Following Flagging/Filtering Steps", x = "", y = "Results Count") +
+ ggplot2::ggplot(
+ review_things$step_rems_plot,
+ ggplot2::aes(x = Count, y = Step)
+ ) +
+ ggplot2::geom_bar(
+ stat = "identity",
+ fill = "#005ea2",
+ color = "black"
+ ) +
+ ggplot2::scale_y_discrete(limits=rev) +
+ ggplot2::labs(title = "Results Retained Following Flagging/Filtering Steps", x = "Results Count", y = "") +
ggplot2::theme_classic(base_size = 16) +
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 45, hjust = 1)) +
ggplot2::geom_text(
ggplot2::aes(
- x = Step,
- y = Count + (0.07 * max(Count)),
+ x = Count + (0.07 * max(Count)),
+ y = Step,
label = Count
),
size = 5,
color = "black"
) #+
})
-
+
output$reason_pie <- shiny::renderPlot({
shiny::req(review_things$rem_reas)
dat <- review_things$rem_reas
if (nrow(review_things$rem_reas) > 1) {
dat$Legend <- paste0(dat$Reason, " - ", dat$Count, " results")
- } else{
+ } else {
dat$Legend <- paste0(dat$Reason)
}
dat <- dat %>%
dplyr::rowwise() %>%
- dplyr::mutate(Legend = TADA::TADA_InsertBreaks(Legend, len = 100))
-
+ dplyr::mutate(Legend = EPATADA::TADA_InsertBreaks(Legend, len = 100))
+
# define number of colors required for pie chart
colorCount <- length(unique(dat$Legend))
-
+
# define color palette
getPalette <-
grDevices::colorRampPalette(RColorBrewer::brewer.pal(8, "Set2"))
-
+
# create pie chart
ggplot2::ggplot(dat, ggplot2::aes(x = "", y = Count, fill = Legend)) +
ggplot2::scale_fill_manual(values = getPalette(colorCount), name = "Removal Reasons") +
diff --git a/R/mod_summary.R b/R/mod_summary.R
index 10f121e71..1306778f1 100644
--- a/R/mod_summary.R
+++ b/R/mod_summary.R
@@ -44,7 +44,7 @@ mod_summary_server <- function(id, tadat) {
} else {
# Apply the instance specific processing to the dataframe and render
# use TADA R package for table contents
- import_summary_table <- TADA::TADA_SummarizeColumn(tadat$raw, col = "TADA.CharacteristicName")
+ import_summary_table <- EPATADA::TADA_SummarizeColumn(tadat$raw, col = "TADA.CharacteristicName")
return(import_summary_table)
}
diff --git a/R/utils.R b/R/utils.R
index f04d2a9f1..607689dc7 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -16,12 +16,12 @@ utils::globalVariables(c(
"Target.TADA.CharacteristicName",
"Target.TADA.MethodSpeciationName",
"write.csv", "read.csv", "downloadHandler",
- "Rank", "Target.TADA.ResultSampleFractionText",
+ "Rank", "Target.TADA.ResultSampleFractionText",
"Field", "characteristicName", "characteristicType",
"countycode", "endDate", "example_data", "huc", "m2f",
"nd_method", "nd_mult", "od_method", "org_table",
"organization", "original_source", "project", "sampleMedia",
"selected_filters", "selected_flags", "siteType",
- "siteid", "startDate", "statecode", "od_mult", "field_sel",
+ "siteid", "startDate", "statecode", "od_mult", "field_sel",
"DetectionQuantitationLimitMeasure.MeasureValue"
))
diff --git a/R/utils_flag_functions.R b/R/utils_flag_functions.R
index 14b4f534a..b736f943f 100644
--- a/R/utils_flag_functions.R
+++ b/R/utils_flag_functions.R
@@ -3,24 +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)
+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: "
+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)))
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)) {
@@ -39,7 +39,7 @@ flagCensus <- function(raw) {
if (tests[row, "keep"]) {
test_results <- !test_results
} else {
-
+
}
results <- results + test_results
}
@@ -49,25 +49,27 @@ 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,56 +79,56 @@ 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)
+ out <- EPATADA::TADA_IDCensoredData(in_table)
# Invalid Speciation
- out <- TADA::TADA_FlagSpeciation(out, clean = "none")
+ out <- EPATADA::TADA_FlagSpeciation(out, clean = "none")
# Invalid fraction
- out <- TADA::TADA_FlagFraction(out, clean = FALSE)
+ out <- EPATADA::TADA_FlagFraction(out, clean = FALSE)
# Invalid result unit
- out <- TADA::TADA_FlagResultUnit(out, clean = "none")
-
+ out <- EPATADA::TADA_FlagResultUnit(out, clean = "none")
+
# QC rep/blank
- out <- TADA::TADA_FindQCActivities(out, clean = FALSE)
+ out <- EPATADA::TADA_FindQCActivities(out, clean = FALSE)
# Result is flagged as suspect by data submitter
- out <- TADA::TADA_FlagMeasureQualifierCode(out, clean = FALSE, define = TRUE)
+ out <- EPATADA::TADA_FlagMeasureQualifierCode(out, clean = FALSE, define = TRUE)
# Invalid analytical method
- out <- TADA::TADA_FlagMethod(out, clean = FALSE)
-
+ out <- EPATADA::TADA_FlagMethod(out, clean = FALSE)
+
# Single org duplicative uploads
- out <- TADA::TADA_FindPotentialDuplicatesSingleOrg(out)
+ out <- EPATADA::TADA_FindPotentialDuplicatesSingleOrg(out)
# multiple org duplicative uploads
## NOTE: THIS FUNCTION USES A REACTIVE OBJECT AS AN INPUT
- out <- TADA::TADA_FindPotentialDuplicatesMultipleOrgs(out, org_hierarchy = orgs)
+ out <- EPATADA::TADA_FindPotentialDuplicatesMultipleOrgs(out, org_hierarchy = 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)
+ out <- EPATADA::TADA_FindQAPPDoc(out, clean = FALSE)
}
# Dataset includes depth profile data - no function for this yet
# out <- out
# Aggregated continuous data
- # out <- TADA::TADA_FlagContinuousData(out, clean = FALSE, flaggedonly = FALSE)
+ # out <- EPATADA::TADA_FlagContinuousData(out, clean = FALSE, flaggedonly = FALSE)
# Above WQX Upper Threshold
- out <- TADA::TADA_FlagAboveThreshold(out, clean = FALSE)
+ out <- EPATADA::TADA_FlagAboveThreshold(out, clean = FALSE)
# Below WQX Lower Threshold
- out <- TADA::TADA_FlagBelowThreshold(out, clean = FALSE)
+ out <- EPATADA::TADA_FlagBelowThreshold(out, clean = FALSE)
# Invalid coordinates
out <-
- TADA::TADA_FlagCoordinates(
+ EPATADA::TADA_FlagCoordinates(
out,
clean_outsideUSA = "no",
clean_imprecise = FALSE,
@@ -138,14 +140,14 @@ applyFlags <- function(in_table, orgs) {
checkFlagColumns <- function(dataset) {
missing <- setdiff(active_flags, names(dataset))
- found = setdiff(active_flags, missing)
+ found <- setdiff(active_flags, missing)
if (length(missing) > length(found)) {
return(FALSE)
} else {
- if (length(missing) > 0){
+ 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 7b6ab224a..3a1e8c54a 100644
--- a/R/utils_track_progress.R
+++ b/R/utils_track_progress.R
@@ -1,20 +1,19 @@
-
writeFile <- function(tadat, filename) {
- original_source = tadat$original_source
- job_id = tadat$job_id
- statecode = tadat$statecode
- countycode = tadat$countycode
- example_data = tadat$example_data
- huc = tadat$huc
- siteid = tadat$siteid
- siteType = tadat$siteType
- characteristicName = tadat$characteristicName
- characteristicType = tadat$characteristicType
- sampleMedia = tadat$sampleMedia
- project = tadat$project
- organization = tadat$organization
- startDate = tadat$startDate
- endDate = tadat$endDate
+ original_source <- tadat$original_source
+ job_id <- tadat$job_id
+ statecode <- tadat$statecode
+ countycode <- tadat$countycode
+ example_data <- tadat$example_data
+ huc <- tadat$huc
+ siteid <- tadat$siteid
+ siteType <- tadat$siteType
+ characteristicName <- tadat$characteristicName
+ characteristicType <- tadat$characteristicType
+ sampleMedia <- tadat$sampleMedia
+ project <- tadat$project
+ organization <- tadat$organization
+ startDate <- tadat$startDate
+ endDate <- tadat$endDate
org_table <- tadat$org_table
selected_flags <- tadat$selected_flags
m2f <- tadat$m2f
@@ -24,7 +23,7 @@ writeFile <- function(tadat, filename) {
nd_mult <- tadat$nd_mult
od_mult <- tadat$od_mult
field_sel <- tadat$field_sel
-
+
save(
original_source,
job_id,
@@ -52,22 +51,21 @@ writeFile <- function(tadat, filename) {
field_sel,
file = filename
)
-
}
readFile <- function(tadat, filename) {
load(filename, verbose = FALSE)
- tadat$load_progress_file = filename
-
+ tadat$load_progress_file <- filename
+
# Confirm compatibility
- job_id = job_id
+ job_id <- job_id
if (!is.null(m2f)) {
- tadat$m2f = m2f
+ tadat$m2f <- m2f
}
-
+
if (!is.null(selected_flags)) {
- tadat$selected_flags = selected_flags
+ tadat$selected_flags <- selected_flags
shinyjs::enable(selector = '.nav li a[data-value="Flag"]')
}
@@ -76,28 +74,28 @@ readFile <- function(tadat, filename) {
shinyjs::enable(selector = '.nav li a[data-value="Filter"]')
}
- tadat$original_source = original_source
- tadat$job_id = job_id
- tadat$example_data = example_data
- tadat$statecode = statecode
- tadat$countycode = countycode
- tadat$huc = huc
- tadat$siteid = siteid
- tadat$siteType = siteType
- tadat$characteristicName = characteristicName
- tadat$characteristicType = characteristicType
- tadat$sampleMedia = sampleMedia
- tadat$project = project
- tadat$organization = organization
- tadat$startDate = startDate
- tadat$endDate = endDate
- tadat$org_table = org_table
- tadat$selected_filters = selected_filters
- tadat$nd_method = nd_method
- tadat$od_method = od_method
- tadat$nd_mult = nd_mult
- tadat$od_mult = od_mult
- tadat$field_sel = field_sel
+ tadat$original_source <- original_source
+ tadat$job_id <- job_id
+ tadat$example_data <- example_data
+ tadat$statecode <- statecode
+ tadat$countycode <- countycode
+ tadat$huc <- huc
+ tadat$siteid <- siteid
+ tadat$siteType <- siteType
+ tadat$characteristicName <- characteristicName
+ tadat$characteristicType <- characteristicType
+ tadat$sampleMedia <- sampleMedia
+ tadat$project <- project
+ tadat$organization <- organization
+ tadat$startDate <- startDate
+ tadat$endDate <- endDate
+ tadat$org_table <- org_table
+ tadat$selected_filters <- selected_filters
+ tadat$nd_method <- nd_method
+ tadat$od_method <- od_method
+ tadat$nd_mult <- nd_mult
+ tadat$od_mult <- od_mult
+ tadat$field_sel <- field_sel
}
@@ -109,16 +107,16 @@ invalidFile <- function(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)
-
+ 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)
+
# Data Query Tab
if (tadat$original_source == "Example") {
- df[nrow(df) + 1, ] = c("Example data file", tadat$example_data)
+ df[nrow(df) + 1, ] <- c("Example data file", tadat$example_data)
} else if (tadat$original_source == "Query") {
- query_params = data.frame(
+ query_params <- data.frame(
param = c(
"State Code",
"County Code",
@@ -150,53 +148,53 @@ writeNarrativeDataFrame <- function(tadat) {
)
for (i in seq_len(nrow(query_params))) {
if (!is.null(query_params[i, "value"])) {
- df[nrow(df) + 1, ] = query_params[i,]
+ df[nrow(df) + 1, ] <- query_params[i, ]
}
}
}
# Overview Tab
for (row in 1:nrow(tadat$org_table)) {
- df[nrow(df) + 1, ] = c(paste0("Organization Rank ", row), tadat$org_table[row, 'OrganizationFormalName'])
+ df[nrow(df) + 1, ] <- c(paste0("Organization Rank ", row), tadat$org_table[row, "OrganizationFormalName"])
}
-
+
# Flagging Tab
for (flag in tadat$selected_flags) {
- df[nrow(df) + 1, ] = c("Selected Flag", flag)
+ df[nrow(df) + 1, ] <- c("Selected Flag", flag)
}
-
+
if (!is.null(tadat$m2f)) {
- df[nrow(df) + 1, ] = c("Depth unit conversion", tadat$m2f)
+ df[nrow(df) + 1, ] <- c("Depth unit conversion", tadat$m2f)
} else {
- df[nrow(df) + 1, ] = c("Depth unit conversion", "None")
+ df[nrow(df) + 1, ] <- c("Depth unit conversion", "None")
}
-
+
# Filtering tab
for (row in 1:nrow(tadat$selected_filters)) {
- df[nrow(df) + 1, ] = c(
+ df[nrow(df) + 1, ] <- c(
"Selected Filter",
paste0(
- tadat$selected_filters[row, 'Filter'],
+ tadat$selected_filters[row, "Filter"],
": ",
- tadat$selected_filters[row, 'Field'],
+ tadat$selected_filters[row, "Field"],
" = ",
- tadat$selected_filters[row, 'Value']
+ tadat$selected_filters[row, "Value"]
)
)
}
-
+
# Censored Data tab
- if (is.null(tadat$nd_mult)){
- tadat$nd_mult = "n/a"
+ if (is.null(tadat$nd_mult)) {
+ tadat$nd_mult <- "n/a"
}
- if (is.null(tadat$od_mult)){
- tadat$od_mult = "n/a"
+ if (is.null(tadat$od_mult)) {
+ tadat$od_mult <- "n/a"
}
- df[nrow(df) + 1, ] = c("Non-Detect Handling Method", sub("x", tadat$nd_mult, tadat$nd_method))
- df[nrow(df) + 1, ] = c("Over-Detect Handling Method", sub("x", tadat$od_mult, tadat$od_method))
-
+ df[nrow(df) + 1, ] <- c("Non-Detect Handling Method", sub("x", tadat$nd_mult, tadat$nd_method))
+ df[nrow(df) + 1, ] <- c("Over-Detect Handling Method", sub("x", tadat$od_mult, tadat$od_method))
+
return(df)
}
diff --git a/README.md b/README.md
index ba2d054d6..fafe14a33 100644
--- a/README.md
+++ b/README.md
@@ -60,4 +60,4 @@ This United States Environmental Protection Agency (EPA) GitHub project code is
## Contact
-If you have any questions, please reach out to Cristina Mullin (mullin.cristina\@epa.gov).
+If you have any questions, please reach out to the TADA Team at mywaterway\@epa.gov.
diff --git a/rsconnect/rstudio-connect.dmap-stage.aws.epa.gov/Cristina/tadashiny.dcf b/rsconnect/rstudio-connect.dmap-stage.aws.epa.gov/Cristina/tadashiny.dcf
new file mode 100644
index 000000000..7947e8931
--- /dev/null
+++ b/rsconnect/rstudio-connect.dmap-stage.aws.epa.gov/Cristina/tadashiny.dcf
@@ -0,0 +1,12 @@
+name: tadashiny
+title: TADAShiny
+username: Cristina
+account: Cristina
+server: rstudio-connect.dmap-stage.aws.epa.gov
+hostUrl: https://rstudio-connect.dmap-stage.aws.epa.gov/__api__
+appId: 403
+bundleId: 2745
+url: https://rstudio-connect.dmap-stage.aws.epa.gov/content/da3ffe2f-b443-4051-a029-3adb491434cb/
+version: 1
+asMultiple: FALSE
+asStatic: FALSE