# 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 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()
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()
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") }
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")) }
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.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.