Comments and documentation updates

COMPASS-DOE · Dec 21, 2023 · 3a98533 · 3a98533
1 parent 65c84ff
commit 3a98533
Show file tree

Hide file tree

Showing 7 changed files with 108 additions and 88 deletions.
diff --git a/synoptic/L1_normalize.qmd b/synoptic/L1_normalize.qmd
@@ -49,6 +49,11 @@ if(packageVersion("compasstools") < "0.2") {
          "devtools::install_github('COMPASS-DOE/compasstools')")
 }
 
+# Warnings are not allowed here, as this usually means a column format
+# problem that we want to fix immediately
+oldwarn <- options()$warn
+options(warn = 2)
+
 # Read the design table (everything must have an entry)
 DESIGN_TABLE <- file.path(params$DATA_ROOT, params$DESIGN_TABLE)
 dt <- read_csv(DESIGN_TABLE, col_types = "cccccDcc")
@@ -88,6 +93,9 @@ source("out-of-service.R")
 troll <- read_csv(file.path(params$DATA_ROOT, params$OOS,
                             "troll_maintenance.csv"), col_types = "cccccccc")
 oos_troll <- prep_troll_oos_table(troll) # in helpers.R
+
+# Restore old warning setting
+options(warn = oldwarn)
 ```
 
 I see `r length(files_to_process)` files to process in `r L0`.

diff --git a/synoptic/data_TEST/L1_metadata/L1_metadata_columns.csv b/synoptic/data_TEST/L1_metadata/L1_metadata_columns.csv
@@ -1,8 +1,8 @@
 Column,Description
-TIMESTAMP,Original datalogger timestamp (EST) (POSIXct)
+TIMESTAMP,Datalogger timestamp (EST) (POSIXct)
 design_link,Design name that links to experimental unit (character)
 research_name,Measurement name (character)
 value,Observed value (numeric). The no-data value is '[NA_STRING_L1]'
 ID,Observation ID (character)
-F_OOB,Flag: Out of instrumental bounds (1=TRUE) (logical)
-F_OOS,Flag: Out of service according to records (1=TRUE) (logical)
+F_OOB,Flag: Out of instrumental bounds (logical; 1=TRUE)
+F_OOS,Flag: Sensor listed as out of service (logical; 1=TRUE)
diff --git a/synoptic/data_TEST/L1_metadata/L1_metadata_template.txt b/synoptic/data_TEST/L1_metadata/L1_metadata_template.txt
@@ -1,14 +1,15 @@
-L1 data documentation file
+COMPASS-FME L1 data documentation file
 [FOLDER_NAME]
 [TIMESTAMP]
 
 
 General information
 —----------------------------------
-L1 data are close to raw data, although they have been units-transformed and 
-have a single out-of-instrument-bounds flag applied. True duplicates are removed 
-but otherwise these data are not filtered, and have not been subject to any algorithmic
-or human QA/QC. Any use of these data for science analyses should be done with care.
+Level 1 (L1) data are close to raw, although they have been units-transformed
+and have out-of-instrument-bounds and out-of-service flags added.
+Duplicates are removed but otherwise these data are not filtered,
+and have not been subject to any algorithmic or human QA/QC.
+Any use of L1 data for science analyses should be done with care.
 
 
 Site information:

diff --git a/synoptic/data_TEST/design_table_README.md b/synoptic/data_TEST/design_table_README.md
@@ -23,15 +23,16 @@ separate information about different tables.
 
 Design links follow a pattern of {what}-{site}-{plot}-{which}, e.g.
 `GW_BattV-TMP-F-200B` (groundwater battery voltage, TEMPEST, Freshwater plot, the 200B AquaTroll).
+The out-of-service check in `L1_normalize.qmd` depends on this format being followed.
 
 The `valid_through` column is used when a sensor is reassigned, for example if a tree
 dies and we reassign its sapflux sensor to a new tree, and encodes the last valid
 date for a given design link. In this case the loggernet variable has _two_ entries
 (rows): the original assignment, with a YYYY-MM-DD `valid_through` entry, and the new assignment,
 with a blank `valid_through` entry.
 
-The TEMPEST sapflow assignments are based on
-COMPASS -> COMPASS FME -> ARCHIVE _ Pilot Project -> COMPASS FME Task 2 -> TEMPEST -> Sensor Networks & Infrastructure -> Monitoring Documents -> TEMPEST Sap Flow Monitoring
+The TEMPEST sapflow assignments are based on:
+COMPASS FME Task 2 -> TEMPEST -> Sensor Networks & Infrastructure -> Monitoring Documents -> TEMPEST Sap Flow Monitoring
 
 The Synoptic Sap Flow Monitoring, TEROS Monitoring, and Aquatroll Monitoring documents live here:
-COMPASS -> COMPASS FME -> ARCHIVE _ Pilot Project -> COMPASS FME Task 1 -> 1.2 Synoptic -> Sensor Maintenance
+COMPASS FME Task 1 -> 1.2 Synoptic -> Sensor Maintenance
diff --git a/synoptic/data_TEST/out-of-service/README.md b/synoptic/data_TEST/out-of-service/README.md
@@ -0,0 +1,7 @@
+# out-of-service
+
+This folder holds COMPASS-FME instrument maintenance records that are read
+by `L1_normalize.qmd` and used to add out-of-service flags to data.
+
+`troll_maintenance.csv` tracks the "Aquatroll Calibration/Removal Log" 
+spreadsheet on the COMPASS-FME Google Drive.
diff --git a/synoptic/helpers.R b/synoptic/helpers.R
@@ -306,48 +306,49 @@ valid_entries <- function(objects, times, valid_through) {
     valids
 }
 
-# Sample data. We have two objects (sensors) at time points 1:3
-test_data <- data.frame(obj = c(1, 1, 1, 2, 2, 2), time = c(1, 2, 3, 1, 2, 3))
-# Object 2 changes its design link after time 2
-test_dt <- data.frame(obj = c(1,2,2),
-                      dl = c("A", "B", "C"),
-                      valid_through = c(NA, 2, NA))
-# Merge the 'data' with the 'design link table'
-x <- merge(test_data, test_dt)
-# Call valid_entries. It figures out that all the object 1 entries should be
-# retained, but 1 of 2 entries in each timestep should be dropped for object 2.
-# This is because there are two design_table entries for it (see above); the
-# first ends at time point 2, and the second is indefinite after that.
-valid_entries(x$obj, x$time, x$valid_through)
-
-# Test code for valid_entries
-
-# No shifting objects
-ret <- valid_entries(c(1, 1, 1), c(1, 2, 3), c(NA, NA, NA))
-stopifnot(all(ret))
-# One object, shift time is never reached
-ret <- valid_entries(c(1, 1, 1, 1), c(1, 1, 2, 2), c(4, NA, 4, NA))
-stopifnot(ret == c(TRUE, FALSE, TRUE, FALSE))
-# One object, shift time is in the past
-ret <- valid_entries(c(1, 1, 1, 1), c(3, 3, 4, 4), c(2, NA, 2, NA))
-stopifnot(ret == c(FALSE, TRUE, FALSE, TRUE))
-# One object, shifts
-ret <- valid_entries(c(1, 1, 1, 1), c(2, 2, 3, 3), c(2, NA, 2, NA))
-stopifnot(ret == c(TRUE, FALSE, FALSE, TRUE))
-# One objects, shifts twice (valid_throughs at 1 and 2)
-ret <- valid_entries(objects = rep(1, 9),
-                     times = c(1, 1, 1, 2, 2, 2, 3, 3, 3),
-                     valid_through = c(1, 2, NA, 1, 2, NA, 1, 2, NA))
-stopifnot(ret == c(TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE))
-# Two objects, only one shifts
-ret <- valid_entries(objects = c(1, 1, 1, 2, 2, 2, 2, 2, 2),
-                     times = c(1, 2, 3, 1, 1, 2, 2, 3, 3),
-                     valid_through = c(NA, NA, NA, 2, NA, 2, NA, 2, NA))
-stopifnot(ret == c(TRUE, TRUE, TRUE, # obj 1
-                   TRUE, FALSE, TRUE, FALSE, FALSE, TRUE)) # obj 2
-# There's a valid_through but no new entry
-ret <- valid_entries(objects = c(1, 1),
-                     times = c(1, 2),
-                     valid_through = c(1, 1))
-stopifnot(ret == c(TRUE, FALSE))
-
+# Test code for valid_entries()
+test_valid_entries <- function() {
+    # Sample data. We have two objects (sensors) at time points 1:3
+    test_data <- data.frame(obj = c(1, 1, 1, 2, 2, 2), time = c(1, 2, 3, 1, 2, 3))
+    # Object 2 changes its design link after time 2
+    test_dt <- data.frame(obj = c(1,2,2),
+                          dl = c("A", "B", "C"),
+                          valid_through = c(NA, 2, NA))
+    # Merge the 'data' with the 'design link table'
+    x <- merge(test_data, test_dt)
+    # Call valid_entries. It figures out that all the object 1 entries should be
+    # retained, but 1 of 2 entries in each timestep should be dropped for object 2.
+    # This is because there are two design_table entries for it (see above); the
+    # first ends at time point 2, and the second is indefinite after that.
+    valid_entries(x$obj, x$time, x$valid_through)
+
+    # No shifting objects
+    ret <- valid_entries(c(1, 1, 1), c(1, 2, 3), c(NA, NA, NA))
+    stopifnot(all(ret))
+    # One object, shift time is never reached
+    ret <- valid_entries(c(1, 1, 1, 1), c(1, 1, 2, 2), c(4, NA, 4, NA))
+    stopifnot(ret == c(TRUE, FALSE, TRUE, FALSE))
+    # One object, shift time is in the past
+    ret <- valid_entries(c(1, 1, 1, 1), c(3, 3, 4, 4), c(2, NA, 2, NA))
+    stopifnot(ret == c(FALSE, TRUE, FALSE, TRUE))
+    # One object, shifts
+    ret <- valid_entries(c(1, 1, 1, 1), c(2, 2, 3, 3), c(2, NA, 2, NA))
+    stopifnot(ret == c(TRUE, FALSE, FALSE, TRUE))
+    # One objects, shifts twice (valid_throughs at 1 and 2)
+    ret <- valid_entries(objects = rep(1, 9),
+                         times = c(1, 1, 1, 2, 2, 2, 3, 3, 3),
+                         valid_through = c(1, 2, NA, 1, 2, NA, 1, 2, NA))
+    stopifnot(ret == c(TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, TRUE))
+    # Two objects, only one shifts
+    ret <- valid_entries(objects = c(1, 1, 1, 2, 2, 2, 2, 2, 2),
+                         times = c(1, 2, 3, 1, 1, 2, 2, 3, 3),
+                         valid_through = c(NA, NA, NA, 2, NA, 2, NA, 2, NA))
+    stopifnot(ret == c(TRUE, TRUE, TRUE, # obj 1
+                       TRUE, FALSE, TRUE, FALSE, FALSE, TRUE)) # obj 2
+    # There's a valid_through but no new entry
+    ret <- valid_entries(objects = c(1, 1),
+                         times = c(1, 2),
+                         valid_through = c(1, 1))
+    stopifnot(ret == c(TRUE, FALSE))
+}
+test_valid_entries()
diff --git a/synoptic/out-of-service.R b/synoptic/out-of-service.R
@@ -95,35 +95,37 @@ oos <- function(oos_df, data_df) {
 }
 
 # Test code for oos()
-
-data_df <- data.frame(TIMESTAMP = 1:3, x = letters[1:3], y = 4:6)
-
-# No other conditions beyond time window
-oos_df <- data.frame(oos_begin = 1, oos_end = 1)
-stopifnot(oos(oos_df, data_df) == c(TRUE, FALSE, FALSE))
-oos_df <- data.frame(oos_begin = 4, oos_end = 5)
-stopifnot(oos(oos_df, data_df) == c(FALSE, FALSE, FALSE))
-oos_df <- data.frame(oos_begin = 0, oos_end = 2)
-stopifnot(oos(oos_df, data_df) == c(TRUE, TRUE, FALSE))
-oos_df <- data.frame(oos_begin = 0, oos_end = 3)
-stopifnot(oos(oos_df, data_df) == c(TRUE, TRUE, TRUE))
-
-# x condition - doesn't match even though timestamp does
-oos_df <- data.frame(oos_begin = 1, oos_end = 1, x = "b")
-stopifnot(oos(oos_df, data_df) == c(FALSE, FALSE, FALSE))
-# x condition - matches and timestamp does
-oos_df <- data.frame(oos_begin = 1, oos_end = 1, x = "a")
-stopifnot(oos(oos_df, data_df) == c(TRUE, FALSE, FALSE))
-# x condition - some match, some don't
-oos_df <- data.frame(oos_begin = 1, oos_end = 2, x = "b")
-stopifnot(oos(oos_df, data_df) == c(FALSE, TRUE, FALSE))
-# x and y condition
-oos_df <- data.frame(oos_begin = 1, oos_end = 2, x = "b", y = 5)
-stopifnot(oos(oos_df, data_df) == c(FALSE, TRUE, FALSE))
-oos_df <- data.frame(oos_begin = 1, oos_end = 2, x = "a", y = 5)
-stopifnot(oos(oos_df, data_df) == c(FALSE, FALSE, FALSE))
-
-# Error thrown if condition column(s) not present
-oos_df <- data.frame(oos_begin = 1, oos_end = 2, z = 1)
-out <- try(oos(oos_df, data_df), silent = TRUE)
-stopifnot(class(out) == "try-error")
+test_oos <- function() {
+    data_df <- data.frame(TIMESTAMP = 1:3, x = letters[1:3], y = 4:6)
+
+    # No other conditions beyond time window
+    oos_df <- data.frame(oos_begin = 1, oos_end = 1)
+    stopifnot(oos(oos_df, data_df) == c(TRUE, FALSE, FALSE))
+    oos_df <- data.frame(oos_begin = 4, oos_end = 5)
+    stopifnot(oos(oos_df, data_df) == c(FALSE, FALSE, FALSE))
+    oos_df <- data.frame(oos_begin = 0, oos_end = 2)
+    stopifnot(oos(oos_df, data_df) == c(TRUE, TRUE, FALSE))
+    oos_df <- data.frame(oos_begin = 0, oos_end = 3)
+    stopifnot(oos(oos_df, data_df) == c(TRUE, TRUE, TRUE))
+
+    # x condition - doesn't match even though timestamp does
+    oos_df <- data.frame(oos_begin = 1, oos_end = 1, x = "b")
+    stopifnot(oos(oos_df, data_df) == c(FALSE, FALSE, FALSE))
+    # x condition - matches and timestamp does
+    oos_df <- data.frame(oos_begin = 1, oos_end = 1, x = "a")
+    stopifnot(oos(oos_df, data_df) == c(TRUE, FALSE, FALSE))
+    # x condition - some match, some don't
+    oos_df <- data.frame(oos_begin = 1, oos_end = 2, x = "b")
+    stopifnot(oos(oos_df, data_df) == c(FALSE, TRUE, FALSE))
+    # x and y condition
+    oos_df <- data.frame(oos_begin = 1, oos_end = 2, x = "b", y = 5)
+    stopifnot(oos(oos_df, data_df) == c(FALSE, TRUE, FALSE))
+    oos_df <- data.frame(oos_begin = 1, oos_end = 2, x = "a", y = 5)
+    stopifnot(oos(oos_df, data_df) == c(FALSE, FALSE, FALSE))
+
+    # Error thrown if condition column(s) not present
+    oos_df <- data.frame(oos_begin = 1, oos_end = 2, z = 1)
+    out <- try(oos(oos_df, data_df), silent = TRUE)
+    stopifnot(class(out) == "try-error")
+}
+test_oos()