In bcgov/hydrolook: Hydrometric Network Diagnostic

# 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::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE, fig.width = 8, 
                      fig.height = 8, fig.path = here::here("report/Realtime_lag"))



library(tidyhydat)
library(hydrolook)
library(ggplot2)
library(dplyr)
library(tidyr)
library(readr)
library(knitr)
library(kableExtra)

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

#params <- tibble(table_format = "latex", prov = "PE")
bc_lag <- check_realtime_lag(prov_terr_state_loc = params$prov)
network_info <- realtime_stations(prov_terr_state_loc = params$prov)
#bc_lag <- check_realtime_lag(STATION_NUMBER = c("08NL071","08LG048"))

#bc_lag

Summary

Summary of difference between most recent observation and uploaded time

lag_tbl <- bc_lag %>%
  filter(!is.na(time_lag_num)) %>%
  summarise_at(vars(time_lag_num), funs(mean, median, sd, min, max, n()))

cat(paste0("Province surveyed: ", params$prov))

if (params$table_format == "latex"){
kable(lag_tbl, format = "latex", booktabs = T) %>%
  kable_styling(latex_options = c("striped", "HOLD_position")) %>%
  #kable_styling(bootstrap_options = c("striped", "hover"))  %>%
  add_footnote(c("Values presented in hours"), notation = "number")
}

if (params$table_format == "html"){
  kable(lag_tbl, format = "html") %>%
  kable_styling(bootstrap_options = c("striped", "hover"))  %>%
  add_footnote(c("Values presented in hours"), notation = "number")
}

#existing_data = read_csv("C:/_dev/Git_repos/hydrolook_output/report/Realtime_lag/lag_record.csv")
#
#lag_tbl %>%
#  mutate(Datetime = Sys.time()) %>%
#  bind_rows(existing_data) %>%
#  write_csv("C:/_dev/Git_repos/hydrolook_output/report/Realtime_lag/lag_record.csv") %>%
#  gather(vars, value, -Datetime, -n) %>%
#  ggplot(aes(x = Datetime, y = value, colour = vars)) +
#  geom_point() +
#  scale_x_datetime(date_labels = "%b %d") +
#  geom_line()

Distribution of Data Lag

num_stations = nrow(bc_lag)

bc_lag %>%
  mutate(Grouping = case_when(
   time_lag_num >= 1000 ~ "Over 1000 minutes", 
   time_lag_num < 1000 ~ "Under 1000 minutes"
  )  ) %>%
  filter(!is.na(Grouping)) %>%
  ggplot(aes(x = time_lag_num)) +
  geom_histogram() +
  geom_rug() +
  labs(x = "Difference between upload time and most recent observations (minutes)",
       y = "Number of Ocurrences",
       title = paste0("Realtime Hydrometric Station Data Lag (n = ",num_stations,")"),
       subtitle = "Each station was pinged for the most recent hydrometric observation. The difference between this value and the time of data upload is considered the lag time" ) +
  facet_wrap(~Grouping, scales = "free_x") +
  theme_minimal()

Stations greater than 10 hour lag

big_lags <- bc_lag %>%
  filter(time_lag_num > 10) %>%
  left_join(network_info, by = c("STATION_NUMBER")) %>%
  select(STATION_NUMBER, STATION_NAME, time_obs, time_mod, time_lag) %>%
  arrange(time_lag)

if (nrow(big_lags) == 0){
  cat("No stations with a lag greater than 10 hours")
}

if (params$table_format == "latex" && nrow(big_lags) > 0){
  kable(big_lags, format = "latex", longtable = T, booktabs = T) %>%
    kable_styling(font_size = 5, latex_options = c("striped","HOLD_position","repeat_header")) %>%
    add_footnote(c("Values presented in hours"), notation = "number")
}

if (params$table_format == "html" && nrow(big_lags) > 0){
  kable(big_lags, format = "html") %>%
    kable_styling(bootstrap_options = c("striped", "hover"))  %>%
    add_footnote(c("Values presented in hours"), notation = "number")
}

Stations that have not being updated in the last 24 hours

cat("Current date and time:")
print(Sys.time())

not_updating <- bc_lag %>%
  filter(time_obs < Sys.time() - (24*60*60)) %>%
  left_join(network_info, by = c("STATION_NUMBER")) %>%
  select(STATION_NUMBER, STATION_NAME, time_obs) %>%
  arrange(time_obs)

if (nrow(not_updating) == 0){
  cat("All stations have updated measurements taken within the last 24 hours")
}

if (params$table_format == "latex" && nrow(not_updating) > 0){
  kable(not_updating, format = "latex", longtable = T, booktabs = T) %>%
    kable_styling(font_size = 8, latex_options = c("striped","HOLD_position","repeat_header")) 
}

if (params$table_format == "html" && nrow(not_updating) > 0){
  kable(font_size =5,not_updating, format = "html") %>%
    kable_styling(bootstrap_options = c("striped", "hover")) 
}

License

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.

bcgov/hydrolook documentation built on May 2, 2021, 11:23 p.m.