DWD: Climate Water Balance
Source:vignettes/dwd_climate-water-balance.Rmd
dwd_climate-water-balance.RmdHelper 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])
#> `summarise()` has grouped output by 'Decade', 'Decade_Label'. You can override
#> using the `.groups` argument.
#> `summarise()` has grouped output by 'Decade'. You can override using the
#> `.groups` argument.
gg2 <- plot_decades(data)
#> `summarise()` has grouped output by 'Decade', 'Decade_Label'. You can override
#> using the `.groups` argument.
#> `summarise()` has grouped output by 'Decade'. You can override using the
#> `.groups` argument.
#> `summarise()` has grouped output by 'Decade', 'Decade_Label', 'Month'. You can
#> override using the `.groups` argument.
#> 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.
#> `summarise()` has grouped output by 'Year'. You can override using the
#> `.groups` argument.
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])
#> `summarise()` has grouped output by 'Decade', 'Decade_Label'. You can override
#> using the `.groups` argument.
#> `summarise()` has grouped output by 'Decade'. You can override using the
#> `.groups` argument.
gg2 <- plot_decades(data)
#> `summarise()` has grouped output by 'Decade', 'Decade_Label'. You can override
#> using the `.groups` argument.
#> `summarise()` has grouped output by 'Decade'. You can override using the
#> `.groups` argument.
#> `summarise()` has grouped output by 'Decade', 'Decade_Label', 'Month'. You can
#> override using the `.groups` argument.
#> `summarise()` has grouped output by 'Year'. You can override using the
#> `.groups` argument.
print_to_pdf(gg2,
file = sprintf("%sdecades.pdf", file_name_base),
width.cm = 35)