Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft material for SP workshop slides #208

Closed
wants to merge 7 commits into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -4,3 +4,6 @@
.Ruserdata
.DS_Store
*.dcf

sp-slides_files/
sp-slides_cache/
206 changes: 206 additions & 0 deletions sp-slides.qmd
Original file line number Diff line number Diff line change
@@ -0,0 +1,206 @@
---
title: "sp-slides"
title-block-banner: true
params:
L1_DATA: "./synoptic/data/L1/"
date: now
date-format: "YYYY-MM-DD HH:mm:ssZ"
format:
html:
code-fold: true
editor: visual
---

## Maps and figures

```{r prelims}
#| include: false

library(readr)
library(dplyr)
library(tidyr)
library(lubridate)
library(gt)

library(ggplot2)
theme_set(theme_bw())
library(scales)
library(viridis)
library(gt)

make_depth <- function(research_name) {
depth <- gsub("cm", " cm", substr(research_name, 10, 13))
factor(depth, levels = c("5 cm", "10 cm", "15 cm", "30 cm"))
}
```

![Synoptic sites](synoptic/docs/synoptic_sites.png)

![Exchange sites](synoptic/docs/exchange-synoptic.png)

![Installation](synoptic/docs/alice_install.jpg)
![Sensor](synoptic/docs/teros-12-soil-water-potential-sensor-curved.png)


## Data prep

```{r data-prep}
#| include: false
#| cache: true

variable <- "soil_vwc"

# Get the names of the files we need. Note this assumes that your
# working directory is the main directory of the L1 data
files <- list.files(params$L1_DATA,
pattern = ".*L1_v1-[0-9]\\.csv$",
recursive = TRUE, full.names = TRUE)

# Helper function to read the files and filter to just the variable we want
# Note that we set "col_types" to force the "Plot" column to be read as a
# character; see https://github.com/COMPASS-DOE/data-workflows/issues/186
f <- function(f, variable) {
message("Reading ", basename(f))
x <- read_csv(f, col_types = "ccTccccdccii")
x <- x[grep(variable, x$research_name),]
x %>%
group_by(Site, research_name) %>%
summarise(TIMESTAMP = mean(TIMESTAMP), n = n(), .groups = "drop") %>%
mutate(Date = as.Date(TIMESTAMP)) %>%
select(-TIMESTAMP)
}

# Read the files and concatenate
dat <- lapply(files, f, variable)
dat <- bind_rows(dat)

```

## Observations (M)

```{r table}
dat %>%
mutate(Year = year(Date)) %>%
group_by(Year, Site) %>%
summarise(n = sum(n, na.rm = TRUE), .groups = "drop") %>%
pivot_wider(names_from = "Year", values_from = "n", values_fill = 0) %>%
arrange(Site) ->
dat_table

dat_table %>%
gt::gt() %>%
grand_summary_rows(columns = which(sapply(dat_table, is.numeric)),
fmt = ~fmt_number(., scale_by = 1e-6, decimals = 2),
fns = list(label = "Totals", id = "totals", fn = "sum")) %>%
fmt_number(scale_by = 1e-6, decimals = 2)
```

## Observations over time

```{r obs-over-time}
dat %>%
complete(Site, Date, research_name, fill = list(rows = 0)) %>%
group_by(Site, Date) %>%
summarise(n = sum(n, na.rm = TRUE), .groups = "drop") %>%
arrange(Date) %>%
group_by(Site) %>%
mutate(cum_n = cumsum(n)) ->
smry1

p1 <- ggplot(smry1, aes(Date, cum_n, fill = Site)) +
geom_area(alpha = 0.8 , linewidth = 0.5, colour = "white") +
xlab("Year") + ylab("COMPASS-FME VWC observations") +
scale_fill_viridis(discrete = TRUE) +
theme(axis.title = element_text(size = 14)) +
scale_y_continuous(labels = unit_format(unit = "M", scale = 1e-6))
print(p1)

dat %>%
complete(Site, Date, research_name, fill = list(rows = 0)) %>%
group_by(Date, research_name) %>%
summarise(n = sum(n, na.rm = TRUE), .groups = "drop") %>%
arrange(Date) %>%
group_by(research_name) %>%
mutate(cum_n = cumsum(n),
Depth = make_depth(research_name)) ->
smry2

p2 <- ggplot(smry2, aes(Date, cum_n, fill = Depth)) +
geom_area(alpha = 0.8 , linewidth = 0.5, colour = "white") +
xlab("Year") + ylab("COMPASS-FME VWC observations") +
scale_fill_viridis(discrete = TRUE) +
theme(axis.title = element_text(size = 14)) +
scale_y_continuous(labels = unit_format(unit = "M", scale = 1e-6))
print(p2)
```

## TEMPEST TEROS data

```{r teros-prep}
#| include: false
#| cache: true

# Focus on TEMPEST control to show some nice time series
files <- list.files(params$L1_DATA,
pattern = "^TMP_C.*L1_v1-[0-9]\\.csv$",
recursive = TRUE, full.names = TRUE)

f <- function(f, variable) {
message("Reading ", basename(f))
x <- read_csv(f, col_types = "ccTccccdccii")
x[grep(variable, x$Instrument), c("TIMESTAMP", "Sensor_ID", "Value", "research_name")]
}

# Read the files and concatenate
teros_dat <- lapply(files, f, "TEROS")
teros_dat <- bind_rows(teros_dat)
```

```{r two-days}
teros_dat %>%
filter(as.Date(TIMESTAMP) %in% c(ymd("2021-06-14"), ymd("2021-06-15"))) ->
twodays

twodays <- twodays[grep("soil_vwc", twodays$research_name),]

# Two days plot that shows a cool midnight rain event
twodays %>%
mutate(Depth = make_depth(research_name)) %>%
ggplot(aes(TIMESTAMP, Value, color = Depth, group = Sensor_ID)) +
geom_line(na.rm = TRUE) +
scale_x_datetime(date_breaks = "1 day") +
ylab("Soil VWC") +
theme(axis.text.x = element_text(angle = 90)) +
ggtitle("Rain event - TEMPEST control plot") +
facet_wrap(~Depth)
```

```{r teros-plot}
teros_dat %>%
mutate(Date = as.Date(TIMESTAMP)) %>%
group_by(Sensor_ID, research_name, Date) %>%
summarise(Value = mean(Value, na.rm = TRUE), .groups = "drop") %>%
mutate(Depth = make_depth(research_name)) ->
full_record

full_record_vwc <- full_record[grep("soil_vwc", full_record$research_name),]

# Plot complete VWC record at TEMPEST control
ggplot(full_record_vwc, aes(Date, Value, color = Depth, group = Sensor_ID)) +
geom_line(na.rm = TRUE, alpha = 0.5) +
ylab("Soil VWC") +
ylim(c(0.1, 0.5)) +
ggtitle("TEMPEST control plot, all data")

# Plot VWC versus temperature
full_record %>%
mutate(Month = month(Date)) %>%
select(-Depth) %>%
pivot_wider(names_from = "research_name", values_from = "Value") %>%
ggplot(aes(soil_temp_15cm, soil_vwc_15cm, color = Month)) +
geom_point(size = 0.4, na.rm = TRUE) +
ylim(c(0.1, 0.5)) + xlim(c(0,25)) +
xlab("Soil 15 cm temperature") + ylab("Soil 15 cm VWC") +
ggtitle("TEMPEST control plot, all data")
```

Binary file added synoptic/docs/alice_install.jpg
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
Binary file added synoptic/docs/exchange-synoptic.png
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
Binary file added synoptic/docs/synoptic_sites.png
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
Loading