--- title: "DWD: Climate Water Balance" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{DWD: Climate Water Balance} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` ### Helper Functions ```{r helper functions} library(kwb.impetus) summarise_means <- function(data) { data %>% dplyr::summarise( q05 = quantile(.data$mean, probs = 0.05), q95 = quantile(.data$mean, probs = 0.95), mean = mean(.data$mean) ) } decade_year_sums <- function(data, full_years = TRUE, unit = "mm/a") { years <- unique(data$year) if(full_years) { years <- data %>% dplyr::count(Decade, Decade_Label, Year) %>% dplyr::filter(.data$n == 12) %>% dplyr::pull(.data$Year) } data %>% dplyr::filter(.data$year %in% years) %>% dplyr::group_by(Decade, Decade_Label, Year) %>% dplyr::summarise(mean = sum(mean)) %>% summarise_means() %>% dplyr::mutate(Decade_Label_new = sprintf("%s\nq95: %3.1f %s\nmean: %3.1f %s\nq05: %3.1f %s", .data$Decade_Label, .data$q95, unit, .data$mean, unit, .data$q05, unit)) } filter_for_max_year <- function(data) { data[data$Year == max(data$Year),] } plot_yearly <- function(data, y_label) { data %>% dplyr::group_by(year) %>% dplyr::summarise(mean = sum(mean)) %>% dplyr::mutate( Year = as.integer(.data$year), Decade = kwb.impetus::floor_decade(.data$year), Decade_Label = kwb.impetus::decade_label(.data$Decade)) %>% ggplot2::ggplot(mapping = ggplot2::aes(x = year, y = mean)) + ggplot2::geom_point() + ggplot2::geom_line() + ggplot2::theme_bw() + ggplot2::labs(x = "Year", y = sprintf("%s (mm/a)", y_label)) } plot_decades <- function(data, unit = "mm/a") { decade_sums <- decade_year_sums(data) %>% dplyr::ungroup() %>% dplyr::select(Decade_Label, Decade_Label_new) aggregated_data <- data %>% kwb.impetus::group_by_decade_month_label() %>% summarise_means() %>% dplyr::ungroup() %>% dplyr::left_join(decade_sums, by = "Decade_Label") %>% dplyr::select(-.data$Decade_Label) %>% dplyr::rename(Decade_Label = .data$Decade_Label_new) decades <- kwb.impetus::decades_tibble( decade_labels = aggregated_data$Decade_Label, colors = c('darkgreen', 'lightgreen', 'orange', 'red') ) p1 <- aggregated_data p2 <- data %>% filter_for_max_year() %>% kwb.impetus::group_by_decade_label() %>% kwb.impetus::group_by_year_month() %>% summarise_means() p1 %>% ggplot2::ggplot(mapping = ggplot2::aes( x = as.integer(.data$Month), y = .data$mean, col = as.factor(.data$Decade_Label) )) + #ggplot2::geom_point(alpha = 0.5) + kwb.impetus::decade_ribbons() + kwb.impetus::scale_fill_decades(decades) + kwb.impetus::scale_color_decades(decades) + ggplot2::geom_point() + ggplot2::geom_point(ggplot2::aes( x = as.integer(.data$Month), y = .data$mean ), data = p2, col = "darkgrey", alpha = 0.5, inherit.aes = FALSE, show.legend = FALSE ) + kwb.impetus::ggplot2_scale_x_continuous_12() + #ggplot2::geom_boxplot() + ggplot2::facet_wrap( ~ .data$Decade_Label, nrow = 1L, ncol = length(unique(p1$Decade_Label)) ) + ggplot2::theme_bw() + ggplot2::theme(legend.position = "bottom") + ggplot2::labs( y = sprintf("Mean '%s' (%s)", parameter_name, unit), x = "Month Number", col = "Mean", fill = "5%/95% Conf.-Interval", title = unique(p1$Label) ) } print_to_pdf <- function(gg, file, width.cm) { kwb.utils::preparePdf( file, landscape = TRUE, width.cm = width.cm, height.cm = 21 ) on.exit(dev.off()) print(gg) } ``` ## Climate Water Balance ### Precipitation - Evaporation, potential ```{r waterbalance_1} parameter_name <- "Precipitation - Evaporation, real" parameter_id <- "evapo_p" file_name_base <- sprintf("precipitation-%s_", parameter_id) data <- kwb.impetus::dwd_berlin_monthly %>% dplyr::select(parameter, date, year, month, mean) %>% dplyr::filter(parameter %in% c("precipitation", parameter_id)) %>% tidyr::pivot_wider(names_from = "parameter", values_from = "mean") %>% dplyr::mutate( Year = as.integer(.data$year), Decade = kwb.impetus::floor_decade(.data$year), Decade_Label = kwb.impetus::decade_label(.data$Decade), Month = as.factor(.data$month), Label = sprintf("DWD, monthly '%s'", parameter_name), mean = .data$precipitation - .data[[parameter_id]] ) %>% dplyr::filter(!is.na(mean)) %>% dplyr::select(- .data$precipitation, - .data[[parameter_id]]) ``` **By Year** ```{r waterbalance_1_by_year} gg1 <- plot_yearly(data, y_label = parameter_name) plotly::ggplotly(gg1) print_to_pdf(gg1, file = sprintf("%syearly.pdf", file_name_base), width.cm = 35) ``` **By Decade** ```{r waterbalance_1_by_decade_table} DT::datatable(decade_year_sums(data)[,-6]) ``` ```{r waterbalance_1_by_decade_plot} gg2 <- plot_decades(data) print_to_pdf(gg2, file = sprintf("%sdecades.pdf", file_name_base), width.cm = 35) ``` ### Precipitation - Evaporation, real ```{r waterbalance_2} parameter_name <- "Precipitation - Evaporation, real" parameter_id <- "evapo_r" file_name_base <- sprintf("precipitation-%s_", parameter_id) data <- kwb.impetus::dwd_berlin_monthly %>% dplyr::select(parameter, date, year, month, mean) %>% dplyr::filter(parameter %in% c("precipitation", parameter_id)) %>% tidyr::pivot_wider(names_from = "parameter", values_from = "mean") %>% dplyr::mutate( Year = as.integer(.data$year), Decade = kwb.impetus::floor_decade(.data$year), Decade_Label = kwb.impetus::decade_label(.data$Decade), Month = as.factor(.data$month), Label = sprintf("DWD, monthly '%s'", parameter_name), mean = .data$precipitation - .data[[parameter_id]] ) %>% dplyr::filter(!is.na(mean)) %>% dplyr::select(- .data$precipitation, - .data[[parameter_id]]) ``` **By Year** ```{r waterbalance_2_by_year} gg1 <- plot_yearly(data, y_label = parameter_name) plotly::ggplotly(gg1) print_to_pdf(gg1, file = sprintf("%syearly.pdf", file_name_base), width.cm = 35) ``` **By Decade** ```{r waterbalance_2_by_decade_table} DT::datatable(decade_year_sums(data)[,-6]) ``` ```{r waterbalance_2_by_decade_plot} gg2 <- plot_decades(data) print_to_pdf(gg2, file = sprintf("%sdecades.pdf", file_name_base), width.cm = 35) ``` ## Download The plots created with the code above were exported into `pdf` files, which are available for download here: ```{r download, echo = FALSE, results ='asis'} files_pdf <- list.files(pattern = "^precipitation-evapo.*\\.pdf$") download_pdf <- sprintf("**PDF**:\n\n%s", paste0( sprintf("- [%s](https://kwb-r.github.io/kwb.impetus/%s)", files_pdf, files_pdf), collapse = "\n\n") ) cat(download_pdf) ```