initializeFlagScheme,section-method added

brianstock · May 12, 2018 · 7990701 · 7990701
1 parent 1675f55
commit 7990701
Show file tree

Hide file tree

Showing 18 changed files with 176 additions and 0 deletions.
diff --git a/R/section.R b/R/section.R
@@ -146,6 +146,27 @@ setMethod("handleFlags",
               res
           })
 
+#' @templateVar details This applies \code{initializeFlagScheme} for each \code{ctd} station within the \code{stations} element of the \code{data} slot.
+#' @template initializeFlagSchemeTemplate
+#'
+#' @examples
+#' data(section)
+#' sectionWithFlags <- initializeFlagScheme(section, "WHP bottle")
+#' station1 <- sectionWithFlags[["station", 1]]
+#' str(station1[["flagScheme"]])
+setMethod("initializeFlagScheme",
+          c(object="section", name="ANY", mapping="ANY", debug="ANY"),
+          function(object, name=NULL, mapping=NULL, debug=getOption("oceDebug")) {
+              res <- object
+              for (i in seq_along(object@data$station)) {
+                  res@data$station[[i]] <- initializeFlagScheme(object@data$station[[i]], name, mapping, debug=debug-1)
+              }
+              res@processingLog <- processingLogAppend(res@processingLog,
+                                                       paste("initializeFlagScheme(object",
+                                                             ", name=\"", name,
+                                                             "\", mapping=", gsub(" ", "", paste(as.character(deparse(mapping))))))
+              res
+          })
 
 #' @title Summarize a Section Object
 #'

diff --git a/man/handleFlags-adp-method.Rd b/man/handleFlags-adp-method.Rd
diff --git a/man/handleFlags-argo-method.Rd b/man/handleFlags-argo-method.Rd
diff --git a/man/handleFlags-ctd-method.Rd b/man/handleFlags-ctd-method.Rd
diff --git a/man/handleFlags-section-method.Rd b/man/handleFlags-section-method.Rd
diff --git a/man/handleFlags.Rd b/man/handleFlags.Rd
diff --git a/man/initializeFlagScheme-ctd-method.Rd b/man/initializeFlagScheme-ctd-method.Rd
diff --git a/man/initializeFlagScheme-oce-method.Rd b/man/initializeFlagScheme-oce-method.Rd
diff --git a/man/initializeFlagScheme-section-method.Rd b/man/initializeFlagScheme-section-method.Rd
diff --git a/man/initializeFlagScheme.Rd b/man/initializeFlagScheme.Rd
diff --git a/man/initializeFlags-adp-method.Rd b/man/initializeFlags-adp-method.Rd
diff --git a/man/initializeFlags-oce-method.Rd b/man/initializeFlags-oce-method.Rd
diff --git a/man/initializeFlags.Rd b/man/initializeFlags.Rd
diff --git a/man/setFlags-adp-method.Rd b/man/setFlags-adp-method.Rd
diff --git a/man/setFlags-ctd-method.Rd b/man/setFlags-ctd-method.Rd
diff --git a/man/setFlags-oce-method.Rd b/man/setFlags-oce-method.Rd
diff --git a/man/setFlags.Rd b/man/setFlags.Rd
diff --git a/tests/testthat/test_flags.R b/tests/testthat/test_flags.R
@@ -51,6 +51,13 @@ test_that("user-created flag scheme", {
                                                mapping=list(unknown=1, good=2, bad=3)))
 })
 
+test_that("cannot alter existing flag scheme", {
+          data(ctd)
+          a <- initializeFlagScheme(ctd, "myscheme", list(unknown=1, good=2, bad=3))
+          expect_warning(initializeFlagScheme(a, "WHP CTD"),
+                         "cannot alter a flagScheme that is already is place")
+})
+
 test_that("ctd flag scheme action", {
           data(ctd)
           a <- initializeFlags(ctd, "temperature", 2) # 2="acceptable
@@ -205,3 +212,15 @@ test_that("does subset() work on adp flags? (issue 1410)", {
           expect_equal(adp[["vFlag"]][look, , ], sub[["vFlag"]]) # flag values ok?
 })
 
+
+
+test_that("set flags on section object", {
+          data(section)
+          a <- initializeFlagScheme(section, "WHP bottle")
+          expect_equal(a[["station", 1]][["flagScheme"]],
+                       list(name="WHP bottle",
+                            mapping=list(no_information=1, no_problems_noted=2, leaking=3,
+                                         did_not_trip=4, not_reported=5, discrepency=6,
+                                         unknown_problem=7, did_not_trip=8, no_sample=9)))
+})
+