In bcgov/hydrolook: Hydrometric Network Diagnostic

subtitle: "Province examined: `r params$prov`"

library(ggplot2)
library(dplyr)
library(tidyr)
library(purrr)
library(forcats)
library(readr)
library(tidyhydat)
library(hydrolook)
library(knitr)
library(kableExtra)
library(here)

#   Copyright 2017 Province of British Columbia

#   Licensed under the Apache License, Version 2.0 (the "License");
#   you may not use this file except in compliance with the License.
#   You may obtain a copy of the License at 

#      http://www.apache.org/licenses/LICENSE-2.0

#   Unless required by applicable law or agreed to in writing, software
#   distributed under the License is distributed on an "AS IS" BASIS,
#   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#   See the License for the specific language governing permissions and
#   limitations under the License.


## Knitr options dependent on type of document
if(params$table_format == "latex"){
  opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE, 
                      fig.width = 8, fig.height = 8, fig.path = file.path("report/net_diag/"))
}

if(params$table_format == "html"){
  opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE, 
                      fig.width = 8, fig.height = 8)
}

options(knitr.table.format = params$table_format) 

#params <- data.frame(table_format = "latex", prov = "BC")

Scope

This document is autogenerated to output a diagnostic of hydrometric stations within the shared federal-provincial network. Real-time hydrometric data is being downloaded from Water Survey of Canada's datamart for each real-time station in the province each time this report is generated.

Water Office Status

The following table identifies all stations that have not currently reported in the last 6 hours:

stns <- realtime_stations(prov_terr_state_loc = params$prov)

stns_split <- split(stns$STATION_NUMBER, (seq(length(stns$STATION_NUMBER))) %/% 20)

six_hour_status <- map_dfr(stns_split, ~ check_water_office_status(.x)) %>%
  filter(DATA_LAST_SIX_HOURS == "No") %>%
  select(-PROV_TERR_STATE_LOC) %>%
  arrange(OPERATION_SCHEDULE)

if(params$table_format == "latex"){
  six_hour_status %>%
    kable(format = "latex", booktabs = T) %>%
    kable_styling(font_size = 6,latex_options = c("striped", "HOLD_position"))
}

if(params$table_format == "html"){
  six_hour_status %>%
    kable(format = "html") %>%
    kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"))
}

Historical Performance

Here is a running total of stations that have had data issues.

Operation Status: Continuous

if(file.exists(here("report/net_diag", "water_office_record.csv"))) {
  hist_wo_status <- read_csv(here("report/net_diag", "water_office_record.csv"))

  today_stns_no_report <- hist_wo_status %>%
    filter(as.Date(Date) == Sys.Date()) %>%
    filter(DATA_LAST_SIX_HOURS == "No") %>%
    pull(STATION_NUMBER)

  hist_wo_status_plot_df <- hist_wo_status %>%
    filter(STATION_NUMBER %in% today_stns_no_report,  OPERATION_SCHEDULE == "Continuous") %>%
    filter(as.Date(Date) > (Sys.Date()-14)) %>%
    mutate(STATION_NUMBER = factor(STATION_NUMBER), levels = sort(STATION_NUMBER)) %>%
    mutate(STATION = paste0(STATION_NAME," (", STATION_NUMBER,")"))

  ## Station factor ordered by STATION_NUMBER factor level
  ordered_STATION <- unique(hist_wo_status_plot_df[order(hist_wo_status_plot_df$STATION_NUMBER),]$STATION)

  hist_wo_status_plot_df %>%
    mutate(STATION = factor(STATION, levels = ordered_STATION)) %>%
    ggplot(aes(x = Date, y = STATION, colour = DATA_LAST_SIX_HOURS)) +
    geom_line(colour = "black", linetype = 2) +
    geom_point(size = 3) +
    scale_colour_discrete(name = "Data record in the last six hours on the 'Date of Evaluation'") +
    labs(title = "Water Office Historical Data Reporting - Continuous Stations", subtitle = "Raw data available from: https://wateroffice.ec.gc.ca/mainmenu/real_time_data_index_e.html",
         y = "Station", x = "Date of Evaluation") +
    theme_minimal() +
    theme(legend.position = "bottom")
}

Operation Status: Seasonal

if(file.exists(here("report/net_diag", "water_office_record.csv"))) {
  hist_wo_status <- read_csv(here("report/net_diag", "water_office_record.csv"))

   today_stns_no_report <- hist_wo_status %>%
    filter(as.Date(Date) == Sys.Date()) %>%
    filter(DATA_LAST_SIX_HOURS == "No") %>%
    pull(STATION_NUMBER)

  hist_wo_status_plot_df <- hist_wo_status %>%
    filter(STATION_NUMBER %in% today_stns_no_report,  OPERATION_SCHEDULE == "Seasonal") %>%
    filter(as.Date(Date) >= (Sys.Date()-21)) %>%
    mutate(STATION_NUMBER = factor(STATION_NUMBER), levels = sort(STATION_NUMBER)) %>%
    mutate(STATION = paste0(STATION_NAME," (", STATION_NUMBER,")"))

  ## Station factor ordered by STATION_NUMBER factor level
  ordered_STATION <- unique(hist_wo_status_plot_df[order(hist_wo_status_plot_df$STATION_NUMBER),]$STATION)

  hist_wo_status_plot_df %>%
    mutate(STATION = factor(STATION, levels = ordered_STATION)) %>%
    ggplot(aes(x = Date, y = STATION, colour = DATA_LAST_SIX_HOURS)) +
    geom_line(colour = "black", linetype = 2) +
    geom_point(size = 3) +
    scale_colour_discrete(name = "Data record in the last six hours on the 'Date of Evaluation'") +
    labs(title = "Water Office Historical Data Reporting - Seasonal Stations", subtitle = "Raw data available from: https://wateroffice.ec.gc.ca/mainmenu/real_time_data_index_e.html",
         y = "Station", x = "Date of Evaluation") +
    theme_minimal() +
    theme(legend.position = "bottom")
}

Datamart Status

The following stations are listed on the hydrometric station list both not in the datamart. These stations can be considered stations that are not transmitting real-time data but should be. If no table is presented, all stations are reporting in realtime.

check_datamart_status(params$prov)

Stations that haven't reported in the past 6 hours

Continuous stations

continuous <- six_hour_status %>%
  filter(DATA_LAST_SIX_HOURS == "No", OPERATION_SCHEDULE == "Continuous") %>%
  pull(STATION_NUMBER) %>%
  realtime_dd() %>%
  filter(!is.na(STATION_NUMBER), !is.na(Value))

if(nrow(continuous) > 0){
  continuous %>%
    left_join(stns,by = c("STATION_NUMBER", "PROV_TERR_STATE_LOC")) %>%
    mutate(STATION = paste0(STATION_NAME, " - ", STATION_NUMBER)) %>%
    ggplot(aes(x = Date, y = STATION, colour = Value)) +
    geom_point() +
    facet_wrap(~Parameter, ncol = 2) +
    theme_minimal()
}

Seasonal stations

seasonal <- six_hour_status %>%
  filter(DATA_LAST_SIX_HOURS == "No", OPERATION_SCHEDULE == "Seasonal") %>%
  pull(STATION_NUMBER) %>%
  realtime_dd() %>%
  filter(!is.na(STATION_NUMBER), !is.na(Value))


if(nrow(seasonal) > 0){
  seasonal %>%
    left_join(stns,by = c("STATION_NUMBER", "PROV_TERR_STATE_LOC")) %>%
    mutate(STATION = paste0(STATION_NAME, " - ", STATION_NUMBER)) %>%
    ggplot(aes(x = Date, y = STATION, colour = Value)) +
    geom_point() +
    facet_wrap(~Parameter, ncol = 2) +
    theme_minimal()
}