Merge pull request bcgov#36 from poissonconsulting/main

Add your own data and other upgrades
poissonconsulting · Dec 11, 2023 · ac0c880 · ac0c880
2 parents 17f0f81 + a3b5a2c
commit ac0c880
Show file tree

Hide file tree

Showing 21 changed files with 586 additions and 400 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: shinywqbench
 Title: R Shiny App to Calculates Aquatic Life Benchmarks
-Version: 0.1.0.9000
+Version: 0.2.0
 Authors@R: c(
     person("Ayla", "Pearson", , "[email protected]", role = "aut",
            comment = c(ORCID = "0000-0001-7388-1222")),
@@ -16,8 +16,9 @@ Description: This package is the user interface to the wqbench R package
     compute the aquatic life water quality benchmark for a compound.
 License: Apache License (== 2)
 Depends: 
-    R (>= 2.10)
+    R (>= 4.1)
 Imports: 
+    chk,
     dplyr,
     DT,
     ggplot2,
@@ -30,6 +31,7 @@ Imports:
     shiny,
     shinyjs,
     stringr,
+    tidyr,
     utils,
     waiter,
     wqbench,

diff --git a/NEWS.md b/NEWS.md
@@ -1,8 +1,24 @@
-<!-- NEWS.md is maintained by https://cynkra.github.io/fledge, do not edit -->
+<!-- NEWS.md is maintained by https://fledge.cynkra.com, contributors should not edit this file -->
 
-# shinywqbench (development version)
+# shinywqbench 0.2.0 (2023-12-07)
 
-- Updating title, adding instructions to data tab, updating user and about tabs
+### New feature
+
+- Ability to add your own data by uploading a file. 
+
+### Major changes 
+
+- Updated data in app to the Ecotox Sept 2023 data set.
+- Number of bootstrap samples is 1000 (for SSD method). 
+
+### Minor improvements and bug fixes
+
+- Added number of bootstrap samples to tab 2.2 and pdf report when the method is SSD.	
+- Column order changes in tab 1.1 (displayed and download table).
+- Switched block/stop on generating guideline to second tab when the chemical already has a BC wqg.
+- Updated naming to be Review instead of Raw.
+- Added hyperlink to write up in about and user guide tab.
+- BC gov style added. 
 
 # shinywqbench 0.1.0
 

diff --git a/R/app-ui.R b/R/app-ui.R
@@ -20,7 +20,10 @@ app_ui <- function() {
     shinyjs::useShinyjs(),
     waiter::useWaiter(),
     navbarPage(
-      title = "Emergent Contaminant Aquatic Life Benchmarks - DRAFT",
+      title = div(
+        img(src = "../images/gov3_bc_logo.png", style = "padding-right: 20px;"),
+        "Emerging Contaminant Aquatic Life Benchmarks - DRAFT"
+      ),
       selected = "tab1",
       id = "navbarID",
       tabPanel(
@@ -51,6 +54,10 @@ app_ui <- function() {
         title = "User Guide",
         mod_user_ui("mod_user_ui")
       )
+    ),
+    div(
+      class = "footer",
+      includeHTML("www/footer.html")
     )
   )
 }
diff --git a/R/css.R b/R/css.R
@@ -14,7 +14,7 @@
 
 add_external_resources <- function() {
   addResourcePath("www", system.file("app/www", package = "shinywqbench"))
-  tagList(tags$link(rel = "stylesheet", type = "text/css", href = "www/style.css"))
+  tagList(tags$link(rel = "stylesheet", type = "text/css", href = "www/bcgov.css"))
 }
 
 css_styling <- function() {
@@ -29,6 +29,17 @@ css_styling <- function() {
       padding: 0.3em;
       padding-right: 1em;
     }
+  
+    .container-fluid {
+      margin-top: 10px;
+    }
+  
+    .navbar-nav {
+      float: right;
+      margin-bottom: 0;
+      margin-right: 20px !important;
+    }
+  
   "
   tags$style(css_text, type = "text/css")
 }
diff --git a/R/functions.R b/R/functions.R
@@ -150,12 +150,26 @@ filter_data_raw_dl <- function(data) {
   data <-
     data |>
     dplyr::select(
-      "chemical_name", "cas",
-      "latin_name", "common_name", "endpoint", "effect", "effect_conc_mg.L",
-      "lifestage", "duration_hrs", "duration_class", "effect_conc_std_mg.L",
-      "acr", "media_type", "trophic_group", "ecological_group",
+      "chemical_name", 
+      "cas",
+      "common_name", 
+      "latin_name", 
+      "endpoint", 
+      "effect", 
+      "lifestage",
+      "effect_conc_mg.L",
+      "effect_conc_std_mg.L", 
+      "trophic_group", 
+      "ecological_group",
       "species_present_in_bc",
-      "author", "title", "source", "publication_year",
+      "duration_hrs", 
+      "duration_class", 
+      "acr", 
+      "media_type", 
+      "author", 
+      "title", 
+      "source", 
+      "publication_year",
       "ecotox_download_date" = "download_date",
       "ecotox_version" = "version"
     )
@@ -174,3 +188,30 @@ filter_data_agg_dl <- function(data) {
     )
   data
 }
+
+# Upload Data -----
+is_try_error <- function(x) inherits(x, "try-error")
+
+check_modal <- function(check, title = "Please fix the following issue ...") {
+  msg <- stringr::str_replace(check[1], "^Error\\s*.*[:]", "")
+  msg <- gsub("Error : ", "", msg)
+  modalDialog(
+    paste(msg),
+    title = title,
+    footer = modalButton("Got it")
+  )
+}
+
+check_upload <- function(x, ext = "csv") {
+  if (is.null(x)) {
+    chk::abort_chk("A file needs to be uploaded before it can be added.")
+  }
+  if (!any(stringr::str_detect(x, ext))) {
+    ext <- paste0(ext, collapse = " or ")
+    chk::abort_chk(
+      "We're not sure what to do with that file type. Please upload a ",
+      ext,
+      " file."
+    )
+  }
+}
diff --git a/R/mod-bench.R b/R/mod-bench.R
@@ -48,6 +48,7 @@ mod_bench_ui <- function(id, label = "bench") {
             h5(uiOutput(ns("ui_text_2"))),
             uiOutput(ns("ui_table_trophic_groups")),
             uiOutput(ns("ui_text_3")),
+            uiOutput(ns("ui_text_3_1")),
             br(),
             uiOutput(ns("ui_text_4")),
             uiOutput(ns("ui_table_bench")),
@@ -80,6 +81,7 @@ mod_bench_server <- function(id, ext) {
         cas = NULL,
         fit = NULL,
         bench = NULL,
+        nboot = 1000,
         gp_results = NULL,
         bench_display = NULL,
         raw = NULL,
@@ -93,6 +95,36 @@ mod_bench_server <- function(id, ext) {
       w <- waiter_data("Running model for selected chemical ...")
 
       observeEvent(input$benchmark, {
+        # Don't allow value to be generated if already present
+        guideline_present <- cname |>
+          dplyr::filter(.data$cas_number == ext$chem_check) |>
+          dplyr::select("present_in_bc_wqg") |>
+          dplyr::pull()
+
+        if (guideline_present) {
+          chem_msg <- ext$chem_check
+
+          return(
+            showModal(
+              modalDialog(
+                div(
+                  paste(
+                    cname$chemical_name[cname$cas_number == chem_msg],
+                    "has a guideline present. To look up this guideline go to the"
+                  ),
+                  tags$a(
+                    "BC Water Quality Guideline Look-up App",
+                    target = "_blank",
+                    href = "https://www2.gov.bc.ca/gov/content/environment/air-land-water/water/water-quality/water-quality-guidelines/approved-water-quality-guidelines",
+                    target = "_blank"
+                  )
+                ),
+                footer = modalButton("Got it")
+              )
+            )
+          )
+        }
+
         w$show()
         rv$raw <- ext$data
         rv$selected <- ext$selected
@@ -115,7 +147,11 @@ mod_bench_server <- function(id, ext) {
           rv$gp_results <- wqbench::wqb_plot_det(rv$agg_af)
         } else {
           rv$fit <- wqbench::wqb_ssd_fit(rv$agg_af)
-          rv$bench <- wqbench::wqb_method_ssd(rv$agg_af, rv$fit)
+          rv$bench <- wqbench::wqb_method_ssd(
+            rv$agg_af, 
+            rv$fit, 
+            nboot = rv$nboot
+          )
           rv$gp_results <- wqbench::wqb_plot_ssd(rv$agg_af, rv$fit)
         }
 
@@ -211,6 +247,22 @@ mod_bench_server <- function(id, ext) {
         text_output(ns("text_3"))
       })
 
+      output$text_3_1 <- renderText({
+        req(rv$method)
+        if (rv$method == "SSD") {
+          paste(
+            "Number of bootstrap samples: ", rv$nboot
+          )
+        } else {
+          paste("")
+        }
+      })
+
+      output$ui_text_3_1 <- renderUI({
+        req(rv$bench)
+        htmlOutput(ns("text_3_1"))
+      })
+
       output$text_4 <- renderText({
         paste("Critical Toxicity Value (HC<sub>5</sub> if method is SSD):")
       })
@@ -281,7 +333,7 @@ mod_bench_server <- function(id, ext) {
         req(rv$bench)
         htmlOutput(ns("text_8"))
       })
-
+      
       output$download_data_bench <- renderUI({
         req(rv$cas, rv$bench, rv$af_table)
         download_button(ns("dl_data_bench"))