In bcgov/bcgwlreports: Create BC Groundwater Level Reports

library(dplyr)
library(ggplot2)
library(kableExtra)
library(glue)
library(lubridate)
library(stringr)
library(patchwork)

knitr::opts_chunk$set(echo = FALSE)
options(knitr.kable.NA = '')
w_full <- params$w_full
w_hist <- params$w_hist
w_comp <- params$w_comp
w_perc <- params$w_perc
w_dates <- params$w_dates
n_days <- params$n_days
report_dates <- params$report_dates
ows <- unique(w_full$ow)
years_min <- params$years_min

window <- w_perc %>%
  filter(window) %>%
  pull(report_dates) %>%
  unique()

Section 1 - Overview

well_table_overview(w_dates) %>%
  kable(booktabs = TRUE, longtable = TRUE, format = "latex", digits = 2, linesep = "",
        escape = FALSE,
        caption = glue("\\textbf{{Well numbers and reporting dates}}\\\\",
                       "Values are depth below ground (m) for a given well/date.\\\\",
                       "Blank cells indicate no data.\\\\",
                       "** indicates a value not on the exact reporting date but within ",
                       "a {n_days*2 + 1}-day window around the reporting date.")) %>%
  kable_styling(latex_options = c("hold_position", "repeat_header"))

\newpage

Wells Below Normal

t <- well_table_below_norm(w_perc, window)

t %>%
  kable(format = "latex", booktabs = TRUE, linesep = "",
        caption = glue("\\textbf{{Proportion of wells Below Normal or Much Below Normal}}\\\\",
                       "(X/Y) indicates X wells with low values out of Y wells total for that ",
                       "date/category.\\\\",
                       "Blank cells indicate no wells with data\\\\",
                       "** indicates reporting dates which include values within ",
                       "a {n_days*2 + 1}-day window around it")) %>%
  kable_styling(latex_options = "hold_position") %>%
  row_spec(str_which(t$`Aquifer Type`, "Across all types"), hline_after = TRUE)

Groundwater Level Status

t <- well_table_status(w_perc, perc_values, window)

t %>%
  mutate(colour = "") %>%
  kable(format = "latex", col.names = c(" ", "Percentile class", names(.)[-c(1:2)]), 
        booktabs = TRUE, linesep = "",
        caption = glue("\\textbf{{Number of wells in each percentile class ",
                       "by date}}\\\\",
                       "** indicates reporting dates which include values within ",
                       "a {n_days*2 + 1}-day window around it")) %>%
  kable_styling(latex_options = "hold_position") %>%
  column_spec(1, background = c("white", t$colour)) %>%
  row_spec(str_which(t$class, "Across"), hline_after = TRUE)

\newpage

\blandscape

Section 2 - Summary

\captionsetup{width=0.9\paperwidth}

t <- well_table_summary(w_dates, w_hist, perc_values)
bg_colour <- t$bg_colour
txt_colour <- t$txt_colour
t <- select(t, -bg_colour, -txt_colour)

t %>%
  kable(format = "latex", booktabs = TRUE, longtable = TRUE, escape = FALSE, linesep = "",
        col.names = linebreak(names(t), align = "c"), align = "lllllcrclrr",
        caption = glue("\\textbf{{Information on observation wells in ",
                       "{year(t$`Latest\nDate`[1])}}}\\\\", 
                       "Includes comparison of latest water depth value ",
                       "compared to last year's value. ",
                       "Values/Medians are in meters below ground. ",
                       "Perc. Years are the number of years included in the ",
                       "percentile calculation.\\\\",
                       "** Indicates Values with an Approval Status of 'Working'\\\\", # Require extra *
                       "*** Indicates a daily percentile calculated from more than ",
                       "{years_min} but less than {years_max} years worth of data")) %>%
  kable_styling(latex_options = c("hold_position", "repeat_header")) %>%
  column_spec(str_which(names(t), "Aquifer Type"), width = "7em", latex_valign = "m") %>%
  column_spec(str_which(names(t), "Percentile Class"), width = "8em", latex_valign = "m", 
              background = bg_colour, color = txt_colour)

\elandscape

\newpage

Section 3 - Plots

date_range <- w_full %>%
  filter(CurrentYear) %>%
  select(WaterYear, water_year_start) %>%
  distinct() %>%
  glue_data("{WaterYear}-{water_year_start}-01") %>%
  ymd()
date_range <- c(date_range - years(20), date_range)

latest_date <- w_dates %>% 
  group_by(ow) %>% 
  filter(!is.na(Value)) %>%
  filter(Date == max(Date)) %>%
  filter(CurrentYear) #Keep only ones that are in Table 4?

for(ow in sort(ows)) {
  cat(glue("### {ow}\n\n"))
  full <- filter(w_full, ow == !!ow)
  hist <- filter(w_hist, ow == !!ow)
  date <- filter(latest_date, ow == !!ow)

  g1 <- well_plot_perc(full, hist, date, years_min)
  g2 <- well_plot_hist(full, hist, date_range, date, wrap_year = TRUE)

  g <- g1 / g2 + plot_layout(heights = c(1, 2))
  print(g)

  cat("\n\n\\newpage\n\n")
}

\newpage

Appendix A - Dates

If data isn't available for an exact reporting date, dates up to r n_days before and r n_days after the report date are examined for non-missing data. Thus, an alternative date is chosen within a r n_days * 2 + 1 day window, centred on the reporting date.

If there are multiple dates with data, the dates are ranked based on their historical data quality (for calculating percentiles) and their nearness to the original date indicated. The top date is then chosen for that well and that reporting date.

This table lists the original reporting dates, and the actual dates used for each observation well.

appendix_dates(w_dates) %>%
  kable(booktabs = TRUE, longtable = TRUE, format = "latex", digits = 2, linesep = "",
          escape = FALSE,
          caption = glue("\\textbf{{Exact reporting dates}}\\\\",
                         "Blank cells indicate no data (i.e. no date with ",
                         "non-missing values within a {n_days*2 + 1}-day window ",
                         "around the reporting date).\\\\")) %>%
    kable_styling(latex_options = c("hold_position", "repeat_header")) %>%
    add_header_above(c("", "", "", "Report Dates vs. Measurement dates" = 4))

\newpage

Appendix B - Calculations

General details

• Water year starts in October
• Well measurements are all in Depth Below Ground in metres
• Current Water Year plots show data for the most recent water year with at least 1 week of data (7 days).

Percentiles

• Percentiles are calculated individually for each day of the year for each well
• 366 day in leap years is omitted
• They are based on data in the last r years_max years starting in the Water Year before the current one
• "Good" quality data have 'Approved' historical values for all r years_max years
• "Fair" quality data have 'Approved' historical values for >= r years_min but < r years_max years
• "Poor" quality data have 'Approved' historical values for < r years_min years and are not used (percentiles for that well on that day of the year are missing from the figures and tables).

\newpage

Appendix C - Run info

Date/Time: r Sys.time()

Parameters

• Report Dates (report_dates): r glue_collapse(report_dates[1:2], ", ")
• Days in Window (n_days): r n_days
• Total window around (and including) a date is r n_days * 2 + 1 days
• Percentile Calculations
• Min number of years (years_min) - r years_min
• Max no. years (years_max) - r years_max

Session Info

Platform

sessioninfo::platform_info()

Packages

sessioninfo::package_info()

bcgov/bcgwlreports documentation built on Aug. 9, 2024, 10:47 p.m.