knitr::opts_chunk$set(
  collapse = TRUE, comment = "#>", results="asis", eval=T,
  echo=F, warning=F, message=F, fig.width=8, fig.height=5, fig.path="../figures/"
)
library(tidyverse)
library(lubridate)
library(ggspatial)
library(ggsci)
library(ggthemes)
library(patchwork)
library(zoo)

# Define standard colour scheme
whitered <- colorRampPalette(c('#fff7ec','#fee8c8','#fdd49e','#fdbb84','#fc8d59','#ef6548','#d7301f','#b30000','#7f0000'))(255)
#pie(rep(1,9),col=c('#fff7ec','#fee8c8','#fdd49e','#fdbb84','#fc8d59','#ef6548','#d7301f','#b30000','#7f0000'))

whiteblue <- colorRampPalette(c('#f7fcf0','#e0f3db','#ccebc5','#a8ddb5','#7bccc4','#4eb3d3','#2b8cbe','#0868ac','#084081'))(255)
#pie(rep(1,9),col=c('#f7fcf0','#e0f3db','#ccebc5','#a8ddb5','#7bccc4','#4eb3d3','#2b8cbe','#0868ac','#084081'))

bluewhitered <- colorRampPalette(c("#009392","#39b185","#9ccb86","#e9e29c","#eeb479","#e88471","#cf597e"))(255)
#pie(rep(1,7),col=c("#009392","#39b185","#9ccb86","#e9e29c","#eeb479","#e88471","#cf597e"))
# Load shapefile of Bavaria
data("bavaria", package="bdc")
bavaria <- sf::st_as_sf(bavaria)

General information

The Euro-Cordex data have been derived from: https://esgf-data.dkrz.de/search/cordex-dkrz/

More information on the Euro-Cordex project can be found here: https://euro-cordex.net/060378/index.php.en

An analysis of the Euro-Codex data for Europe can be found here: https://www.dkrz.de/projekte-und-partner/HLRE-Projekte/focus/regionale-klimaprojektionen-fuer-europa

While, an analysis of the Euro-Cordex data for Germany has previously been published in:

Dalelane, C., Früh, B., Steger, C., & Walter, A. (2018). A pragmatic approach to build a reduced regional climate projection ensemble for Germany using the EURO-CORDEX 8.5 ensemble. Journal of Applied Meteorology and Climatology, 57(3), 477-491.

And can be found here: https://journals.ametsoc.org/doi/full/10.1175/JAMC-D-17-0141.1

Data Overview

Here we use the CORDEX regional climate model (RCM) simulations for the European Domain (EUR-11) at the finer resolution of 0.11° (~12.5km). We use monthly bias-Adjusted data of minimum and maximum temperature as well as total precipitation (pr, tasmin and tasmax). The data comes in the form of monthly values in NetCDF-format and cover a time period from 1950 to 2100.

We use 30-year averages of the monthly values of those three variables to calculate the 19 bioclimatic variables commonly used for species distribution models. Bioclimatic variables were calculated using the biovars() function from the dismo package.

Bioclimatic variables

Bioclimatic variables are derived from the monthly temperature and rainfall values in order to generate more biologically meaningful variables. These are often used in species distribution modeling and related ecological modeling techniques. The bioclimatic variables represent annual trends (e.g., mean annual temperature, annual precipitation) seasonality (e.g., annual range in temperature and precipitation) and extreme or limiting environmental factors (e.g., temperature of the coldest and warmest month, and precipitation of the wet and dry quarters). A quarter is a period of three months (1/4 of the year).

They are coded as follows:

BIO1 = Annual Mean Temperature
BIO2 = Mean Diurnal Range (Mean of monthly (max temp - min temp))
BIO3 = Isothermality (BIO2/BIO7) ( 100)
BIO4 = Temperature Seasonality (standard deviation
100)
BIO5 = Max Temperature of Warmest Month
BIO6 = Min Temperature of Coldest Month
BIO7 = Temperature Annual Range (BIO5-BIO6)
BIO8 = Mean Temperature of Wettest Quarter
BIO9 = Mean Temperature of Driest Quarter
BIO10 = Mean Temperature of Warmest Quarter
BIO11 = Mean Temperature of Coldest Quarter
BIO12 = Annual Precipitation
BIO13 = Precipitation of Wettest Month
BIO14 = Precipitation of Driest Month
BIO15 = Precipitation Seasonality (Coefficient of Variation)
BIO16 = Precipitation of Wettest Quarter
BIO17 = Precipitation of Driest Quarter
BIO18 = Precipitation of Warmest Quarter
BIO19 = Precipitation of Coldest Quarter

Both datasets (cordex_bioclim_bav.csv.xz & cordex_bioclim_bav_tk4tel.csv.xz) just contain the data of three 30-year time periods (1991-2020, 2041-2070, 2071-2100).

The dataset cordex_bioclim_bav_tk4tel.csv.xz was additionaly converted to a different grid, so that it corresponds to the grid of the Bavarian biodiversity data.

Note: If you use the climate data for Bavaria together with other data (i.e. IUCN/BirdLife-data), please use the Euro-Cordex data in its native resolution (cordex_bioclim_bav.csv.xz), as the cordex_bioclim_bav_tk4tel.csv.xz is only intended to be used with data that natively comes in this resolution.

Both datasets consist of 27 columns with the following names:

x, y, gcm, ensemble, rcm, rs, rcp, time_frame, bio1, bio2, bio3, bio4, bio5, bio6, bio7, bio8, bio9, bio10, bio11, bio12, bio13, bio14, bio15, bio16, bio17, bio18, bio19

Here I explain each of the columns:

Note: For each gcm, ensemble, rcm, rs, rcp and time_frame combination there is a complete set of climte data for each grid cell. To use a specific combination, please filter() or subset() your dataframe accordingly..

Note: The bias-adjusted data has no output for a historical experiment, unlike the original (non bias-adjusted) data. And some GCM/RCM combinations are also not available for the bias-adjusted data.

Data Analysis

Here, I perform a first analysis of the Euro-Cordex bias-adjusted temperature and precipitation data for Bavaria at 0.11 degree (EUR-11, ~12.5 km).

The Euro-Cordex data for Bavaria (cordex_prAdjust_bav.rda, cordex_tasAdjust_bav.rda, cordex_tasminAdjust_bav.rda, cordex_tasmaxAdjust_bav.rda and cordex_bioclim_bav.rda), which I use here, can be downloaded from https://github.com/RS-eco/bdc/blob/main/data/.

The code for how the Euro-Cordex data (cordex_prAdjust_bav.rda, cordex_tasAdjust_bav.rda, cordex_tasminAdjust_bav.rda. cordex_tasmaxAdjust_bav.rda and cordex_bioclim_bav.rda) was created can be found here: https://github.com/RS-eco/bdc/blob/main/data-raw/euro_cordex.R

Temporal patterns

Minimum temperature

# Load data
load(system.file("extdata", "cordex_tasminAdjust_bav.rda", package = "bdc"))

# Calculate mean temperature of Bavaria for a given time period and scenario (gcm, rcp, rcm, ensemble)
mean_tasminAdjust <- cordex_tasminAdjust_bav %>% mutate(mon=month(time), yr=year(time)) %>%
  group_by(mon, yr, gcm, rcp, rcm, ensemble) %>% 
  summarise(mn=mean(value, na.rm=T), err=sd(value, na.rm=T))
rm(cordex_tasminAdjust_bav); invisible(gc())
mean_tasminAdjust %>% filter(yr %in% c(1970, 2000, 2030, 2060, 2090)) %>% 
  group_by(mon, yr, rcp) %>% summarise(mn=mean(mn)) %>%
  ggplot(aes(x=mon, y=mn, colour=factor(yr))) + facet_wrap(rcp~., nrow=1) + 
  geom_line() + scale_x_continuous(breaks=1:12, labels=month.abb) + 
  scale_colour_manual(name="Year", values=c('#e41a1c','#377eb8','#4daf4a',"#984ea3","#ff7f00")) + 
  theme_few() + theme(axis.text.x=element_text(angle=90)) + labs(x="", y="Mean monthly temperature")

Fig. 1. Mean monthly minimum temperature for 7 selected years and each of the three rcps (ensemble mean of different gcms, rcms and ensembles).

mean_tasminAdjust %>% ungroup() %>% mutate(mon = (mon-1)/12) %>%
  mutate(monyear=yr + mon) %>% mutate(monyear = as.Date(as.yearmon(monyear))+14) %>%
  group_by(monyear, rcp) %>% summarise(mn=mean(mn, na.rm=T), err=mean(err)) %>% 
  ggplot() + geom_ribbon(aes(x=monyear, ymin=mn-err, ymax=mn+err)) + 
  geom_line(aes(x=monyear, y=mn), colour="red") + 
  geom_smooth(aes(x=monyear, y=mn), method="lm") +
  facet_wrap(rcp~., ncol=1, strip.position = "left") + scale_x_date(expand=c(.01,.01)) + theme_few() + 
  theme(strip.placement = "outside") + labs(x="Year", y="")

Fig. 2. Mean monthly minimum temperature over time (ensemble mean of different gcms, rcms and ensembles) shown for the three experiments (RCP2.6, RCP4.5, RCP8.5) for which bias-adjusted data is available.

mean_tasminAdjust %>% ungroup() %>% mutate(mon = (mon-1)/12) %>%
  group_by(yr, rcp, gcm, rcm, ensemble) %>% 
  summarise(mn1=sum(mn, na.rm=T), err=sd(mn)) %>% group_by(yr, rcp) %>%
  summarise(mn=mean(mn1, na.rm=T), err=sd(mn1, na.rm=T)) %>%
  ggplot() + geom_ribbon(aes(x=yr, ymin=mn-err, ymax=mn+err), alpha=0.5) + 
  geom_line(aes(x=yr, y=mn)) + 
  facet_wrap(rcp~., ncol=1, strip.position = "left") + 
  geom_smooth(aes(x=yr, y=mn), method="lm") + scale_x_continuous(expand=c(.01,.01)) + 
  theme_few() + theme(strip.placement = "outside", legend.position="none") + labs(x="Year", y="")

Fig. 3. Mean annual minimum temperature over time (ensemble mean of different gcms, rcms and ensembles) shown for the three experiments (RCP2.6, RCP4.5, RCP8.5) for which bias-adjusted data is available.

mean_tasminAdjust %>% ungroup() %>% mutate(mon = (mon-1)/12) %>%
  mutate(monyear=yr + mon) %>% mutate(monyear = as.Date(as.yearmon(monyear))+14) %>%
  group_by(monyear, rcp, gcm, rcm, ensemble) %>% summarise(mn2=mean(mn, na.rm=T), err=sd(mn)) %>% 
  ggplot() + geom_ribbon(aes(x=monyear, ymin=mn2-err, ymax=mn2+err)) + 
  geom_line(aes(x=monyear, y=mn2), colour="red") + 
  facet_grid(rcp ~ rcm+gcm+ensemble) + geom_smooth(aes(x=monyear, y=mn2), method="lm") + 
  scale_x_date(expand=c(.01,.01)) + theme_few() + 
  scale_colour_manual(name="Year", values=c('#e41a1c','#377eb8','#4daf4a',"#984ea3","#ff7f00"))
mean_tasminAdjust %>% filter(yr %in% c(1970, 2000, 2030, 2060, 2090)) %>% 
  ggplot(aes(x=mon, y=mn, colour=factor(yr), linetype=rcp)) +
  geom_line() + facet_wrap(. ~ rcm+gcm+ensemble, ncol=5) + 
  scale_x_continuous(breaks=1:12, labels=month.abb) + 
  scale_colour_manual(name="Year", values=c('#e41a1c','#377eb8','#4daf4a',"#984ea3","#ff7f00")) + 
  theme_few() + labs(x="", y="Mean monthly temperature") + 
  theme(axis.text.x=element_text(angle=90))

Fig. 4. Mean monthly minimum temperature for 7 selected years and the different experiments (RCP2.6, RCP4.5, RCP8.5) for each GCM, RCM and Ensemble combination.

mean_tasminAdjust %>% ungroup() %>% mutate(mon = (mon-1)/12) %>%
  mutate(monyear=yr + mon) %>% mutate(monyear = as.Date(zoo::as.yearmon(monyear))+14) %>%
  ggplot() + geom_ribbon(aes(x=monyear, ymin=mn-err, ymax=mn+err)) + 
  geom_line(aes(x=monyear, y=mn, linetype=rcp, colour=rcp)) + 
  geom_smooth(aes(x=monyear, y=mn), method="lm") + 
  facet_wrap(. ~ rcm+gcm+ensemble, ncol=4) + scale_x_date(expand=c(.01,.01)) + 
  scale_colour_manual(name="Year", values=c('#e41a1c','#377eb8','#4daf4a',"#984ea3","#ff7f00")) + 
  theme_few() + labs(x="", y="Mean monthly temperature") + theme(legend.position="bottom")
mean_tasminAdjust %>% ungroup() %>% mutate(mon = (mon-1)/12) %>%
  group_by(yr, rcm, gcm, rcp, ensemble) %>% summarise(mn=mean(mn, na.rm=T), err=mean(err)) %>% 
  ggplot() + #geom_ribbon(aes(x=yr, ymin=mn-err, ymax=mn+err)) + 
  geom_line(aes(x=yr, y=mn, colour=rcp)) + 
  #geom_smooth(aes(x=yr, y=mn), method="lm") + 
  facet_wrap(. ~ rcm+gcm+ensemble, ncol=4) + #scale_x_date(expand=c(.01,.01)) + 
  scale_colour_manual(name="RCP", values=c("#0099B4FF", "#ADB6B6FF", "#AD002AFF")) + 
  theme_few() + labs(x="", y="Mean annual minimum temperature") + 
  theme(legend.position=c(0.9,0.15), panel.spacing.x = unit(0.75, "lines"))

Fig. 5. Mean annual minimum temperature over time. Colour indicates the different experiments (RCP2.6, RCP4.5, RCP8.5). Each plot represents one GCM, RCM and Ensemble combination.

Maximum temperature

# Load data
load(system.file("extdata", "cordex_tasmaxAdjust_bav.rda", package = "bdc"))

# Calculate mean temperature of Bavaria for a given time period and scenario (gcm, rcp, rcm, ensemble)
mean_tasmaxAdjust <- cordex_tasmaxAdjust_bav %>% mutate(mon=month(time), yr=year(time)) %>%
  group_by(mon, yr, gcm, rcp, rcm, ensemble) %>% 
  summarise(mn=mean(value, na.rm=T), err=sd(value, na.rm=T)); rm(cordex_tasmaxAdjust_bav); invisible(gc())
mean_tasmaxAdjust %>% filter(yr %in% c(1970, 2000, 2030, 2060, 2090)) %>% 
  group_by(mon, yr, rcp) %>% summarise(mn=mean(mn)) %>%
  ggplot(aes(x=mon, y=mn, colour=factor(yr))) + facet_wrap(rcp~., nrow=1) + 
  geom_line() + scale_x_continuous(breaks=1:12, labels=month.abb) + 
  scale_colour_manual(name="Year", values=c('#e41a1c','#377eb8','#4daf4a',"#984ea3","#ff7f00")) + 
  theme_few() + theme(axis.text.x=element_text(angle=90)) + labs(x="", y="Mean monthly temperature")

Fig. 6. Mean monthly maximum temperature for 7 selected years and each of the three rcps (ensemble mean of different gcms, rcms and ensembles).

mean_tasmaxAdjust %>% ungroup() %>% mutate(mon = (mon-1)/12) %>%
  mutate(monyear=yr + mon) %>% mutate(monyear = as.Date(as.yearmon(monyear))+14) %>%
  group_by(monyear, rcp) %>% summarise(mn=mean(mn, na.rm=T), err=mean(err)) %>% 
  ggplot() + geom_ribbon(aes(x=monyear, ymin=mn-err, ymax=mn+err)) + 
  geom_line(aes(x=monyear, y=mn), colour="red") + 
  geom_smooth(aes(x=monyear, y=mn), method="lm") +
  facet_wrap(rcp~., ncol=1, strip.position = "left") + scale_x_date(expand=c(.01,.01)) + theme_few() + 
  theme(strip.placement = "outside") + labs(x="Year", y="")

Fig. 7. Mean monthly maximum temperature over time (ensemble mean of different gcms, rcms and ensembles) shown for the three experiments (RCP2.6, RCP4.5, RCP8.5) for which bias-adjusted data is available.

mean_tasmaxAdjust %>% ungroup() %>% mutate(mon = (mon-1)/12) %>%
  group_by(yr, rcp, gcm, rcm, ensemble) %>% 
  summarise(mn1=sum(mn, na.rm=T), err=sd(mn)) %>% group_by(yr, rcp) %>%
  summarise(mn=mean(mn1, na.rm=T), err=sd(mn1, na.rm=T)) %>%
  ggplot() + geom_ribbon(aes(x=yr, ymin=mn-err, ymax=mn+err), alpha=0.5) + 
  geom_line(aes(x=yr, y=mn)) + 
  facet_wrap(rcp~., ncol=1, strip.position = "left") + 
  geom_smooth(aes(x=yr, y=mn), method="lm") + scale_x_continuous(expand=c(.01,.01)) + 
  theme_few() + theme(strip.placement = "outside", legend.position="none") + labs(x="Year", y="")

Fig. 8. Mean annual maximum temperature over time (ensemble mean of different gcms, rcms and ensembles) shown for the three experiments (RCP2.6, RCP4.5, RCP8.5) for which bias-adjusted data is available.

mean_tasmaxAdjust %>% ungroup() %>% mutate(mon = (mon-1)/12) %>%
  mutate(monyear=yr + mon) %>% mutate(monyear = as.Date(as.yearmon(monyear))+14) %>%
  group_by(monyear, rcp, gcm, rcm, ensemble) %>% summarise(mn2=mean(mn, na.rm=T), err=sd(mn)) %>% 
  ggplot() + geom_ribbon(aes(x=monyear, ymin=mn2-err, ymax=mn2+err)) + 
  geom_line(aes(x=monyear, y=mn2), colour="red") + 
  facet_grid(rcp ~ rcm+gcm+ensemble) + geom_smooth(aes(x=monyear, y=mn2), method="lm") + 
  scale_x_date(expand=c(.01,.01)) + theme_few() + 
  scale_colour_manual(name="Year", values=c('#e41a1c','#377eb8','#4daf4a',"#984ea3","#ff7f00"))
mean_tasmaxAdjust %>% filter(yr %in% c(1970, 2000, 2030, 2060, 2090)) %>% 
  ggplot(aes(x=mon, y=mn, colour=factor(yr), linetype=rcp)) +
  geom_line() + facet_wrap(. ~ rcm+gcm+ensemble, ncol=5) + 
  scale_x_continuous(breaks=1:12, labels=month.abb) + 
  scale_colour_manual(name="Year", values=c('#e41a1c','#377eb8','#4daf4a',"#984ea3","#ff7f00")) + 
  theme_few() + labs(x="", y="Mean monthly maximum temperature") + 
  theme(axis.text.x=element_text(angle=90))

Fig. 9. Mean monthly maximum temperature for 7 selected years and the different experiments (RCP2.6, RCP4.5, RCP8.5) for each GCM, RCM and Ensemble combination.

mean_tasmaxAdjust %>% ungroup() %>% mutate(mon = (mon-1)/12) %>%
  mutate(monyear=yr + mon) %>% mutate(monyear = as.Date(zoo::as.yearmon(monyear))+14) %>%
  ggplot() + geom_ribbon(aes(x=monyear, ymin=mn-err, ymax=mn+err)) + 
  geom_line(aes(x=monyear, y=mn, linetype=rcp, colour=rcp)) + 
  geom_smooth(aes(x=monyear, y=mn), method="lm") + 
  facet_wrap(. ~ rcm+gcm+ensemble, ncol=5) + scale_x_date(expand=c(.01,.01)) + 
  scale_colour_manual(name="Year", values=c('#e41a1c','#377eb8','#4daf4a',"#984ea3","#ff7f00")) + 
  theme_few() + labs(x="", y="Mean monthly temperature") + 
  theme(legend.position="bottom")
mean_tasmaxAdjust %>% ungroup() %>% mutate(mon = (mon-1)/12) %>%
  group_by(yr, rcm, gcm, rcp, ensemble) %>% summarise(mn=mean(mn, na.rm=T), err=mean(err)) %>% 
  ggplot() + #geom_ribbon(aes(x=yr, ymin=mn-err, ymax=mn+err)) + 
  geom_line(aes(x=yr, y=mn, colour=rcp)) + 
  #geom_smooth(aes(x=yr, y=mn), method="lm") + 
  facet_wrap(. ~ rcm+gcm+ensemble, ncol=4) + #scale_x_date(expand=c(.01,.01)) + 
  scale_colour_manual(name="RCP", values=c("#0099B4FF", "#ADB6B6FF", "#AD002AFF")) + 
  theme_few() + labs(x="", y="Mean annual maximum temperature") + 
  theme(legend.position=c(0.8,0.1), panel.spacing.x = unit(0.75, "lines"))

Fig. 10. Mean annual maximum temperature over time. Colour indicates the different experiments (RCP2.6, RCP4.5, RCP8.5). Each plot represents one GCM, RCM and Ensemble combination.

Precipitation

load(system.file("extdata", "cordex_prAdjust_bav.rda", package = "bdc"))
mn_prAdjust <- cordex_prAdjust_bav %>% mutate(mon=month(time), yr=year(time)) %>%
  group_by(mon, yr, gcm, rcp, rcm, ensemble) %>% 
  summarise(mn=mean(value), err=sd(value)); rm(cordex_prAdjust_bav); invisible(gc())

mn_prAdjust %>% filter(yr %in% c(1970, 2000, 2030, 2060, 2090)) %>% 
  group_by(mon, yr, rcp) %>% summarise(mn=mean(mn)) %>%
  ggplot(aes(x=mon, y=mn, colour=factor(yr))) + facet_wrap(rcp~., nrow=1) + 
  geom_line() + scale_x_continuous(breaks=1:12, labels=month.abb) + 
  scale_colour_manual(name="Year", values=c('#e41a1c','#377eb8','#4daf4a',"#984ea3","#ff7f00")) + 
  theme_few() + theme(axis.text.x=element_text(angle=90)) + labs(x="", y="Mean monthly precipitation (mm)")

Fig. 11. Mean monthly precipitation for 7 selected years and each of the three rcps (ensemble mean of different gcms, rcms and ensembles).

mn_prAdjust %>% ungroup() %>% mutate(mon = (mon-1)/12) %>%
  mutate(monyear=yr + mon) %>% mutate(monyear = as.Date(zoo::as.yearmon(monyear))+14) %>%
  group_by(monyear, rcp) %>% summarise(mn=mean(mn), err=sd(mn)) %>%
  ggplot() + geom_ribbon(aes(x=monyear, ymin=mn-err, ymax=mn+err), colour="black") + 
  geom_line(aes(x=monyear, y=mn), colour="red") + 
  geom_smooth(aes(x=monyear, y=mn), method="lm") + scale_x_date(expand=c(.01,.01)) + 
  facet_wrap(.~rcp, ncol=1, strip.position="left") + theme_few() + 
  theme(strip.placement = "outside") + labs(x="Year", y="")

Fig. 12. Mean monthly precipitation over time (ensemble mean of different gcms, rcms and ensembles) shown for the three experiments (RCP2.6, RCP4.5, RCP8.5) for which bias-adjusted data is available.

mn_prAdjust %>% ungroup() %>% group_by(yr, rcp, gcm, rcm, ensemble) %>% 
  summarise(mn1=sum(mn, na.rm=T), err=sd(mn)) %>% group_by(yr, rcp) %>%
  summarise(mn=mean(mn1, na.rm=T), err=sd(mn1, na.rm=T)) %>%
  ggplot() + geom_ribbon(aes(x=yr, ymin=mn-err, ymax=mn+err), alpha=0.5) + 
  geom_line(aes(x=yr, y=mn)) + 
  facet_wrap(rcp~., ncol=1, strip.position = "left") + 
  geom_smooth(aes(x=yr, y=mn), method="lm") + scale_x_continuous(expand=c(.01,.01)) + 
  theme_few() + theme(strip.placement = "outside", legend.position="none") + labs(x="Year", y="")

Fig. 13. Mean annual precipitation over time (ensemble mean of different gcms, rcms and ensembles) shown for the three experiments (RCP2.6, RCP4.5, RCP8.5) for which bias-adjusted data is available.

mn_prAdjust %>% filter(yr %in% c(1970, 2000, 2030, 2060, 2090)) %>% 
  ggplot(aes(x=mon, y=mn, colour=factor(yr), linetype=rcp)) +
  geom_line() + facet_wrap(. ~ rcm+gcm, ncol=5) + 
  scale_x_continuous(breaks=1:12, labels=month.abb) + 
  scale_colour_manual(name="Year", values=c('#e41a1c','#377eb8','#4daf4a',"#984ea3","#ff7f00")) + 
  theme_few() + labs(x="", y="") + theme(axis.text.x=element_text(angle=90))

Fig. 14. Mean monthly precipitation for 7 selected years and the different experiments (RCP2.6, RCP4.5, RCP8.5) for each GCM, RCM and Ensemble combination.

mn_prAdjust %>% ungroup() %>% mutate(mon = (mon-1)/12) %>%
  mutate(monyear=yr + mon) %>% mutate(monyear = as.Date(zoo::as.yearmon(monyear))+14) %>%
  ggplot() + geom_line(aes(x=monyear, y=mn, colour=rcp)) + 
  geom_smooth(aes(x=monyear, y=mn), method="lm") + 
  facet_wrap(. ~ rcm+gcm, ncol=5) + scale_x_date(expand=c(.01,.01)) + 
  theme_few() + theme(legend.position="bottom") + labs(x="", y="Mean monthly precipitation (mm)")
mn_prAdjust %>% group_by(yr, rcm, gcm, rcp, ensemble) %>% 
  summarise(tot=sum(mn)) %>% 
  ggplot() + geom_line(aes(x=yr, y=tot, colour=rcp)) + 
  facet_wrap(. ~ rcm+gcm+ensemble, ncol=4) + 
  scale_colour_manual(name="RCP", values=c("#0099B4FF", "#ADB6B6FF", "#AD002AFF")) + 
  theme_few() + labs(x="", y="Mean annual precipitation (mm)") + 
  theme(legend.position=c(0.8,0.1), panel.spacing.x = unit(0.75, "lines"))

Fig. 15. Mean annual precipitation over time. Colour indicates the different experiments (RCP2.6, RCP4.5, RCP8.5). Each plot represents one GCM, RCM and Ensemble combination.

Spatial patterns

Minimum temperature

load(system.file("extdata", "cordex_tasminAdjust_bav.rda", package = "bdc"))
tasminAdjust_30yr <- cordex_tasminAdjust_bav %>% 
  mutate(yr = lubridate::year(time), mon = lubridate::month(time)) %>%
  filter(yr %in% c(1991:2020, 2041:2070, 2071:2100)) %>%
  mutate(yr = ifelse(yr %in% c(1991:2020), "past", ifelse(yr %in% c(2041:2070), "future", "extfuture"))) %>% 
  mutate(yr = factor(yr, levels=c("past", "future", "extfuture"), labels=c("1991-2020", "2041-2070", "2071-2100"))) %>%
  group_by(x, y, mon, yr, gcm, rcp, rcm, ensemble) %>% 
  summarise(mn=mean(value), err=sd(value), mini=min(value), maxi=max(value))
rm(cordex_tasminAdjust_bav); invisible(gc())

# Plot map of temperature
dat <- tasminAdjust_30yr %>% group_by(x, y, yr, rcp) %>% summarise(mn=mean(mn, na.rm=T))
col_val <- scales::rescale(quantile(dat$mn, probs=seq(0,1,0.12)))
lim <- c(min(dat$mn, na.rm=T), max(dat$mn, na.rm=T))
dat %>% ggplot() + geom_tile(aes(x=x, y=y, fill=mn)) + facet_grid(rcp~yr) + 
  scale_fill_gradientn(name="tasmin", colours=whitered, limits=lim, values=col_val) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + labs(x="", y="")

Fig. 16. Map of 30-yr average minimum temperature for three selected time periods (1991-2020, 2041-2070, 2071-2100) and the three rcps (RCP2.6, RCP4.5, RCP8.5).

# Plot month against year
tasminAdjust_30yr %>% ggplot() + geom_tile(aes(x=x, y=y, fill=mn)) + facet_grid(mon~yr) + 
  scale_fill_gradientn(name="tasmin", colours=whitered) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + labs(x="", y="")
# Plot season against year
dat <- tasminAdjust_30yr %>% ungroup() %>% mutate(mon=ifelse(mon==12,1,mon)) %>% # This make months unmeaningful
  mutate(season=cut(mon, breaks=c(1,3,5,8,12), right=F)) %>% 
  mutate(season = factor(season, labels=c("DJF", "MAM", "JJA", "SON"))) %>%
  group_by(x, y, season, yr) %>% summarise(mn=mean(mn))
col_val <- scales::rescale(quantile(dat$mn, probs=seq(0,1,0.12)))
lim <- c(min(dat$mn, na.rm=T), max(dat$mn, na.rm=T))
dat %>% ggplot() + geom_tile(aes(x=x, y=y, fill=mn)) + facet_grid(season~yr) + 
  scale_fill_gradientn(name="tasmin", colours=whitered, limits=lim, values=col_val) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + labs(x="", y="")

Fig. 17. Seasonal patterns of 30-yr average minimum temperature for three selected time periods (1991-2020, 2041-2070, 2071-2100).

# Plot summer/winter against year
dat1 <- tasminAdjust_30yr %>% ungroup() %>% mutate(season=cut(mon, breaks=c(0,4,10,13), right=F)) %>% 
  mutate(season = factor(season, labels=c("Winter", "Summer", "Winter"))) %>%
  group_by(x, y, season, yr) %>% summarise(mn=mean(mn)) %>% filter(season == "Summer")
col_val <- scales::rescale(quantile(dat1$mn, probs=seq(0,1,0.12)))
lim <- c(min(dat1$mn, na.rm=T), max(dat1$mn, na.rm=T))
p1 <- dat1 %>% ggplot() + geom_tile(aes(x=x, y=y, fill=mn)) + facet_grid(season~yr) + 
  scale_fill_gradientn(name="tasmin", colours=whitered, limits=lim, values=col_val) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + labs(x="", y="")

dat2 <- tasminAdjust_30yr %>% ungroup() %>% mutate(season=cut(mon, breaks=c(0,4,10,13), right=F)) %>% 
  mutate(season = factor(season, labels=c("Winter", "Summer", "Winter"))) %>%
  group_by(x, y, season, yr) %>% summarise(mn=mean(mn)) %>% filter(season == "Winter")
col_val <- scales::rescale(quantile(dat2$mn, probs=seq(0,1,0.12)))
lim <- c(min(dat2$mn, na.rm=T), max(dat2$mn, na.rm=T))
p2 <- dat2 %>% ggplot() + geom_tile(aes(x=x, y=y, fill=mn)) + facet_grid(season~yr) + 
  scale_fill_gradientn(name="tasmin", colours=whitered, limits=lim, values=col_val) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + labs(x="", y="")
p1 + p2 + plot_layout(ncol=1)

Fig. 18. Map of 30-yr average minimum temperature for three selected time periods (1991-2020, 2041-2070, 2071-2100) separately for summer (top) and winter (bottom).

# Plot map of temperature (1991-2020, 2021-205, 2071-2100) against GCM
tasminAdjust_30yr %>% group_by(x, y, yr, gcm, rcm, ensemble) %>% summarise(mn=mean(mn, na.rm=T)) %>%
  ggplot() + geom_tile(aes(x=x, y=y, fill=mn)) + facet_grid(gcm + rcm + ensemble ~ yr) + 
  scale_fill_gradientn(name="tasmin", colours=whitered) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + labs(x="", y="")

Maximum temperature

load(system.file("extdata", "cordex_tasmaxAdjust_bav.rda", package = "bdc"))

tasmaxAdjust_30yr <- cordex_tasmaxAdjust_bav %>% 
  mutate(yr = lubridate::year(time), mon = lubridate::month(time)) %>%
  filter(yr %in% c(1991:2020, 2041:2070, 2071:2100)) %>%
  mutate(yr = ifelse(yr %in% c(1991:2020), "past", ifelse(yr %in% c(2041:2070), "future", "extfuture"))) %>% 
  mutate(yr = factor(yr, levels=c("past", "future", "extfuture"), labels=c("1991-2020", "2041-2070", "2071-2100"))) %>%
  group_by(x, y, mon, yr, gcm, rcp, rcm, ensemble) %>% 
  summarise(mn=mean(value), err=sd(value), mini=min(value), maxi=max(value))
rm(cordex_tasmaxAdjust_bav); invisible(gc())

# Plot map of temperature
dat <- tasmaxAdjust_30yr %>% group_by(x, y, yr, rcp) %>% summarise(mn=mean(mn, na.rm=T))
col_val <- scales::rescale(quantile(dat$mn, probs=seq(0,1,0.12)))
lim <- c(min(dat$mn, na.rm=T), max(dat$mn, na.rm=T))
dat %>% ggplot() + geom_tile(aes(x=x, y=y, fill=mn)) + facet_grid(rcp~yr) + 
  scale_fill_gradientn(name="tasmin", colours=whitered, limits=lim, values=col_val) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + labs(x="", y="")

Fig. 19. Map of 30-yr average maximum temperature for three selected time periods (1991-2020, 2041-2070, 2071-2100) and the three rcps (RCP2.6, RCP4.5, RCP8.5).

# Plot month against year
tasmaxAdjust_30yr %>% ggplot() + geom_tile(aes(x=x, y=y, fill=mn)) + facet_grid(mon~yr) + 
  scale_fill_gradientn(name="tasmax", colours=whitered) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + labs(x="", y="")
# Plot season against year
dat <- tasmaxAdjust_30yr %>% ungroup() %>% mutate(mon=ifelse(mon==12,1,mon)) %>% # This make months unmeaningful
  mutate(season=cut(mon, breaks=c(1,3,5,8,12), right=F)) %>% 
  mutate(season = factor(season, labels=c("DJF", "MAM", "JJA", "SON"))) %>%
  group_by(x, y, season, yr) %>% summarise(mn=mean(mn))
col_val <- scales::rescale(quantile(dat$mn, probs=seq(0,1,0.12)))
lim <- c(min(dat$mn, na.rm=T), max(dat$mn, na.rm=T))
dat %>% ggplot() + geom_tile(aes(x=x, y=y, fill=mn)) + facet_grid(season~yr) + 
  scale_fill_gradientn(name="tasmax", colours=whitered, limits=lim, values=col_val) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + labs(x="", y="")

Fig. 20. Seasonal patterns of 30-yr average maximum temperature for three selected time periods (1991-2020, 2041-2070, 2071-2100).

# Plot summer/winter against year
dat1 <- tasmaxAdjust_30yr %>% ungroup() %>% mutate(season=cut(mon, breaks=c(0,4,10,13), right=F)) %>% 
  mutate(season = factor(season, labels=c("Winter", "Summer", "Winter"))) %>%
  group_by(x, y, season, yr) %>% summarise(mn=mean(mn)) %>% filter(season == "Summer")
col_val <- scales::rescale(quantile(dat1$mn, probs=seq(0,1,0.12)))
lim <- c(min(dat1$mn, na.rm=T), max(dat1$mn, na.rm=T))
p1 <- dat1 %>% ggplot() + geom_tile(aes(x=x, y=y, fill=mn)) + facet_grid(season~yr) + 
  scale_fill_gradientn(name="tasmax", colours=whitered, limits=lim, values=col_val) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + labs(x="", y="")

dat2 <- tasmaxAdjust_30yr %>% ungroup() %>% mutate(season=cut(mon, breaks=c(0,4,10,13), right=F)) %>% 
  mutate(season = factor(season, labels=c("Winter", "Summer", "Winter"))) %>%
  group_by(x, y, season, yr) %>% summarise(mn=mean(mn)) %>% filter(season == "Winter")
col_val <- scales::rescale(quantile(dat2$mn, probs=seq(0,1,0.12)))
lim <- c(min(dat2$mn, na.rm=T), max(dat2$mn, na.rm=T))
p2 <- dat2 %>% ggplot() + geom_tile(aes(x=x, y=y, fill=mn)) + facet_grid(season~yr) + 
  scale_fill_gradientn(name="tasmax", colours=whitered, limits=lim, values=col_val) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + labs(x="", y="")
p1 + p2 + plot_layout(ncol=1)

Fig. 21. Map of 30-yr average maximum temperature for three selected time periods (1991-2020, 2041-2070, 2071-2100) separately for summer (top) and winter (bottom).

# Plot map of temperature (1991-2020, 2021-205, 2071-2100) against GCM
tasmaxAdjust_30yr %>% group_by(x, y, yr, gcm, rcm, ensemble) %>% summarise(mn=mean(mn, na.rm=T)) %>%
  ggplot() + geom_tile(aes(x=x, y=y, fill=mn)) + facet_grid(gcm + rcm + ensemble  ~ yr) + 
  scale_fill_gradientn(name="tasmax", colours=whitered) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + labs(x="", y="")

Precipitation

load(system.file("extdata", "cordex_prAdjust_bav.rda", package = "bdc"))

prAdjust_30yr <- cordex_prAdjust_bav %>% 
  mutate(yr = lubridate::year(time), mon = lubridate::month(time)) %>%
  filter(yr %in% c(1991:2020, 2041:2070, 2071:2100)) %>%
  mutate(yr = ifelse(yr %in% c(1991:2020),"past", 
                     ifelse(yr %in% c(2041:2070), "future", "extfuture"))) %>% 
  mutate(yr = factor(yr, levels=c("past", "future", "extfuture"), 
                     labels=c("1991-2020", "2041-2070", "2071-2100"))) %>% 
  group_by(x, y, mon, yr, gcm, rcp, rcm, ensemble) %>% 
  summarise(mn=mean(value), err=sd(value), mini=min(value), maxi=max(value))
rm(cordex_prAdjust_bav); invisible(gc())

# Plot map of precipitation
dat <- prAdjust_30yr %>% group_by(x, y, yr, rcp, gcm, rcm, ensemble) %>% 
  summarise(mn1=sum(mn, na.rm=T), err=sd(mn)) %>% group_by(x,y, yr, rcp) %>%
  summarise(mn=mean(mn1, na.rm=T), err=sd(mn1, na.rm=T))
col_val <- scales::rescale(quantile(dat$mn, probs=seq(0,1,0.12)))
lim <- c(min(dat$mn, na.rm=T), max(dat$mn, na.rm=T))
dat %>% ggplot() + geom_tile(aes(x=x, y=y, fill=mn)) + facet_grid(rcp~yr) + 
  scale_fill_gradientn(name="pr", colours=whiteblue, limits=lim, values=col_val) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + labs(x="", y="")

Fig. 22. Map of 30-yr average precipitation for three selected time periods (1991-2020, 2041-2070, 2071-2100) and the three rcps (RCP2.6, RCP4.5, RCP8.5).

# Plot month against year
prAdjust_30yr %>% ggplot() + geom_tile(aes(x=x, y=y, fill=mn)) + facet_grid(yr~mon) + 
  ggsci::scale_fill_gsea() + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + labs(x="", y="")
# Plot season against year
dat <- prAdjust_30yr %>% ungroup() %>% mutate(mon=ifelse(mon==12,1,mon)) %>% # This make months unmeaningful
  mutate(season=cut(mon, breaks=c(1,3,5,8,12), right=F)) %>%
  mutate(season = factor(season, labels=c("DJF", "MAM", "JJA", "SON"))) %>%
  group_by(x, y, season, yr, rcp, gcm, rcm, ensemble) %>% 
  summarise(mn1=sum(mn, na.rm=T), err=sd(mn)) %>% group_by(x,y, season, yr) %>%
  summarise(mn=mean(mn1, na.rm=T), err=sd(mn1, na.rm=T))
col_val <- scales::rescale(quantile(dat$mn, probs=seq(0,1,0.12)))
lim <- c(min(dat$mn, na.rm=T), max(dat$mn, na.rm=T))
dat %>% ggplot() + geom_tile(aes(x=x, y=y, fill=mn)) + facet_grid(season~yr, switch="y") + 
  scale_fill_gradientn(name="pr", colours=whiteblue, limits=lim, values=col_val) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + theme(strip.placement = "outside") + labs(x="", y="")

Fig. 23. Seasonal patterns of 30-yr average precipitation for three selected time periods (1991-2020, 2041-2070, 2071-2100).

# Plot summer/winter against year
dat1 <- prAdjust_30yr %>% ungroup() %>% mutate(season=cut(mon, breaks=c(0,4,10,13), right=F)) %>% 
  mutate(season = factor(season, labels=c("Winter", "Summer", "Winter"))) %>%
  group_by(x, y, season, yr, rcp, gcm, rcm, ensemble) %>% 
  summarise(mn1=sum(mn, na.rm=T), err=sd(mn)) %>% group_by(x,y, season, yr) %>%
  summarise(mn=mean(mn1, na.rm=T), err=sd(mn1, na.rm=T)) %>% filter(season == "Summer")
col_val <- scales::rescale(quantile(dat1$mn, probs=seq(0,1,0.12)))
lim <- c(min(dat1$mn, na.rm=T), max(dat1$mn, na.rm=T))
p1 <- dat1 %>% ggplot() + geom_tile(aes(x=x, y=y, fill=mn)) + facet_grid(season~yr, switch="y") + 
  scale_fill_gradientn(name="pr", colours=whiteblue, limits=lim, values=col_val) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + theme(strip.placement = "outside") + labs(x="", y="")

dat2 <- prAdjust_30yr %>% ungroup() %>% mutate(season=cut(mon, breaks=c(0,4,10,13), right=F)) %>% 
  mutate(season = factor(season, labels=c("Winter", "Summer", "Winter"))) %>%
   group_by(x, y, season, yr, rcp, gcm, rcm, ensemble) %>% 
  summarise(mn1=sum(mn, na.rm=T), err=sd(mn)) %>% group_by(x,y, season, yr) %>%
  summarise(mn=mean(mn1, na.rm=T), err=sd(mn1, na.rm=T)) %>% filter(season == "Winter")
col_val <- scales::rescale(quantile(dat2$mn, probs=seq(0,1,0.12)))
lim <- c(min(dat2$mn, na.rm=T), max(dat2$mn, na.rm=T))
p2 <- dat2 %>% ggplot() + geom_tile(aes(x=x, y=y, fill=mn)) + facet_grid(season~yr, switch="y") + 
  scale_fill_gradientn(name="pr", colours=whiteblue, limits=lim, values=col_val) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + theme(strip.placement = "outside") + 
  labs(x="", y="")
p1 + p2 + plot_layout(ncol=1)

Fig. 24. Map of 30-yr average precipitation for three selected time periods (1991-2020, 2041-2070, 2071-2100) separately for summer (top) and winter (bottom).

# Plot map of precipitation against GCM
prAdjust_30yr %>% group_by(x, y, yr, gcm, rcm, ensemble) %>% summarise(mn=mean(mn, na.rm=T)) %>%
  ggplot() + geom_tile(aes(x=x, y=y, fill=mn)) + facet_grid(gcm + rcm + ensemble  ~ yr) + 
  scale_fill_gradientn(name="pr", colours=whiteblue) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + labs(x="", y="")

Spatial changes

Minimum temperature

2041-2070

# Plot change between 1991-2020 and 2021 - 2050
df <- tasminAdjust_30yr %>% dplyr::select(-c(err, mini, maxi)) %>% tidyr::spread(yr, mn) %>%
  mutate(tasmin_change = `2041-2070`-`1991-2020`) %>%
  mutate(tasmin_rel_change = tasmin_change/`1991-2020`*100) %>% 
  group_by(x, y, rcp) %>% summarise(tasmin_change=mean(tasmin_change, na.rm=T),
                                    tasmin_rel_change=mean(tasmin_rel_change, na.rm=T))

col_val <- scales::rescale(quantile(df$tasmin_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmin_change, na.rm=T), max(df$tasmin_change, na.rm=T))
p1 <- df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=tasmin_change)) + facet_wrap(.~rcp, nrow=1) + 
  scale_fill_gradientn(name="change", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")

col_val <- scales::rescale(unique(c(seq(min(df$tasmin_rel_change, na.rm=T), 0, length=5), 
                                  seq(0, max(df$tasmin_rel_change, na.rm=T), length=5))))
lim <- c(min(df$tasmin_rel_change, na.rm=T), max(df$tasmin_rel_change, na.rm=T))
p2 <- df %>% 
  ggplot() + geom_tile(aes(x=x, y=y, fill=tasmin_rel_change)) + facet_wrap(.~rcp, nrow=1) + 
  scale_fill_gradientn(name="% change", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")
p1 + p2 + plot_layout(ncol=1)

Fig. 25. Map of change and relative change (%) in 30-yr average minimum temperature (2041-2070 - 1991-2020) and the three rcps (RCP2.6, RCP4.5, RCP8.5).

# Plot monthly change between 1991-2020 and 2021 - 2050
df <- tasminAdjust_30yr %>% group_by(x, y, mon, yr) %>% summarise(mn=mean(mn)) %>%
  tidyr::spread(yr, mn)
df$tasmin_change <- df$`2041-2070`-df$`1991-2020`#/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$tasmin_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmin_change, na.rm=T), max(df$tasmin_change, na.rm=T))
df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=tasmin_change)) + facet_wrap(.~mon) + 
  scale_fill_gradientn(name="tasmin", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")
# Plot seasonal change between 1991-2020 and 2021 - 2050
df <- tasminAdjust_30yr %>% ungroup() %>% 
  mutate(mon=ifelse(mon==12,1,mon)) %>% # This make months unmeaningful
  mutate(season=cut(mon, breaks=c(1,3,5,8,12), right=F)) %>%
  mutate(season = factor(season, labels=c("DJF", "MAM", "JJA", "SSO"))) %>%
  group_by(x, y, yr, season) %>% summarise(mn=mean(mn)) %>%
  tidyr::spread(yr,mn)
df$tasmin_change <- (df$`2041-2070`-df$`1991-2020`)#/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$tasmin_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmin_change, na.rm=T), max(df$tasmin_change, na.rm=T))
df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=tasmin_change)) + facet_wrap(.~season) + 
  scale_fill_gradientn(name="tasmin", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")

Fig. 26. Seasonal change in 30-yr average minimum temperature (2041-2070 - 1991-2020).

# Plot map of precipitation against GCM
df <- tasminAdjust_30yr %>% 
  group_by(x, y, yr, gcm, rcm, ensemble) %>% summarise(mn=mean(mn, na.rm=T)) %>%
  tidyr::spread(yr, mn)
df$tasmin_change <- (df$`2041-2070`-df$`1991-2020`)#/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$tasmin_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmin_change, na.rm=T), max(df$tasmin_change, na.rm=T))
df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=tasmin_change)) + facet_wrap(gcm + rcm + ensemble  ~ ., ncol=5) + 
  scale_fill_gradientn(name="tasmin", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")

Fig. 27. Map of change in 30-yr average minimum temperature (2041-2070 - 1991-2020) separately for RCP, GCM, RCM and Ensemble combination.

2071 - 2100

# Plot change between 1991-2020 and 2021 - 2050
df <- tasminAdjust_30yr %>% group_by(x, y, yr, rcp) %>% summarise(mn=mean(mn)) %>%
  tidyr::spread(yr, mn)
df$tasmin_change <- df$`2071-2100`-df$`1991-2020`
df$tasmin_rel_change <- (df$`2071-2100`-df$`1991-2020`)/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$tasmin_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmin_change, na.rm=T), max(df$tasmin_change, na.rm=T))
p1 <- df %>%
  ggplot() + geom_tile(aes(x=x, y=y, fill=tasmin_change)) + facet_wrap(.~rcp, nrow=1) + 
  scale_fill_gradientn(name="change", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")

col_val <- scales::rescale(quantile(df$tasmin_rel_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmin_rel_change, na.rm=T), max(df$tasmin_rel_change, na.rm=T))
p2 <- df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=tasmin_rel_change)) + facet_wrap(.~rcp, nrow=1) + 
  scale_fill_gradientn(name="% change", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")
p1 + p2 + plot_layout(ncol=1)

Fig. 28. Map of change and relative change (%) in 30-yr average minimum temperature (2071-2100 - 1991-2020) and the three rcps (RCP2.6, RCP4.5, RCP8.5).

# Plot monthly change between 1991-2020 and 2071 - 2100
df <- tasminAdjust_30yr %>% group_by(x, y, mon, yr) %>% summarise(mn=mean(mn)) %>%
  tidyr::spread(yr, mn)
df$tasmin_change <- (df$`2071-2100`-df$`1991-2020`)#/df$`1991-2020`*100
col_val <- scales::rescale(quantile(df$tasmin_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmin_change, na.rm=T), max(df$tasmin_change, na.rm=T))
df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=tasmin_change)) + facet_wrap(.~mon) + 
  scale_fill_gradientn(name="tasmin", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + labs(x="", y="")
# Plot seasonal change between 1991-2020 and 2071 - 2100
df <- tasminAdjust_30yr %>% ungroup() %>% mutate(mon=ifelse(mon==12,1,mon)) %>% # This make months unmeaningful
  mutate(season=cut(mon, breaks=c(1,3,5,8,12), right=F)) %>%
  mutate(season = factor(season, labels=c("DJF", "MAM", "JJA", "SSO"))) %>%
  group_by(x, y, yr, season) %>% summarise(mn=mean(mn)) %>%
  tidyr::spread(yr, mn)
df$tasmin_change <- (df$`2071-2100`-df$`1991-2020`)#/df$`1991-2020`*100
col_val <- scales::rescale(quantile(df$tasmin_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmin_change, na.rm=T), max(df$tasmin_change, na.rm=T))
df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=tasmin_change)) + facet_wrap(.~season) + 
  scale_fill_gradientn(name="tasmin", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")

Fig. 29. Seasonal change in 30-yr average minimum temperature (2071-2100 - 1991-2020).

# Plot map of tasmin against GCM
df <- tasminAdjust_30yr %>% 
  group_by(x, y, yr, gcm, rcm, ensemble) %>% summarise(mn=mean(mn, na.rm=T)) %>%
  tidyr::spread(yr, mn)
df$tasmin_change <- (df$`2041-2070`-df$`1991-2020`)#/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$tasmin_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmin_change, na.rm=T), max(df$tasmin_change, na.rm=T))
df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=tasmin_change)) + facet_wrap(gcm + rcm + ensemble  ~ ., ncol=5) + 
  scale_fill_gradientn(name="tasmin", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")

Fig. 30. Map of change in 30-yr average minimum temperature (2071-2100 - 1991-2020) separately for GCM, RCM and Ensemble combination.

Maximum temperature

2041-2070

# Plot monthly change between 1991-2020 and 2021 - 2050
df <- tasmaxAdjust_30yr %>% group_by(x, y, yr, rcp) %>% summarise(mn=mean(mn)) %>%
  tidyr::spread(yr, mn)
df$tasmax_change <- df$`2041-2070`-df$`1991-2020`
df$tasmax_rel_change <- (df$`2041-2070`-df$`1991-2020`)/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$tasmax_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmax_change, na.rm=T), max(df$tasmax_change, na.rm=T))
p1 <- df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=tasmax_change)) + facet_wrap(.~rcp, nrow=1) + 
  scale_fill_gradientn(name="change", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")

col_val <- scales::rescale(quantile(df$tasmax_rel_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmax_rel_change, na.rm=T), max(df$tasmax_rel_change, na.rm=T))
p2 <- df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=tasmax_rel_change)) + facet_wrap(.~rcp, nrow=1) +
  scale_fill_gradientn(name="% change", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")
p1 + p2 + plot_layout(ncol=1)

Fig. 31. Map of change and relative change (%) in 30-yr average maximum temperature (2041-2070 - 1991-2020) and the three rcps (RCP2.6, RCP4.5, RCP8.5).

# Plot monthly change between 1991-2020 and 2021 - 2050
df <- tasmaxAdjust_30yr %>% group_by(x, y, mon, yr) %>% summarise(mn=mean(mn)) %>%
  tidyr::spread(yr, mn)
df$tasmax_change <- df$`2041-2070`-df$`1991-2020`#/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$tasmax_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmax_change, na.rm=T), max(df$tasmax_change, na.rm=T))
df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=tasmax_change)) + facet_wrap(.~mon) + 
  scale_fill_gradientn(name="tasmax", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")
# Plot seasonal change between 1991-2020 and 2021 - 2050
df <- tasmaxAdjust_30yr %>% ungroup() %>% 
  mutate(mon=ifelse(mon==12,1,mon)) %>% # This make months unmeaningful
  mutate(season=cut(mon, breaks=c(1,3,5,8,12), right=F)) %>%
  mutate(season = factor(season, labels=c("DJF", "MAM", "JJA", "SSO"))) %>%
  group_by(x, y, yr, season) %>% summarise(mn=mean(mn)) %>%
  tidyr::spread(yr, mn)
df$tasmax_change <- (df$`2041-2070`-df$`1991-2020`)#/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$tasmax_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmax_change, na.rm=T), max(df$tasmax_change, na.rm=T))
df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=tasmax_change)) + facet_wrap(.~season) + 
  scale_fill_gradientn(name="tasmax", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")

Fig. 32. Seasonal change in 30-yr average maximum temperature (2041-2070 - 1991-2020).

# Plot map of tasmax against GCM
df <- tasmaxAdjust_30yr %>% 
  group_by(x, y, yr, gcm, rcm, ensemble) %>% summarise(mn=mean(mn, na.rm=T)) %>%
  tidyr::spread(yr, mn)
df$tasmax_change <- (df$`2041-2070`-df$`1991-2020`)#/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$tasmax_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmax_change, na.rm=T), max(df$tasmax_change, na.rm=T))
df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=tasmax_change)) + facet_wrap(gcm + rcm + ensemble  ~ .,ncol=5) + 
  scale_fill_gradientn(name="tasmax", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")

Fig. 33. Map of change in 30-yr average maximum temperature (2041-2070 - 1991-2020) separately for GCM, RCM and Ensemble combination.

2071 - 2100

# Plot change between 1991-2020 and 2021 - 2050
df <- tasmaxAdjust_30yr %>% group_by(x, y, yr, rcp) %>% summarise(mn=mean(mn)) %>%
  tidyr::spread(yr, mn)
df$tasmax_change <- df$`2071-2100`-df$`1991-2020`
df$tasmax_rel_change <- (df$`2071-2100`-df$`1991-2020`)/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$tasmax_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmax_change, na.rm=T), max(df$tasmax_change, na.rm=T))
p1 <- df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=tasmax_change)) + facet_wrap(.~rcp, nrow=1) + 
  scale_fill_gradientn(name="change", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")

col_val <- scales::rescale(quantile(df$tasmax_rel_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmax_rel_change, na.rm=T), max(df$tasmax_rel_change, na.rm=T))
p2 <- df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=tasmax_rel_change)) + facet_wrap(.~rcp, nrow=1) + 
  scale_fill_gradientn(name="% change", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")
p1 + p2 + plot_layout(ncol=1)

Fig. 34. Map of change and relative change (%) in 30-yr average maximum temperature (2071-2100 - 1991-2020) and the three rcps (RCP2.6, RCP4.5, RCP8.5).

# Plot monthly change between 1991-2020 and 2071 - 2100
df <- tasmaxAdjust_30yr %>% group_by(x, y, mon, yr) %>% summarise(mn=mean(mn)) %>%
  tidyr::spread(yr, mn)
df$tasmax_change <- (df$`2071-2100`-df$`1991-2020`)#/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$tasmax_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmax_change, na.rm=T), max(df$tasmax_change, na.rm=T))
df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=tasmax_change)) + facet_wrap(.~mon) + 
  scale_fill_gradientn(name="tasmax", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")
# Plot seasonal change between 1991-2020 and 2071 - 2100
df <- tasmaxAdjust_30yr %>% ungroup() %>% mutate(mon=ifelse(mon==12,1,mon)) %>% # This make months unmeaningful
  mutate(season=cut(mon, breaks=c(1,3,5,8,12), right=F)) %>%
  mutate(season = factor(season, labels=c("DJF", "MAM", "JJA", "SSO"))) %>%
  group_by(x, y, yr, season) %>% summarise(mn=mean(mn)) %>%
  tidyr::spread(yr, mn)
df$tasmax_change <- (df$`2071-2100`-df$`1991-2020`)#/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$tasmax_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmax_change, na.rm=T), max(df$tasmax_change, na.rm=T))
df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=tasmax_change)) + facet_wrap(.~season) + 
  scale_fill_gradientn(name="tasmax", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")

Fig. 35. Seasonal change in 30-yr average maximum temperature (2071-2100 - 1991-2020).

# Plot map of tasmax against GCM
df <- tasmaxAdjust_30yr %>% 
  group_by(x, y, yr, gcm, rcm, ensemble) %>% summarise(mn=mean(mn, na.rm=T)) %>%
  tidyr::spread(yr, mn)
df$tasmax_change <- (df$`2041-2070`-df$`1991-2020`)#/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$tasmax_change, probs=seq(0,1,0.12)))
lim <- c(min(df$tasmax_change, na.rm=T), max(df$tasmax_change, na.rm=T))
df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=tasmax_change)) + facet_wrap(gcm + rcm + ensemble  ~ ., ncol=5) + 
  scale_fill_gradientn(name="tasmax", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")

Fig. 36. Map of change in 30-yr average maximum temperature (2071-2100 - 1991-2020) separately for GCM, RCM and Ensemble combination.

Precipitation

2021 - 2050

# Plot change between 1991-2020 and 2021 - 2050
df <- prAdjust_30yr %>% group_by(x, y, yr, rcp) %>% summarise(mn=mean(mn)) %>%
  tidyr::spread(yr, mn)
df$pr_change <- (df$`2041-2070`-df$`1991-2020`)
df$pr_rel_change <- (df$`2041-2070`-df$`1991-2020`)/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$pr_change, probs=seq(0,1,0.12)))
lim <- c(min(df$pr_change, na.rm=T), max(df$pr_change, na.rm=T))
p1 <- df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=pr_change)) + facet_wrap(.~rcp, nrow=1) + 
  scale_fill_gradientn(name="change", colours=whiteblue, limits=lim, values=col_val) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + labs(x="", y="")

col_val <- scales::rescale(quantile(df$pr_rel_change, probs=seq(0,1,0.12)))
lim <- c(min(df$pr_rel_change, na.rm=T), max(df$pr_rel_change, na.rm=T))
p2 <- df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=pr_rel_change)) + facet_wrap(.~rcp, nrow=1) + 
  scale_fill_gradientn(name="% change", colours=whiteblue, limits=lim, values=col_val) + geom_sf(data=bavaria, fill="NA") + 
  coord_sf() + theme_few() + labs(x="", y="")
p1 + p2 + plot_layout(ncol=1)

Fig. 37. Map of change and relative change (%) in 30-yr average precipitation (2041-2070 - 1991-2020) and the three rcps (RCP2.6, RCP4.5, RCP8.5).

# Plot monthly change between 1991-2020 and 2021 - 2050
df <- prAdjust_30yr %>% group_by(x, y, mon, yr) %>% summarise(mn=mean(mn)) %>%
  tidyr::spread(yr, mn)
df$pr_change <- (df$`2041-2070`-df$`1991-2020`)#/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$pr_change, probs=seq(0,1,0.12)))
lim <- c(min(df$pr_change, na.rm=T), max(df$pr_change, na.rm=T))
df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=pr_change)) + facet_wrap(.~mon) + 
  scale_fill_gradientn(name="pr", colours=whiteblue, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")
# Plot seasonal change between 1991-2020 and 2021 - 2050
df <- prAdjust_30yr %>% ungroup() %>% mutate(mon=ifelse(mon==12,1,mon)) %>% # This make months unmeaningful
  mutate(season=cut(mon, breaks=c(1,3,5,8,12), right=F)) %>%
  mutate(season = factor(season, labels=c("DJF", "MAM", "JJA", "SSO"))) %>%
  group_by(x, y, yr,season) %>% summarise(tot=sum(mn)) %>%
  tidyr::spread(yr, tot)
df$pr_change <- (df$`2041-2070`-df$`1991-2020`)#/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$pr_change, probs=seq(0,1,0.12)))
lim <- c(min(df$pr_change, na.rm=T), max(df$pr_change, na.rm=T))
df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=pr_change)) + facet_wrap(.~season) + 
  scale_fill_gradientn(name="pr", colours=whiteblue, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")

Fig. 38. Seasonal change in 30-yr average precipitation (2041-2070 - 1991-2020).

# Plot map of precipitation against GCM
df <- prAdjust_30yr %>% 
  group_by(x, y, yr, gcm, rcm, ensemble) %>% summarise(mn=mean(mn, na.rm=T)) %>%
  tidyr::spread(yr, mn)
df$pr_change <- (df$`2041-2070`-df$`1991-2020`)#/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$pr_change, probs=seq(0,1,0.12)))
lim <- c(min(df$pr_change, na.rm=T), max(df$pr_change, na.rm=T))
df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=pr_change)) + facet_wrap(gcm + rcm + ensemble  ~ ., ncol=5) + 
  scale_fill_gradientn(name="pr", colours=whiteblue, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")

Fig. 39. Map of change in 30-yr average precipitation (2041-2070 - 1991-2020) separately for RCP, GCM, RCM and Ensemble combination.

2071 - 2100

# Plot monthly change between 1991-2020 and 2071 - 2100
df <- prAdjust_30yr %>% group_by(x, y, yr, rcp) %>% summarise(mn=mean(mn)) %>%
  tidyr::spread(yr, mn)
df$pr_change <- (df$`2071-2100`-df$`1991-2020`)
df$pr_rel_change <- (df$`2071-2100`-df$`1991-2020`)/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$pr_change, probs=seq(0,1,0.12)))
lim <- c(min(df$pr_change, na.rm=T), max(df$pr_change, na.rm=T))
p1 <- df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=pr_change)) + facet_wrap(.~rcp, nrow=1) + 
  scale_fill_gradientn(name="change", colours=whiteblue, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")

col_val <- scales::rescale(quantile(df$pr_rel_change, probs=seq(0,1,0.12)))
lim <- c(min(df$pr_rel_change, na.rm=T), max(df$pr_rel_change, na.rm=T))
p2 <- df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=pr_rel_change)) + facet_wrap(.~rcp, nrow=1) +
  scale_fill_gradientn(name="% change", colours=whiteblue, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")
p1 + p2 + plot_layout(ncol=1)

Fig. 40. Map of change and relative change (%) in 30-yr average precipitation (2071-2100 - 1991-2020) and the three rcps (RCP2.6, RCP4.5, RCP8.5).

# Plot seasonal change between 1991-2020 and 2071 - 2100
df <- prAdjust_30yr %>% ungroup() %>% mutate(mon=ifelse(mon==12,1,mon)) %>% # This make months unmeaningful
  mutate(season=cut(mon, breaks=c(1,3,5,8,12), right=F)) %>%
  mutate(season = factor(season, labels=c("DJF", "MAM", "JJA", "SSO"))) %>%
  group_by(x, y, yr, season) %>% summarise(mn=mean(mn)) %>%
  tidyr::spread(yr, mn)
df$pr_change <-(df$`2071-2100`-df$`1991-2020`)/df$`1991-2020`*100

col_val <- scales::rescale(quantile(df$pr_change, probs=seq(0,1,0.12)))
lim <- c(min(df$pr_change, na.rm=T), max(df$pr_change, na.rm=T))
df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=pr_change)) + facet_wrap(.~season) + 
  scale_fill_gradientn(name="pr", colours=whiteblue, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")

Fig. 41. Seasonal change in 30-yr average precipitation (2071-2100 - 1991-2020).

# Plot map of precipitation against GCM
df <- prAdjust_30yr %>% 
  group_by(x, y, yr, gcm, rcm, ensemble) %>% summarise(mn=mean(mn, na.rm=T)) %>%
  tidyr::spread(yr, mn)
df$pr_change <- (df$`2071-2100`-df$`1991-2020`)

col_val <- scales::rescale(quantile(df$pr_change, probs=seq(0,1,0.12)))
lim <- c(min(df$pr_change, na.rm=T), max(df$pr_change, na.rm=T))
df %>% ggplot() + geom_tile(aes(x=x, y=y, fill=pr_change)) + facet_wrap(gcm + rcm + ensemble  ~ ., ncol=5) + 
  scale_fill_gradientn(name="pr", colours=whiteblue, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + labs(x="", y="")

Fig. 42. Map of change in 30-yr average precipitation (2071-2100 - 1991-2020) separately for GCM, RCM and Ensemble combination.

Maps of Slope and R2 of modelled (linear) change

Minimum temperature

#' For every grid cell calculate monthly mean per year using as.yearmon() from the zoo package.
#' Make a linear model using do() and extract Intercept, Slope and R2 values per grid cell.
load(system.file("extdata", "cordex_tasminAdjust_bav.rda", package = "bdc"))
tasminAdjust_lm <- cordex_tasminAdjust_bav %>% mutate(yrmon = zoo::as.yearmon(time)) %>%
  mutate(x = round(x, digits=5), y = round(y, digits=5)) %>% 
  group_by(x, y, rcp) %>% do(mod = lm(value ~ yrmon, data = .)) %>%
  mutate(Intercept = summary(mod)$coeff[1],
         Slope = summary(mod)$coeff[2],
         R2 = summary(mod)$r.squared) %>%
  dplyr::select(-mod); rm(cordex_tasminAdjust_bav); invisible(gc())

col_val <- scales::rescale(quantile(tasminAdjust_lm$Slope, probs=seq(0,1,0.12)))
lim <- c(min(tasminAdjust_lm$Slope, na.rm=T), max(tasminAdjust_lm$Slope, na.rm=T))
p1 <- tasminAdjust_lm %>% ggplot() + geom_tile(aes(x=x, y=y, fill=Slope)) + 
  scale_fill_gradientn(name="Slope", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + facet_wrap(.~rcp, nrow=1) + coord_sf() + theme_few() + labs(x="", y="")

col_val <- scales::rescale(quantile(tasminAdjust_lm$R2, probs=seq(0,1,0.12)))
lim <- c(min(tasminAdjust_lm$R2, na.rm=T), max(tasminAdjust_lm$R2, na.rm=T))
p2 <- tasminAdjust_lm %>% ggplot() + geom_tile(aes(x=x, y=y, fill=R2)) + 
  scale_fill_gradientn(name="R2", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + facet_wrap(.~rcp, nrow=1) + coord_sf() + theme_few() + labs(x="", y="")
p1 + p2 + plot_layout(ncol=1)

Fig. 43. Map of Slope (top) and R^2^ (bottom) of linear model of minimum temperature for each of the three rcps. One linear model was run for each grid cell.

Maximum temperature

#' For every grid cell calculate monthly mean per year using as.yearmon() from the zoo package.
#' Make a linear model using do() and extract Intercept, Slope and R2 values per grid cell.
load(system.file("extdata", "cordex_tasmaxAdjust_bav.rda", package = "bdc"))
tasmaxAdjust_lm <- cordex_tasmaxAdjust_bav %>% mutate(yrmon = zoo::as.yearmon(time)) %>%
  mutate(x = round(x, digits=5), y = round(y, digits=5)) %>% 
  group_by(x, y, rcp) %>% do(mod = lm(value ~ yrmon, data = .)) %>%
  mutate(Intercept = summary(mod)$coeff[1],
         Slope = summary(mod)$coeff[2],
         R2 = summary(mod)$r.squared) %>%
  dplyr::select(-mod); rm(cordex_tasmaxAdjust_bav); invisible(gc())

col_val <- scales::rescale(quantile(tasmaxAdjust_lm$Slope, probs=seq(0,1,0.12)))
lim <- c(min(tasmaxAdjust_lm$Slope, na.rm=T), max(tasmaxAdjust_lm$Slope, na.rm=T))
p1 <- tasmaxAdjust_lm %>% ggplot() + geom_tile(aes(x=x, y=y, fill=Slope)) + 
  scale_fill_gradientn(name="Slope", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + facet_wrap(.~rcp, nrow=1) + coord_sf() + theme_few() + labs(x="", y="")

col_val <- scales::rescale(quantile(tasmaxAdjust_lm$R2, probs=seq(0,1,0.12)))
lim <- c(min(tasmaxAdjust_lm$R2, na.rm=T), max(tasmaxAdjust_lm$R2, na.rm=T))
p2 <- tasmaxAdjust_lm %>% ggplot() + geom_tile(aes(x=x, y=y, fill=R2)) + 
  scale_fill_gradientn(name="R2", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + facet_wrap(.~rcp, nrow=1) + coord_sf() + theme_few() + labs(x="", y="")
p1 + p2 + plot_layout(ncol=1)

Fig. 44. Map of Slope (top) and R^2^ (bottom) of linear model of maximum temperature for each of the three rcps. One linear model was run for each grid cell.

Precipitation

#' For every grid cell calculate monthly mean per year using as.yearmon() from the zoo package.
#' Make a linear model using do() and extract Intercept, Slope and R2 values per grid cell.
load(system.file("extdata", "cordex_prAdjust_bav.rda", package = "bdc"))
prAdjust_lm <- cordex_prAdjust_bav %>% mutate(yrmon = zoo::as.yearmon(time)) %>%
  mutate(x = round(x, digits=5), y = round(y, digits=5)) %>% 
  group_by(x, y, rcp) %>% do(mod = lm(value ~ yrmon, data = .)) %>% 
  mutate(Intercept = summary(mod)$coeff[1],
         Slope = summary(mod)$coeff[2],
         R2 = summary(mod)$r.squared) %>%
  dplyr::select(-mod); rm(cordex_prAdjust_bav); invisible(gc())

col_val <- scales::rescale(quantile(prAdjust_lm$Slope, probs=seq(0,1,0.12)))
lim <- c(min(prAdjust_lm$Slope, na.rm=T), max(prAdjust_lm$Slope, na.rm=T))
p1 <- prAdjust_lm %>% ungroup() %>% ggplot() + geom_tile(aes(x=x, y=y, fill=Slope)) + 
  scale_fill_gradientn(name="Slope", colours=whiteblue, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + facet_wrap(.~rcp, nrow=1) + 
  coord_sf() + theme_few() + labs(x="", y="")

col_val <- scales::rescale(quantile(prAdjust_lm$R2, probs=seq(0,1,0.12)))
lim <- c(min(prAdjust_lm$R2, na.rm=T), max(prAdjust_lm$R2, na.rm=T))
p2 <- prAdjust_lm %>% ggplot() + geom_tile(aes(x=x, y=y, fill=R2)) + 
  scale_fill_gradientn(name="R2", colours=whiteblue, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + facet_wrap(.~rcp, nrow=1) + 
  coord_sf() + theme_few() + labs(x="", y="")
p1 + p2 + plot_layout(ncol=1)

Fig. 45. Map of Slope (top) and R^2^ (bottom) of linear model of precipitation for each of the three rcps. One linear model was run for each grid cell.

Bioclimatic variables

data("cordex_bioclim_bav", package="bdc") # 66123

Temporal patterns

tidyr::gather(cordex_bioclim_bav, var, value, -c(x,y,yr,gcm,rcp,rcm,ensemble,rs)) %>%
  mutate(var = factor(var, levels=paste0("bio", 1:19))) %>% ggplot() + geom_violin(aes(x=yr, y=value, fill=rcp)) + 
  facet_wrap(.~var, scales="free_y", strip.position = "left", ncol=4) + 
  theme_few() + theme(strip.background = element_blank(),
                       legend.position=c(0.9,0.05), strip.placement = "outside",
                       axis.text.x = element_text(angle=45, vjust=0.5)) + 
  scale_fill_manual(name="", values=c("#0099B4FF", "#ADB6B6FF", "#AD002AFF")) + labs(x="", y="")

Fig. 46. Temporal changes in bioclimatic conditions for the different rcps. The individual violins show the variation among x, y, gcms, rcms and ensemble.

tidyr::gather(cordex_bioclim_bav, var, value, -c(x,y,yr,gcm,rcp,rcm,ensemble,rs)) %>%
  filter(var == "bio1") %>% ggplot() + geom_violin(aes(x=yr, y=value, fill=rcp)) + 
  facet_wrap(.~gcm+rcm+ensemble, ncol=5) + 
  theme_few() + theme(axis.text.x = element_text(angle=45, vjust=0.5)) + 
  scale_fill_manual(name="", values=c("#0099B4FF", "#ADB6B6FF", "#AD002AFF")) + labs(x="", y="")

Fig. 47. Temporal changes in bio1 for the different rcps and gcm, rcm and ensemble combinations. The individual violins show the variation in x and y.

tidyr::gather(cordex_bioclim_bav, var, value, -c(x,y,yr,gcm,rcp,rcm,ensemble,rs)) %>%
  filter(var == "bio12") %>% ggplot() + geom_violin(aes(x=yr, y=value, fill=rcp)) + 
  facet_wrap(.~gcm+rcm+ensemble, ncol=5) + 
  theme_few() + theme(axis.text.x = element_text(angle=45, vjust=0.5)) + 
  scale_fill_manual(name="", values=c("#0099B4FF", "#ADB6B6FF", "#AD002AFF")) + labs(x="", y="")

Fig. 48. Temporal changes in bio12 for the different rcps and gcm, rcm and ensemble combinations. The individual violins show the variation in x and y.

Spatial patterns

dat <- tidyr::gather(cordex_bioclim_bav, var, value, -c(x,y,yr,gcm,rcp,rcm,ensemble,rs)) %>%
  mutate(var = factor(var, levels=paste0("bio", 1:19))) %>% 
  filter(var == "bio1") %>%
  group_by(x, y, yr, rcp, var) %>% summarise(value=mean(value))
col_val <- scales::rescale(quantile(dat$value, probs=seq(0,1,0.12)))
lim <- c(min(dat$value, na.rm=T), max(dat$value, na.rm=T))
dat %>% ggplot() + geom_tile(aes(x=x, y=y, fill=value)) + 
  facet_grid(rcp~yr, switch = "y") + geom_sf(data=bavaria, fill="NA") + 
  scale_fill_gradientn(name="bio1", colours=whitered, limits=lim, values=col_val) + 
  coord_sf() + theme_few() + theme(strip.placement = "outside", axis.text.x = element_text(angle=45, vjust=0.5)) + 
  labs(x="", y="")

Fig. 49. Map of bio1 for the three selected time periods (1991-2020, 2041-2070, 2071-2100) and the three rcps (RCP2.6, RCP4.5, RCP8.5).

dat <- tidyr::gather(cordex_bioclim_bav, var, value, -c(x,y,yr,gcm,rcp,rcm,ensemble,rs)) %>%
  mutate(var = factor(var, levels=paste0("bio", 1:19))) %>% 
  filter(var == "bio4") %>%
  group_by(x, y, yr, rcp, var) %>% summarise(value=mean(value))
col_val <- scales::rescale(quantile(dat$value, probs=seq(0,1,0.12)))
lim <- c(min(dat$value, na.rm=T), max(dat$value, na.rm=T))
dat %>% ggplot() + geom_tile(aes(x=x, y=y, fill=value)) + 
  facet_grid(rcp~yr, switch = "y") + geom_sf(data=bavaria, fill="NA") + 
  scale_fill_gradientn(name="bio4", colours=whitered, limits=lim, values=col_val) + 
  coord_sf() + theme_few() + theme(strip.placement = "outside", axis.text.x = element_text(angle=45, vjust=0.5)) + 
  labs(x="", y="")

Fig. 50. Map of bio4 for the three selected time periods (1991-2020, 2041-2070, 2071-2100) and the three rcps (RCP2.6, RCP4.5, RCP8.5).

dat <- tidyr::gather(cordex_bioclim_bav, var, value, -c(x,y,yr,gcm,rcp,rcm,ensemble,rs)) %>%
  mutate(var = factor(var, levels=paste0("bio", 1:19))) %>% 
  filter(var == "bio5") %>%
  group_by(x, y, yr, rcp, var) %>% summarise(value=mean(value))
col_val <- scales::rescale(quantile(dat$value, probs=seq(0,1,0.12)))
lim <- c(min(dat$value, na.rm=T), max(dat$value, na.rm=T))

dat %>% ggplot() + geom_tile(aes(x=x, y=y, fill=value)) + geom_sf(data=bavaria, fill="NA") + 
  facet_grid(rcp~yr, switch = "y") + scale_fill_gradientn(name="bio5", colours=whitered, limits=lim, values=col_val) + 
  coord_sf() + theme_few() + theme(strip.placement = "outside", axis.text.x = element_text(angle=45, vjust=0.5)) + 
  labs(x="", y="")

Fig. 51. Map of bio5 for the three selected time periods (1991-2020, 2041-2070, 2071-2100) and the three rcps (RCP2.6, RCP4.5, RCP8.5).

dat <- tidyr::gather(cordex_bioclim_bav, var, value, -c(x,y,yr,gcm,rcp,rcm,ensemble,rs)) %>%
  mutate(var = factor(var, levels=paste0("bio", 1:19))) %>% 
  filter(var == "bio12") %>%
  group_by(x, y, yr, rcp, var) %>% summarise(value=mean(value))
col_val <- scales::rescale(quantile(dat$value, probs=seq(0,1,0.12)))
lim <- c(min(dat$value, na.rm=T), max(dat$value, na.rm=T))
dat %>% ggplot() + geom_tile(aes(x=x, y=y, fill=value)) + geom_sf(data=bavaria, fill="NA") + 
  facet_grid(rcp~yr, switch = "y") + scale_fill_gradientn(name="bio12", colours=whiteblue, limits=lim, values=col_val) + 
  coord_sf() + theme_few() + theme(strip.placement = "outside", axis.text.x = element_text(angle=45, vjust=0.5)) + 
  labs(x="", y="")

Fig. 52. Map of bio12 for the three selected time periods (1991-2020, 2041-2070, 2071-2100) and the three rcps (RCP2.6, RCP4.5, RCP8.5).

dat <- tidyr::gather(cordex_bioclim_bav, var, value, -c(x,y,yr,gcm,rcp,rcm,ensemble,rs)) %>%
  mutate(var = factor(var, levels=paste0("bio", 1:19))) %>% 
  filter(var == "bio15") %>%
  group_by(x, y, yr, rcp, var) %>% summarise(value=mean(value))
col_val <- scales::rescale(quantile(dat$value, probs=seq(0,1,0.12)))
lim <- c(min(dat$value, na.rm=T), max(dat$value, na.rm=T))
dat %>% ggplot() + geom_tile(aes(x=x, y=y, fill=value)) + geom_sf(data=bavaria, fill="NA") + 
  facet_grid(rcp~yr, switch = "y") + scale_fill_gradientn(name="bio15", colours=whiteblue, limits=lim, values=col_val) + 
  coord_sf() + theme_few() + theme(strip.placement = "outside", axis.text.x = element_text(angle=45, vjust=0.5)) + 
  labs(x="", y="")

Fig. 53. Map of bio15 for the three selected time periods (1991-2020, 2041-2070, 2071-2100) and the three rcps (RCP2.6, RCP4.5, RCP8.5).

Spatial change

2021 - 2050

# Plot bioclimatic changes between 1991-2020 and 2021 - 2050
bioclim_30yr <- tidyr::gather(cordex_bioclim_bav, var, value, -c(x,y,yr,gcm,rcp,rcm,ensemble,rs)) %>% 
  group_by(x, y, yr, var, rcp) %>% summarise(value=mean(value)) %>%
  tidyr::spread(yr,value) %>% filter(var == "bio1")
bioclim_30yr$change <- (bioclim_30yr$`2041-2070`-bioclim_30yr$`1991-2020`)
bioclim_30yr$rel_change <- (bioclim_30yr$`2041-2070`-bioclim_30yr$`1991-2020`)/bioclim_30yr$`1991-2020`*100

col_val <- scales::rescale(quantile(bioclim_30yr$change, probs=seq(0,1,0.12)))
lim <- c(min(bioclim_30yr$change, na.rm=T), max(bioclim_30yr$change, na.rm=T))
p1 <- bioclim_30yr %>% ggplot() + geom_tile(aes(x=x, y=y, fill=change)) + facet_grid(var~rcp, switch="y") + 
  scale_fill_gradientn(name="change", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + 
  theme(strip.placement = "outside", axis.text.x = element_text(angle=45, vjust=0.5)) + labs(x="", y="")

col_val <- scales::rescale(quantile(bioclim_30yr$rel_change, probs=seq(0,1,0.12)))
lim <- c(min(bioclim_30yr$rel_change, na.rm=T), max(bioclim_30yr$rel_change, na.rm=T))
p2 <- bioclim_30yr %>% ggplot() + geom_tile(aes(x=x, y=y, fill=rel_change)) + facet_grid(var~rcp, switch="y") + 
  scale_fill_gradientn(name="% change", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + 
  theme(strip.placement = "outside", axis.text.x = element_text(angle=45, vjust=0.5)) + labs(x="", y="")
p1 + p2 + plot_layout(ncol=1)

Fig. 54. Change (top) and relative change (bottom) of bio1 until 2041-2070 for the three rcps (RCP2.6, RCP4.5, RCP8.5).

# Plot bioclimatic changes between 1991-2020 and 2021 - 2050
bioclim_30yr <- tidyr::gather(cordex_bioclim_bav, var, value, -c(x,y,yr,gcm,rcp,rcm,ensemble,rs)) %>% 
  group_by(x, y, yr, var, rcp) %>% summarise(value=mean(value)) %>%
  tidyr::spread(yr,value) %>% filter(var == "bio12")
bioclim_30yr$change <- (bioclim_30yr$`2041-2070`-bioclim_30yr$`1991-2020`)
bioclim_30yr$rel_change <- (bioclim_30yr$`2041-2070`-bioclim_30yr$`1991-2020`)/bioclim_30yr$`1991-2020`*100

col_val <- scales::rescale(quantile(bioclim_30yr$change, probs=seq(0,1,0.12)))
lim <- c(min(bioclim_30yr$change, na.rm=T), max(bioclim_30yr$change, na.rm=T))
p1 <- bioclim_30yr %>% ggplot() + geom_tile(aes(x=x, y=y, fill=change)) + facet_grid(var~rcp, switch="y") + 
  scale_fill_gradientn(name="change", colours=whiteblue, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + 
  theme(strip.placement = "outside", axis.text.x = element_text(angle=45, vjust=0.5)) + labs(x="", y="")

col_val <- scales::rescale(quantile(bioclim_30yr$rel_change, probs=seq(0,1,0.12)))
lim <- c(min(bioclim_30yr$rel_change, na.rm=T), max(bioclim_30yr$rel_change, na.rm=T))
p2 <- bioclim_30yr %>% ggplot() + geom_tile(aes(x=x, y=y, fill=rel_change)) + facet_grid(var~rcp, switch="y") + 
  scale_fill_gradientn(name="% change", colours=whiteblue, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + 
  theme(strip.placement = "outside", axis.text.x = element_text(angle=45, vjust=0.5)) + labs(x="", y="")
p1 + p2 + plot_layout(ncol=1)

Fig. 55. Change (top) and relative change (bottom) of bio12 until 2041-2070 for the three rcps (RCP2.6, RCP4.5, RCP8.5).

2071 - 2100

# Plot bioclimatic changes between 1991-2020 and 2021 - 2050
bioclim_30yr <- tidyr::gather(cordex_bioclim_bav, var, value, -c(x,y,yr,gcm,rcp,rcm,ensemble,rs)) %>% 
  group_by(x, y, yr, var, rcp) %>% summarise(value=mean(value)) %>%
  tidyr::spread(yr,value) %>% filter(var == "bio1")
bioclim_30yr$change <- (bioclim_30yr$`2071-2100`-bioclim_30yr$`1991-2020`)
bioclim_30yr$rel_change <- (bioclim_30yr$`2071-2100`-bioclim_30yr$`1991-2020`)/bioclim_30yr$`1991-2020`*100

col_val <- scales::rescale(quantile(bioclim_30yr$change, probs=seq(0,1,0.12)))
lim <- c(min(bioclim_30yr$change, na.rm=T), max(bioclim_30yr$change, na.rm=T))
p1 <- bioclim_30yr %>% ggplot() + geom_tile(aes(x=x, y=y, fill=change)) + facet_grid(var~rcp, switch="y") + 
  scale_fill_gradientn(name="change", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + 
  theme(strip.placement = "outside", axis.text.x = element_text(angle=45, vjust=0.5)) + labs(x="", y="")

col_val <- scales::rescale(quantile(bioclim_30yr$rel_change, probs=seq(0,1,0.12)))
lim <- c(min(bioclim_30yr$rel_change, na.rm=T), max(bioclim_30yr$rel_change, na.rm=T))
p2 <- bioclim_30yr %>% 
  ggplot() + geom_tile(aes(x=x, y=y, fill=rel_change)) + facet_grid(var~rcp, switch="y") + 
  scale_fill_gradientn(name="% change", colours=whitered, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + 
  theme(strip.placement = "outside", axis.text.x = element_text(angle=45, vjust=0.5)) + labs(x="", y="")
p1 + p2 + plot_layout(ncol=1)

Fig. 56. Change (top) and relative change (bottom) of bio1 until 2071-2100 for the three rcps (RCP2.6, RCP4.5, RCP8.5).

# Plot bioclimatic changes between 1991-2020 and 2021 - 2050
bioclim_30yr <- tidyr::gather(cordex_bioclim_bav, var, value, -c(x,y,yr,gcm,rcp,rcm,ensemble,rs)) %>% 
  group_by(x, y, yr, var, rcp) %>% summarise(value=mean(value)) %>%
  tidyr::spread(yr,value) %>% filter(var == "bio12")
bioclim_30yr$change <- (bioclim_30yr$`2071-2100`-bioclim_30yr$`1991-2020`)
bioclim_30yr$rel_change <- (bioclim_30yr$`2071-2100`-bioclim_30yr$`1991-2020`)/bioclim_30yr$`1991-2020`*100

col_val <- scales::rescale(quantile(bioclim_30yr$change, probs=seq(0,1,0.12)))
lim <- c(min(bioclim_30yr$change, na.rm=T), max(bioclim_30yr$change, na.rm=T))
p1 <- bioclim_30yr %>% ggplot() + geom_tile(aes(x=x, y=y, fill=change)) + facet_grid(var~rcp, switch="y") + 
  scale_fill_gradientn(name="change", colours=whiteblue, limits=lim, values=col_val) +
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + 
  theme(strip.placement = "outside", axis.text.x = element_text(angle=45, vjust=0.5)) + labs(x="", y="")

col_val <- scales::rescale(quantile(bioclim_30yr$rel_change, probs=seq(0,1,0.12)))
lim <- c(min(bioclim_30yr$rel_change, na.rm=T), max(bioclim_30yr$rel_change, na.rm=T))
p2 <- bioclim_30yr %>% ggplot() + geom_tile(aes(x=x, y=y, fill=rel_change)) + facet_grid(var~rcp, switch="y") + 
  scale_fill_gradientn(name="% change", colours=whiteblue, limits=lim, values=col_val) + 
  geom_sf(data=bavaria, fill="NA") + coord_sf() + theme_few() + 
  theme(strip.placement = "outside", axis.text.x = element_text(angle=45, vjust=0.5)) + labs(x="", y="")
p1 + p2 + plot_layout(ncol=1)
rm(list=ls());invisible(gc())

Fig. 57. Change (top) and relative change (bottom) of bio12 until 2071-2100 for the three rcps (RCP2.6, RCP4.5, RCP8.5).



RS-eco/bdc documentation built on Aug. 12, 2022, 11:56 a.m.