v2.0.7.9025

* refactor: QC function to move QC columns, Issue #154 + Flag. and Comment.MOD cols next to measurement columns + Ignore Date, Time, and Date.Time
leppott · Jan 25, 2024 · 1dd6106 · 1dd6106
1 parent 5022620
commit 1dd6106
Show file tree

Hide file tree

Showing 9 changed files with 446 additions and 23 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: ContDataQC
 Title: Quality Control (QC) of Continous Monitoring Data
-Version: 2.0.7.9024
+Version: 2.0.7.9025
 Authors@R: c(
 	person("Erik W", "Leppo", email="[email protected]",role=c("aut","cre")),
 	person("Ann","Roseberry Lincoln", role="ctb"),
@@ -42,5 +42,5 @@ Remotes:
     tsangyp/StreamThermal,
     jasonelaw/iha
 StagedInstall: no
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.0
 Config/testthat/edition: 3
diff --git a/NEWS b/NEWS
@@ -3,10 +3,24 @@ NEWS-ContDataQC
 
 <!-- NEWS.md is generated from NEWS.Rmd. Please edit that file -->
 
-    #> Last Update: 2023-09-22 16:14:21.634179
+    #> Last Update: 2024-01-25 12:04:12.540163
 
 # Version History
 
+## v2.0.7.9025
+
+2024-01-25
+
+- refactor: QC function to move QC columns, Issue \#154
+  - Flag. and Comment.MOD cols next to measurement columns
+  - Ignore Date, Time, and Date.Time
+
+## v2.0.7.9024
+
+2023-09-28
+
+- refactor: Use USEPA template
+
 ## v2.0.7.9023
 
 2023-09-18

diff --git a/NEWS.md b/NEWS.md
@@ -3,10 +3,18 @@ NEWS-ContDataQC
 
 <!-- NEWS.md is generated from NEWS.Rmd. Please edit that file -->
 
-    #> Last Update: 2023-09-28 11:06:45.427073
+    #> Last Update: 2024-01-25 12:04:12.540163
 
 # Version History
 
+## v2.0.7.9025
+
+2024-01-25
+
+- refactor: QC function to move QC columns, Issue \#154
+  - Flag. and Comment.MOD cols next to measurement columns
+  - Ignore Date, Time, and Date.Time
+
 ## v2.0.7.9024
 
 2023-09-28

diff --git a/NEWS.rmd b/NEWS.rmd
@@ -21,6 +21,13 @@ cat(paste0("Last Update: ",Sys.time()))
 
 # Version History
 
+## v2.0.7.9025
+2024-01-25
+
+* refactor: QC function to move QC columns, Issue #154
+    + Flag. and Comment.MOD cols next to measurement columns
+    + Ignore Date, Time, and Date.Time
+
 ## v2.0.7.9024
 2023-09-28
 

diff --git a/R/fun.QC.File.R b/R/fun.QC.File.R
@@ -91,6 +91,7 @@ fun.QC.File <- function(fun.myFile
                        , fun.CreateReport = TRUE
                        , fun.AddDeployCol = FALSE
                        ) {##FUN.fun.QC.START
+  boo_DEBUG <- FALSE
   #
   # # A. Data Prep ####
   # # Convert Data Type to proper case
@@ -1188,7 +1189,198 @@ fun.QC.File <- function(fun.myFile
 #     data.import[,paste(myName.Raw,j,sep=".")] <- data.import[,j]
     #
     # 6-9 #not here
-    #
+
+    # B.5.1. Move "Comment.MOD" next to "Flag" ----
+    # 2024-01-22
+    boo_move_CM <- TRUE
+    if (boo_move_CM) {
+      # boo_DEBUG <- FALSE
+
+      patt_flag_env <- ContData.env$myName.Flag
+      patt_flag     <- paste0("^", patt_flag_env, ".")
+      patt_cm_env   <- "Comment.MOD"
+      patt_cm       <-  paste0("^", patt_cm_env, ".")
+      patt_datetime <- c(ContData.env$myName.Date
+                         , ContData.env$myName.Time
+                         , ContData.env$myName.DateTime)
+      patt_flag_datetime <- paste(patt_flag_env, patt_datetime, sep = ".")
+      patt_cm_datetime   <- paste(patt_cm_env, patt_datetime, sep = ".")
+
+      ## Names, all
+      names_all <- names(data.import)
+      if (boo_DEBUG) {
+        names_all
+      }## IF ~ boo_DEBUG
+
+      ## Names, Flag
+      names_flag <- names(data.import)[grepl(patt_flag, names(data.import))]
+      if (boo_DEBUG) {
+        names_flag
+      }## IF ~ boo_DEBUG
+      # Remove Discrete
+      patt_discrete <- "Discrete."
+      names_flag <- names_flag[!grepl(patt_discrete, names_flag)]
+
+      ## Names, Comment.MOD
+      names_cm <- names(data.import)[grepl(patt_cm, names(data.import))]
+      # remove date time
+      names_cm <- names_cm[!names_cm %in% patt_cm_datetime]
+      if (boo_DEBUG) {
+        names_cm
+      }## IF ~ boo_DEBUG
+
+      #ContData.env$myNames.QCTests <- c("Gross","Spike","RoC","Flat")
+      myNames.QCTests <- c("Gross","Spike","RoC","Flat")
+      patt_QCTests <- paste(myNames.QCTests, collapse = "|")
+      # ONLY QC Test flags
+      names_flag_qctests <- names_flag[grepl(patt_QCTests, names_flag)]
+      # Non QC Test flags
+      names_flag_overall <- names_flag[!grepl(patt_QCTests, names_flag)]
+      # Non Discrete
+      patt_discrete <- "Discrete."
+      names_flag_overall <- names_flag_overall[!grepl(patt_discrete, names_flag_overall)]
+      ## remove Date.Time
+      names_flag_overall <- names_flag_overall[!names_flag_overall %in% patt_flag_datetime]
+
+      #IF len not > 0 then quit
+
+      # Names, Measurements
+      names_flag_measurements <- sub(patt_flag, "", names_flag_overall)
+      names_cm_measurements <- sub(patt_cm, "", names_cm)
+      # remove Date.Time
+      names_flag_measurements <- names_flag_measurements[!names_flag_measurements %in% patt_datetime]
+      names_cm_measurements <- names_cm_measurements[!names_cm_measurements %in% patt_datetime]
+
+      if (boo_DEBUG) {
+        names_flag_qctests
+        names_flag_overall
+        names_flag_measurements
+        names_cm_measurements
+        names_cm
+      }## IF ~ boo_DEBUG
+
+      # names position
+      colnums_flag_qctests <- match(names_flag_qctests, names(data.import))
+      colnums_flag_overall <- match(names_flag_overall, names(data.import))
+      colnums_cm <- match(names_cm, names(data.import))
+      colnums_remove <- sort(c(colnums_flag_overall, colnums_flag_qctests, colnums_cm))
+
+      colnums_orig <- seq_len(ncol(data.import))
+      colnums_remove_all <- colnums_orig[-c(colnums_remove )]
+
+      # measurements should be in the same order for flags and cm but not guaranteed!
+
+      # at position of each names_flag_overall create new order
+      # p <- names_flag_measurements[1] # testing
+
+      for (p in names_flag_measurements) {
+
+        if (boo_DEBUG) {
+          print(p)
+          print(names_flag_overall)
+          print(colnums_flag_overall)
+          print(colnums_cm)
+        }## IF ~ boo_DEBUG
+
+        # number for iterations
+        p_num <- match(p, names_flag_measurements)
+        if (boo_DEBUG) {
+          p_num
+        }## IF ~ boo_DEBUG
+
+        # flag measure
+        p_flag_msr <- p
+        if (boo_DEBUG) {
+          print(p_flag_msr)
+        }## IF ~ boo_DEBUG
+
+        # match flag measure with cm measure
+        p_flag_msr_match_cm_msr <- match(p_flag_msr, names_cm_measurements)
+        if (boo_DEBUG) {
+          print(p_flag_msr_match_cm_msr)
+        }## IF ~ boo_DEBUG
+
+        # cm
+        p_cm <- names_cm[p_flag_msr_match_cm_msr]
+        if (boo_DEBUG) {
+          print(p_cm)
+        }## IF ~ boo_DEBUG
+
+        # flag_overall
+        p_flag_overall <- names_flag_overall[grepl(p, names_flag_overall)]
+        if (boo_DEBUG) {
+          print(p_flag_overall)
+        }## IF ~ boo_DEBUG
+
+        # flag_qctests
+        p_flag_qctests <- names_flag_qctests[grepl(p, names_flag_qctests)]
+        if (boo_DEBUG) {
+          print(p_flag_qctests)
+        }## IF ~ boo_DEBUG
+
+        # Col Num, all
+        if (p_num == 1) {
+          colnums_mod <- colnums_remove_all
+        }## IF ~ p_num == 1
+        if (boo_DEBUG) {
+          print(colnums_mod)
+        }## IF ~ boo_DEBUG
+
+        # 0. find measurement colnum
+        # insert after it using append
+        # 1. Flag overall
+        # 2. Comment.MOD
+        # 3. Other flags
+
+        # Col Num, p (measurement)
+        colnum_p_orig <- match(p, names_all)
+        if (boo_DEBUG) {
+          print(colnum_p_orig)
+        }## IF ~ boo_DEBUG
+
+        # Col Num, p_flag_overall
+        colnum_p_flag_overall_orig <- match(p_flag_overall, names_all)
+        if (boo_DEBUG) {
+          print(colnum_p_flag_overall_orig)
+        }## IF ~ boo_DEBUG
+
+        # Col Num, p_cm
+        colnum_p_cm_orig <- match(p_cm, names_all)
+        # MIGHT CHANGE, could be out of order
+        if (boo_DEBUG) {
+          print(colnum_p_cm_orig)
+        }## IF ~ boo_DEBUG
+
+        # Col Num, p_flag_qctests
+        colnum_p_flag_qctests_orig <- match(p_flag_qctests, names_all)
+        # MIGHT CHANGE, could be out of order
+        if (boo_DEBUG) {
+          print(colnum_p_flag_qctests_orig)
+        }## IF ~ boo_DEBUG
+
+        # Col Num, insert
+        colnum_p_insert <- c(colnum_p_flag_overall_orig
+                             , colnum_p_cm_orig
+                             , colnum_p_flag_qctests_orig)
+
+        # new position in modified data frame
+        colnum_p_new <- match(colnum_p_orig, colnums_mod)
+        if (boo_DEBUG) {
+          print(colnum_p_new)
+        }## IF ~ boo_DEBUG
+
+        # insert CM after Flag
+        colnums_mod <- append(colnums_mod
+                              , values = colnum_p_insert
+                              , after = colnum_p_new)
+
+      }## FOR ~ p ~ names_flag_overall
+
+      # resort data frame on new columns
+      data.import <- data.import[, colnums_mod]
+
+    }## IF ~ boo_move_CM
+
     #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     # save file then run QC Report in a separate Script
     #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~