v2.0.0.9126

* fix: Update app BCG calculation for cases where have no flags
leppott · Dec 7, 2023 · 5d78b18 · 5d78b18
1 parent 69cf5db
commit 5d78b18
Show file tree

Hide file tree

Showing 7 changed files with 92 additions and 48 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: BCGcalc
 Type: Package
 Title: Biological Condition Gradient, calculator
-Version: 2.0.0.9125
+Version: 2.0.0.9126
 Authors@R: c(
   person("Erik W.", "Leppo", email="Erik.Leppo@tetratech.com", role=c("aut","cre")), 
   person("Jen", "Stamp", email="Jen.Stamp@tetratech.com", role="ctb"),

diff --git a/NEWS b/NEWS
@@ -1,11 +1,15 @@
 BCGcalc-NEWS
 ================
 <Erik.Leppo@tetratech.com>
-2023-12-06 17:24:31.591232
+2023-12-07 10:21:20.730164
 
 <!-- NEWS.md is generated from NEWS.Rmd. Please edit that file -->
 
-    #> Last Update: 2023-12-06 17:24:31.645299
+    #> Last Update: 2023-12-07 10:21:20.763828
+
+# BCGcalc 2.0.0.9126 (2023-12-07)
+
+- fix: Update app BCG calculation for cases where have no flags
 
 # BCGcalc 2.0.0.9125 (2023-12-06)
 

diff --git a/NEWS.md b/NEWS.md
@@ -1,11 +1,15 @@
 BCGcalc-NEWS
 ================
 <Erik.Leppo@tetratech.com>
-2023-12-06 17:24:31.591232
+2023-12-07 10:21:20.730164
 
 <!-- NEWS.md is generated from NEWS.Rmd. Please edit that file -->
 
-    #> Last Update: 2023-12-06 17:24:31.645299
+    #> Last Update: 2023-12-07 10:21:20.763828
+
+# BCGcalc 2.0.0.9126 (2023-12-07)
+
+- fix: Update app BCG calculation for cases where have no flags
 
 # BCGcalc 2.0.0.9125 (2023-12-06)
 

diff --git a/NEWS.rmd b/NEWS.rmd
@@ -21,6 +21,10 @@ knitr::opts_chunk$set(
 cat(paste0("Last Update: ",Sys.time()))
 ```
 
+# BCGcalc 2.0.0.9126 (2023-12-07)
+
+* fix: Update app BCG calculation for cases where have no flags
+
 # BCGcalc 2.0.0.9125 (2023-12-06)
 
 * fix: Update MN fish metric names (trout) to be more specific

diff --git a/inst/shiny-examples/BCGcalc/external/RMD_Results/Results_BCG_Summary.Rmd b/inst/shiny-examples/BCGcalc/external/RMD_Results/Results_BCG_Summary.Rmd
@@ -22,7 +22,7 @@ cat("**Filename:** ", inFile$name, "\n\n", sep = "")
 
 ```{r plot}
 # use results before trimmed L1:6
-df_plot <- df_lev_flags 
+df_plot <- df_levassign 
 alpha_rect <- 0.25
 plot_mean <- mean(df_plot$Primary_BCG_Level)
 

diff --git a/inst/shiny-examples/BCGcalc/global.R b/inst/shiny-examples/BCGcalc/global.R
@@ -1,7 +1,7 @@
 # Shiny Global File
 
 # Version ----
-pkg_version <- "2.0.0.9125"
+pkg_version <- "2.0.0.9126"
 
 # Packages----
 # nolint start

diff --git a/inst/shiny-examples/BCGcalc/server.R b/inst/shiny-examples/BCGcalc/server.R
@@ -2405,56 +2405,88 @@ shinyServer(function(input, output) {
       incProgress(1/prog_n, detail = prog_detail)
       Sys.sleep(prog_sleep)
 
-      # Calc
-      # df_checks loaded in global.R
-      df_flags <- BioMonTools::qc.checks(df_metval, df_checks)
-      # Change terminology; PASS/FAIL to NA/flag
-      df_flags[, "FLAG"][df_flags[, "FLAG"] == "FAIL"] <- "flag"
-      df_flags[, "FLAG"][df_flags[, "FLAG"] == "PASS"] <- NA
-      # long to wide format
-      df_flags_wide <- reshape2::dcast(df_flags
-                                       , SAMPLEID ~ CHECKNAME
-                                       , value.var = "FLAG")
-      # Calc number of "flag"s by row.
-      df_flags_wide$NumFlags <- rowSums(df_flags_wide == "flag", na.rm = TRUE)
-      # Rearrange columns
-      NumCols <- ncol(df_flags_wide)
-      df_flags_wide <- df_flags_wide[, c(1, NumCols, 2:(NumCols - 1))]
-      # Merge Levels and Flags
-      df_lev_flags <- merge(df_levassign
-                            , df_flags_wide
-                            , by.x = "SampleID"
-                            , by.y = "SAMPLEID"
-                            , all.x = TRUE)
-      # Summarize Flags
-      df_lev_flags_summ <- as.data.frame.matrix(table(df_flags[, "CHECKNAME"]
-                                                      , df_flags[, "FLAG"]
-                                                      , useNA = "ifany"))
+      # 2023-12-06
+      # Split if no flags so doesn't crash
+
+      # Check if Flags exist for data
+      col_index_metval <- c("INDEX_NAME", "INDEX_CLASS")
+      col_index_checks <- c("Index_Name", "INDEX_CLASS")
+      index_metval <- unique(df_metval[, col_index_metval])
+      index_checks <- unique(df_checks[, col_index_checks])
+      index_merge <- merge(index_metval, index_checks
+                           , by.x = col_index_metval
+                           , by.y = col_index_checks)
+
+      if (nrow(index_merge) == 0) {
+
+        # create dummy files
+        str_nodata <- "No flags for the Index Name/Class combinations present in data"
+        # Flags
+        df_flags <- data.frame(x = str_nodata
+                               , CHECKNAME = "No Flags"
+                               , FLAG = NA)
+        df_lev_flags <- df_levassign
+        # Flags Summary
+        df_lev_flags_summ <- data.frame(x = str_nodata)
+        # Results
+        df_results <- data.frame(x = str_nodata)
+        # Flag Metrics
+        df_metflags <- data.frame(x = str_nodata)
+
+      } else {
+
+        # Calc
+        # df_checks loaded in global.R
+        df_flags <- BioMonTools::qc.checks(df_metval, df_checks)
+        # Change terminology; PASS/FAIL to NA/flag
+        df_flags[, "FLAG"][df_flags[, "FLAG"] == "FAIL"] <- "flag"
+        df_flags[, "FLAG"][df_flags[, "FLAG"] == "PASS"] <- NA
+        # long to wide format
+        df_flags_wide <- reshape2::dcast(df_flags
+                                         , SAMPLEID ~ CHECKNAME
+                                         , value.var = "FLAG")
+        # Calc number of "flag"s by row.
+        df_flags_wide$NumFlags <- rowSums(df_flags_wide == "flag", na.rm = TRUE)
+        # Rearrange columns
+        NumCols <- ncol(df_flags_wide)
+        df_flags_wide <- df_flags_wide[, c(1, NumCols, 2:(NumCols - 1))]
+        # Merge Levels and Flags
+        df_lev_flags <- merge(df_levassign
+                              , df_flags_wide
+                              , by.x = "SampleID"
+                              , by.y = "SAMPLEID"
+                              , all.x = TRUE)
+        # Flags Summary
+        df_lev_flags_summ <- as.data.frame.matrix(table(df_flags[, "CHECKNAME"]
+                                                        , df_flags[, "FLAG"]
+                                                        , useNA = "ifany"))
+        # Results
+        df_results <- df_lev_flags[, !names(df_lev_flags) %in% c(paste0("L", 1:6))]
+        ## remove L1:6
+
+        # Flag Metrics
+        col2keep_metflags <- c("SAMPLEID", "INDEX_NAME", "INDEX_CLASS"
+                               , "METRIC_NAME", "CHECKNAME", "METRIC_VALUE"
+                               , "SYMBOL", "VALUE", "FLAG")
+        df_metflags <- df_flags[, col2keep_metflags]
+
+      }## IF ~ check for matching index name and class
 
-      # Save Flags Summary
-      fn_levflags <- paste0(fn_abr_save, "6levflags.csv")
+
+      # Save, Flags Summary
+      fn_levflags <- paste0(fn_input_base, fn_abr_save, "6levflags.csv")
       dn_levflags <- path_results_sub
       pn_levflags <- file.path(dn_levflags, fn_levflags)
       write.csv(df_lev_flags_summ, pn_levflags, row.names = TRUE)
 
-      # Create Results
-      df_results <- df_lev_flags[, !names(df_lev_flags) %in% c(paste0("L", 1:6))]
-      ## remove L1:6
-
-      # Save Results
-      fn_results <- paste0("_", fn_abr_save, "RESULTS.csv")
+      # Save, Results
+      fn_results <- paste0(fn_input_base, fn_abr_save, "RESULTS.csv")
       dn_results <- path_results_sub
       pn_results <- file.path(dn_results, fn_results)
       write.csv(df_results, pn_results, row.names = FALSE)
 
-
-      ## Calc, 8b, QC Flag Metrics ----
-      # create
-      col2keep <- c("SAMPLEID", "INDEX_NAME", "INDEX_CLASS", "METRIC_NAME"
-                    , "CHECKNAME", "METRIC_VALUE", "SYMBOL", "VALUE", "FLAG")
-      df_metflags <- df_flags[, col2keep]
-      # save
-      fn_metflags <- paste0(fn_abr_save, "6metflags.csv")
+      # Save, Flag Metrics
+      fn_metflags <- paste0(fn_input_base, fn_abr_save, "6metflags.csv")
       dn_metflags <- path_results_sub
       pn_metflags <- file.path(dn_metflags, fn_metflags)
       write.csv(df_metflags, pn_metflags, row.names = FALSE)