Load packages

library(tidyverse)
library(rvest)
library(tinytable)

Daten

Datenquelle: Deutscher Wetterdienst (DWD), Climate Data Center, opendata.dwd.de, Lizenz: CC BY 4.0

base_url <- "https://opendata.dwd.de/climate_environment/CDC/regional_averages_DE"

Hilfsfunktion: alle .txt-Dateilinks eines Verzeichnisses auslesen

list_txt_files <- function(dir_url) {
  page <- read_html(dir_url)
  hrefs <- page |> html_elements("a") |> html_attr("href")
  hrefs[str_ends(hrefs, ".txt")]
}

Hilfsfunktion: eine DWD-Bundesland-Zeitreihendatei einlesen

Jahresdateien haben den Header “Jahr;Jahr;Bundesland1;…”: die zweite Spalte ist nur ein Textlabel (“year”), keine echte zweite Jahresangabe. Bei doppelten Namen die zweite Vorkommnis auf “Periode” umbenennen, sonst kollidieren beide zu “Jahr…1”/“Jahr…2” und “Jahr” existiert danach nicht mehr als eigenstaendige Spalte.

read_regional_file <- function(url) {

  # Header steht in Zeile 2 der Datei (Zeile 1 ist ein Titel/Kommentar).
  header <- read_lines(url, skip = 1, n_max = 1) |>
    str_split(";") |>
    unlist() |>
    str_trim()
  header <- header[header != ""]  # trailing Semikolon entfernt leere Spalte



  dupe <- duplicated(header)
  header[dupe] <- "Periode"

  spez <- ifelse(header == "Jahr", "i",
           ifelse(header %in% c("Monat", "Periode"), "c", "d"))
  spez <- setNames(spez, header)

  df <- read_delim(
    url, delim = ";", skip = 2, trim_ws = TRUE,
    na = c("", "NA"), show_col_types = FALSE,
    col_names = header, col_types = paste(spez, collapse = "")
  )

  if ("Monat" %in% names(df)) df <- df |> mutate(Monat = as.integer(Monat))
  if ("Periode" %in% names(df)) df <- df |> select(-Periode)

  df |> select(where(~ !all(is.na(.))))
}

1. Monatswerte: Temperatur

tm_dir   <- file.path(base_url, "monthly/air_temperature_mean")
tm_files <- list_txt_files(tm_dir)

temperatur_monat <- map_dfr(tm_files, ~ read_regional_file(file.path(tm_dir, .x)))

temperatur_lang <- temperatur_monat |>
  pivot_longer(
    cols = -c(Jahr, Monat),
    names_to = "Bundesland",
    values_to = "Temp_Mittel_C"
  ) |>
  filter(!is.na(Temp_Mittel_C)) |>
  arrange(Bundesland, Jahr, Monat)

#write_csv(temperatur_lang, "temperatur_bundesland_monat.csv")

2. Monatswerte: Niederschlag (optional, fuer CDD/CWD-Kontext PRCPTOT)

rr_dir   <- file.path(base_url, "monthly/precipitation")
rr_files <- list_txt_files(rr_dir)

niederschlag_lang <- map_dfr(rr_files, ~ read_regional_file(file.path(rr_dir, .x))) |>
  pivot_longer(cols = -c(Jahr, Monat), names_to = "Bundesland", values_to = "Niederschlag_mm") |>
  filter(!is.na(Niederschlag_mm)) |>
  arrange(Bundesland, Jahr, Monat)

#write_csv(niederschlag_lang, "niederschlag_bundesland_monat.csv")

3. Jahreswerte: Kenntage (FD, SU, TR, hot_days, ice_days, Starkregentage)

kenntage_ordner <- c(
  frost_days        = "annual/frost_days",         # FD
  summer_days       = "annual/summer_days",        # SU
  tropical_nights   = "annual/tropical_nights_tminGE20",  # TR
  hot_days          = "annual/hot_days",
  ice_days          = "annual/ice_days",
  precipGE10mm_days = "annual/precipGE10mm_days",
  precipGE20mm_days = "annual/precipGE20mm_days"
)

kenntage_liste <- imap(kenntage_ordner, function(pfad, label) {
  dir_url <- file.path(base_url, pfad)
  files   <- list_txt_files(dir_url)
  if (length(files) == 0) return(NULL)
  df <- read_regional_file(file.path(dir_url, files[1]))
  df |>
    pivot_longer(cols = -any_of(c("Jahr", "Monat")), names_to = "Bundesland", values_to = "Wert") |>
    filter(!is.na(Wert)) |>
    mutate(Indikator = label)
})

kenntage_lang <- bind_rows(kenntage_liste) |>
  arrange(Indikator, Bundesland, Jahr)

# write_csv(kenntage_lang, "klimakenntage_bundesland_jahr.csv")

4. Jahreswerte: Trockenheit (abgeleitet aus den Monatsniederschlaegen)

# Ein Monat gilt als "trocken", wenn sein Niederschlag unter dem 20%-Quantil
# der langjaehrigen Monatsniederschlaege des jeweiligen Bundeslands liegt
# (bundeslandspezifischer, relativer Schwellenwert statt fixer mm-Grenze,
# da die Bundeslaender klimatisch sehr unterschiedlich trocken/feucht sind).
trockenheit_lang <- niederschlag_lang |>
  group_by(Bundesland) |>
  mutate(schwelle = quantile(Niederschlag_mm, 0.2, na.rm = TRUE)) |>
  ungroup() |>
  group_by(Bundesland, Jahr) |>
  summarise(Wert = sum(Niederschlag_mm < schwelle, na.rm = TRUE), .groups = "drop") |>
  mutate(Indikator = "trocken_monate")

kenntage_lang <- bind_rows(kenntage_lang, trockenheit_lang) |>
  arrange(Indikator, Bundesland, Jahr)

# write_csv(kenntage_lang, "klimakenntage_bundesland_jahr.csv")

ref_start <- 1991
ref_end   <- 2020

temperatur_jahr <- temperatur_lang |>
  group_by(Bundesland, Jahr) |>
  summarise(Temp_Mittel_C = mean(Temp_Mittel_C, na.rm = TRUE), .groups = "drop")

referenz_temp <- temperatur_jahr |>
  filter(Jahr >= ref_start, Jahr <= ref_end) |>
  group_by(Bundesland) |>
  summarise(Referenzmittel_C = mean(Temp_Mittel_C, na.rm = TRUE), .groups = "drop")

letztes_jahr <- max(temperatur_jahr$Jahr)

abweichung_temp <- temperatur_jahr |>
  filter(Jahr == letztes_jahr) |>
  left_join(referenz_temp, by = "Bundesland") |>
  mutate(Abweichung_C = Temp_Mittel_C - Referenzmittel_C) |>
  arrange(desc(Abweichung_C))

abweichung_temp |>
  select(Bundesland, !!paste0("Jahr_", letztes_jahr) := Temp_Mittel_C,
         Referenzmittel_C, Abweichung_C) |>
  tt() |>
  format_tt(digits = 2)

ggplot(abweichung_temp, aes(x = reorder(Bundesland, Abweichung_C), y = Abweichung_C,
                             fill = Abweichung_C > 0)) +
  geom_col() +
  coord_flip() +
  scale_fill_manual(values = c(`TRUE` = "firebrick", `FALSE` = "steelblue"), guide = "none") +
  labs(
    title = paste("Temperaturabweichung", letztes_jahr, "vom Referenzmittel", ref_start, "-", ref_end),
    x = NULL, y = "Abweichung (°C)"
  )

referenz_kenntage <- kenntage_lang |>
  filter(Jahr >= ref_start, Jahr <= ref_end) |>
  group_by(Indikator) |>
  summarise(Referenzmittel = mean(Wert, na.rm = TRUE), .groups = "drop")

letztes_jahr_kenntage <- max(kenntage_lang$Jahr)

abweichung_kenntage <- kenntage_lang |>
  filter(Jahr == letztes_jahr_kenntage) |>
  group_by(Indikator) |>
  summarise(Wert_aktuell = mean(Wert, na.rm = TRUE), .groups = "drop") |>
  left_join(referenz_kenntage, by = "Indikator") |>
  mutate(Differenz = Wert_aktuell - Referenzmittel) |>
  arrange(desc(Differenz))

abweichung_kenntage |> tt() |> format_tt(digits = 2)

Überblick über die aggregierten Daten

cat("Temperatur:", nrow(temperatur_lang), "Zeilen,",
    n_distinct(temperatur_lang$Bundesland), "Bundeslaender,",
    "Zeitraum", min(temperatur_lang$Jahr), "-", max(temperatur_lang$Jahr), "\n")
#> Temperatur: 29699 Zeilen, 17 Bundeslaender, Zeitraum 1881 - 2026
cat("Kenntage:", nrow(kenntage_lang), "Zeilen,",
    n_distinct(kenntage_lang$Indikator), "Indikatoren\n")
#> Kenntage: 8925 Zeilen, 7 Indikatoren

Monatsdaten Temperatur & Niederschlag zusammenfuehren

Neben den 16 Regionen enthalten die DWD-Rohdaten zusaetzlich “Deutschland” als Gesamtwert; die Zeile bleibt hier erhalten, sodass pro Jahr-Monat-Kombination 17 Zeilen (16 Regionen + Deutschland) entstehen.

wetterdaten_monat <- temperatur_lang |>
  inner_join(niederschlag_lang, by = c("Jahr", "Monat", "Bundesland")) |>
  transmute(
    year   = Jahr,
    month  = Monat,
    region = Bundesland,
    precip = Niederschlag_mm,
    temp   = Temp_Mittel_C
  ) |>
  arrange(year, month, region)

write_csv(wetterdaten_monat, "wetterdaten_monat.csv")