DWD: Climate Water Balance

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


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]])
#> Warning: Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0.
#> ℹ Please use `"precipitation"` instead of `.data$precipitation`
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
#> generated.
#> Warning: Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0.
#> ℹ Please use `all_of(var)` (or `any_of(var)`) instead of `.data[[var]]`
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
#> generated.

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

DT::datatable(decade_year_sums(data)[,-6])
gg2 <- plot_decades(data)
#> Warning: Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0.
#> ℹ Please use `"Decade_Label"` instead of `.data$Decade_Label`
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
#> generated.
#> Warning: Use of .data in tidyselect expressions was deprecated in tidyselect 1.2.0.
#> ℹ Please use `"Decade_Label_new"` instead of `.data$Decade_Label_new`
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
#> generated.
print_to_pdf(gg2,
             file = sprintf("%sdecades.pdf", file_name_base), 
             width.cm = 35)

Precipitation - Evaporation, real


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

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

DT::datatable(decade_year_sums(data)[,-6])
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:

PDF: