From 1afb07a4e84cb9b8f6abc7a3454fa4194a48a4ab Mon Sep 17 00:00:00 2001 From: zoeread <51928532+zoeread@users.noreply.github.com> Date: Tue, 31 Mar 2026 15:57:21 -0400 Subject: [PATCH] Update Aquatroll Plots to match Peter's --- current-data-zr.qmd | 545 ------------------------------------------ scripts/synoptic_v2.R | 2 +- 2 files changed, 1 insertion(+), 546 deletions(-) delete mode 100644 current-data-zr.qmd diff --git a/current-data-zr.qmd b/current-data-zr.qmd deleted file mode 100644 index 8180da3..0000000 --- a/current-data-zr.qmd +++ /dev/null @@ -1,545 +0,0 @@ ---- -author: "COMPASS workflows team" -params: - DROPBOX: "C:/Users/readz/Smithsonian Dropbox/Zoe Read" - SITES: "CB" -date: now -date-format: "YYYY-MM-DD HH:mm:ssZ" -execute: - echo: false -format: - html: - toc: true - toc-expand: 2 - embed-resources: true -title: "Current Dropbox data: `r paste(params$SITE, collapse = ', ')`" -title-block-banner: true -editor: visual ---- - -```{r init} -#| include: false - -library(readr) -library(ggplot2) -theme_set(theme_bw()) -library(dplyr) -library(tidyr) -library(gt) -library(lubridate) - -SITES <- params$SITES -PATH <- params$DROPBOX - -PLOT_FACTOR_LEVELS <- c("C", "F", "S", # TMP plots - "UP", "SWAMP", "TR", "WTE", "W", # synoptic plots - "F1", "F2", "F3", "R1", "R2") # DLG plots - -# User can specify groups of synoptic sites: CB or LE -if(length(SITES == 1)) { - if(SITES == "CB") { - SITES <- c("SWH", "GWI", "MSM", "GCW") - } else if(SITES == "LE") { - SITES <- c("PTR", "CRC", "OWC") - } else if(SITES == "TESTING") { - SITES <- c("SWH", "GWI", "MSM", "GCW", "TMP", "OWC") - } -} - -# Well dimensions, for computing water level below surface -# This file, and the following code, are from the sensor data pipeline -WELL_DIMS_FILE <- "ancillary-data/well_dimensions.csv" -message("Reading ", WELL_DIMS_FILE) -WELL_DIMS <- readr::read_csv(WELL_DIMS_FILE, - comment = "#", - col_types = "ccccddcddddd") -WELL_DIMS$ground_to_sensor_cm <- - with(WELL_DIMS, ring_to_pressure_sensor_cm - - (well_top_to_ground_cm - bolt_to_cap_cm)) -# TEMPEST trolls were installed differently; 2 parameters instead of 3 -tmp <- WELL_DIMS$Site == "TMP" -WELL_DIMS$ground_to_sensor_cm[tmp] <- WELL_DIMS$Bolt_to_sensor_depth_cm[tmp] + WELL_DIMS$Bolt_to_ground_cm[tmp] - -WELL_DIMS <- WELL_DIMS[c("Site", "Plot", "Instrument_ID", "ground_to_sensor_cm")] - -# Sapflow information. These files are from different places on the -# Google Drive and need to be munged to the same format -SF_TMP_FILE <- "ancillary-data/TEMPEST_SF_Monitoring.xlsx - Tracking.csv" -message("Reading ", SF_TMP_FILE) -sf_tmp <- read_csv(SF_TMP_FILE, col_types = "ccccccdd__c__") -SF_CB_FILE <- "ancillary-data/COMPASS_Synoptic_SF_Monitoring.xlsx - Tracking.csv" -message("Reading ", SF_CB_FILE) -sf_cb <- read_csv(SF_CB_FILE, col_types = "cccc_cdd__c__") -SF_LE_FILE <- "ancillary-data/LE_sapflow_inventory - Copy of Sheet1.csv" -message("Reading ", SF_LE_FILE) -sf_le <- read_csv(SF_LE_FILE, col_types = "ccdcdcc__") -sf_tmp %>% - mutate(Site = "TMP") %>% - select(Site, Logger, Port, Sapflux_ID, Tree_ID) %>% - bind_rows(sf_cb %>% select(Site, Logger, Port, Sapflux_ID, Tree_ID)) %>% - bind_rows(sf_le %>% select(Site, Logger, Port, Sapflux_ID = Tree_Code, Tree_ID = Tag)) %>% - mutate(Tree = paste0(Sapflux_ID, " (", Tree_ID, ")")) %>% - select(-Sapflux_ID, -Tree_ID) -> - SF_METADATA - -# TEROS information, same deal -TEROS_TMP_FILE <- "ancillary-data/TEMPEST_TEROS_Network_Location&Status.csv" -message("Reading ", TEROS_TMP_FILE) -teros_tmp <- read_csv(TEROS_TMP_FILE, col_types = "c__ccdcc___d") -TEROS_CB_FILE <- "ancillary-data/COMPASS_Synoptic_Teros_Monitoring.csv" -message("Reading ", TEROS_CB_FILE) -teros_cb <- read_csv(TEROS_CB_FILE, col_types = "cc_cddc") -# TODO: where is LE file? -teros_tmp %>% - mutate(Site = "TMP", - Plot = case_when(Plot == "Freshwater" ~ "F", - Plot == "Seawater" ~ "S", - Plot == "Control" ~ "C")) %>% - select(Site, Plot, Logger = `Data Logger ID`, Port = `Terosdata table channel`, ID, Depth_cm) %>% - bind_rows(teros_cb %>% select(Site, Plot = Zone, Logger, Port = Address, ID = `Probe ID`, Depth_cm = Depth)) %>% - mutate(Port = as.character(Port), - Site = if_else(Site == "GCREW", "GCW", Site), - Plot = if_else(Plot == "Swamp", "SWAMP", Plot), - Plot = factor(Plot, levels = PLOT_FACTOR_LEVELS), - Logger = if_else(Site == "SWH" & Plot == "UP", "424", Logger)) -> - TEROS_METADATA -``` - -Sites: `r paste(SITES, collapse = ", ")` - -Data path: `r PATH` - -```{r helper-functions} -#| include: false - -# Insert an HTML banner if no data -no_data_check <- function(x, what) { - message("Total: ", nrow(x), " data rows") - if(nrow(x) == 0) { - cat('::: {.callout-important appearance="simple"}', - '## No Data', - '', - paste('No data files were found for', what), - '', - ':::', sep = "\n") - } -} - -# Read a raw datalogger file. This is copied from the sensor data pipeline code -read_datalogger_file <- function(filename, quiet = TRUE, ...) { - - # Parse line one to extract logger and table names - dat <- read_lines(filename) - if(!quiet) message("\t- ", basename(filename), " (", length(dat)-4, " rows)") - header_split <- strsplit(dat[1], ",")[[1]] - header_split <- gsub("\"", "", header_split) # remove quotation marks - format_name <- header_split[1] # first field of row 1 - logger_name <- header_split[2] # second field of row 1 - table_name <- header_split[length(header_split)] - - x <- read_csv(I(dat[-c(1, 3, 4)]), - show_col_types = FALSE, - na = c("NAN", "-99999", "")) - # Remove inconsistent and/or not useful columns - x$Statname <- x$PB <- x$RECORD <- NULL - # Some Aquatroll tables (specifically at OWC; see e.g. #21) have blank - # tables, and their "Aquatroll_IDx" columns get parsed as numeric, which - # causes errors at the bind_rows() step below. Pre-emptively fix this - fixcol <- grep("^Aquatroll_ID", colnames(x)) - if(length(fixcol) > 0) x[fixcol] <- as.character(x[fixcol]) - - info <- tibble(Logger_raw = rep(logger_name, nrow(x)), - Table = rep(table_name, nrow(x))) - as_tibble(cbind(info, x)) -} - -# Find and read raw data files -read_files <- function(type, sitelist = SITES, path = PATH) { - - # Loop through the sites and load files - sitedat <- list() - for(site in sitelist) { - # Figure out where this site's files are - if(site == "DLG") { - SUBPATH <- "COMPASS_PNNL_Data" - CURRENT <- "current_data" - PATTERN <- paste0(site, "-.*_[0-9]+_", type) - } else if(site %in% c("PTR", "CRC", "OWC", "SWH", "GWI", "MSM", "GCW")) { - SUBPATH <- "COMPASS_PNNL_Data" - CURRENT <- "current_data" - PATTERN <- paste0("_", site, "_.*_", type) - } else if(site == "TMP") { - SUBPATH <- "TEMPEST_PNNL_Data" - CURRENT <- "Current_data" # you're killing me, Roy - PATTERN <- paste0("_", type) - } else { - stop("Unknown site: ", site) - } - - files <- list.files(file.path(path, SUBPATH, CURRENT), - pattern = PATTERN, - ignore.case = TRUE, # TMP has different capitalization - full.names = TRUE) - if(any(grepl("backup$", files))) { - message(site, ": ignoring backup file(s)") - files <- files[grep("backup$", files, invert = TRUE)] - } - filetext <- if_else(length(files) == 1, " file", " files") - message(site, ": found ", length(files), filetext) - x <- lapply(files, read_datalogger_file) - x <- bind_rows(x) - if(nrow(x) == 0) next # no data! - - # Split "Logger_raw" field into "Site", "Plot", and "Logger" - if(site == "DLG") { - # The DLG data files have logger_raw with format DLG-{PLOT}_{LOGGER} - x %>% - separate(Logger_raw, into = c("Site", "Plot", "Logger"), remove = TRUE) -> - x - } else if(site == "TMP") { - # The TMP data files have logger_raw with format PNNL_{LOGGER} - x %>% - separate(Logger_raw, into = c("Site", "Logger"), remove = TRUE) %>% - mutate(Site = "TMP", - Plot = case_when(Logger %in% c("11", "12", "13") ~ "C", - Logger %in% c("21", "22", "23") ~ "F", - Logger %in% c("31", "32", "33") ~ "S")) -> - x - } else { - # The synoptic sites have format Compass_{SITE}_{PLOT}_{LOGGER} - x %>% - separate(Logger_raw, into = c("Junk", "Site", "Plot", "Logger"), - fill = "right", # we need this because Buoy data have no logger info - remove = TRUE) %>% - select(-Junk) -> - x - } - - # Change Plot to a factor and reorder columns - x %>% mutate(Plot = factor(Plot, levels = PLOT_FACTOR_LEVELS)) -> - x - left_cols <- c("Site", "Plot", "Logger", "Table") - x <- bind_cols(select(x, all_of(left_cols)), select(x, -all_of(left_cols))) - - sitedat[[site]] <- x - - } # for site - bind_rows(sitedat, .id = "Site") -} - -# Pivot wide Campbell format to long -pivotstep <- function(x) { - x %>% - pivot_longer(-1:-5) %>% - filter(name != "BattV_Avg") # we probably don't care about this -} - -# Make a nice string, robust to all NA/NaN, for a vector's range -robust_range <- function(x, digits) { - if(any(!is.na(x))) { - return(paste(round(range(x, na.rm = TRUE), digits = digits), collapse = "-")) - } else { - return("-") - } -} -``` - -# Sapflow - -```{r sf-read} -#| output: "asis" - -sf <- read_files("Sapflow") -no_data_check(sf, "Sapflow") -``` - -```{r sf-plots} -#| fig-width: 9 -if(nrow(sf) > 0) { - sf %>% - pivotstep() %>% - filter(grepl("DiffVolt.?_Avg", name)) %>% # needed for TMP - mutate(Port = gsub("DiffVolt.?_Avg\\(", "", name), - Port = as.double(gsub(")", "", Port))) %>% - left_join(SF_METADATA, by = c("Site", "Logger", "Port")) -> - sf_long - - sf_long_current <- sf_long %>% - filter( - TIMESTAMP >= Sys.time() - days(7), - TIMESTAMP <= Sys.time() - ) - - for(site in unique(sf_long_current$Site)) { - p <- ggplot(filter(sf_long_current, Site == site), - aes(TIMESTAMP, value, color = interaction(Plot, Tree))) + - facet_grid(. ~ Plot) + - ylab("Raw sapflow") + - geom_point(na.rm = TRUE) + - ggtitle(site) + - print(p) - } -} -``` - -# TEROS - -```{r teros-read} -#| output: "asis" -teros <- read_files("Teros") -no_data_check(teros, "TEROS") -``` - -```{r teros-plots} -#| fig-width: 9 -#| fig-height: 6 -if(nrow(teros) > 0) { - teros %>% - pivotstep() %>% - # NA value is -99999.00 - mutate(value = if_else(value == -9999, NA_real_, value), - name = gsub("Teros.+\\(", "", name), - name = gsub(")", "", name)) %>% - separate(name, into = c("Port", "sensor"), convert = FALSE) %>% - left_join(TEROS_METADATA, by = c("Site", "Plot", "Logger", "Port")) %>% - #filter(!is.na(ID)) %>% - # the join changes Plot back to character - mutate(Plot = factor(Plot, levels = PLOT_FACTOR_LEVELS), - Depth_cm = as.factor(Depth_cm), - sensor_name = case_when( - sensor == "1" ~ "VWC", - sensor == "2" ~ "Temp", - sensor == "3" ~ "EC" - )) -> - teros_long - -teros_long_current <- teros_long %>% - filter( - TIMESTAMP >= Sys.time() - days(7), - TIMESTAMP <= Sys.time() - ) - - for(site in unique(teros_long_current$Site)) { - teros_site <- filter(teros_long_current, Site == site) - p <- ggplot(teros_site, aes(TIMESTAMP, value, color = Depth_cm)) + - facet_grid(sensor_name ~ Plot, scales = "free") + - geom_point(na.rm = TRUE) + - theme(axis.text.x = element_text(angle = 90)) + - ggtitle(paste(site, "TEROS")) - print(p) - } -} -``` - -# AquaTROLL - -```{r troll-read} -#| output: "asis" -troll <- read_files("WaterLevel") -no_data_check(troll, "AquaTROLL") -``` - -```{r troll-plots} -#| fig-width: 9 -#| fig-height: 4 -if(nrow(troll) > 0) { - troll %>% - select(-starts_with("Aquatroll")) %>% # remove text column - pivotstep() %>% - # NA value is -99999.00 - mutate(value = if_else(value == -99999, NA_real_, value)) -> - troll_long - -# Ugh, of course TMP trolls are totally different. Handle -if("TMP" %in% troll_long$Site) { - troll_long %>% - filter(Site == "TMP") %>% - # hard coded, crappy, sorry - mutate(Instrument_ID = - case_when(Logger == "12" & Table == "WaterLevel200" ~ "683451", - Logger == "13" & Table == "WaterLevel600" ~ "685442", - Logger == "21" & Table == "WaterLevel200" ~ "683416", - Logger == "23" & Table == "WaterLevel200" ~ "683345", - Logger == "23" & Table == "WaterLevel600" ~ "685474", - Logger == "31" & Table == "WaterLevel200" ~ "683408", - Logger == "32" & Table == "WaterLevel600" ~ "685410")) -> - troll_long_tmp -} else { - troll_long_tmp <- NULL -} - -troll_long %>% - filter(Site != "TMP") %>% - mutate(Instrument_ID = substr(Table, nchar(Table), nchar(Table))) %>% - # add TMP data back in - bind_rows(troll_long_tmp) %>% - # remove "600" with optional A/B/C - mutate(name = gsub("[26]00[ABC]?$", "", name)) %>% - # compute water level - left_join(WELL_DIMS, by = c("Site", "Plot", "Instrument_ID")) %>% - # the join changes Plot back to character - mutate(Plot = factor(Plot, levels = PLOT_FACTOR_LEVELS)) %>% - # filter per SW: WL, temp, salinity, DO, and pH - filter(name %in% c("Temperature", "Salinity", "RDO_concen", - "pH", "Water_Density", "Pressure")) -> - troll_long - - # Compute water level. For each Site, Plot, and Instrument_ID, - # extract the pressure, density, and ground_to_sensor info (happily - # guaranteed to be same order and timestamps since from same instrument) - troll_long %>% - filter(name %in% c("Water_Density", "Pressure"), !is.na(value)) %>% - # Sometimes (not totally sure why) there's more than one value per timestep - # average those away - group_by(Site, Plot, Logger, Table, TIMESTAMP, name, Instrument_ID, - ground_to_sensor_cm) %>% - summarise(value = mean(value, na.rm = TRUE), .groups = "drop") %>% - pivot_wider(names_from = "name") %>% - # This follows Peter Regier's code, and Fausto M-S's logic - mutate(density_gcm3_cor = if_else(Water_Density >= 0.98 & Water_Density <= 1.05, - Water_Density, 1), - pressure_mbar = if_else(Pressure == -99999, 0, Pressure), - pressurehead_m = (pressure_mbar * 100) / (density_gcm3_cor * 1000 * 9.80665), - water_level_cm = round(100 * pressurehead_m - ground_to_sensor_cm, 1)) %>% - select(Site, Plot, Instrument_ID, TIMESTAMP, water_level_cm) -> - wl - - # join is many-to-one: many names at a given timestamp - troll_long %>% - left_join(wl, by = c("Site", "Plot", "Instrument_ID", "TIMESTAMP"), - relationship = "many-to-one") -> - troll_long - - troll_long_current <- troll_long %>% - filter( - TIMESTAMP >= Sys.time() - days(7), - TIMESTAMP <= Sys.time() - ) - - p <- ggplot(troll_long_current, aes(TIMESTAMP, water_level_cm, color = water_level_cm < -ground_to_sensor_cm)) + - facet_grid(Site ~ Plot, scales = "free") + - geom_point(na.rm = TRUE) + - scale_color_manual("WL below sensor", values = c("black", "red")) + - ggtitle("water_level_cm") + - theme(axis.text.x = element_text(angle = 90)) - print(p) - - for(nm in unique(troll_long_current$name)) { - x <- filter(troll_long_current, name == nm) - p <- ggplot(x, aes(TIMESTAMP, value, color = water_level_cm < -ground_to_sensor_cm)) + - facet_grid(Site ~ Plot, scales = "free") + - ylab(nm) + - ggtitle(nm) + - scale_color_manual("WL below sensor", values = c("black", "red")) + - geom_point(na.rm = TRUE) + - theme(axis.text.x = element_text(angle = 90)) - print(p) - } -} -``` - -# Redox - -```{r redox-read} -#| output: "asis" -redox <- read_files("Redox") -no_data_check(redox, "Redox") -``` - -```{r redox-plots} -#| fig-width: 9 -#| fig-height: 8 - -#redox colors -redox_colors <- c("10-1" = "darkgoldenrod1", - "10-2" = "darkorange", - "10-3" = "chocolate", - "15-1" = "chartreuse2", - "15-2" = "darkolivegreen3", - "15-3" = "green4", - "30-1" = "cyan", - "30-2" = "deepskyblue1", - "30-3" = "dodgerblue3", - "45-1" = "darkorchid2", - "45-2" = "orchid3", - "45-3" = "mediumpurple4") - -redox_assignments <- tribble(~number, ~Depth, ~Rep, - 1, 10, 1, - 2, 15, 1, - 3, 30, 1, - 4, 45, 1, - 5, 10, 2, - 6, 15, 2, - 7, 30, 2, - 8, 45, 2, - 9, 10, 3, - 10, 15, 3, - 11, 30, 3, - 12, 45, 3) - - -if(nrow(redox) > 0) { - redox %>% - select(-BattV) %>% - filter(Table == "Redox15") %>% # per SJW: only look at 15 minutes data - pivotstep() %>% - separate(name, into = c("which", "number"), extra = "drop") %>% - mutate(number = as.numeric(number)) %>% - left_join(redox_assignments, by = "number") %>% - mutate(Depth = as.factor(Depth)) %>% - mutate(Depth_Rep = as.factor(paste(Depth, Rep, sep = "-"))) -> - redox_long - -redox_long_current <- redox_long %>% - filter( - TIMESTAMP >= Sys.time() - days(7), - TIMESTAMP <= Sys.time() - ) - - - for(site in unique(redox_long_current$Site)) { - redox_site <- filter(redox_long_current, Site == site) - p <- ggplot(redox_site, aes(TIMESTAMP, value, color = Depth_Rep)) + - facet_grid(which ~ Plot) + - geom_point(na.rm = TRUE) + - scale_color_manual(values = redox_colors) + - theme(axis.text.x = element_text(angle = 90)) + - ggtitle(paste(site, "Redox")) - print(p) - } -} -``` - -# Sonde - -```{r exo-read} -#| output: "asis" -exo <- read_files("Exo") -no_data_check(exo, "Exo") -``` - -```{r exo-plots} -#| fig-width: 9 -#| fig-height: 9 -if(nrow(exo) > 0) { - exo %>% - select(-Date, -Time, -sn, -snn) %>% - pivotstep() -> - exo_long - -exo_long_current <- exo_long %>% - filter( - TIMESTAMP >= Sys.time() - days(7), - TIMESTAMP <= Sys.time() - ) - - for(site in unique(exo_long_current$Site)) { - p <- ggplot(filter(exo_long_current, Site == site), aes(TIMESTAMP, value)) + - facet_wrap(. ~ name, scales = "free") + - geom_point(na.rm = TRUE) + - ggtitle(site) - print(p) - } -} -``` diff --git a/scripts/synoptic_v2.R b/scripts/synoptic_v2.R index 206ef10..f082482 100755 --- a/scripts/synoptic_v2.R +++ b/scripts/synoptic_v2.R @@ -284,7 +284,7 @@ ts_sal_plot <- ts_plot("salinity", "Salinity (PSU)") ts_do_plot <- ts_plot("do_mgl", "DO (mg/L)") ts_ph_plot <- ts_plot("p_h", "pH") -ts_plots <- plot_grid(ts_pressure_plot, +ts_wl_plot <- plot_grid(ts_pressure_plot, ts_temp_plot, ts_sal_plot, ts_do_plot,