2019-11-auswirkungen-klimawandel

R-Script & Daten

Die Vorprozessierung und Analyse wurde im Statistikprogramm R vorgenommen. Das zugrunde liegende Script sowie die prozessierten Daten können unter diesem Link heruntergeladen werden. Durch Ausführen von main.Rmd kann der hier beschriebene Prozess nachvollzogen und der für den Artikel verwendete Datensatz generiert werden. Dabei werden Daten aus dem Ordner input eingelesen und Ergebnisse in den Ordner output geschrieben.

SRF Data verwendet das rddj-template von Timo Grossenbacher als Grundlage für seine R-Scripts. Entstehen bei der Ausführung dieses Scripts Probleme, kann es helfen, die Anleitung von rddj-template zu studieren.

Debug-Informationen: This report was generated on 2019-11-30 10:31:44. R version: 3.5.3 on x86_64-apple-darwin15.6.0. For this report, CRAN packages as of 2019-03-01 were used.

GitHub

Der Code für die vorliegende Datenprozessierung ist auf https://github.com/srfdata/2019-11-auswirkungen-klimawandel zur freien Verwendung verfügbar.

Lizenz

2019-11-auswirkungen-klimawandel von SRF Data ist lizenziert unter einer Creative Commons Namensnennung - Weitergabe unter gleichen Bedingungen 4.0 International Lizenz.

Weitere Projekte

Code & Daten von SRF Data sind unter https://srfdata.github.io verfügbar.

Haftungsausschluss

Die veröffentlichten Informationen sind sorgfältig zusammengestellt, erheben aber keinen Anspruch auf Aktualität, Vollständigkeit oder Richtigkeit. Es wird keine Haftung übernommen für Schäden, die durch die Verwendung dieses Scripts oder der daraus gezogenen Informationen entstehen. Dies gilt ebenfalls für Inhalte Dritter, die über dieses Angebot zugänglich sind.

Datenbeschreibung

Originalquelle

Die Daten des interaktiven Artikel stammen hauptsächlich von den «Klimaszenarien CH2018», die im November 2018 veröffentlicht wurden (CH2018 Project Team (2018): CH2018 - Climate Scenarios for Switzerland. National Centre for Climate Services. doi: 10.18751/Climate/Scenarios/CH2018/1.0). Grundlage bilden Simulationen mit insgesamt 21 verschiedenen Computermodellen, die an europäischen Forschungsinstitutionen – koordiniert durch das Projekt EURO-CORDEX – betrieben werden. Das Projekt EURO-CORDEX ist eine Initiative des WCRP.

Die regionalen Klimasimulationen berücksichtigen drei verschiedene Szenarien, je nach Entwicklung der Treibhausgasemissionen:

Die regionalen Klimasimulationen berücksichtigen drei verschiedene Szenarien, je nach Entwicklung der Treibhausgasemissionen:

• Kein Klimaschutz (RCP8.5): Die klimawirksamen Emissionen nehmen stetig zu (hier verwendet als «pessimistisches Szenario»)

• Konsequenter Klimaschutz (RCP2.6): Durch rasche und drastische Senkungen des Treibhausgasausstosses kann bis in 20 Jahren der Anstieg der Treibhausgase in der Atmosphäre gestoppt werden (hier verwendet als «optimistisches Szenario»). Damit lassen sich die Ziele des Pariser Klimaabkommens von 2015 wahrscheinlich erreichen und die globale Erwärmung auf zwei Grad Celsius gegenüber dem vorindustriellen Zustand begrenzen.

• Begrenzter Klimaschutz (RCP4.5): Eine mittlere Entwicklung mit begrenztem Klimaschutz (hier nicht verwendet)

Die Klimaszenarien CH2018 beziehen sich jeweils auf einen Mittelwert der geschätzten klimatischen Verhältnisse über einen längeren Zeitraum. Wenn es im Text «2035» heisst, bezieht sich das auf die nahe Zukunft von 2020-2049. Ist die Rede von «2060», geht es um die Mitte des Jahrhunderts (2045-2074) und «2085» bezieht sich auf das Ende des Jahrhunderts (2070-2099). Als Referenzperiode gilt der Zeitraum von 1981 bis 2010. Werte von «heute» sind also gemittelte Messwerte über diesen Zeitraum.

Diese Projektionen der Klimamodelle sind jedoch nicht exakt, sondern streuen immer über einen gewissen Bereich. Der Median davon entspricht am ehesten dem absehbaren Wert und wird als «erwartetes» Ergebnis behandelt.

Packages definieren

# from https://mran.revolutionanalytics.com/web/packages/checkpoint/vignettes/using-checkpoint-with-knitr.html
# if you don't need a package, remove it from here (commenting is probably not sufficient)
# tidyverse: see https://blog.rstudio.org/2016/09/15/tidyverse-1-0-0/
cat("
library(rstudioapi)
library(rgdal)
library(raster) # raster used for relief important: load before tidyverse
library(glue) # cooler string templating
library(tidyverse) # ggplot2, dplyr, tidyr, readr, purrr, tibble
library(magrittr) # pipes
library(readxl) # excel
library(scales) # scales for ggplot2
library(jsonlite) # json
library(lintr) # code linting
library(sf) # spatial data handling
library(ncdf4) # package to read netCDF files
library(ncdf4.helpers)
library(PCICt)
library(rmarkdown)",
file = "manifest.R")

Packages installieren

# if checkpoint is not yet installed, install it (for people using this
# system for the first time)
if (!require(checkpoint)) {
  if (!require(devtools)) {
    install.packages("devtools", repos = "http://cran.us.r-project.org")
    require(devtools)
  }
  devtools::install_github("RevolutionAnalytics/checkpoint",
                           ref = "v0.3.2", # could be adapted later,
                           # as of now (beginning of July 2017
                           # this is the current release on CRAN)
                           repos = "http://cran.us.r-project.org")
  require(checkpoint)
}
# nolint start
if (!dir.exists("~/.checkpoint")) {
  dir.create("~/.checkpoint")
}
# nolint end
# install packages for the specified CRAN snapshot date
checkpoint(snapshotDate = package_date,
           project = path_to_wd,
           verbose = T,
           scanForPackages = T,
           use.knitr = F,
           R.version = R_version)
rm(package_date)

Packages laden

source("manifest.R")
unlink("manifest.R")
sessionInfo()

## R version 3.5.3 Patched (2019-03-11 r76227)
## Platform: x86_64-apple-darwin15.6.0 (64-bit)
## Running under: macOS Mojave 10.14.5
## 
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/3.5/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/3.5/Resources/lib/libRlapack.dylib
## 
## locale:
## [1] de_CH.UTF-8/de_CH.UTF-8/de_CH.UTF-8/C/de_CH.UTF-8/de_CH.UTF-8
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] rmarkdown_1.11      PCICt_0.5-4.1       ncdf4.helpers_0.3-3
##  [4] ncdf4_1.16          sf_0.7-3            lintr_1.0.3        
##  [7] jsonlite_1.6        scales_1.0.0        readxl_1.3.0       
## [10] magrittr_1.5        forcats_0.4.0       stringr_1.4.0      
## [13] dplyr_0.8.3         purrr_0.3.0         readr_1.3.1        
## [16] tidyr_1.0.0         tibble_2.1.3        ggplot2_3.1.0      
## [19] tidyverse_1.2.1     glue_1.3.0          raster_2.8-19      
## [22] rgdal_1.3-9         sp_1.3-1            checkpoint_0.4.0   
## [25] rstudioapi_0.9.0    knitr_1.21         
## 
## loaded via a namespace (and not attached):
##  [1] tidyselect_0.2.5 xfun_0.5         haven_2.1.0      lattice_0.20-38 
##  [5] colorspace_1.4-0 vctrs_0.2.0      generics_0.0.2   htmltools_0.3.6 
##  [9] yaml_2.2.0       rlang_0.4.0      e1071_1.7-0.1    pillar_1.3.1    
## [13] DBI_1.0.0        withr_2.1.2      modelr_0.1.4     lifecycle_0.1.0 
## [17] plyr_1.8.4       munsell_0.5.0    gtable_0.2.0     cellranger_1.1.0
## [21] rvest_0.3.2      codetools_0.2-16 evaluate_0.13    rex_1.1.2       
## [25] class_7.3-15     broom_0.5.1      Rcpp_1.0.1       classInt_0.3-1  
## [29] backports_1.1.3  hms_0.4.2        digest_0.6.18    stringi_1.4.3   
## [33] grid_3.5.3       cli_1.0.1        tools_3.5.3      lazyeval_0.2.1  
## [37] crayon_1.3.4     pkgconfig_2.0.2  zeallot_0.1.0    xml2_1.2.0      
## [41] lubridate_1.7.4  assertthat_0.2.0 httr_1.4.0       R6_2.4.0        
## [45] units_0.6-2      nlme_3.1-137     compiler_3.5.3

Zusätzliche Scripts laden

# if you want to outsource logic to other script files, see README for 
# further information
knitr::read_chunk("scripts/my_script.R")
source("scripts/my_script.R")
my_function(5)

## [1] 5

Klimaregionen einlesen

Wir lesen die Daten zu den Klimaregionen ein und matchen diese dann ebenfalls mit den Gemeinden. Dadurch können wir die Gemeinden einer Klimaregion zuordnen.

climate_regions_geo_points <- c(
  "Alpen", 
  "AlpenS", 
  "Jura", 
  "Voralpen", 
  "Mittelland"
  ) %>%
  map_df(function(region) {
    # determine filepath
    filepath <- glue("input/climate_regions/{region}.nc")
    if (file.exists(filepath)) {
      # extract all values of the selected climate variable
      current_file <- nc_open(filepath)
      lon <- ncvar_get(current_file, varid = "lon")
      lat <- ncvar_get(current_file, varid = "lat")
      current_region <- ncvar_get(current_file, region)
      current_region_vec <- as.vector(current_region)
      lonlat <- as.matrix(expand.grid(lon, lat))
      lonlat_df <- data.frame(
        cbind(
          lonlat, 
          current_region_vec
          )
        ) %>%
        filter(
          current_region_vec > 0
          ) %>% 
          mutate(current_region_vec = case_when(
      current_region_vec == 1 ~ region
      ))
      nc_close(current_file)
      result <- tibble(
        region = lonlat_df$current_region,
        lon = lonlat_df$Var1,
        lat = lonlat_df$Var2
        )
    }
    return(result)
  }
  ) %>%
  st_as_sf(coords = c("lon", "lat"),  crs = 4326) %>%
  st_transform(2056)

# join the two datasets (matched and missing muncipalities)
climate_regions_all_municipalities <- st_join(
  municipality_geo_point %>% 
    select(GMDNR, GMDNAME, geometry),
  climate_regions_geo_points,
  join = st_nearest_feature
  ) %>% 
  st_drop_geometry() %>% 
  select(GMDNR, region)

Klimavariablen als Gitternetzpunkte einlesen

Wir lesen die Daten ein, machen einen Spatial-Join mit dem 2-km-Gitternetzpunkt, der einem Gemeindeortszentrum, am nächsten liegt.

lonlat_filename <- "input/FD_obs_CH2018/FD_RCP2.6_2035_q5.nc"
lonlat_file <- nc_open(lonlat_filename)
lon <- ncvar_get(lonlat_file, varid = "lon")
lat <- ncvar_get(lonlat_file, varid = "lat")
lonlat <- as.matrix(expand.grid(lon, lat))

# cleanup
rm(lonlat_filename, lonlat_file, lon, lat)

climate_projections_wide <- c(
  "FD", "HD", "ID", "SD", "snowdays", "TN", "pr", "tas"
  ) %>%
  map_dfc(function(climate_variable) {
    # map through different rcp scenarios
      c("RCP2.6", "RCP4.5", "RCP8.5") %>%
      map_dfc(function(rcp) {
        # map through different periods
         c("2035", "2060", "2085") %>%
          map_dfc(function(period) {
            # map through different estimates
            c("q5", "q50", "q95") %>%
              map_dfc(function(estimate) {
                 # determine folder
                folder <- glue("{climate_variable}_obs_CH2018/")
                if (climate_variable == "pr" || climate_variable == "tas") {
                  # map through different seasons
                  c("DJF", "MAM", "JJA", "SON") %>% 
                    map_dfc(function(season) {
                      # determine filename
                      filename <- glue(
                        "{climate_variable}_",
                        "{rcp}_",
                        "{period}_",
                        "{season}_",
                        "{estimate}.nc"
                        )
                      filepath <- glue("input/{folder}{filename}")
                      if (file.exists(filepath)) {
                        current_file <- nc_open(filepath)
                        # extract all values of the selected climate variable
                        current_climate_values <- ncvar_get(
                          current_file, 
                          climate_variable
                          )
                        current_climate_values_vec <- as.vector(
                          current_climate_values
                          )
                        nc_close(current_file)
                        col_name <- glue(
                          "{climate_variable}|",
                          "{rcp}|",
                          "{period}|",
                          "{estimate}|",
                          "{season}"
                          )
                        result <- tibble(
                          !!col_name := current_climate_values_vec
                          )
                       }
                    })
                  }
                  else {
                   # determine filename
                   filename <- glue(
                     "{climate_variable}_{rcp}_{period}_{estimate}.nc"
                     )
                   filepath <- glue("input/{folder}{filename}")
                   if (file.exists(filepath)) {
                       current_file <- nc_open(filepath)
                       # extract all values of the selected climate variable
                       current_climate_values <- ncvar_get(
                         current_file,
                         climate_variable
                         )
                       current_climate_values_vec <- as.vector(
                         current_climate_values)
                       nc_close(current_file)
                       col_name <- glue(
                         "{climate_variable}|{rcp}|{period}|{estimate}"
                         )
                       result <- tibble(
                         !!col_name := current_climate_values_vec
                       )
                   }
                  }
                   })
              })
          })
      }
    ) %>% 
  cbind(lonlat) %>%
  rename(
    lon = Var1,
    lat = Var2
    )

# for some weird reason we can't read the observational data in the same map
climate_observations_wide <- c(
  "FD", "HD", "ID", "SD", "snowdays", "TN", "pr", "tas"
  ) %>%
  map_dfc(function(climate_variable) {
    # map through different rcp scenarios
      c("obs") %>%
      map_dfc(function(rcp) {
        # map through different periods
         c("1981-2010") %>%
          map_dfc(function(period) {
            # map through different estimates
            c("mean", "yearly_mean") %>%
              map_dfc(function(estimate) {
                 # determine folder
                folder <- glue("{climate_variable}_obs_CH2018/")
                if (climate_variable == "pr" || climate_variable == "tas") {
                  # map through different seasons
                  c("DJF", "MAM", "JJA", "SON") %>% 
                    map_dfc(function(season) {
                      # determine filename
                      filename <- glue(
                        "{climate_variable}_",
                        "{rcp}_",
                        "{period}_",
                        "{season}_",
                        "{estimate}.nc"
                        )
                      filepath <- glue("input/{folder}{filename}")
                      if (file.exists(filepath)) {
                        current_file <- nc_open(filepath)
                        # extract all values of the selected climate variable
                        current_climate_values <- ncvar_get(
                          current_file, 
                          climate_variable
                          )
                        current_climate_values_vec <- as.vector(
                          current_climate_values
                          )
                        nc_close(current_file)
                        col_name <- glue(
                          "{climate_variable}|",
                          "{rcp}|",
                          "{period}|",
                          "{estimate}|",
                          "{season}"
                          )
                        result <- tibble(
                          !!col_name := current_climate_values_vec
                          )
                       }
                    })
                  }
                  else {
                   # determine filename
                   filename <- glue(
                     "{climate_variable}_{rcp}_{period}_{estimate}.nc"
                     )
                   filepath <- glue("input/{folder}{filename}")
                   if (file.exists(filepath)) {
                       current_file <- nc_open(filepath)
                       # extract all values of the selected climate variable
                       current_climate_values <- ncvar_get(
                         current_file, 
                         climate_variable
                         )
                       current_climate_values_vec <- as.vector(
                         current_climate_values
                         )
                       nc_close(current_file)
                       col_name <- glue(
                         "{climate_variable}|{rcp}|{period}|{estimate}"
                         )
                       result <- tibble(
                         !!col_name := current_climate_values_vec
                       )
                   }
                  }
                   })
              })
          })
      }
    ) %>% 
  cbind(lonlat) %>% 
  rename(
    lon = Var1, 
    lat = Var2
    )

# put the two data sets together (observations and projections)
climate_data_all_grid_points <- climate_projections_wide %>% 
  left_join(climate_observations_wide,
            by = c("lon" = "lon", "lat" = "lat")) %>% 
  group_by(lat, lon) %>% 
  drop_na()

# create geo point of lat lon from netcdf files
climate_values_geo_point <- climate_data_all_grid_points %>%
  st_as_sf(coords = c("lon", "lat"),  crs = 4326) %>%
  st_transform(2056)

# look for grid point that is closest (st_nearest feature) to the municipality
climate_values_all_municipalities <- st_join(
  municipality_geo_point %>% select(GMDNR, GMDNAME, geometry),
  climate_values_geo_point,
  join = st_nearest_feature
  ) %>% 
  st_drop_geometry() %>% 
  select(GMDNR, GMDNAME, everything())

# convert wide data frame into long data frame
climate_projections_by_municipality <- 
  climate_values_all_municipalities %>% 
  gather(string, value, -GMDNR, -GMDNAME) %>%
  # extract keys of climate variables
  tidyr::extract(
    col = "string",
    into = c("key", "rcp", "period", "estimate", "season"),
    regex = "(\\w+)\\|([\\w\\.]+)\\|([\\d-]+)\\|(\\w+)(?:\\|(\\w+))?",
    remove = TRUE
  ) %>%
  rename(bfs_id = GMDNR)

# join altitude information and climate regions
climate_projections_by_municipality %<>%
  left_join(
    municipality_geo %>% 
      st_drop_geometry() %>% 
      select(GMDNR, Z_CNTR), 
    by = c("bfs_id" = "GMDNR")
  ) %>% 
  mutate(
    altitude = case_when(
      Z_CNTR <= 800 ~ "0-800",
      Z_CNTR > 800 & Z_CNTR <= 1500 ~ "801-1500",
      Z_CNTR > 1500 ~ ">1500"
    )
  ) %>%
  select(-Z_CNTR) %>%
  # join climate regions from chunk above
  left_join(
    climate_regions_all_municipalities,
    by = c("bfs_id" = "GMDNR")
  )

#cleanup
rm(
  lonlat, 
  climate_projections_wide,
  climate_observations_wide,
  climate_data_all_grid_points, 
  climate_values_by_municipality,
  municipalities_with_no_match,
  climate_values_municipalities_no_match,
  climate_values_all_municipalities
  )

# save the data frame to an Rdata file
save(
  climate_projections_by_municipality, 
  file = "climate_projections_by_municipality.Rdata"
  )
save(
  climate_values_geo_point, 
  file = "climate_values_geo_point.Rdata"
  )

if (file.exists("climate_projections_by_municipality.Rdata")) {
  print("loading climate data")
  load("climate_projections_by_municipality.Rdata")
} else {
  print("please run the big chunk above")
}

## [1] "loading climate data"

Frosttage (FD)

Am stärksten zeigt sich der Rückgang der Frosttage in den Alpen. In gewissen Berggemeinden gibt es gemäss Prognose (RCP2.6) bereits im Jahr 2035 mehr als 20 Frosttage weniger.

## Histogram
# 2035 mit RCP4.5
HistogramPlot(climate_projections_by_municipality, "FD", "2035", "RCP4.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# 2060 mit RCP4.5
HistogramPlot(climate_projections_by_municipality, "FD", "2060", "RCP4.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# 2085 mit RCP4.5
HistogramPlot(climate_projections_by_municipality, "FD", "2085", "RCP4.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## Violin Plot
# Year 2085, prognosis with different RCP
ViolinPlot(climate_projections_by_municipality, "FD", "2085", "rcp") 

# Prognosis with RCP8.5 for different periods
ViolinPlot(climate_projections_by_municipality, "FD", "RCP8.5", "period")

# Maps for RCP8.5 all periods
SmallMultipleMaps(climate_projections_by_municipality, "FD", "RCP8.5", "q50")

# Extreme municipalities for certain scenario
ExtremeMunicipalities(
  climate_projections_by_municipality, 
  "FD", "2035", "RCP2.6"
  )

## # A tibble: 20 x 8
##    bfs_id GMDNAME             key   altitude region     future   now  delta
##     <dbl> <chr>               <chr> <chr>    <chr>       <dbl> <dbl>  <dbl>
##  1   3781 Bever               FD    >1500    Alpen       214.  238.  -24.2 
##  2   3783 Madulain            FD    >1500    Alpen       227.  251.  -24.2 
##  3   3785 La Punt-Chamues-ch  FD    >1500    Alpen       227.  251.  -24.2 
##  4   6288 Saas-Almagell       FD    >1500    Alpen       212.  236.  -24.2 
##  5   3786 Samedan             FD    >1500    Alpen       214.  238.  -23.9 
##  6   3782 Celerina/Schlarigna FD    >1500    Alpen       213.  237.  -23.7 
##  7   3784 Pontresina          FD    >1500    Alpen       219.  243.  -23.7 
##  8   1202 Andermatt           FD    801-1500 Alpen       234.  258.  -23.5 
##  9   6054 Binn                FD    801-1500 Alpen       198.  221.  -23.3 
## 10   3788 S-chanf             FD    >1500    Alpen       221.  244.  -22.8 
## 11   5639 Lully (VD)          FD    0-800    Mittelland   39.6  50.0 -10.4 
## 12   5640 Lussy-sur-Morges    FD    0-800    Mittelland   39.6  50.0 -10.4 
## 13   5613 Bourg-en-Lavaux     FD    0-800    Mittelland   33.1  43.3 -10.3 
## 14   5606 Lutry               FD    0-800    Mittelland   32    42.1 -10.1 
## 15    581 Interlaken          FD    0-800    Alpen        89.4  99.5 -10.1 
## 16    593 Unterseen           FD    0-800    Alpen        89.4  99.5 -10.1 
## 17   5192 Lugano              FD    0-800    AlpenS       15.4  25.5 -10.1 
## 18   5588 Paudex              FD    0-800    Mittelland   31.6  41.4  -9.80
## 19   5590 Pully               FD    0-800    Mittelland   31.6  41.4  -9.80
## 20   5113 Locarno             FD    0-800    AlpenS       10.6  18.4  -7.73

# Different regions compared
Regions(climate_projections_by_municipality, "FD", "RCP4.5")

Hitzetage (HD)

Bei den Hitzetagen kommt es in den Grossen Agglomerationen, im Mittelland und im Jura zu krassen Veränderungen. In allen drei Gebieten verdoppelt sich gemäss Prognose (RCP4.5) die Anzahl der Hitzetage bis 2080.

## Histogram
# 2035 mit RCP4.5
HistogramPlot(climate_projections_by_municipality, "HD", "2035", "RCP4.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# 2060 mit RCP4.5
HistogramPlot(climate_projections_by_municipality, "HD", "2060", "RCP4.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# 2085 mit RCP4.5
HistogramPlot(climate_projections_by_municipality, "HD", "2085", "RCP4.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## Violin Plot
# Year 2085, prognosis with different RCP
ViolinPlot(climate_projections_by_municipality, "HD", "2085", "rcp") 

# Prognosis with RCP8.5 for different periods
ViolinPlot(climate_projections_by_municipality, "HD", "RCP8.5", "period")

# Maps for RCP8.5 all periods
SmallMultipleMaps(climate_projections_by_municipality, "HD", "RCP8.5", "q50")

# Extreme municipalities for certain scenario
ExtremeMunicipalities(
  climate_projections_by_municipality, 
  "HD", "2035", "RCP2.6"
  )

## # A tibble: 20 x 8
##    bfs_id GMDNAME            key   altitude region  future     now    delta
##     <dbl> <chr>              <chr> <chr>    <chr>    <dbl>   <dbl>    <dbl>
##  1   6300 Zermatt            HD    >1500    Alpen   0       0.100   -0.100 
##  2    584 Lauterbrunnen      HD    801-1500 Alpen   0.0333  0.0667  -0.0333
##  3   3789 Sils im Engadin/S… HD    >1500    Alpen   0       0.0333  -0.0333
##  4   3823 Soazza             HD    0-800    AlpenS  0.0667  0.100   -0.0333
##  5    578 Gündlischwand      HD    0-800    Alpen   0       0        0     
##  6    782 Guttannen          HD    801-1500 Alpen   0       0        0     
##  7    841 Gsteig             HD    801-1500 Alpen   0       0        0     
##  8   1202 Andermatt          HD    801-1500 Alpen   0       0        0     
##  9   1208 Göschenen          HD    801-1500 Alpen   0       0        0     
## 10   1209 Gurtnellen         HD    801-1500 Alpen   0       0        0     
## 11   5097 Brissago           HD    0-800    AlpenS 31.0    18.5     12.5   
## 12   5125 Ronco sopra Ascona HD    0-800    AlpenS 32.1    19.5     12.5   
## 13   5091 Ascona             HD    0-800    AlpenS 32.4    19.8     12.6   
## 14   6135 Leytron            HD    0-800    Alpen  24.6    12.0     12.6   
## 15   6022 Chamoson           HD    0-800    Alpen  24.4    11.6     12.8   
## 16   6025 Vétroz             HD    0-800    Alpen  26.3    13.4     12.9   
## 17   6023 Conthey            HD    0-800    Alpen  25.9    13.0     12.9   
## 18   6021 Ardon              HD    0-800    Alpen  26.5    13.2     13.2   
## 19   6263 Grimisuat          HD    801-1500 Alpen  28.3    14.7     13.6   
## 20   6266 Sion               HD    0-800    Alpen  29.0    15       14.0

# Different regions compared
Regions(climate_projections_by_municipality, "HD", "RCP4.5")

Eistage (ID)

Bei Gemeinden in den Alpen ist der Rückgang der Eistage am stärksten ausgeprägt. Gewisse Berggemeinden haben gemäss Prognose (RCP2.6) bereits im Jahr 2035 beinahe 20 Eistage weniger.

## Histogram
# 2035 mit RCP4.5
HistogramPlot(climate_projections_by_municipality, "ID", "2035", "RCP4.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# 2060 mit RCP4.5
HistogramPlot(climate_projections_by_municipality, "ID", "2060", "RCP4.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# 2085 mit RCP4.5
HistogramPlot(climate_projections_by_municipality, "ID", "2085", "RCP4.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## Violin Plot
# Year 2085, prognosis with different RCP
ViolinPlot(climate_projections_by_municipality, "ID", "2085", "rcp") 

# Prognosis with RCP8.5 for different periods
ViolinPlot(climate_projections_by_municipality, "ID", "RCP8.5", "period")

# Maps for RCP8.5 all periods
SmallMultipleMaps(climate_projections_by_municipality, "ID", "RCP8.5", "q50")

# Extreme municipalities for certain scenario
ExtremeMunicipalities(
  climate_projections_by_municipality, 
  "ID", "2035", "RCP2.6"
  )

## # A tibble: 20 x 8
##    bfs_id GMDNAME          key   altitude region  future     now   delta
##     <dbl> <chr>            <chr> <chr>    <chr>    <dbl>   <dbl>   <dbl>
##  1   1202 Andermatt        ID    801-1500 Alpen  127.    146.    -19.2  
##  2   3681 Avers            ID    >1500    Alpen  111.    130.    -18.2  
##  3   6054 Binn             ID    801-1500 Alpen   87     104.    -17.4  
##  4   5063 Bedretto         ID    801-1500 AlpenS  98.6   116.    -17.1  
##  5   3851 Davos            ID    >1500    Alpen   84.5   100.    -15.9  
##  6   6288 Saas-Almagell    ID    >1500    Alpen   77.7    93.5   -15.8  
##  7   6292 St. Niklaus      ID    801-1500 Alpen   83.4    98.6   -15.2  
##  8   5105 Frasco           ID    801-1500 AlpenS  47.5    62.2   -14.8  
##  9   6287 Randa            ID    801-1500 Alpen   74.2    88.8   -14.6  
## 10   6202 Wiler (Lötschen) ID    801-1500 Alpen   89.5   104.    -14.3  
## 11   5225 Sorengo          ID    0-800    AlpenS   0.233   0.800  -0.567
## 12   5171 Caslano          ID    0-800    AlpenS   0.233   0.733  -0.500
## 13   5206 Neggio           ID    0-800    AlpenS   0.233   0.733  -0.500
## 14   5216 Pura             ID    0-800    AlpenS   0.233   0.733  -0.500
## 15   5287 Riviera          ID    0-800    AlpenS   0.333   0.833  -0.500
## 16   5397 Centovalli       ID    0-800    AlpenS   0.267   0.767  -0.500
## 17   5192 Lugano           ID    0-800    AlpenS   0.133   0.600  -0.467
## 18   5141 Agno             ID    0-800    AlpenS   0.233   0.700  -0.467
## 19   5230 Vernate          ID    0-800    AlpenS   0.233   0.700  -0.467
## 20   5113 Locarno          ID    0-800    AlpenS   0.133   0.567  -0.433

# Different regions compared
Regions(climate_projections_by_municipality, "ID", "RCP4.5")

Sommertage (SD)

Die Sommertage nehmen deutlich zu. Dies zeigt sich vor allem im Jura, in den grossen Agglomerationen und im Mittelland.

## Histogram
# 2035 mit RCP4.5
HistogramPlot(climate_projections_by_municipality, "SD", "2035", "RCP4.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# 2060 mit RCP4.5
HistogramPlot(climate_projections_by_municipality, "SD", "2060", "RCP4.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# 2085 mit RCP4.5
HistogramPlot(climate_projections_by_municipality, "SD", "2085", "RCP4.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## Violin Plot
# Year 2085, prognosis with different RCP
ViolinPlot(climate_projections_by_municipality, "SD", "2085", "rcp") 

# Prognosis with RCP8.5 for different periods
ViolinPlot(climate_projections_by_municipality, "SD", "RCP8.5", "period")

# Maps for RCP8.5 all periods
SmallMultipleMaps(climate_projections_by_municipality, "SD", "RCP8.5", "q50")

# Extreme municipalities for certain scenario
ExtremeMunicipalities(
  climate_projections_by_municipality, 
  "SD", "2035", "RCP2.6"
  )

## # A tibble: 20 x 8
##    bfs_id GMDNAME            key   altitude region  future     now    delta
##     <dbl> <chr>              <chr> <chr>    <chr>    <dbl>   <dbl>    <dbl>
##  1   1202 Andermatt          SD    801-1500 Alpen   0       0.0667  -0.0667
##  2   6054 Binn               SD    801-1500 Alpen   0.0333  0.100   -0.0667
##  3   3681 Avers              SD    >1500    Alpen   0       0        0     
##  4   5063 Bedretto           SD    801-1500 AlpenS  0       0        0     
##  5   6202 Wiler (Lötschen)   SD    801-1500 Alpen   0.0667  0.0333   0.0333
##  6   6032 Bourg-Saint-Pierre SD    >1500    Alpen   0.0667  0        0.0667
##  7   6288 Saas-Almagell      SD    >1500    Alpen   0.267   0.167    0.100 
##  8   5105 Frasco             SD    801-1500 AlpenS  0.233   0.0667   0.167 
##  9   1208 Göschenen          SD    801-1500 Alpen   0.267   0.0667   0.200 
## 10   5304 Bosco/Gurin        SD    801-1500 AlpenS  0.333   0.100    0.233 
## 11   6281 Baltschieder       SD    0-800    Alpen  78.4    58.8     19.6   
## 12   6198 Niedergesteln      SD    0-800    Alpen  81.4    61.7     19.7   
## 13   6199 Raron              SD    0-800    Alpen  81.4    61.7     19.7   
## 14   6246 Saint-Léonard      SD    0-800    Alpen  70.0    50.3     19.7   
## 15   6089 Vex                SD    801-1500 Alpen  59.7    39.9     19.7   
## 16   6248 Sierre             SD    0-800    Alpen  69.5    49.7     19.7   
## 17   6118 Gampel-Bratsch     SD    0-800    Alpen  76.4    56.5     19.9   
## 18   6204 Steg-Hohtenn       SD    0-800    Alpen  76.4    56.5     19.9   
## 19   6035 Sembrancher        SD    0-800    Alpen  56.6    36.5     20.1   
## 20   6136 Martigny           SD    0-800    Alpen  75      54.3     20.7

# Different regions compared
Regions(climate_projections_by_municipality, "SD", "RCP4.5")

Schneetage (snowdays)

Der Rückgang der Schneetage betrifft die Berggebiete am stärksten. In gewissen Berggemeinden wird es laut Prognose mehr als 15 Schneetage weniger geben.

## Histogram
# 2035 mit RCP4.5
HistogramPlot(climate_projections_by_municipality, "snowdays", "2035", "RCP4.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# 2060 mit RCP4.5
HistogramPlot(climate_projections_by_municipality, "snowdays", "2060", "RCP4.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# 2085 mit RCP4.5
HistogramPlot(climate_projections_by_municipality, "snowdays", "2085", "RCP4.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## Violin Plot
# Year 2085, prognosis with different RCP
ViolinPlot(climate_projections_by_municipality, "snowdays", "2085", "rcp") 

# Prognosis with RCP8.5 for different periods
ViolinPlot(climate_projections_by_municipality, "snowdays", "RCP8.5", "period")

# Maps for RCP8.5 all periods
SmallMultipleMaps(
  climate_projections_by_municipality, 
  "snowdays", "RCP8.5", "q50"
  )

# Extreme municipalities for certain scenario
ExtremeMunicipalities(
  climate_projections_by_municipality, 
  "snowdays", "2035", "RCP2.6"
  )

## # A tibble: 20 x 8
##    bfs_id GMDNAME         key      altitude region     future   now  delta
##     <dbl> <chr>           <chr>    <chr>    <chr>       <dbl> <dbl>  <dbl>
##  1   1208 Göschenen       snowdays 801-1500 Alpen        56.9  75.6 -18.7 
##  2   1219 Unterschächen   snowdays 801-1500 Alpen        60.5  78.9 -18.4 
##  3    782 Guttannen       snowdays 801-1500 Alpen        48.1  66.3 -18.2 
##  4   3983 Medel (Lucmagn) snowdays 801-1500 Alpen        36.3  54.4 -18.1 
##  5   3986 Tujetsch        snowdays 801-1500 Alpen        37.9  55.8 -17.9 
##  6    578 Gündlischwand   snowdays 0-800    Alpen        49.1  66.9 -17.9 
##  7   5304 Bosco/Gurin     snowdays 801-1500 AlpenS       29.9  47.6 -17.7 
##  8   1212 Realp           snowdays >1500    Alpen        59.5  77.1 -17.6 
##  9   6033 Liddes          snowdays 801-1500 Alpen        35.1  51.8 -16.7 
## 10    841 Gsteig          snowdays 801-1500 Alpen        55.0  71.7 -16.7 
## 11    885 Uttigen         snowdays 0-800    Mittelland   20.3  19.2   1.07
## 12   2011 Cugy (FR)       snowdays 0-800    Mittelland   14.0  13.0   1.07
## 13    869 Kaufdorf        snowdays 0-800    Mittelland   20.6  19.5   1.10
## 14    873 Kirchenthurnen  snowdays 0-800    Mittelland   20.6  19.5   1.10
## 15    881 Rümligen        snowdays 0-800    Mittelland   20.6  19.5   1.10
## 16   2045 Vallon          snowdays 0-800    Mittelland   13.0  11.9   1.10
## 17    868 Jaberg          snowdays 0-800    Mittelland   20.4  19.3   1.13
## 18   2027 Ménières        snowdays 0-800    Mittelland   14.8  13.5   1.30
## 19   2016 Fétigny         snowdays 0-800    Mittelland   14.3  12.9   1.47
## 20   5831 Valbroye        snowdays 0-800    Mittelland   14.5  13     1.47

# Different regions compared
Regions(climate_projections_by_municipality, "snowdays", "RCP4.5")

Tropennächte (TN)

Aktuell sind Tropennächte in der Schweiz eine Besonderheit. In den meisten Gemeinden gab es im langjährigen Mittel (1981-2010) keine Tropennächte. In der Zukunft ändert sich das. Vor allem in den grossen Agglomerationen kann es gemäss Prognose (RCP4.5) bis 2080 durchschnittlich 5 Tropennächte geben.

## Histogram
# 2035 mit RCP4.5
HistogramPlot(climate_projections_by_municipality, "TN", "2035", "RCP4.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# 2060 mit RCP4.5
HistogramPlot(climate_projections_by_municipality, "TN", "2060", "RCP4.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# 2085 mit RCP4.5
HistogramPlot(climate_projections_by_municipality, "TN", "2085", "RCP4.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## Violin Plot
# Year 2085, prognosis with different RCP
ViolinPlot(climate_projections_by_municipality, "TN", "2085", "rcp") 

# Prognosis with RCP8.5 for different periods
ViolinPlot(climate_projections_by_municipality, "TN", "RCP8.5", "period")

# Maps for RCP8.5 all periods
SmallMultipleMaps(climate_projections_by_municipality, "TN", "RCP8.5", "q50")

# Extreme municipalities for certain scenario
ExtremeMunicipalities(
  climate_projections_by_municipality, 
  "TN", "2035", "RCP2.6"
  )

## # A tibble: 20 x 8
##    bfs_id GMDNAME            key   altitude region  future     now    delta
##     <dbl> <chr>              <chr> <chr>    <chr>    <dbl>   <dbl>    <dbl>
##  1   1207 Flüelen            TN    0-800    Alpen   0.233   0.5     -0.267 
##  2    785 Meiringen          TN    0-800    Alpen   0.0667  0.200   -0.133 
##  3    784 Innertkirchen      TN    0-800    Alpen   0.0667  0.133   -0.0667
##  4    783 Hasliberg          TN    801-1500 Alpen   0.0333  0.100   -0.0667
##  5    441 Renan (BE)         TN    801-1500 Jura    0       0.0333  -0.0333
##  6   3823 Soazza             TN    0-800    AlpenS  0       0.0333  -0.0333
##  7   5078 Prato (Leventina)  TN    801-1500 AlpenS  0       0.0333  -0.0333
##  8   5105 Frasco             TN    801-1500 AlpenS  0       0.0333  -0.0333
##  9   6191 Ausserberg         TN    801-1500 Alpen   0.0333  0.0667  -0.0333
## 10   6281 Baltschieder       TN    0-800    Alpen   0.0333  0.0667  -0.0333
## 11   5097 Brissago           TN    0-800    AlpenS 18.7     8       10.7   
## 12   5125 Ronco sopra Ascona TN    0-800    AlpenS 19.5     8.63    10.8   
## 13   5397 Centovalli         TN    0-800    AlpenS 19.1     8.23    10.9   
## 14   5091 Ascona             TN    0-800    AlpenS 19.5     8.5     11.0   
## 15   5115 Losone             TN    0-800    AlpenS 20.0     8.80    11.2   
## 16   5396 Terre di Pedemonte TN    0-800    AlpenS 20.0     8.77    11.3   
## 17   5210 Paradiso           TN    0-800    AlpenS 21.9     9.80    12.1   
## 18   5225 Sorengo            TN    0-800    AlpenS 21.9     9.80    12.1   
## 19   5192 Lugano             TN    0-800    AlpenS 27.8    13.8     14     
## 20   5113 Locarno            TN    0-800    AlpenS 34.1    19.4     14.7

# Different regions compared
Regions(climate_projections_by_municipality, "TN", "RCP4.5")

Tagesmittelwerte (Temperatur)

Bei allen drei Szenarien wird die Temperatur in allen vier Jahreszeiten steigen. Im Schnitt um etwa 1.2 Grad Celsius (1981-2010 vs. 2085) mit RCP2.6 oder 4 Grad Celsius mit RCP8.5.

Seasons(climate_projections_by_municipality, "tas", "2085", "RCP8.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## Regions and altitude
# spring
RegionsSeason(climate_projections_by_municipality, "tas", "RCP4.5", "MAM")

# summer
RegionsSeason(climate_projections_by_municipality, "tas", "RCP4.5", "JJA")

# autumn
RegionsSeason(climate_projections_by_municipality, "tas", "RCP4.5", "SON")

# winter
RegionsSeason(climate_projections_by_municipality, "tas", "RCP4.5", "DJF")

Tagesmittelwerte (Niederschlag)

Die Veränderung der Niederschlagsmenge ist sehr unterschiedlich je nach Jahreszeit. Im Schnitt wird sie in den Frühlings- und Wintermonaten eher grösser, in den Herbstmonaten in etwa gleich bleiben und in den Sommermonaten kleiner. Diese Tendenz ist schwächer bei dem Szenario RCP2.6 und stärker bei RCP8.5. Es ist auch ersichtlich, dass die Niederschlagsmenge auf der Alpensüdseite am grössten ist, insbesondere im Herbst und Frühling.

Seasons(climate_projections_by_municipality, "pr", "2085", "RCP8.5")

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## Regions and altitude
# spring
RegionsSeason(climate_projections_by_municipality, "pr", "RCP4.5", "MAM")

# summer
RegionsSeason(climate_projections_by_municipality, "pr", "RCP4.5", "JJA")

# autumn
RegionsSeason(climate_projections_by_municipality, "pr", "RCP4.5", "SON")

# winter
RegionsSeason(climate_projections_by_municipality, "pr", "RCP4.5", "DJF")

Datenexport

climate_projections_by_municipality %>%
  # iterate over bfs_ids to create one file for each municipality
  distinct(bfs_id) %>%
  pwalk(function(...) {
    current <- tibble(...)

    # filter and keep only entries with current municipality
    export_selection <- climate_projections_by_municipality %>%
      filter(bfs_id == current$bfs_id) %>%
      filter(
        rcp != "RCP4.5"
      ) %>%
      # remove columns that we don't need in frontend
      select(bfs_id, rcp, period, key, value, estimate, season) %>%
      # round values
      mutate(value = round(value, 1))

    write_json(
        export_selection,
        glue(
          "output/",
          "climate_projections_{current$bfs_id}.json"
        )
      )
    # browser()
  })

municipalities_in_urban_areas <-
  st_join(
  big_regions_shapefile %>% filter(Name_Prodr == "Grosse Agglomerationen"),
  municipality_geo %>% select(GMDNR, GMDNAME, geometry), 
  join = st_intersects
  )

plot <- ggplot() +
  geom_sf(
        data = municipalities_in_urban_areas,
        fill = "#56B1F7",
        color = "transparent"
      ) +
  geom_sf(
        data = municipality_geo,
        fill = "transparent",
        color = "#000000",
        size = 0.1
      ) +
  geom_text(
    data = municipality_geo,
    mapping = aes(
      x = E_CNTR,
      y = N_CNTR,
      label = GMDNR
    ),
    inherit.aes = FALSE,
    size = 0.5
  ) +
  theme_void() +
  theme(
    panel.grid.major = element_line("transparent"),
    legend.position = "none"
    )

ggsave("output/map.pdf", plot = plot)

## Saving 7 x 5 in image

municipalities_in_urban_areas_matrix <- as.matrix(
  municipalities_in_urban_areas %>% 
    st_drop_geometry %>% 
    select(GMDNR)
  )

write_json(
  climate_projections_by_municipality %>%
    distinct(bfs_id, .keep_all = TRUE) %>%
    select(
      bfs_id,
      name = GMDNAME,
      altitude,
      region
    ) %>%
    mutate(urban = bfs_id %in% municipalities_in_urban_areas_matrix) %>% 
    rename(bfsId = bfs_id),
  glue(
    "output/",
    "municipalities.json"
  )
)