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)
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
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 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:
x & y are the coordinates of the grid cells
gcm is the global climate model used for the simulations and can have one of the following three values: ICHEC-EC-EARTH, IPSL-IPSL-CM5A-MR, MPI-M-MPI-ESM-LR
ensemble is the used ensemble: r1i1p1
rcm ist the regional climate model used for the simulation and can be one of three values: KNMI-RACMO22E, MPI-CSC-REMO2009, SMHI-RCA4
rs is the downscaling realisation: v1
rcp is the Representative Concentration Pathway used and can be one of three values: RCP2.6, RCP4.5 and RCP8.5
time_frame ist the 30-year time period. Here I provide data for three different periods: 1991-2020, 2041-2070, 2071-2100.
The variables bio1 - bio19 are the 19 bioclimatic variables (which I explained above or are also described here: http://worldclim.org/bioclim).
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.
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
# 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.
# 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.
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.
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="")
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="")
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="")
# 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.
# 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.
# 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.
# 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.
# 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.
# 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.
#' 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.
#' 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.
#' 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.
data("cordex_bioclim_bav", package="bdc") # 66123
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.
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).
# 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).
# 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).
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.