From a6983c9bc38c8f7ba0a9b051e05a1195d0ca2299 Mon Sep 17 00:00:00 2001 From: Hook Date: Fri, 3 Nov 2023 15:08:37 -0400 Subject: [PATCH] latest --- R/app_server.R | 3 + R/golem_utils_ui.R | 1 + R/mod_censored_data.R | 304 +++++++++++++++++++++++++++++++-------- R/mod_data_flagging.R | 8 +- R/mod_overview.R | 170 ++++++++++++++++------ R/utils_track_progress.R | 45 +++++- 6 files changed, 420 insertions(+), 111 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 5f036c454..546772431 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -32,6 +32,9 @@ app_server <- function(input, output, session) { shinyjs::disable(selector = '.nav li a[data-value="Figures"]') shinyjs::disable(selector = '.nav li a[data-value="Review"]') + # switch that indicates when a file is being loaded + tadat$load_file = NA + # 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, { diff --git a/R/golem_utils_ui.R b/R/golem_utils_ui.R index 0d11ee4e7..c91475023 100644 --- a/R/golem_utils_ui.R +++ b/R/golem_utils_ui.R @@ -230,6 +230,7 @@ with_red_star <- function(text) { #' @examples #' rep_br(5) #' @importFrom shiny HTML + rep_br <- function(times = 1) { HTML(rep("
", times = times)) } diff --git a/R/mod_censored_data.R b/R/mod_censored_data.R index f712c2c57..58b5a762c 100644 --- a/R/mod_censored_data.R +++ b/R/mod_censored_data.R @@ -7,36 +7,82 @@ #' @noRd #' #' @importFrom shiny NS tagList + +nd_method_options <- + c("Multiply detection limit by x", + "Random number between 0 and detection limit", + "No change") +od_method_options <- c("Multiply detection limit by x", "No change") + mod_censored_data_ui <- function(id) { ns <- NS(id) tagList( shiny::fluidRow(htmltools::h3("Censored Data Categories")), - shiny::fluidRow("TADAdataRetrieval assigns each result in your dataset to non-detect, over-detect, other, or uncensored. The pie chart below displays the relative proportions of results in each category. Please note that detection limit data with conflicts or data quality issues are not displayed in this pie chart or handled in the methods below."), + shiny::fluidRow( + "TADAdataRetrieval assigns each result in your dataset to non-detect, over-detect, other, or uncensored. The pie chart below displays the relative proportions of results in each category. Please note that detection limit data with conflicts or data quality issues are not displayed in this pie chart or handled in the methods below." + ), htmltools::br(), - shiny::fluidRow(column(12, shiny::plotOutput(ns("id_censplot")))), + shiny::fluidRow(column(12, shiny::plotOutput( + ns("id_censplot") + ))), htmltools::br(), - shiny::fluidRow(htmltools::h3("Handle Censored Data Using Simple Methods")), - shiny::fluidRow("Use the drop down menus below to pick a simple method for handling non-detects and over-detects in the dataset. When you press 'Apply Methods to Dataset', a table will appear below with the first 10 detection limit results, showing their initial values and estimated values."), + shiny::fluidRow(htmltools::h3( + "Handle Censored Data Using Simple Methods" + )), + shiny::fluidRow( + "Use the drop down menus below to pick a simple method for handling non-detects and over-detects in the dataset. When you press 'Apply Methods to Dataset', a table will appear below with the first 10 detection limit results, showing their initial values and estimated values." + ), htmltools::br(), shiny::fluidRow( - column(3, shiny::selectInput(ns("nd_method"), "Non-Detect Handling Method", choices = c("Multiply detection limit by x", "Random number between 0 and detection limit", "No change"), multiple = FALSE)), + column( + 3, + shiny::selectInput( + ns("nd_method"), + "Non-Detect Handling Method", + choices = nd_method_options, + multiple = FALSE + ) + ), column(3, shiny::uiOutput(ns("nd_mult"))), - column(3, shiny::selectInput(ns("od_method"), "Over-Detect Handling Method", choices = c("Multiply detection limit by x", "No change"), selected = "No change", multiple = FALSE)), + column( + 3, + shiny::selectInput( + ns("od_method"), + "Over-Detect Handling Method", + choices = od_method_options, + selected = "No change", + multiple = FALSE + ) + ), column(3, shiny::uiOutput(ns("od_mult"))) ), shiny::fluidRow( - column(3, shiny::actionButton(ns("apply_methods"), "Apply Methods to Dataset", style = "color: #fff; background-color: #337ab7; border-color: #2e6da4")), + column( + 3, + shiny::actionButton(ns("apply_methods"), "Apply Methods to Dataset", style = "color: #fff; background-color: #337ab7; border-color: #2e6da4") + ), column(3, shiny::uiOutput(ns("undo_methods"))) ), htmltools::br(), - shiny::fluidRow(column(12, DT::DTOutput(ns("see_det")))), + shiny::fluidRow(column(12, DT::DTOutput(ns( + "see_det" + )))), htmltools::br(), - shiny::fluidRow(htmltools::h3("Consider More Complex Censored Data Handling Methods")), - shiny::fluidRow("Use the picker list below to select grouping columns to create summary table. The summary table shows the number of non- and over-detects in each group, the total number of results in each group, the number of detection limit types (censoring levels) and the percentage of the dataset that is censored. These numbers are then used to suggest a potential statistical censored data method to use. Currently, the user must perform more complex analyses outside of TADAShiny."), + shiny::fluidRow( + htmltools::h3("Consider More Complex Censored Data Handling Methods") + ), + shiny::fluidRow( + "Use the picker list below to select grouping columns to create summary table. The summary table shows the number of non- and over-detects in each group, the total number of results in each group, the number of detection limit types (censoring levels) and the percentage of the dataset that is censored. These numbers are then used to suggest a potential statistical censored data method to use. Currently, the user must perform more complex analyses outside of TADAShiny." + ), htmltools::br(), shiny::fluidRow(shiny::wellPanel( - shiny::fluidRow(column(12, shiny::uiOutput(ns("cens_groups")))), - shiny::fluidRow(column(12, shiny::actionButton(ns("cens_sumbutton"), "ID and Summarize Censored Data", style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"))) + shiny::fluidRow(column(12, shiny::uiOutput( + ns("cens_groups") + ))), + shiny::fluidRow(column( + 12, + shiny::actionButton(ns("cens_sumbutton"), "ID and Summarize Censored Data", style = "color: #fff; background-color: #337ab7; border-color: #2e6da4") + )) )), shiny::fluidRow(DT::DTOutput(ns("cens_sumtable")), width = 600) ) @@ -48,10 +94,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) @@ -64,42 +112,105 @@ mod_censored_data_server <- function(id, tadat) { # paste0(length(dat$ResultIdentifier[dat$TADA.Remove==TRUE])," results were flagged for removal because they have conflicting, ambiguous and/or unfamiliar detection limits and conditions. These will show up in the pie chart, but only 'Non-Detect', 'Over-Detect', and 'Uncensored' results will be used in the sections below. You may download your dataset for review at any time using the 'Download Working Dataset' button at the bottom of the page.") # )) # } - censdat$dat <- 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 + censdat$dat <- + 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) piedat <- censdat$dat %>% dplyr::group_by(TADA.CensoredData.Flag) %>% dplyr::summarise(num = length(ResultIdentifier)) - piedat$Label <- paste0(piedat$TADA.CensoredData.Flag, " - ", scales::comma(piedat$num), " results") + piedat$Label <- + 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") + ggplot2::theme_void() + # remove background, grid, numeric labels - ggplot2::theme(plot.title = ggplot2::element_text(face = "bold", size = 18), legend.title = ggplot2::element_text(size = 16), legend.text = ggplot2::element_text(size = 14)) #+ + ggplot2::theme( + plot.title = ggplot2::element_text(face = "bold", size = 18), + legend.title = ggplot2::element_text(size = 16), + legend.text = ggplot2::element_text(size = 14) + ) #+ # 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({ if (input$nd_method == "Multiply detection limit by x") { - shiny::numericInput(ns("nd_mult"), "Multiplier (x)", value = 0.5, min = 0) + shiny::numericInput(ns("nd_mult"), + "Multiplier (x)", + value = 0.5, + 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({ if (input$od_method == "Multiply detection limit by x") { - shiny::numericInput(ns("od_mult"), "Multiplier (x)", value = 1, min = 0) + shiny::numericInput(ns("od_mult"), + "Multiplier (x)", + value = 1, + min = 0) } }) + + + # initialize global variables for saving/loading + + tadat$censor_applied = FALSE + shiny::observe({ + print("Something changed") + checkStatus("Before") + tadat$nd_method = input$nd_method + tadat$od_method = input$od_method + tadat$nd_mult = input$nd_mult + tadat$od_mult = input$od_mult + checkStatus("After") + }) + + shiny::observeEvent(tadat$load_file, { + if (!is.na(tadat$load_file)) { + print("Loading from progress file") + checkStatus("Before") + shiny::updateSelectInput(session, + "nd_method", + choices = nd_method_options, + selected = tadat$nd_method) + shiny::updateSelectInput(session, + "od_method", + choices = nd_method_options, + selected = tadat$od_method) + shiny::updateNumericInput(session, "nd_mult", value = tadat$nd_mult) + shiny::updateNumericInput(session, "od_mult", value = tadat$od_mult) + checkStatus("After") + } + }) + + checkStatus <- function(label){ + print(paste0(label, " status:")) + print(paste0("tadat$nd_method: ", tadat$nd_method)) + print(paste0("input$nd_method: ", input$nd_method)) + print(paste0("tadat$od_method: ", tadat$od_method)) + print(paste0("input$od_method: ", input$od_method)) + print(paste0("tadat$nd_mult: ", tadat$nd_mult)) + print(paste0("input$nd_mult: ", input$nd_mult)) + print(paste0("tadat$od_mult: ", tadat$od_mult)) + print(paste0("input$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( @@ -108,10 +219,21 @@ mod_censored_data_server <- function(id, tadat) { text = "Applying selected methods...", session = shiny::getDefaultReactiveDomain() ) - removed <- subset(tadat$raw, tadat$raw$TADA.Remove == TRUE) # first, remove results we dont want to handle at all - good <- subset(tadat$raw, tadat$raw$TADA.Remove == FALSE) # keep the "goods" that will be run through the simpleCensoredMethods function - trans <- data.frame(input = c("Multiply detection limit by x", "Random number between 0 and detection limit", "No change"), actual = c("multiplier", "randombelowlimit", "as-is")) - if (is.null(input$nd_mult)) { # these if's get the reactive inputs into a format that the TADA function will understand + removed <- + subset(tadat$raw, tadat$raw$TADA.Remove == TRUE) # first, remove results we dont want to handle at all + good <- + subset(tadat$raw, tadat$raw$TADA.Remove == FALSE) # keep the "goods" that will be run through the simpleCensoredMethods function + trans <- + data.frame( + input = c( + "Multiply detection limit by x", + "Random number between 0 and detection limit", + "No change" + ), + actual = c("multiplier", "randombelowlimit", "as-is") + ) + if (is.null(input$nd_mult)) { + # these if's get the reactive inputs into a format that the TADA function will understand nd_multiplier <- "null" } else { nd_multiplier <- input$nd_mult @@ -121,41 +243,81 @@ mod_censored_data_server <- function(id, tadat) { } else { od_multiplier <- input$od_mult } - good <- TADA::TADA_SimpleCensoredMethods(good, nd_method = trans$actual[trans$input == input$nd_method], nd_multiplier = nd_multiplier, od_method = trans$actual[trans$input == input$od_method], od_multiplier = od_multiplier) - tadat$raw <- plyr::rbind.fill(removed, good) # stitch good and removed datasets back together in tadat$raw + good <- + TADA::TADA_SimpleCensoredMethods( + good, + nd_method = trans$actual[trans$input == input$nd_method], + nd_multiplier = nd_multiplier, + od_method = trans$actual[trans$input == input$od_method], + od_multiplier = od_multiplier + ) + tadat$raw <- + plyr::rbind.fill(removed, good) # stitch good and removed datasets back together in tadat$raw tadat$raw <- TADA::TADA_OrderCols(tadat$raw) - + # create dataset displayed in table below - dat <- subset(good, good$TADA.CensoredData.Flag %in% c("Non-Detect", "Over-Detect")) - dat <- dat[, c("ResultIdentifier", "TADA.CharacteristicName", "TADA.DetectionQuantitationLimitMeasure.MeasureValue", "DetectionQuantitationLimitMeasure.MeasureUnitCode", "TADA.ResultMeasureValue", "TADA.ResultMeasure.MeasureUnitCode")] - dat <- dat %>% dplyr::rename("Estimated Detection Limit Value" = TADA.ResultMeasureValue, "Original Detection Limit Value" = TADA.DetectionQuantitationLimitMeasure.MeasureValue, "Original Unit" = DetectionQuantitationLimitMeasure.MeasureUnitCode, "Estimated Unit" = TADA.ResultMeasure.MeasureUnitCode) - censdat$exdat <- dat[1:10, ] # just show the first 10 records so user can see what happened to data + dat <- + subset(good, + good$TADA.CensoredData.Flag %in% c("Non-Detect", "Over-Detect")) + dat <- + dat[, c( + "ResultIdentifier", + "TADA.CharacteristicName", + "TADA.DetectionQuantitationLimitMeasure.MeasureValue", + "DetectionQuantitationLimitMeasure.MeasureUnitCode", + "TADA.ResultMeasureValue", + "TADA.ResultMeasure.MeasureUnitCode" + )] + dat <- + dat %>% dplyr::rename( + "Estimated Detection Limit Value" = TADA.ResultMeasureValue, + "Original Detection Limit Value" = TADA.DetectionQuantitationLimitMeasure.MeasureValue, + "Original Unit" = DetectionQuantitationLimitMeasure.MeasureUnitCode, + "Estimated Unit" = TADA.ResultMeasure.MeasureUnitCode + ) + 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 }) - + # 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 - tadat$raw$TADA.ResultMeasureValue <- ifelse(tadat$raw$TADA.ResultMeasureValueDataTypes.Flag == "Result Value/Unit Estimated from Detection Limit", tadat$raw$TADA.DetectionQuantitationLimitMeasure.MeasureValue, tadat$raw$TADA.ResultMeasureValue) # reset to detection quantitation limit value - 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$TADA.ResultMeasureValue <- + ifelse( + tadat$raw$TADA.ResultMeasureValueDataTypes.Flag == "Result Value/Unit Estimated from Detection Limit", + tadat$raw$TADA.DetectionQuantitationLimitMeasure.MeasureValue, + tadat$raw$TADA.ResultMeasureValue + ) # reset to detection quantitation limit value + 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 }) - + # creates a nice table showing an example of how censored data were changed. output$see_det <- DT::renderDT({ shiny::req(censdat$exdat) - DT::datatable(censdat$exdat[1:10, ], - options = list(dom = "t", scrollX = TRUE, pageLength = 10, searching = FALSE), - selection = "none", rownames = FALSE + DT::datatable( + censdat$exdat[1:10, ], + options = list( + dom = "t", + scrollX = TRUE, + pageLength = 10, + searching = FALSE + ), + selection = "none", + 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) @@ -168,34 +330,62 @@ mod_censored_data_server <- function(id, tadat) { "TADA.DetectionQuantitationLimitMeasure.MeasureValue", "DetectionQuantitationLimitMeasure.MeasureValue" )] # remove the columns that are generally unique to each result from consideration. Why would someone want to group by result value or identifier? Then every summary would be unique to one value...not a "summary" - tcols <- ccols[grepl("TADA.", ccols)] # put all of the TADA columns at the top of the selection drop down - ucols <- ccols[!grepl("TADA.", ccols)] # then have the WQP columns - ccols <- c(tcols, ucols) # string them back together in one vector used in the selection widget below - shiny::selectizeInput(ns("cens_groups"), + tcols <- + ccols[grepl("TADA.", ccols)] # put all of the TADA columns at the top of the selection drop down + ucols <- + ccols[!grepl("TADA.", ccols)] # then have the WQP columns + ccols <- + c(tcols, ucols) # string them back together in one vector used in the selection widget below + shiny::selectizeInput( + ns("cens_groups"), label = "Select Grouping Columns for Summarization", - choices = ccols, selected = c("TADA.ComparableDataIdentifier"), + choices = ccols, + selected = c("TADA.ComparableDataIdentifier"), 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) - censdat$summary <- summary[, !names(summary) %in% c("UpperFence", "LowerFence", "Min", "Max", "Mean", "Percentile_5th", "Percentile_10th", "Percentile_15th", "Percentile_25th", "Percentile_50th_Median", "Percentile_75th", "Percentile_85th", "Percentile_95th", "Percentile_98th")] + summary <- + TADA::TADA_Stats(censdat$dat, group_cols = input$cens_groups) + censdat$summary <- + summary[, !names(summary) %in% c( + "UpperFence", + "LowerFence", + "Min", + "Max", + "Mean", + "Percentile_5th", + "Percentile_10th", + "Percentile_15th", + "Percentile_25th", + "Percentile_50th_Median", + "Percentile_75th", + "Percentile_85th", + "Percentile_95th", + "Percentile_98th" + )] }) - + # creates summary table complete with csv button in case someone wants to # download the summary table output$cens_sumtable <- DT::renderDT({ - DT::datatable(censdat$summary, + DT::datatable( + censdat$summary, extensions = "Buttons", options = list( - dom = "Blftipr", scrollX = TRUE, - pageLength = 10, searching = FALSE, - order = list(list(length(input$cens_groups), "desc")), + dom = "Blftipr", + scrollX = TRUE, + pageLength = 10, + searching = FALSE, + order = list(list(length( + input$cens_groups + ), "desc")), buttons = c("csv") ), - selection = "none", rownames = FALSE + selection = "none", + rownames = FALSE ) }) }) diff --git a/R/mod_data_flagging.R b/R/mod_data_flagging.R index b9ab6c67e..a77bfb332 100644 --- a/R/mod_data_flagging.R +++ b/R/mod_data_flagging.R @@ -77,7 +77,7 @@ mod_data_flagging_server <- function(id, tadat) { # were excluded during the first step values <- shiny::reactiveValues() values$n_fails <- integer(length(n_switches)) - values$selected_flags <- character() + tadat$selected_flags <- character() # Runs when the flag button is clicked shiny::observeEvent(input$runFlags, { @@ -176,7 +176,13 @@ mod_data_flagging_server <- function(id, tadat) { shinyjs::enable(selector = '.nav li a[data-value="Review"]') }) + shiny::observeEvent(tadat$m2f, { + print("tadat$m2f changed") + updateRadioButtons(session, "m2f", selected=tadat$m2f) + }) + shiny::observeEvent(input$m2f, { + tadat$m2f <- input$m2f shiny::req(tadat$raw) if (input$m2f == "feet") { shinybusy::show_modal_spinner( diff --git a/R/mod_overview.R b/R/mod_overview.R index afb37398a..b8542d166 100644 --- a/R/mod_overview.R +++ b/R/mod_overview.R @@ -13,23 +13,49 @@ mod_overview_ui <- function(id) { ns <- NS(id) tagList( htmltools::h3("Data Overview"), - htmltools::HTML("Note: This page shows maps and figures using the original dataset uploaded to this TADAShiny session. If you'd like to see updated figures after working in other tabs, please press the 'Refresh' button."), + htmltools::HTML( + "Note: This page shows maps and figures using the original dataset uploaded to this TADAShiny session. If you'd like to see updated figures after working in other tabs, please press the 'Refresh' button." + ), htmltools::div(style = "margin-bottom:10px"), - shiny::fluidRow(column(3, shiny::actionButton(ns("refresh_overview"), "Refresh", shiny::icon("arrows-rotate"), style = "color: #fff; background-color: #337ab7; border-color: #2e6da4"))), + shiny::fluidRow(column( + 3, + shiny::actionButton( + ns("refresh_overview"), + "Refresh", + shiny::icon("arrows-rotate"), + style = "color: #fff; background-color: #337ab7; border-color: #2e6da4" + ) + )), htmltools::hr(), - shiny::fluidRow(column(12, shiny::wellPanel(shiny::htmlOutput(ns("overview_totals"))))), - htmltools::HTML("Your dataset, mapped: Zoom in and click on sites of interest. A pop up will appear that shows the number of measurements, characteristics, and visits at each site."), + shiny::fluidRow(column( + 12, shiny::wellPanel(shiny::htmlOutput(ns( + "overview_totals" + ))) + )), + htmltools::HTML( + "Your dataset, mapped: Zoom in and click on sites of interest. A pop up will appear that shows the number of measurements, characteristics, and visits at each site." + ), htmltools::br(), - shiny::fluidRow(column(12, shinycssloaders::withSpinner(leaflet::leafletOutput(ns("overview_map"), height = "500px")))), # "Larger point sizes represent more samples collected at a site; darker points represent more characteristics collected at a site. Click on a point to see the site ID, name, and sample/visit/parameter counts." + shiny::fluidRow(column( + 12, shinycssloaders::withSpinner(leaflet::leafletOutput(ns("overview_map"), height = "500px")) + )), + # "Larger point sizes represent more samples collected at a site; darker points represent more characteristics collected at a site. Click on a point to see the site ID, name, and sample/visit/parameter counts." htmltools::br(), shiny::fluidRow( - column(6, shiny::plotOutput(ns("overview_hist"), height = "500px")), # "This histogram shows sample collection frequency for all sites over the time period queried.", - column(6, shiny::plotOutput(ns("overview_barchar"), height = "600px")) + column(6, shiny::plotOutput(ns("overview_hist"), height = "500px")), + # "This histogram shows sample collection frequency for all sites over the time period queried.", + column(6, shiny::plotOutput(ns( + "overview_barchar" + ), height = "600px")) ), htmltools::h3("Organizations in dataset"), - htmltools::HTML("The table below shows the organizations that collected data in your dataset and the number of measurements collected by each. Notice the third column, 'Rank'. This editable column is present because sometimes organizations unintentionally upload the same dataset multiple times to the WQP. For example, USGS will collect data at the request of state agencies. The USGS 'copy' of the results is uploaded to NWIS and made available in the portal, and the state agency's 'copy' of the results is uploaded to WQX. This rank provides the necessary info needed to flag and select one representative result from groups of duplicative uploads based on date, characteristic and result value/unit, and proximity to other sites. Double click in a cell in the 'Rank' column to edit the hierarchy of organizations and Ctrl-Enter to save those changes in the table: the default ranks organizations by the number of measurements in the dataset. Using the state vs USGS data example, if the state agency's organization name has a higher rank (ex. ranked #1) than USGS (ex. ranked #2), its result will be selected over the USGS upload of the sample, and the USGS version will be flagged for removal."), + htmltools::HTML( + "The table below shows the organizations that collected data in your dataset and the number of measurements collected by each. Notice the third column, 'Rank'. This editable column is present because sometimes organizations unintentionally upload the same dataset multiple times to the WQP. For example, USGS will collect data at the request of state agencies. The USGS 'copy' of the results is uploaded to NWIS and made available in the portal, and the state agency's 'copy' of the results is uploaded to WQX. This rank provides the necessary info needed to flag and select one representative result from groups of duplicative uploads based on date, characteristic and result value/unit, and proximity to other sites. Double click in a cell in the 'Rank' column to edit the hierarchy of organizations and Ctrl-Enter to save those changes in the table: the default ranks organizations by the number of measurements in the dataset. Using the state vs USGS data example, if the state agency's organization name has a higher rank (ex. ranked #1) than USGS (ex. ranked #2), its result will be selected over the USGS upload of the sample, and the USGS version will be flagged for removal." + ), htmltools::div(style = "margin-bottom:10px"), - shiny::fluidRow(column(12, DT::DTOutput(ns("overview_orgtable"), height = "500px"))) + shiny::fluidRow(column(12, DT::DTOutput( + ns("overview_orgtable"), height = "500px" + ))) ) } @@ -39,24 +65,29 @@ 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, { req(tadat$raw) # create gray text tile info mapdat$text <- tadat$raw %>% dplyr::filter(TADA.Remove == FALSE) %>% - dplyr::select(ResultIdentifier, MonitoringLocationIdentifier, OrganizationFormalName, ActivityStartDate) + dplyr::select( + ResultIdentifier, + MonitoringLocationIdentifier, + OrganizationFormalName, + ActivityStartDate + ) # create summary info and binning for map orgs <- tadat$raw %>% dplyr::filter(TADA.Remove == FALSE) %>% dplyr::group_by(OrganizationFormalName, OrganizationIdentifier) %>% dplyr::summarise("Result_Count" = length(unique(ResultIdentifier))) %>% dplyr::ungroup() - mapdat$orgs <- orgs %>% + tadat$org_table <- orgs %>% dplyr::arrange(-Result_Count) %>% dplyr::mutate("Rank" = 1:length(Result_Count)) # get top 10 characteristics by result number in the dataset and place the rest in a group called "all others" @@ -64,82 +95,127 @@ mod_overview_server <- function(id, tadat) { dplyr::filter(TADA.Remove == FALSE) %>% dplyr::group_by(TADA.CharacteristicName) %>% dplyr::summarise("Result_Count" = length(unique(ResultIdentifier))) - topslice <- chars %>% dplyr::slice_max(order_by = Result_Count, n = 10) + topslice <- + chars %>% dplyr::slice_max(order_by = Result_Count, n = 10) bottomslice <- chars %>% dplyr::ungroup() %>% dplyr::filter(!TADA.CharacteristicName %in% topslice$TADA.CharacteristicName) %>% dplyr::select("Result_Count") %>% dplyr::summarise("Result_Count" = sum(Result_Count)) %>% dplyr::mutate("TADA.CharacteristicName" = "ALL OTHERS") - chars <- plyr::rbind.fill(topslice, bottomslice) %>% dplyr::filter(Result_Count > 0) - chars <- chars %>% dplyr::mutate(TADA.Chars = substr(TADA.CharacteristicName, 1, 22)) - chars$TADA.Chars <- ifelse(nchar(chars$TADA.CharacteristicName) > 22, paste0(chars$TADA.Chars, "..."), chars$TADA.Chars) - chars <- chars %>% dplyr::mutate(TADA.Chars = forcats::fct_reorder(TADA.Chars, Result_Count, .desc = TRUE)) + chars <- + plyr::rbind.fill(topslice, bottomslice) %>% dplyr::filter(Result_Count > 0) + chars <- + chars %>% dplyr::mutate(TADA.Chars = substr(TADA.CharacteristicName, 1, 22)) + chars$TADA.Chars <- + ifelse( + nchar(chars$TADA.CharacteristicName) > 22, + paste0(chars$TADA.Chars, "..."), + chars$TADA.Chars + ) + chars <- + chars %>% dplyr::mutate(TADA.Chars = forcats::fct_reorder(TADA.Chars, Result_Count, .desc = TRUE)) mapdat$chars <- chars tadat$ovgo <- NULL if (is.null(tadat$orgs)) { - tadat$orgs <- mapdat$orgs$OrganizationIdentifier + 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) - paste0("Your dataset contains ", scales::comma(length(unique(mapdat$text$ResultIdentifier))), " unique results from ", scales::comma(length(unique(mapdat$text$MonitoringLocationIdentifier))), " monitoring location(s) and ", scales::comma(length(unique(mapdat$text$OrganizationFormalName))), " unique organization(s).") + paste0( + "Your dataset contains ", + scales::comma(length( + unique(mapdat$text$ResultIdentifier) + )), + " unique results from ", + scales::comma(length( + unique(mapdat$text$MonitoringLocationIdentifier) + )), + " monitoring location(s) and ", + scales::comma(length( + unique(mapdat$text$OrganizationFormalName) + )), + " 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, ]) + TADA::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( - mapdat$orgs[, !names(mapdat$orgs) %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", "Results Count", "Rank - Double Click to Edit, Ctrl-Enter to Save"), - options = list(pageLength = length(unique(mapdat$orgs$OrganizationFormalName)), searching = FALSE, scrollY = TRUE), + colnames = c( + "Organization Name", + "Results Count", + "Rank - Double Click to Edit, Ctrl-Enter to Save" + ), + options = list( + pageLength = length(unique( + tadat$org_table$OrganizationFormalName + )), + searching = FALSE, + scrollY = TRUE + ), rownames = FALSE, selection = "none" ) - - # observe({ - # print("What did the two raindrops say to the third one? Two is company, but three is a cloud.") - # print(input$overview_orgtable_cell_edit) - # }) - + shiny::observeEvent(input$overview_orgtable_cell_edit, { - org_rank <- data.frame(OrganizationIdentifier = mapdat$orgs$OrganizationIdentifier, Rank = as.numeric(input$overview_orgtable_cell_edit$value)) %>% dplyr::arrange(Rank) - mapdat$orgs <- mapdat$orgs %>% - dplyr::select(-Rank) %>% - dplyr::left_join(org_rank) %>% - dplyr::arrange(Rank) - # mapdat$orgs = 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::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::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)), label = Result_Count), size = 5, color = "black") #+ + ggplot2::geom_text( + ggplot2::aes( + x = TADA.Chars, + y = Result_Count + (0.07 * max(Result_Count)), + label = Result_Count + ), + size = 5, + color = "black" + ) #+ }) - + shiny::observeEvent(input$refresh_overview, { shiny::req(mapdat$text) tadat$ovgo <- TRUE diff --git a/R/utils_track_progress.R b/R/utils_track_progress.R index 6241a7116..de874aeb1 100644 --- a/R/utils_track_progress.R +++ b/R/utils_track_progress.R @@ -28,32 +28,57 @@ trackMemory <- function(tadat, input) { writeFile <- function(tadat, filename) { job_id <- paste0("ts", format(Sys.time(), "%y%m%d%H%M%S")) - flagSwitches <- - dataSource <- tadat$dataSource + org_table <- tadat$org_table + dataSource <- tadat$dataSource dataSourceDesc <- tadat$dataSourceDesc selected_flags <- tadat$selected_flags + m2f <- tadat$m2f selected_filters <- tadat$selected_filters + nd_method <- tadat$nd_method + od_method <- tadat$od_method + nd_mult <- tadat$nd_mult + od_mult <- tadat$od_mult + print(nd_method) + print(nd_mult) + print(od_method) + print(od_mult) + save(job_id, + org_table, + m2f, dataSource, dataSourceDesc, selected_flags, selected_filters, + nd_method, + od_method, + nd_mult, + od_mult, file = filename) } readFile <- function(tadat, filename) { load(filename, verbose = TRUE) - + tadat$load_file = filename # Confirm compatibility #job_id = job_id #shinyjs::disable(selector = '.nav li a[data-value="Overview"]') - + + # Populate organizational rankings + if (!is.null(org_table)){ + tadat$org_table <- org_table + } + # Populate flags if (!is.null(selected_flags)){ tadat$selected_flags = selected_flags shinyjs::enable(selector = '.nav li a[data-value="Flag"]') } + if (!is.null(m2f)){ + tadat$m2f = m2f + } + # Populate filters if (!is.null(selected_filters)){ tadat$selected_filters = selected_filters @@ -62,9 +87,17 @@ readFile <- function(tadat, filename) { shinyjs::enable(selector = '.nav li a[data-value="Censored"]') shinyjs::enable(selector = '.nav li a[data-value="Review"]') -} + + # Censored data + tadat$nd_method = nd_method + tadat$nd_mult = nd_mult + tadat$od_method = od_method + tadat$od_mult = od_mult + } + + invalidFile <- function(trigger){ - print("EPIC FAIL") + print("Failure") print(trigger) }