reconfigured flagging page to populate table whenever flagging column…

…s are present, including in uploaded dataset
USEPA · Jan 10, 2024 · 70801d6 · 70801d6
1 parent ed85f5e
commit 70801d6
Show file tree

Hide file tree

Showing 9 changed files with 14,795 additions and 14,709 deletions.
diff --git a/R/app_server.R b/R/app_server.R
@@ -35,6 +35,7 @@ app_server <- function(input, output, session) {
   # switch that indicates when a file is being loaded
   tadat$load_progress_file = NA
   tadat$save_progress_file = NA
+  tadat$flags_present = FALSE
   job_id = paste0("ts", format(Sys.time(), "%y%m%d%H%M%S"))
   tadat$default_outfile = paste0("tada_output_", job_id)
   tadat$job_id = job_id

diff --git a/R/mod_data_flagging.R b/R/mod_data_flagging.R
@@ -38,7 +38,7 @@ mod_data_flagging_ui <- function(id) {
         ns("m2f"),
         label = "",
         choices = c("feet", "inches", "meters"),
-        selected = character(0),
+        selected = "meters",
         inline = TRUE
       )
     ))
@@ -54,7 +54,7 @@ mod_data_flagging_server <- function(id, tadat) {
     tadat$selected_flags <- character()
     tadat$switch_defaults <- prompt_table$Level != "Optional"
     switch_disabled <- prompt_table$Level == "Required"
-
+    
     flagSwitch <- function(len) {
       inputs <- character(len)
       for (i in seq_len(len)) {
@@ -80,28 +80,26 @@ mod_data_flagging_server <- function(id, tadat) {
       unlist(lapply(seq_len(len), function(i) {
         value <- input[[paste0(id, i)]]
         if (is.null(value)) {
-          TRUE
+          FALSE
         } else {
           value
         }
       }))
     }
 
-
-
-
     # Runs whenever selected flags are changed
     shiny::observeEvent(tadat$selected_flags, {
-      prefix = "Flag: "
+      print(paste0("Selected flags changed. ", length(tadat$selected_flags), " flags selected"))
+
       if (!is.null(tadat$removals)) {
-        tadat$removals = dplyr::select(tadat$removals,-(dplyr::starts_with(prefix)))
+        tadat$removals = dplyr::select(tadat$removals, -(dplyr::starts_with(flag_prefix)))
       }
       # Loop through the flags
       for (flag in tadat$selected_flags) {
         # If not all the values are NA, add the test results to removals
         if (!is.null(tadat$removals)) {
           if (!all(is.na(values$testResults[flag]))) {
-            tadat$removals[paste0(prefix, flag)] = values$testResults[flag]
+            tadat$removals[paste0(flag_prefix, flag)] = values$testResults[flag]
           }
         }
         # If the switch corresponding to this flag isn't on, switch it on
@@ -121,6 +119,69 @@ mod_data_flagging_server <- function(id, tadat) {
       }
     })
 
+    # Any time tadat$raw is changed, check to see if the flagging fields are present
+    shiny::observeEvent(tadat$raw, {
+      tadat$flags_present = checkFlagColumns(tadat$raw)
+    })
+
+    shiny::observeEvent(tadat$flags_present, {
+      if (tadat$flags_present) {
+        # A table (raw rows, flags) indicating whether each record passes each test
+        values$testResults <- flagCensus(tadat$raw)
+
+        # The number of records failing each test
+        values$n_fails <- colSums(values$testResults)
+
+        # Runs when any of the flag switches are changed
+        shiny::observe({
+          switch_id = "switch_"
+          tadat$selected_flags = flag_types[shinyValue(switch_id, n_switches)]
+          for (i in which(switch_disabled)) {
+            shinyjs::disable(paste0(switch_id, i))
+          }
+        })
+
+        switchTable <- shiny::reactive({
+          df <- data.frame(
+            Reason = prompts,
+            Results = values$n_fails,
+            Required = levs,
+            Decision = flagSwitch(n_switches)
+          )
+        })
+
+        output$flagTable <- DT::renderDT(
+          shiny::isolate(switchTable()),
+          escape = FALSE,
+          selection = "none",
+          colnames = c(
+            "Flag reason",
+            "Results affected",
+            "Required/Optional",
+            "Switch 'on' to flag for removal"
+          ),
+          rownames = FALSE,
+          options = list(
+            dom = "t",
+            paging = FALSE,
+            ordering = FALSE,
+            preDrawCallback = DT::JS(
+              "function() { Shiny.unbindAll(this.api().table().node()); }"
+            ),
+            drawCallback = DT::JS(
+              "function() { Shiny.bindAll(this.api().table().node()); } "
+            )
+          )
+        )
+
+        shinyjs::enable(selector = '.nav li a[data-value="Filter"]')
+        shinyjs::enable(selector = '.nav li a[data-value="Censored"]')
+        shinyjs::enable(selector = '.nav li a[data-value="Harmonize"]')
+        shinyjs::enable(selector = '.nav li a[data-value="Figures"]')
+        shinyjs::enable(selector = '.nav li a[data-value="Review"]')
+      }
+    })
+
     # Runs when the flag button is clicked
     shiny::observeEvent(input$runFlags, {
       shinybusy::show_modal_spinner(
@@ -129,68 +190,16 @@ 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
 
-      # 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)
+      # 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
 
       # Remove progress bar and display instructions
       shinybusy::remove_modal_spinner(session = shiny::getDefaultReactiveDomain())
 
-      # Runs when any of the flag switches are changed
-      shiny::observe({
-        switch_id = "switch_"
-        tadat$selected_flags = flag_types[shinyValue(switch_id, n_switches)]
-        for (i in which(switch_disabled)) {
-          shinyjs::disable(paste0(switch_id, i))
-        }
-      })
-
-      switchTable <- shiny::reactive({
-        df <- data.frame(
-          Reason = prompts,
-          Results = values$n_fails,
-          Required = levs,
-          Decision = flagSwitch(n_switches)
-        )
-      })
-
-      output$flagTable <- DT::renderDT(
-        shiny::isolate(switchTable()),
-        escape = FALSE,
-        selection = "none",
-        colnames = c(
-          "Flag reason",
-          "Results affected",
-          "Required/Optional",
-          "Switch 'on' to flag for removal"
-        ),
-        rownames = FALSE,
-        options = list(
-          dom = "t",
-          paging = FALSE,
-          ordering = FALSE,
-          preDrawCallback = DT::JS(
-            "function() { Shiny.unbindAll(this.api().table().node()); }"
-          ),
-          drawCallback = DT::JS(
-            "function() { Shiny.bindAll(this.api().table().node()); } "
-          )
-        )
-      )
-      shinyjs::enable(selector = '.nav li a[data-value="Filter"]')
-      shinyjs::enable(selector = '.nav li a[data-value="Censored"]')
-      shinyjs::enable(selector = '.nav li a[data-value="Harmonize"]')
-      shinyjs::enable(selector = '.nav li a[data-value="Figures"]')
-      shinyjs::enable(selector = '.nav li a[data-value="Review"]')
     })
 
     shiny::observeEvent(tadat$m2f, {
@@ -233,4 +242,4 @@ mod_data_flagging_server <- function(id, tadat) {
       shinybusy::remove_modal_spinner(session = shiny::getDefaultReactiveDomain())
     })
   })
-}
+}
diff --git a/R/mod_query_data.R b/R/mod_query_data.R
@@ -218,15 +218,25 @@ mod_query_data_server <- function(id, tadat) {
     ns <- session$ns
 
     # read in the excel spreadsheet dataset if this input reactive object is populated via fileInput and define as tadat$raw
-    shiny::observe({
-      shiny::req(input$file)
+    shiny::observeEvent(input$file,{
+      # a modal that pops up showing it's working on querying the portal
+      shinybusy::show_modal_spinner(
+        spin = "double-bounce",
+        color = "#0071bc",
+        text = "Uploading dataset...",
+        session = shiny::getDefaultReactiveDomain()
+      )
+
       # user uploaded data
       raw <-
         suppressWarnings(readxl::read_excel(input$file$datapath, sheet = 1))
       initializeTable(tadat, raw)
       if (!is.null(tadat$original_source)){
         tadat$original_source <- "Upload"
       }
+
+      shinybusy::remove_modal_spinner(session = shiny::getDefaultReactiveDomain())
+
     })
 
     # Read the TADA progress file
@@ -238,6 +248,14 @@ mod_query_data_server <- function(id, tadat) {
 
     # if user presses example data button, make tadat$raw the nutrients dataset contained within the TADA package.
     shiny::observeEvent(input$example_data_go, {
+      # a modal that pops up showing it's working on querying the portal
+      shinybusy::show_modal_spinner(
+        spin = "double-bounce",
+        color = "#0071bc",
+        text = "Loading example data...",
+        session = shiny::getDefaultReactiveDomain()
+      )
+
       tadat$example_data <- input$example_data
       if (input$example_data == "Shepherdstown (34k results)") {
         raw <- TADA::Data_NCTCShepherdstown_HUC12
@@ -249,6 +267,9 @@ mod_query_data_server <- function(id, tadat) {
         raw <- TADA::Data_Nutrients_UT
       }
       initializeTable(tadat, raw)
+
+      shinybusy::remove_modal_spinner(session = shiny::getDefaultReactiveDomain())
+
     })
 
     # this section has widget update commands for the selectizeinputs that have a lot of possible selections - shiny suggested hosting the choices server-side rather than ui-side

diff --git a/R/mod_review_data.R b/R/mod_review_data.R
@@ -43,7 +43,6 @@ mod_review_data_server <- function(id, tadat) {
     shiny::observeEvent(input$review_go, {
       removals <- tadat$removals
       sel <- which(removals == TRUE, arr.ind = TRUE)
-      print(length(sel))
       # Bombing here
       if (length(sel) > 0) {
         removals[sel] <- names(removals)[sel[, "col"]]

diff --git a/R/sandbox.R b/R/sandbox.R
@@ -0,0 +1,4 @@
+a = c(1, 2, 3, 4, 5)
+print(a)
+a = 7
+print(a)