Temporal Coverage
library(kwb.impetus)
dwd_timeperiod <- kwb.impetus::dwd_berlin_monthly %>%
dplyr::group_by(.data$parameter_name,
.data$parameter) %>%
dplyr::summarise(date_min = min(.data$date),
date_max = max(.data$date),
number_of_datapoints = dplyr::n()) %>%
dplyr::mutate(file_postfix = stringr::str_replace_all(.data$parameter, "_", "-"))
DT::datatable(dwd_timeperiod, caption = "Monthly DWD Data availability for Berlin")Content
DT::datatable(kwb.impetus::dwd_berlin_monthly)Define Helper Functions
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)
)
}
filter_for_parameter <- function(data, parameter_name) {
data[data$parameter_name == parameter_name,]
}
filter_for_max_year <- function(data) {
data[data$Year == max(data$Year),]
}
aggregate_and_plot <- function(parameter_name, colors, unit = "mm/month") {
full_data <- kwb.impetus::dwd_berlin_monthly %>%
filter_for_parameter(parameter_name) %>%
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)
)
aggregated_data <- full_data %>%
kwb.impetus::group_by_decade_month_label() %>%
summarise_means()
decades <- kwb.impetus::decades_tibble(
decade_labels = aggregated_data$Decade_Label,
colors = colors
)
decade_mean_data <- aggregated_data %>%
kwb.impetus::group_by_decade_label() %>%
dplyr::summarise(annual_mean = sum(.data$mean))
# p1 <- aggregated_data %>%
# dplyr::left_join(decade_mean_data) %>%
# dplyr::mutate(Decade_Label = sprintf(
# "%s\n%3.1f mm/Jahr)",
# .data$Decade_Label,
# round(.data$annual_mean, 1)
# ))
p1 <- aggregated_data
p2 <- full_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)
}Create Plots
Drought index
sel_para <- dwd_timeperiod[dwd_timeperiod$parameter == "drought_index",]
file_name <- sprintf("dwd_berlin_monthly_%s", sel_para$file_postfix)
gg <- aggregate_and_plot(parameter_name = sel_para$parameter_name,
colors = c(
'darkblue', 'blue', 'darkgreen', 'lightgreen', 'orange', 'red'
), unit = "-")
readr::write_csv(gg$data, file = sprintf("%s.csv", file_name))
print_to_pdf(gg, file = sprintf("%s.pdf", file_name), width.cm = 50)Evaporation, potential
sel_para <- dwd_timeperiod[dwd_timeperiod$parameter == "evapo_p",]
file_name <- sprintf("dwd_berlin_monthly_%s", sel_para$file_postfix)
gg <- aggregate_and_plot(parameter_name = sel_para$parameter_name, colors = c(
'darkgreen', 'lightgreen', 'orange', 'red'
))
readr::write_csv(gg$data, file = sprintf("%s.csv", file_name))
print_to_pdf(gg, file = sprintf("%s.pdf", file_name), width.cm = 35)Evaporation, real
sel_para <- dwd_timeperiod[dwd_timeperiod$parameter == "evapo_r",]
file_name <- sprintf("dwd_berlin_monthly_%s", sel_para$file_postfix)
gg <- aggregate_and_plot(parameter_name = sel_para$parameter_name, colors = c(
'darkgreen', 'lightgreen', 'orange', 'red'
))
readr::write_csv(gg$data, file = sprintf("%s.csv", file_name))
print_to_pdf(gg, file = sprintf("%s.pdf", file_name), width.cm = 35)Precipitation
sel_para <- dwd_timeperiod[dwd_timeperiod$parameter == "precipitation",]
file_name <- sprintf("dwd_berlin_monthly_%s", sel_para$file_postfix)
gg <- aggregate_and_plot(parameter_name = sel_para$parameter_name,
colors = c(
'darkblue', 'blue', 'darkgreen', 'lightgreen', 'orange', 'red'
))
readr::write_csv(gg$data, file = sprintf("%s.csv", file_name))
print_to_pdf(gg, file = sprintf("%s.pdf", file_name), width.cm = 50)Soil Moisture
sel_para <- dwd_timeperiod[dwd_timeperiod$parameter == "soil_moist",]
file_name <- sprintf("dwd_berlin_monthly_%s", sel_para$file_postfix)
gg <- aggregate_and_plot(parameter_name = sel_para$parameter_name, colors = c(
'darkgreen', 'lightgreen', 'orange', 'red'
), unit = "%")
readr::write_csv(gg$data, file = sprintf("%s.csv", file_name))
print_to_pdf(gg, file = sprintf("%s.pdf", file_name), width.cm = 35)Soil Temperature
sel_para <- dwd_timeperiod[dwd_timeperiod$parameter == "soil_temperature_5cm",]
file_name <- sprintf("dwd_berlin_monthly_%s", sel_para$file_postfix)
gg <- aggregate_and_plot(parameter_name = sel_para$parameter_name, colors = c(
'darkgreen', 'lightgreen', 'orange', 'red'
), unit = "\u00B0 C")
readr::write_csv(gg$data, file = sprintf("%s.csv", file_name))
print_to_pdf(gg, file = sprintf("%s.pdf", file_name), width.cm = 35)