From aaab5266b3d58a86db7b54fc2ef9bc088d2cfa64 Mon Sep 17 00:00:00 2001
From: ConstantinZohner <68730466+ConstantinZohner@users.noreply.github.com>
Date: Tue, 4 Apr 2023 09:15:03 +0200
Subject: [PATCH] Add files via upload
---
.../Experiment1/Experiment1_chlorophyll.Rmd | 522 +
.../Experiment1_photosynthesis.Rmd | 186 +
R code/Experiment2/Experiment2_budset.Rmd | 550 +
R code/FluxNet_analysis/FluxNet_analysis.Rmd | 737 +
R code/Harvard_analysis/Harvard_models.Rmd | 511 +
...n_Code_GLDAS_Data_Extraction_AP_tier2.html | 14594 ++++++++++++++++
.../1.2.2_order_GLDAS_tables_AP_tier2.R | 64 +
.../1.3_Extract_Photoperiod.R | 73 +
.../1_Data_extraction/1.4_Extract_CO2.R | 96 +
.../1.5_Extract_soil_texture.R | 112 +
.../1.6_Extract_SPEI_AP_tier2.R | 100 +
.../1_PEPdownload_AP_tier2.Rmd | 236 +
.../2.1_Add_Drivers_mcLapply_AP_tier2_v4.1.R | 1256 ++
.../3.1_Sample_sizes/3.1_Sample_sizes.Rmd | 106 +
.../3_Analysis/3.2_Add_preseasons_PEP.R | 367 +
.../3.3_Modeling/3.3.1_Mixed_models.R | 833 +
.../3.3.2_Model_comparison_CV_PEP725.R | 157 +
.../3.3.2_Model_comparison_PEP725.R | 210 +
.../3.3_Modeling/3.3.3_Moving_windows.R | 703 +
...4.1_Moving_windows_preseason_sensitivity.R | 286 +
...3.4.2_Moving_windows_pre_solstice_effect.R | 289 +
.../3.3.4.3_Moving_windows_solstice_effect.R | 268 +
.../3.4_Figures/3.4.1_Main_figures.Rmd | 1209 ++
.../3.4.2_Mixed_model_plots_temporal.Rmd | 326 +
...3_Moving_windows_preseason_sensitivity.Rmd | 587 +
.../1.1_Extract_Photoperiod.R | 74 +
.../1.1_Extract_Photoperiod_VNP.R | 73 +
...AP_tier2_remote_sensing_EOS10_v1.3.start.R | 1375 ++
...2_remote_sensing_EOS50_v1.3.midGreendown.R | 1375 ++
...mote_sensing_EOS85_v1.3.dormancy_reduced.R | 874 +
...P_tier2_remote_sensing_EOSstart_v1.3.VNP.R | 807 +
.../3.1_Sample_sizes_RS.Rmd | 136 +
.../3.2_Add_preseasons_RS_EOS10.R | 410 +
.../3.3_Modeling/3.3.1_Spatial_models_RS.R | 600 +
.../3.3.1_Spatial_models_RS_no_scaling.R | 474 +
.../3.3_Modeling/3.3.2_Model_comparison.R | 212 +
.../3.3_Modeling/3.3.2_Model_comparison_CV.R | 214 +
.../3.4_Figures/3.4.1_Mapping_EOS10.Rmd | 980 ++
.../3.4_Figures/3.4.2_Model_comparison.Rmd | 388 +
.../3.4_Figures/3.4.3.1_Driver_comparison.Rmd | 419 +
...3.4.3.2_Driver_comparison_soilMoisture.Rmd | 412 +
.../3.4.4_Preseason_sensitivity.Rmd | 511 +
.../3.4_Figures/3.4.5_TemporalTrendsMaps.Rmd | 571 +
.../3.4.6_LatitudePlot_pre_solstice.Rmd | 294 +
.../3.4.7_Monthly_water_availability.Rmd | 275 +
.../3.4_Figures/3.4.8_Full_model_noCO2.R | 269 +
.../3.1_Sample_sizes_RS.Rmd | 126 +
.../3.2_Add_preseasons_RS_MidGreendown.R | 397 +
.../3.3_Modeling/3.3.1_Spatial_models_EOS50.R | 599 +
.../3.3.1_Spatial_models_EOS50_no_scaling.R | 465 +
.../3.3.2_Model_comparison_CV_EOS50.R | 214 +
.../3.3.2_Model_comparison_EOS50.R | 212 +
.../3.4_Figures/3.4.1_Mapping_EOS50.Rmd | 968 +
.../3.1_Sample_sizes_RS_EOS85.Rmd | 126 +
.../3.2_Add_preseasons_RS_dormancy.R | 403 +
.../EOS85_Dormancy/3.3_Spatial_models_RS.R | 643 +
.../EOS85_Dormancy/3.4_Mapping_EOS85.Rmd | 1182 ++
.../EOSstart_VNP/3.1_Sample_sizes_VNP.Rmd | 131 +
.../3.2_Add_preseasons_onset_VNP.R | 417 +
.../3.3_Spatial_models_onset_VNP.R | 593 +
.../3.3_Spatial_models_onset_VNP_no_scaling.R | 476 +
.../EOSstart_VNP/3.4_Mapping_onset_VNP.Rmd | 965 +
62 files changed, 43038 insertions(+)
create mode 100644 R code/Experiment1/Experiment1_chlorophyll.Rmd
create mode 100644 R code/Experiment1/Experiment1_photosynthesis.Rmd
create mode 100644 R code/Experiment2/Experiment2_budset.Rmd
create mode 100644 R code/FluxNet_analysis/FluxNet_analysis.Rmd
create mode 100644 R code/Harvard_analysis/Harvard_models.Rmd
create mode 100644 R code/PEP_analysis/1_Data_extraction/1.2.1_Python_Code_GLDAS_Data_Extraction_AP_tier2.html
create mode 100644 R code/PEP_analysis/1_Data_extraction/1.2.2_order_GLDAS_tables_AP_tier2.R
create mode 100644 R code/PEP_analysis/1_Data_extraction/1.3_Extract_Photoperiod.R
create mode 100644 R code/PEP_analysis/1_Data_extraction/1.4_Extract_CO2.R
create mode 100644 R code/PEP_analysis/1_Data_extraction/1.5_Extract_soil_texture.R
create mode 100644 R code/PEP_analysis/1_Data_extraction/1.6_Extract_SPEI_AP_tier2.R
create mode 100644 R code/PEP_analysis/1_Data_extraction/1_PEPdownload_AP_tier2.Rmd
create mode 100644 R code/PEP_analysis/2_Add_drivers/2.1_Add_Drivers_mcLapply_AP_tier2_v4.1.R
create mode 100644 R code/PEP_analysis/3_Analysis/3.1_Sample_sizes/3.1_Sample_sizes.Rmd
create mode 100644 R code/PEP_analysis/3_Analysis/3.2_Add_preseasons_PEP.R
create mode 100644 R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.1_Mixed_models.R
create mode 100644 R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.2_Model_comparison_CV_PEP725.R
create mode 100644 R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.2_Model_comparison_PEP725.R
create mode 100644 R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.3_Moving_windows.R
create mode 100644 R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.4.1_Moving_windows_preseason_sensitivity.R
create mode 100644 R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.4.2_Moving_windows_pre_solstice_effect.R
create mode 100644 R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.4.3_Moving_windows_solstice_effect.R
create mode 100644 R code/PEP_analysis/3_Analysis/3.4_Figures/3.4.1_Main_figures.Rmd
create mode 100644 R code/PEP_analysis/3_Analysis/3.4_Figures/3.4.2_Mixed_model_plots_temporal.Rmd
create mode 100644 R code/PEP_analysis/3_Analysis/3.4_Figures/3.4.3_Moving_windows_preseason_sensitivity.Rmd
create mode 100644 R code/Remote_sensing/1_Data_extraction/1.1_Extract_Photoperiod.R
create mode 100644 R code/Remote_sensing/1_Data_extraction/1.1_Extract_Photoperiod_VNP.R
create mode 100644 R code/Remote_sensing/2_Add_drivers/2.1_Add_Drivers_AP_tier2_remote_sensing_EOS10_v1.3.start.R
create mode 100644 R code/Remote_sensing/2_Add_drivers/2.1_Add_Drivers_AP_tier2_remote_sensing_EOS50_v1.3.midGreendown.R
create mode 100644 R code/Remote_sensing/2_Add_drivers/2.1_Add_Drivers_AP_tier2_remote_sensing_EOS85_v1.3.dormancy_reduced.R
create mode 100644 R code/Remote_sensing/2_Add_drivers/2.1_Add_Drivers_AP_tier2_remote_sensing_EOSstart_v1.3.VNP.R
create mode 100644 R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.1_Sample_sizes_RS.Rmd
create mode 100644 R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.2_Add_preseasons_RS_EOS10.R
create mode 100644 R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.3_Modeling/3.3.1_Spatial_models_RS.R
create mode 100644 R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.3_Modeling/3.3.1_Spatial_models_RS_no_scaling.R
create mode 100644 R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.3_Modeling/3.3.2_Model_comparison.R
create mode 100644 R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.3_Modeling/3.3.2_Model_comparison_CV.R
create mode 100644 R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.1_Mapping_EOS10.Rmd
create mode 100644 R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.2_Model_comparison.Rmd
create mode 100644 R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.3.1_Driver_comparison.Rmd
create mode 100644 R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.3.2_Driver_comparison_soilMoisture.Rmd
create mode 100644 R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.4_Preseason_sensitivity.Rmd
create mode 100644 R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.5_TemporalTrendsMaps.Rmd
create mode 100644 R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.6_LatitudePlot_pre_solstice.Rmd
create mode 100644 R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.7_Monthly_water_availability.Rmd
create mode 100644 R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.8_Full_model_noCO2.R
create mode 100644 R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.1_Sample_sizes_RS.Rmd
create mode 100644 R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.2_Add_preseasons_RS_MidGreendown.R
create mode 100644 R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.3_Modeling/3.3.1_Spatial_models_EOS50.R
create mode 100644 R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.3_Modeling/3.3.1_Spatial_models_EOS50_no_scaling.R
create mode 100644 R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.3_Modeling/3.3.2_Model_comparison_CV_EOS50.R
create mode 100644 R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.3_Modeling/3.3.2_Model_comparison_EOS50.R
create mode 100644 R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.4_Figures/3.4.1_Mapping_EOS50.Rmd
create mode 100644 R code/Remote_sensing/3_Analysis/EOS85_Dormancy/3.1_Sample_sizes_RS_EOS85.Rmd
create mode 100644 R code/Remote_sensing/3_Analysis/EOS85_Dormancy/3.2_Add_preseasons_RS_dormancy.R
create mode 100644 R code/Remote_sensing/3_Analysis/EOS85_Dormancy/3.3_Spatial_models_RS.R
create mode 100644 R code/Remote_sensing/3_Analysis/EOS85_Dormancy/3.4_Mapping_EOS85.Rmd
create mode 100644 R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.1_Sample_sizes_VNP.Rmd
create mode 100644 R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.2_Add_preseasons_onset_VNP.R
create mode 100644 R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.3_Spatial_models_onset_VNP.R
create mode 100644 R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.3_Spatial_models_onset_VNP_no_scaling.R
create mode 100644 R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.4_Mapping_onset_VNP.Rmd
diff --git a/R code/Experiment1/Experiment1_chlorophyll.Rmd b/R code/Experiment1/Experiment1_chlorophyll.Rmd
new file mode 100644
index 0000000..1ac958e
--- /dev/null
+++ b/R code/Experiment1/Experiment1_chlorophyll.Rmd
@@ -0,0 +1,522 @@
+---
+title: "Effect of climate warming on the timing of autumn leaf senescence reverses at the summer solstice"
+subtitle: "Experiment 1: The seasonal effects of temperature and shade on autumn phenology"
+---
+
+
+
+## 1. Load packages and functions
+
+load packages
+
+```{r, message=FALSE, warning=FALSE}
+require(ggplot2)
+require(tidyverse)
+require(broom)
+require(patchwork)
+require(lubridate)
+require(data.table)
+require(gmodels)
+require(wesanderson)
+require(mgcv)
+```
+
+
+
+load functions
+
+```{r, message=FALSE, warning=FALSE}
+##########################################
+# SPAD reading to chlorophyll conversion #
+##########################################
+
+
+SPADtoChl = function(SPAD){
+ Chl = ifelse(SPAD==0, 0, -0.0029*(SPAD^2) + 1.175*SPAD + 3.8506)
+ return(Chl)
+}
+#SPAD: unitless
+#Chl: leaf chlorophyll in microgram / gram fresh weight
+#Intercept forced to zero
+
+#From Percival et al. 2008: The Potential of a Chlorophyll Content SPAD Meter to Quantify Nutrient Stress in Foliar Tissue of Sycamore (Acer pseudoplatanus), English Oak (Quercus robur), and European Beech (Fagus sylvatica)
+
+
+
+############################
+# Keep only number in string
+############################
+
+
+keep.number = function(x){
+ as.numeric(gsub("[^\\d]+", "", x, perl=TRUE))}
+```
+
+
+
+
+
+## 2. Load data
+
+
+
+data tables
+
+```{r}
+################
+# define paths #
+################
+
+
+data.dir = "/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Experiment1/Data/Chlorophyll"
+output.dir = "/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Experiment1/R_output/Chlorophyll"
+
+
+
+#########################
+# Load chlorophyll data #
+#########################
+
+
+chlorophyll.data = read.table(paste(data.dir,"Chlorophyll_2021_master.csv",sep="/"), header=T, sep=",") %>%
+
+ #delete dead individuals
+ group_by(ID) %>%
+ mutate(dead.proportion = mean(as.numeric(Dead)))%>%
+ ungroup() %>%
+ filter(dead.proportion <0.5) %>%
+
+ #delete NAs and Groups
+ filter(!is.na(SPAD),
+ !(Group %in% c("M","L","N","O","P"))) %>%
+
+ #Convert dates to DOY
+ mutate(
+ #Convert dates to DOY
+ date = dmy(date),
+ #merge controls
+ time.period = ifelse(Group %in% c("C","H"),1,
+ ifelse(Group %in% c("D","I"),2,
+ ifelse(Group %in% c("E","J"),3,
+ ifelse(Group %in% c("F","K"),4,0)))),
+ Treatment = ifelse(Group %in% c("C","D","E","F"),"Shade",
+ ifelse(Group %in% c("H","I","J","K"),"Temperature", "Control"))) %>%
+
+ #delete observations during and after treatment period
+ filter(
+ #Treatment 1
+ !(time.period == 1 & date > as.Date("2021-04-30", format="%Y-%m-%d") &
+ date < as.Date("2021-06-15", format="%Y-%m-%d")),
+ #Treatment 2
+ !(time.period == 2 & date > as.Date("2021-05-26", format="%Y-%m-%d") &
+ date < as.Date("2021-07-15", format="%Y-%m-%d")),
+ #Treatment 3
+ !(time.period == 3 & date > as.Date("2021-06-25", format="%Y-%m-%d") &
+ date < as.Date("2021-08-15", format="%Y-%m-%d")),
+ #Treatment 4
+ !(time.period == 4 & date > as.Date("2021-07-25", format="%Y-%m-%d") &
+ date < as.Date("2021-09-15", format="%Y-%m-%d")) )
+```
+
+ ggplot themes
+
+```{r}
+plotTheme1 = theme(
+ legend.position = "none",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.background = element_blank(),
+ axis.text = element_text(colour = "black"),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold",hjust = 0.5))
+```
+
+
+
+
+
+## 3. Prepare and analyze chlorophyll data
+
+Sample sizes
+
+```{r}
+table(chlorophyll.data$Group, chlorophyll.data$date)
+
+table(chlorophyll.data[chlorophyll.data$date=="2022-01-20",]$Group, chlorophyll.data[chlorophyll.data$date=="2022-01-20",]$date)
+
+sum(table(chlorophyll.data[chlorophyll.data$date=="2022-01-20",]$Group, chlorophyll.data[chlorophyll.data$date=="2022-01-20",]$date))
+```
+
+
+
+Data preparation
+
+```{r, warning=F, message=F}
+#####################################################################
+## Transform SPAD to chlorophyll and get relative chlorophyll content
+#####################################################################
+
+
+chlorophyll.data = chlorophyll.data %>%
+ group_by(ID)%>%
+ mutate(
+ #convert SPAD readings to Chlorophyll content (Percival et al. 2008)
+ chlorophyll = SPADtoChl(SPAD),
+ #get relative chlorophyll content per individual
+ chlorophyll.rel = chlorophyll / max(chlorophyll),
+ #get date of maximum chlorophyll content per individual
+ date.max.chl = date[which.max(chlorophyll)]) %>%
+ ungroup()
+
+
+
+##################################################################################
+## Interpolate 10% and 50% senescence dates from seasonal chlorophyll measurements
+##################################################################################
+
+
+# Interpolate EOS10 (date chlorophyll last dropped below 90%)
+senescence.data.10 = chlorophyll.data %>%
+ group_by(ID, Group, Treatment, time.period) %>%
+ # Find the last row with >90% chlorophyll in each group, keep only this row and next
+ filter(row_number() <= max(which(chlorophyll.rel > 0.9))+1,
+ row_number() >= max(which(chlorophyll.rel > 0.9))) %>%
+ #Linear interpolation
+ summarize(EOS = as.Date(approx(chlorophyll.rel, date, .9, ties=min)$y, origin="1970-01-01")) %>%
+ mutate(EOS.DOY = yday(EOS),
+ phenophase = "EOS10") %>%
+ ungroup()
+
+# Interpolate EOS50 (date chlorophyll last dropped below 50%)
+senescence.data.50 = chlorophyll.data %>%
+ group_by(ID, Group, Treatment, time.period) %>%
+ # Find the last row with >50% chlorophyll in each group, keep only this row and next
+ filter(row_number() <= max(which(chlorophyll.rel > 0.5))+1,
+ row_number() >= max(which(chlorophyll.rel > 0.5))) %>%
+ #Linear interpolation
+ summarize(EOS = as.Date(approx(chlorophyll.rel, date, .5, ties=min)$y, origin="1970-01-01")) %>%
+ mutate(EOS.DOY = yday(EOS),
+ phenophase = "EOS50") %>%
+ ungroup()
+
+# Rbind
+senescence.data = rbind(senescence.data.10,senescence.data.50)
+```
+
+
+
+Senescence date analysis
+
+```{r,warning=F}
+################
+## Linear models
+################
+
+
+#Temperature
+resultsLMtemperature = senescence.data %>%
+ filter(!Treatment == "Shade")%>%
+ group_by(phenophase) %>%
+ do({model = lm(EOS.DOY ~ as.factor(time.period), data=.) # create your model
+ data.frame(tidy(model),
+ lowCI=ci(model)[,2],
+ hiCI=ci(model)[,3])}) %>%
+ filter(!term %in% c("(Intercept)")) %>%
+ mutate(phenophase = factor(phenophase, levels=c("EOS10","EOS50")),
+ model = "temperature")
+
+#Shade
+resultsLMshade = senescence.data %>%
+ filter(!Treatment == "Temperature")%>%
+ group_by(phenophase) %>%
+ do({model = lm(EOS.DOY ~ as.factor(time.period), data=.) # create your model
+ data.frame(tidy(model),
+ lowCI=ci(model)[,2],
+ hiCI=ci(model)[,3])}) %>%
+ filter(!term %in% c("(Intercept)")) %>%
+ mutate(phenophase = factor(phenophase, levels=c("EOS10","EOS50")),
+ model = "shade")
+
+#Rbind
+resultsLM = rbind(resultsLMtemperature, resultsLMshade) %>%
+ mutate(term=keep.number(term),
+ variable.type = paste(model, phenophase, sep="."),
+ model = factor(model, levels = c("temperature","shade"), ordered=T),
+ #Reverse effect sizes
+ estimate = estimate*(-1),
+ lowCI = lowCI*(-1),
+ hiCI = hiCI*(-1))
+
+#Show results
+as.data.frame(resultsLM) %>%
+ dplyr::select(-c(variable.type,statistic))%>%
+ mutate_if(is.numeric, round, digits=3)
+```
+
+
+
+
+
+## 4. Figures
+
+
+
+plot 1: Linear model interpolation
+
+```{r, fig.align = "center"}
+########################################
+## Interpolation of monthly estimates ##
+########################################
+
+
+#Interpolation function
+lin_interp = function(x, y, length.out=100) {
+ approx(x, y, xout=seq(min(x), max(x), length.out=length.out))$y
+}
+
+#create identifier
+variable.type = unique(resultsLM$variable.type)
+
+#create interpolation dataframe
+df.interp = data.frame()
+
+#loop over variable x equation x vegetation type vector
+for (variable.name in variable.type){
+
+ #subset table
+ df.sub = resultsLM %>%
+ filter(variable.type == variable.name)
+
+ # Interpolate data
+ created.interp = lin_interp(df.sub$term, df.sub$term)
+ score.interp = lin_interp(df.sub$term, df.sub$estimate)
+ df.interp.sub = data.frame(created=created.interp, score=score.interp)
+ # Make a grouping variable for each pos/neg segment
+ cat.rle = rle(df.interp.sub$score < 0)
+ df.interp.sub = df.interp.sub %>%
+ mutate(group = rep.int(1:length(cat.rle$lengths), times=cat.rle$lengths),
+ phenophase = unique(df.sub$phenophase),
+ model = unique(df.sub$model),
+ variable.type = variable.name)
+ #rbind sub dataframes
+ df.interp = rbind(df.interp, df.interp.sub)
+}
+
+
+#Plot
+LMplot50 = ggplot() +
+ geom_area(data = df.interp[df.interp$phenophase=="EOS50",], aes(x = created, y = score, fill=score>0, group=group)) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+ geom_point(data=resultsLM[resultsLM$phenophase=="EOS50",], aes(x=term, y=estimate))+
+ geom_errorbar(data=resultsLM[resultsLM$phenophase=="EOS50",],
+ aes(x=term, ymin=lowCI, ymax=hiCI),
+ width=.2, position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ geom_vline(xintercept=2.5, size=2, alpha=0.4)+
+ coord_cartesian(ylim=c(-15,15))+
+ xlab("")+ylab("EOS50 anomaly (days)")+
+ scale_x_continuous(breaks = seq(1,4,by=1),
+ labels = c('May','Jun','Jul','Aug'))+
+ facet_wrap(~model, ncol=1)+
+ plotTheme1
+
+#Save PDF
+pdf(paste(output.dir,"LinearModelPlot.pdf",sep="/"), width=3, height=4, useDingbats=FALSE)
+LMplot50
+dev.off()
+
+LMplot50
+
+LMplot10 = ggplot() +
+ geom_area(data = df.interp[df.interp$phenophase=="EOS10",], aes(x = created, y = score, fill=score>0, group=group)) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+ geom_point(data=resultsLM[resultsLM$phenophase=="EOS10",], aes(x=term, y=estimate))+
+ geom_errorbar(data=resultsLM[resultsLM$phenophase=="EOS10",],
+ aes(x=term, ymin=lowCI, ymax=hiCI),
+ width=.2, position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ geom_vline(xintercept=2.5, size=2, alpha=0.4)+
+ coord_cartesian(ylim=c(-35,35))+
+ xlab("")+ylab("EOS10 anomaly (days)")+
+ scale_x_continuous(breaks = seq(1,4,by=1),
+ labels = c('May','Jun','Jul','Aug'))+
+ facet_wrap(~model, ncol=1)+
+ plotTheme1
+
+#Save PDF
+pdf(paste(output.dir,"LinearModelPlot10.pdf",sep="/"), width=3, height=4, useDingbats=FALSE)
+LMplot10
+dev.off()
+
+LMplot10
+```
+
+
+
+plot 2: Chlorophyll curves
+
+```{r, fig.align = "center"}
+#move points .05 to the left and right
+pd = position_dodge(2)
+
+
+#Temperature treatment
+Temperature_curve = chlorophyll.data %>%
+ filter(!Treatment=="Shade") %>%
+ mutate(time.period=as.factor(time.period),
+ time.period = plyr::revalue(time.period,
+ c("0" = "Control" ,
+ "1" = "May",
+ "2" = "June",
+ "3" = "July",
+ "4" = "August"))) %>%
+ ggplot(aes(x=date, y=chlorophyll.rel*100, colour=time.period, group=time.period)) +
+
+ geom_hline(yintercept = 50, colour="lightgrey")+
+ geom_hline(yintercept = 10, colour="lightgrey")+
+ geom_hline(yintercept = 90, colour="lightgrey")+
+
+ geom_vline(xintercept = as.Date('2021-11-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2021-10-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2021-09-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2021-08-01'), colour="lightgrey")+
+
+ stat_summary(fun.data = "mean_cl_normal", geom="line", size = 1.2, position=pd, alpha=0.7) +
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.8, width=0, position=pd) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = 1.2, position=pd) +
+
+ scale_color_manual(values = c('black','#F21A00','#E1AF00','#78B7C5','#3B9AB2'))+
+
+ coord_cartesian(ylim=c(4,96),xlim=c(as.Date(c('2021-07-25','2021-12-01'))))+
+
+ xlab("") +
+ ylab("Relative leaf chlorophyll content (%)") +
+
+ ggtitle("Temperature treatments")+
+
+ plotTheme1 +
+ theme(legend.position = "right")
+
+
+#Shade treatment
+Shade_curve = chlorophyll.data %>%
+ filter(!Treatment=="Temperature") %>%
+ mutate(time.period=as.factor(time.period)) %>%
+ ggplot(aes(x=date, y=chlorophyll.rel*100, colour=time.period, group=time.period)) +
+
+ geom_hline(yintercept = 50, colour="lightgrey")+
+ geom_hline(yintercept = 10, colour="lightgrey")+
+ geom_hline(yintercept = 90, colour="lightgrey")+
+
+ geom_vline(xintercept = as.Date('2021-11-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2021-10-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2021-09-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2021-08-01'), colour="lightgrey")+
+
+ stat_summary(fun.data = "mean_cl_normal", geom="line", size = 1.2, position=pd, alpha=0.7) +
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.8, width=0, position=pd) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = 1.2, position=pd) +
+
+ scale_color_manual(values = c('black','#F21A00','#E1AF00','#78B7C5','#3B9AB2'))+
+
+ coord_cartesian(ylim=c(4,96),xlim=c(as.Date(c('2021-07-25','2021-12-01'))))+
+
+ xlab("Date") +
+ ylab("Relative leaf chlorophyll content (%)") +
+
+ ggtitle("Shade treatments")+
+
+ plotTheme1 +
+ theme(legend.position = "none")
+
+
+#define plot layout
+layout <- "
+A
+B"
+
+#Merge plots
+CurvePlot = Temperature_curve + Shade_curve + plot_layout(design = layout) + plot_annotation(tag_levels = 'a')&
+ theme(plot.tag = element_text(face = 'bold'))
+
+#Save PDF
+pdf(paste(output.dir,"ChlorophyllCurvePlot.pdf",sep="/"), width=7, height=7, useDingbats=FALSE)
+CurvePlot
+dev.off()
+
+CurvePlot
+```
+
+
+
+plot 3: Chlorophyll curves (Individuals)
+
+```{r, fig.width = 10, fig.asp = 1.62, fig.align = "center"}
+################################
+# Relative chlorophyll content #
+################################
+
+
+Chlorophyll_individuals = chlorophyll.data %>%
+ ggplot(aes(x=date, y=chlorophyll.rel*100,
+ colour=Group, fill=Group)) +
+
+ geom_vline(xintercept = as.Date('2021-11-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2021-10-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2021-09-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2021-08-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2021-07-01'), colour="lightgrey")+
+
+ geom_hline(yintercept = 50, colour="black")+
+ geom_hline(yintercept = 10, colour="lightgrey")+
+ geom_hline(yintercept = 90, colour="lightgrey")+
+
+ geom_line(aes(x=date, y=chlorophyll.rel*100), color="black")+
+ geom_point()+
+ geom_area(aes(x=date, y=chlorophyll.rel*100), alpha=0.5) +
+
+ geom_vline(data=senescence.data[senescence.data$phenophase=="EOS10",],
+ aes(xintercept = EOS), linetype = "dashed")+
+ geom_vline(data=senescence.data[senescence.data$phenophase=="EOS50",],
+ aes(xintercept = EOS), linetype = "dashed", color="blue")+
+
+ coord_cartesian(ylim=c(4,110),xlim=c(as.Date(c('2021-06-20','2021-12-01'))))+
+
+ xlab("Date") +
+ ylab("Relative leaf chlorophyll content (%)") +
+
+ facet_wrap(~ID, dir="v", nrow=15)+
+ plotTheme1
+
+#Save PDF
+pdf(paste(output.dir,"IndividualPlot_ChlRel.pdf",sep="/"), width=25, height=25, useDingbats=FALSE)
+Chlorophyll_individuals
+dev.off()
+
+Chlorophyll_individuals
+```
+
+
+
+
+
+## 5. Reproducibility
+
+
+
+Reproducibility info
+
+```{r}
+## date time
+Sys.time()
+
+## session info
+sessionInfo()
+```
+
+
+
+
diff --git a/R code/Experiment1/Experiment1_photosynthesis.Rmd b/R code/Experiment1/Experiment1_photosynthesis.Rmd
new file mode 100644
index 0000000..363387b
--- /dev/null
+++ b/R code/Experiment1/Experiment1_photosynthesis.Rmd
@@ -0,0 +1,186 @@
+---
+title: "Effect of climate warming on the timing of autumn leaf senescence reverses at the summer solstice"
+subtitle: "Experiment 1: Photosynthesis calculation"
+---
+
+
+
+## 1. Load packages
+
+load packages
+
+```{r, message=FALSE, warning=FALSE}
+require(tidyverse)
+require(data.table)
+require(broom)
+require(gmodels)
+require(patchwork)
+```
+
+
+
+
+
+## 2. Load data
+
+
+
+data tables
+
+```{r}
+################
+# define paths #
+################
+
+
+data.dir = "/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Experiment1/Data/Photosynthesis"
+output.dir = "/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Experiment1/R_output/Photosynthesis"
+
+
+
+############################
+# Load photosynthesis data #
+############################
+
+
+Photo.df = read.table(paste(data.dir, "Photosynthesis.csv", sep="/"), header = T, sep=",") %>%
+ #transform date column
+ mutate(Date = plyr::revalue(Date, c("A" = "May", "B" = "June", "C" = "July")),
+ Date = factor(Date, levels = c("May","June","July"))) %>%
+ #delete Groups
+ filter(!(Group %in% c("M","L","N","O","P")))
+```
+
+ ggplot themes
+
+```{r}
+plotTheme1 = theme(
+ legend.position = "right",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.background = element_blank(),
+ axis.text = element_text(colour = "black"),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold",hjust = 0.5))
+```
+
+
+
+
+
+## 3. Analyze photosynthesis data
+
+Sample sizes
+
+```{r}
+table(Photo.df$Group, Photo.df$Date)
+```
+
+
+
+Linear models
+
+```{r}
+#Model relative change in photosynthesis
+LM.df = Photo.df %>%
+ #group by Month
+ group_by(Date) %>%
+ #linear model
+ do({model = lm(A ~ Treatment, data=.) # create your model
+ data.frame(tidy(model),
+ lowCI=ci(model)[,2],
+ hiCI=ci(model)[,3])}) %>%
+ #get percentages by dividing by intercept
+ mutate(Anet.mean = estimate[1],
+ Anet.percent = estimate / Anet.mean *100,
+ Anet.percent.hi = hiCI / Anet.mean *100,
+ Anet.percent.low = lowCI / Anet.mean *100) %>%
+ filter(!term %in% c("(Intercept)"))
+
+as.data.frame(LM.df)
+```
+
+
+
+
+
+## 4. Figures
+
+
+
+plot 1: Absolute and relative photosynthesis
+
+```{r, fig.align = "center"}
+#####################
+#Plot absolute change
+#####################
+
+absolute.plot = ggplot(Photo.df, aes(x=Date, y=A, fill=Treatment)) +
+ geom_boxplot(outlier.shape = NA) +
+ geom_vline(xintercept=1.5, colour="black", linetype="dashed")+
+ geom_vline(xintercept=2.5, colour="black", linetype="dashed")+
+ coord_cartesian(ylim = c(0.48, 10.2))+
+ labs(x = "", y = "Anet (mmol m-2 s-1)") +
+ scale_fill_manual(values = c('#F21A00','#3B9AB2','grey40'))+
+ plotTheme1
+
+
+#####################
+#Plot relative change
+#####################
+
+relative.plot = ggplot(LM.df, aes(x=Date, y=Anet.percent, group = term, fill = term)) +
+
+ geom_bar(position=position_dodge(), stat="identity") +
+ geom_errorbar(aes(ymin=Anet.percent.low, ymax=Anet.percent.hi),
+ width=.2, # Width of the error bars
+ position=position_dodge(.9))+
+ coord_cartesian(ylim=c(-100,100))+
+ geom_hline(yintercept = 0)+
+ geom_vline(xintercept=1.5, colour="black", linetype="dashed")+
+ geom_vline(xintercept=2.5, colour="black", linetype="dashed")+
+ scale_fill_manual(values = c('#3B9AB2','grey40')) +
+ labs(x = "Date", y = "Anet change (%)") +
+ plotTheme1 + theme(legend.position = "none")
+
+
+#define plot layout
+layout <- "
+A
+B"
+
+#Merge plots
+PhotosynthesisPlot = absolute.plot + relative.plot +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'a')&
+ theme(plot.tag = element_text(face = 'bold'))
+
+#Save PDF
+pdf(paste(output.dir,"PhotosynthesisPlot.pdf",sep="/"), width=5, height=5, useDingbats=FALSE)
+PhotosynthesisPlot
+dev.off()
+
+PhotosynthesisPlot
+```
+
+
+
+
+
+## 5. Reproducibility
+
+
+
+Reproducibility info
+
+```{r}
+## date time
+Sys.time()
+
+## session info
+sessionInfo()
+```
+
+
\ No newline at end of file
diff --git a/R code/Experiment2/Experiment2_budset.Rmd b/R code/Experiment2/Experiment2_budset.Rmd
new file mode 100644
index 0000000..97dcb57
--- /dev/null
+++ b/R code/Experiment2/Experiment2_budset.Rmd
@@ -0,0 +1,550 @@
+---
+title: "Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice"
+subtitle: "Experiment 2: The seasonal effects of temperature on autumn bud set"
+---
+
+
+
+## 1. Load packages and functions
+
+load packages
+
+```{r, message=FALSE, warning=FALSE}
+require(ggplot2)
+require(tidyverse)
+require(broom.mixed)
+require(patchwork)
+require(lubridate)
+require(data.table)
+require(gmodels)
+require(wesanderson)
+require(mgcv)
+require(tm)
+require(lme4)
+```
+
+
+
+load functions
+
+```{r, message=FALSE, warning=FALSE}
+```
+
+
+
+
+
+## 2. Load data
+
+
+
+data tables
+
+```{r}
+################
+# define paths #
+################
+
+
+data.dir = "/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Experiment2/Data"
+output.dir = "/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Experiment2/R_output"
+
+
+
+#####################
+# Load bud set data #
+#####################
+
+
+bud.df = read.table(paste(data.dir,"bud_measurements_rm_2022.csv",sep="/"), header=T, sep=",") %>%
+
+ #create ID and treatment columns
+ mutate(ID=readr::parse_number(TreeID), #keep only numbers in string
+ TreatmentLetter=removeNumbers(TreeID),#remove numbers in string
+ date = as.Date(date, format="%d.%m.%y", origin = "1970-01-01"),
+ #merge controls
+ Treatment = ifelse(TreatmentLetter %in% c("A","D","H"),"Control",
+ ifelse(TreatmentLetter %in% c("G"),"Pre",
+ ifelse(TreatmentLetter %in% c("K"), "Post", "Other")))) %>%
+
+ #long format
+ pivot_longer(., -c(TreeID, ID, Treatment, TreatmentLetter, Week, date),
+ names_to = "bud_type", values_to = "bud_length") %>%
+ mutate(bud_type = gsub("\\..*","", bud_type)) %>%
+ filter(!Treatment %in% c('Other'),
+ !is.na(bud_length)) %>%
+ group_by(ID, bud_type) %>%
+ filter(n() >= 8) %>%
+ ungroup()
+```
+
+ ggplot themes
+
+```{r}
+plotTheme1 = theme(
+ legend.position = "none",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.background = element_blank(),
+ axis.text = element_text(colour = "black"),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold",hjust = 0.5))
+```
+
+
+
+
+
+## 3. Prepare and analyze bud set data
+
+Sample sizes
+
+```{r}
+# Observed buds per treatment
+table(bud.df[bud.df$date=="2022-09-01",]$Treatment, bud.df[bud.df$date=="2022-09-01",]$bud_type)
+
+# Number of individual trees
+length(unique(bud.df$ID))
+
+# Number of individual trees per treatment
+length(unique(bud.df[bud.df$Treatment=="Control",]$ID))
+length(unique(bud.df[bud.df$Treatment=="Pre",]$ID))
+length(unique(bud.df[bud.df$Treatment=="Post",]$ID))
+```
+
+
+
+Data preparation
+
+```{r, warning=F, message=F}
+##########################
+## Get relative bud growth
+##########################
+
+
+bud.df = bud.df %>%
+ group_by(ID, bud_type)%>%
+ mutate(
+ #get relative bud length per individual
+ bud.rel = bud_length / max(bud_length),
+ #get bud growth rates per individual
+ across(bud_length, ~c(NA, diff(.)), .names = "bud_growth"),
+ #get relative bud growth rates per individual
+ across(bud.rel, ~c(NA, diff(.)), .names = "relbud_growth"),
+ #get date of maximum bud length per individual
+ date.max.bud = date[which.max(bud_length)]) %>%
+ ungroup()
+
+
+
+######################################################################
+## Interpolate 90% bud set dates from seasonal bud length measurements
+######################################################################
+
+
+bud.data.90 = bud.df %>%
+ group_by(ID, Treatment, bud_type) %>%
+ filter(!(ID %in% c(116) & bud_type == 'Apical'),
+ !(ID %in% c(58) & bud_type == 'Lateral')) %>%
+ # Find the last row with <90% bud length in each group, keep only this row and next
+ filter(row_number() <= min(which(bud.rel > 0.9)),
+ row_number() >= min(which(bud.rel > 0.9))-1) %>%
+ #Linear interpolation
+ summarize(EOS = as.Date(approx(bud.rel, date, .9, ties=min)$y, origin="1970-01-01")) %>%
+ mutate(EOS.DOY = yday(EOS)) %>%
+ ungroup()
+
+mean(bud.data.90$EOS)
+```
+
+
+
+Bud set analysis
+
+```{r,warning=F, message=F}
+################
+## Linear models
+################
+
+
+# Bud set dates
+###############
+
+resultsLM = bud.data.90 %>%
+ do({model = lmer(EOS.DOY ~ Treatment + (1|bud_type), data=.) # create your model
+ data.frame(tidy(model, effect="fixed"))}) %>%
+ filter(!term %in% c("(Intercept)")) %>%
+ mutate(term = factor(term, levels = c("TreatmentPre","TreatmentPost")),
+ #Reverse effect sizes
+ estimate = estimate*(-1))
+
+#Show results
+as.data.frame(resultsLM) %>%
+ dplyr::select(-c(statistic))%>%
+ mutate_if(is.numeric, round, digits=1)
+
+
+# Autumn bud growth rates
+#########################
+
+resultsRelGrowth = bud.df %>%
+ do({model = lmer(relbud_growth*100/7 ~ Treatment + (1|bud_type) + (1|date), data=.) # create your model
+ data.frame(tidy(model, effect="fixed"))}) %>%
+ filter(!term %in% c("(Intercept)")) %>%
+ mutate(term = factor(term, levels = c("TreatmentPre","TreatmentPost")),
+ #Reverse effect sizes
+ estimate = estimate*(-1))
+
+#Show results
+as.data.frame(resultsRelGrowth) %>%
+ dplyr::select(-c(statistic))%>%
+ mutate_if(is.numeric, round, digits=2)
+
+
+# Autumn bud growth
+###################
+
+BudGrowth.df = bud.df %>%
+ group_by(Treatment, ID, bud_type) %>%
+ summarize(RelAutGrowth = (1-(min(bud_length)/max(bud_length)))*100) %>%
+ ungroup()
+
+resultsRelAutGrowth = BudGrowth.df %>%
+ do({model = lmer(RelAutGrowth ~ Treatment + (1|bud_type), data=.)
+ data.frame(tidy(model, effect="fixed"))})
+
+#Show results
+Intercept = resultsRelAutGrowth[1,]$estimate
+as.data.frame(resultsRelAutGrowth) %>%
+ #get relative autumn growth change
+ mutate(PercentGrowthChange = estimate/Intercept*100,
+ PercentGrowth.se = std.error/Intercept*100) %>%
+ dplyr::select(-c(statistic))%>%
+ mutate_if(is.numeric, round, digits=1)
+```
+
+
+
+
+
+## 4. Figures
+
+
+
+plot 1: Linear models
+
+```{r, fig.align = "center"}
+# Bud set dates
+###############
+
+LMplot90 = ggplot() +
+ scale_color_manual(values = c('#F21A00', '#3B9AB2'))+
+ geom_hline(yintercept=0)+
+ geom_point(data=resultsLM, aes(x=term, y=estimate, color=term))+
+ geom_errorbar(data=resultsLM,
+ aes(x=term, ymin=estimate+1.96*std.error, ymax=estimate-1.96*std.error, color=term),
+ width=.2, position=position_dodge(.9)) +
+
+ geom_vline(xintercept=1.5, size=2, alpha=0.4)+
+ coord_cartesian(ylim=c(-10,10))+
+ xlab("")+ylab("Bud set anomaly (days)")+
+ scale_x_discrete(labels = c('Pre','Post'))+
+ plotTheme1
+
+LMplot90
+
+# Relative bud growth rates
+LMplotRelGrowth = ggplot() +
+ scale_color_manual(values = c('#F21A00', '#3B9AB2'))+
+ geom_hline(yintercept=0)+
+ geom_point(data=resultsRelGrowth, aes(x=term, y=estimate, color=term))+
+ geom_errorbar(data=resultsRelGrowth,
+ aes(x=term, ymin=estimate-1.96*std.error, ymax=estimate+1.96*std.error, color=term),
+ width=.2, position=position_dodge(.9)) +
+
+ geom_vline(xintercept=1.5, size=2, alpha=0.4)+
+ coord_cartesian(ylim=c(-0.12,.12))+
+ xlab("")+ylab("Bud growth rate anomaly (% per day)")+
+ scale_x_discrete(labels = c('Pre','Post'))+
+ plotTheme1
+
+LMplotRelGrowth
+```
+
+
+
+plot 2: Bud length curves
+
+```{r, fig.align = "center", warning=F, message=F}
+#move points .05 to the left and right
+pd = position_dodge(2)
+
+
+# Relative bud growth
+RelBudLength_curve = bud.df %>%
+ mutate(Treatment = factor(Treatment, levels=c("Control",'Pre','Post'))) %>%
+ ggplot(aes(x=date, y=bud.rel*100, colour=Treatment, group=Treatment)) +
+
+ geom_hline(yintercept = 60, colour="lightgrey")+
+ geom_hline(yintercept = 70, colour="lightgrey")+
+ geom_hline(yintercept = 80, colour="lightgrey")+
+ geom_hline(yintercept = 90, colour="lightgrey")+
+ geom_hline(yintercept = 100, colour="lightgrey")+
+
+ geom_vline(xintercept = as.Date('2022-11-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2022-10-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2022-09-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2022-08-01'), colour="lightgrey")+
+
+ stat_summary(fun.data = "mean_se", geom="line", size = 1.2, position=pd, alpha=0.7) +
+ stat_summary(fun.data = "mean_se", geom="errorbar", size = 0.8, width=0, position=pd) +
+ stat_summary(fun.data = "mean_se", geom="point", size = 1.2, position=pd) +
+
+ scale_color_manual(values = c('black','#F21A00','#3B9AB2'),
+ labels=c('Control', 'Pre-solstice cooling',"Post-solstice cooling"))+
+
+ coord_cartesian(ylim=c(65,100),xlim=c(as.Date(c('2022-08-25','2022-11-05'))))+
+
+ xlab("") +
+ ylab("Relative bud length (%)") +
+
+ #ggtitle("Relative bud growth")+
+
+ plotTheme1 +
+ theme(legend.position = c(0.7, 0.3),
+ legend.key = element_rect(fill = "transparent"),
+ legend.background = element_rect(fill='white'),
+ legend.box.background = element_rect(fill='transparent'),
+ axis.title.x = element_blank(),
+ axis.text.x = element_blank())
+
+RelBudLength_curve
+
+# Absolute bud growth
+AbsBudLength_curve = bud.df %>%
+ mutate(Treatment = factor(Treatment, levels=c("Control",'Pre','Post'))) %>%
+ ggplot(aes(x=date, y=bud_length, colour=Treatment, group=Treatment)) +
+
+ geom_hline(yintercept = 12.5, colour="lightgrey")+
+ geom_hline(yintercept = 15, colour="lightgrey")+
+ geom_hline(yintercept = 17.5, colour="lightgrey")+
+ geom_hline(yintercept = 20, colour="lightgrey")+
+ geom_hline(yintercept = 22.5, colour="lightgrey")+
+ geom_hline(yintercept = 25, colour="lightgrey")+
+
+ geom_vline(xintercept = as.Date('2022-11-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2022-10-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2022-09-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2022-08-01'), colour="lightgrey")+
+
+ stat_summary(fun.data = "mean_se", geom="line", size = 1.2, position=pd, alpha=0.7) +
+ stat_summary(fun.data = "mean_se", geom="errorbar", size = 0.8, width=0, position=pd) +
+ stat_summary(fun.data = "mean_se", geom="point", size = 1.2, position=pd) +
+
+ scale_color_manual(values = c('black','#F21A00','#3B9AB2'))+
+
+ coord_cartesian(ylim=c(13,24),xlim=c(as.Date(c('2022-08-25','2022-11-05'))))+
+
+ xlab("Date") +
+ ylab("Bud length (mm)") +
+
+ #ggtitle("Absolute bud growth") +
+
+ plotTheme1
+
+AbsBudLength_curve
+
+# Relative bud growth rate
+RelBudGrowth_curve = bud.df %>%
+ ggplot(aes(x=date, y=relbud_growth*100/7, colour=Treatment, group=Treatment)) +
+
+ geom_hline(yintercept = 0.25, colour="lightgrey")+
+ geom_hline(yintercept = 0.5, colour="lightgrey")+
+ geom_hline(yintercept = 0.75, colour="lightgrey")+
+ geom_hline(yintercept = 1, colour="lightgrey")+
+
+ geom_vline(xintercept = as.Date('2022-11-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2022-10-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2022-09-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2022-08-01'), colour="lightgrey")+
+
+ stat_summary(fun.data = "mean_se", geom="line", size = 1.2, position=pd, alpha=0.7) +
+ stat_summary(fun.data = "mean_se", geom="errorbar", size = 0.8, width=0, position=pd) +
+ stat_summary(fun.data = "mean_se", geom="point", size = 1.2, position=pd) +
+
+ scale_color_manual(values = c('black','#F21A00','#3B9AB2'))+
+
+ coord_cartesian(ylim=c(0.056,1.2),xlim=c(as.Date(c('2022-08-25','2022-11-05'))))+
+
+ xlab("") +
+ ylab("% per day") +
+
+ #ggtitle("Bud growth rate")+
+
+ plotTheme1 +
+ theme(legend.position = "right")
+
+RelBudGrowth_curve
+
+# Absolute bud growth
+AbsBudGrowth_curve = bud.df %>%
+ ggplot(aes(x=date, y=bud_growth/7, colour=Treatment, group=Treatment)) +
+
+ geom_hline(yintercept = .1, colour="lightgrey")+
+ geom_hline(yintercept = .2, colour="lightgrey")+
+ geom_hline(yintercept = .3, colour="lightgrey")+
+
+ geom_vline(xintercept = as.Date('2022-11-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2022-10-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2022-09-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2022-08-01'), colour="lightgrey")+
+
+ stat_summary(fun.data = "mean_se", geom="line", size = 1.2, position=pd, alpha=0.7) +
+ stat_summary(fun.data = "mean_se", geom="errorbar", size = 0.8, width=0, position=pd) +
+ stat_summary(fun.data = "mean_se", geom="point", size = 1.2, position=pd) +
+
+ scale_color_manual(values = c('black','#F21A00','#3B9AB2'))+
+
+ coord_cartesian(ylim=c(0.011,0.25),xlim=c(as.Date(c('2022-08-25','2022-11-05'))))+
+
+ xlab("") +
+ ylab("mm per day") +
+
+ #ggtitle("Absolute bud growth")+
+
+ plotTheme1 +
+ theme(legend.position = "right")
+
+AbsBudGrowth_curve
+
+#define plot layout
+layout <- "
+ACC
+BDD"
+
+#Merge plots
+CombinedPlot = LMplot90 + LMplotRelGrowth + RelBudLength_curve + AbsBudLength_curve +
+ plot_layout(design = layout) + plot_annotation(tag_levels = c('A')) &
+ theme(plot.tag = element_text(face = 'bold'))
+
+#Save PDF
+pdf(paste(output.dir,"CombinedPlot_Experiment2.pdf",sep="/"), width=6.5, height=6.5, useDingbats=FALSE)
+CombinedPlot
+dev.off()
+
+CombinedPlot
+```
+
+
+
+plot 3: Bud set curves (Individuals)
+
+```{r, fig.width = 5, fig.asp = 20, fig.align = "center", warning=F, message=F}
+##############
+# Bud length #
+##############
+
+
+budlength_individuals = bud.df %>%
+ ggplot(aes(x=date, y=bud_length,
+ colour=Treatment, fill=Treatment)) +
+
+ geom_vline(xintercept = as.Date('2021-11-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2021-10-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2021-09-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2021-08-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2021-07-01'), colour="lightgrey")+
+
+ geom_hline(yintercept = 10, colour="lightgrey")+
+ geom_hline(yintercept = 20, colour="lightgrey")+
+ geom_hline(yintercept = 30, colour="lightgrey")+
+
+ geom_line(aes(x=date, y=bud_length), color="black")+
+ geom_point()+
+ geom_area(aes(x=date, y=bud_length), alpha=0.5) +
+
+ geom_vline(data=bud.data.90,
+ aes(xintercept = EOS), linetype = "dashed")+
+
+ xlab("Date") +
+ ylab("Bud length (mm)") +
+
+ facet_grid(ID~bud_type)+
+ plotTheme1
+
+#Save PDF
+pdf(paste(output.dir,"IndividualPlot_Budlength.pdf",sep="/"), width=6, height=120, useDingbats=FALSE)
+budlength_individuals
+dev.off()
+
+budlength_individuals
+
+#######################
+# Relative bud length #
+#######################
+
+
+RelBudlength_individuals = bud.df %>%
+ ggplot(aes(x=date, y=bud.rel*100,
+ colour=Treatment, fill=Treatment)) +
+
+ geom_vline(xintercept = as.Date('2021-11-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2021-10-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2021-09-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2021-08-01'), colour="lightgrey")+
+ geom_vline(xintercept = as.Date('2021-07-01'), colour="lightgrey")+
+
+ geom_hline(yintercept = 50, colour="lightgrey")+
+ geom_hline(yintercept = 60, colour="lightgrey")+
+ geom_hline(yintercept = 70, colour="lightgrey")+
+ geom_hline(yintercept = 80, colour="lightgrey")+
+ geom_hline(yintercept = 90, colour="lightgrey")+
+
+ geom_line(aes(x=date, y=bud.rel*100), color="black")+
+ geom_point()+
+ geom_area(aes(x=date, y=bud.rel*100), alpha=0.5) +
+
+ geom_vline(data=bud.data.90,
+ aes(xintercept = EOS), linetype = "dashed")+
+
+ coord_cartesian(ylim=c(45,100))+
+
+ xlab("Date") +
+ ylab("Relative bud length (%)") +
+
+ facet_grid(ID~bud_type)+
+ plotTheme1
+
+#Save PDF
+pdf(paste(output.dir,"IndividualPlot_RelativeBudlength.pdf",sep="/"), width=6, height=120, useDingbats=FALSE)
+RelBudlength_individuals
+dev.off()
+
+RelBudlength_individuals
+```
+
+
+
+
+
+## 5. Reproducibility
+
+
+
+Reproducibility info
+
+```{r}
+## date time
+Sys.time()
+
+## session info
+sessionInfo()
+```
+
+
+
+
+
\ No newline at end of file
diff --git a/R code/FluxNet_analysis/FluxNet_analysis.Rmd b/R code/FluxNet_analysis/FluxNet_analysis.Rmd
new file mode 100644
index 0000000..eeab84a
--- /dev/null
+++ b/R code/FluxNet_analysis/FluxNet_analysis.Rmd
@@ -0,0 +1,737 @@
+---
+title: Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice
+author: Constantin Zohner
+date: "last updated March 29, 2023"
+
+subtitle: FluxNet analysis (Figs. S5 and S6)
+output:
+ html_document:
+ highlight: haddock
+ toc: false
+ use_bookdown: true
+ df_print: paged
+---
+
+
+
+
+
+### Variable names
+- GPP: GPP (day-time method)
+- PD10: Date of 10% photosynthesis decline
+- PD25: Date of 25% photosynthesis decline
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(
+ class.source = "numberLines lineAnchors"
+ )
+```
+
+
+
+```{r, message=FALSE, warning=FALSE, attr.source='.numberLines'}
+#####################
+# Required packages #
+#####################
+
+
+
+require(data.table)
+require(tidyverse)
+require(lme4)
+require(broom)
+require(broom.mixed)
+require(pracma)
+require(effects)
+require(remef)
+require(wesanderson)
+require(patchwork)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#############################
+## Set directory and paths ##
+#############################
+
+
+
+# Set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/FluxNet_analysis/Analysis")
+
+
+#########
+# Paths #
+#########
+
+
+# 1. Input
+##########
+
+input_path = "Fluxnet_data"
+
+
+# 2. Output
+###########
+
+output_path = "Figures"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Flux data
+Flux.df <- fread(paste(input_path, "fluxnet_phenology_roll7_df.csv", sep="/")) %>%
+ group_by(SiteName) %>%
+ #delete sites with fewer than 10 years
+ filter(n() >= 10) %>%
+ ungroup()
+
+
+#Site data
+Site.df <- fread(paste(input_path, "sites_biomes_continents_rm.csv", sep="/"))
+
+
+#Merge
+Flux.df = merge(Flux.df, Site.df, by=c("SiteName")) %>%
+ filter(!forest_type %in% c("EN"),
+ !biome == 6) %>%
+ # sum of April-June photosynthesis
+ mutate(GPP.LO.SO = rowSums(dplyr::select(.,c("GPP_4","GPP_5","GPP_6"))))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+####################################################
+## Check sample sizes, EOS dates and forest types ##
+####################################################
+
+
+
+# Observations per site
+table(Flux.df$SiteName)
+length(table(Flux.df$SiteName))
+
+# EOS dates
+quantile(Flux.df$pd10, c(0.05, 0.5, 0.95))
+quantile(Flux.df$pd25, c(0.05, 0.5, 0.95))
+quantile(Flux.df$pd50, c(0.05, 0.5, 0.95))
+
+# Forest types
+table(Flux.df$forest_type)
+table(Flux.df$`biome name`)
+
+# Years
+range(Flux.df$YEAR)
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+################
+## Plot theme ##
+################
+
+
+#Color.palette: col=c('#F21A00','#E1AF00','#EBCC2A','#78B7C5','#3B9AB2')
+
+plotTheme1 = theme(
+ legend.position = "none",
+ legend.background = element_blank(),
+ legend.text = element_text(color="black"),
+ legend.title = element_blank(),
+ legend.key = element_blank(),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################################################################
+#get advance in PD10/25 per each 10% increase in pre-solstice GPP
+#################################################################
+
+
+
+# mixed model
+coefficients10 = coef(summary(lmer(pd10 ~ GPP.LO.SO + (1 | SiteName), data=Flux.df,
+ na.action = "na.exclude")))[2,1:2]
+
+coefficients25 = coef(summary(lmer(pd25 ~ GPP.LO.SO + (1 | SiteName), data=Flux.df,
+ na.action = "na.exclude")))[2,1:2]
+
+#relative to overall variation
+paste0("PD10 = ",
+ round(coefficients10[1] * (max(Flux.df$GPP.LO.SO)-min(Flux.df$GPP.LO.SO))/10,1),
+ " ± ",
+ round(coefficients10[2] * (max(Flux.df$GPP.LO.SO)-min(Flux.df$GPP.LO.SO))/10,1),
+ " days per 10% GPP")
+paste0("PD25 = ",
+ round(coefficients25[1] * (max(Flux.df$GPP.LO.SO)-min(Flux.df$GPP.LO.SO))/10,1),
+ " ± ",
+ round(coefficients25[2] * (max(Flux.df$GPP.LO.SO)-min(Flux.df$GPP.LO.SO))/10,1),
+ " days per 10% GPP")
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################################
+# Univariate monthly mixed effects model #
+##########################################
+
+
+
+#Prepare data
+#############
+
+
+# Models
+########
+
+#list variables to loop through
+variables = c('GPP')
+phenophases = c("pd10", "pd25","pd50")
+months=c(4:9)
+variables=paste(rep(variables, each=length(months)), months, sep="_")
+
+#create List object to store results
+DataList1 = replicate(length(variables)*length(phenophases), data.frame())
+DataList2 = replicate(length(variables)*length(phenophases), data.frame())
+DataList3 = replicate(length(variables)*length(phenophases), data.frame())
+names(DataList1) = paste(rep(variables, each=length(phenophases)), phenophases, sep="_")
+names(DataList2) = paste(rep(variables, each=length(phenophases)), phenophases, sep="_")
+names(DataList3) = paste(rep(variables, each=length(phenophases)), phenophases, sep="_")
+
+#counter
+i=1
+
+#Loop
+for (variable.name in variables){
+
+ for (phenophase in phenophases){
+
+ #extract variables
+ var = as.numeric(Flux.df %>% pull(variable.name))
+ Senesc_DOY = as.numeric(Flux.df %>% pull(phenophase))
+ Site = Flux.df$SiteName
+
+ #run model
+ fit_multi = lmer(Senesc_DOY ~ var + (1 | Site))
+
+ # Extract information for plotting
+ plotMulti = allEffects(fit_multi)
+
+ # Extract coefficients
+ df.coefficients = tibble(Coefficient = coef(summary(fit_multi))[ , "Estimate"][2],
+ std.error = coef(summary(fit_multi))[ , "Std. Error"][2],
+ CI.lo = confint(fit_multi)[4,1],
+ CI.hi = confint(fit_multi)[4,2],
+ variable = variable.name,
+ phenophase = phenophase)
+
+ # Final table
+ df <- tibble(upper = plotMulti$var$upper[,1],
+ lower = plotMulti$var$lower[,1],
+ off = plotMulti$var$fit[,1],
+ xval = plotMulti$var$x[,1],
+ variable = paste0(variable.name),
+ phenophase = phenophase)
+
+ # get phenology anomalies
+ df = df %>%
+ group_by(variable, phenophase) %>%
+ mutate(anomaly = off - mean(off),
+ anomaly.upper = upper - mean(off),
+ anomaly.lower = lower - mean(off)) %>%
+ ungroup()
+
+ ##############################################################################################################################################
+
+ # get partial Senescence dates, removing site (random) effect
+ y_partial = remef::remef(fit_multi, ran="all", keep.intercept = T)
+
+ # Create table
+ df.fitted = tibble(fitted = y_partial,
+ x = var,
+ variable = variable.name,
+ phenophase = phenophase)
+
+ ##############################################################################################################################################
+
+ #store data frame in variable list
+ DataList1[[i]] = df
+ DataList2[[i]] = df.coefficients %>%
+ mutate(R2 = summary(lm(fitted~x, data=df.fitted))$r.squared,
+ P = summary(lm(fitted~x, data=df.fitted))$coefficients[2,4],
+ Sig = ifelse(P<0.001, "***", ifelse(P<0.01, "**", ifelse(P<0.05, "*", "n.s."))))
+ DataList3[[i]] = df.fitted
+
+ #count
+ #print(paste0('...',i,' out of ',length(DataList1), ' done'))
+ i=i+1
+ }
+}
+
+#bind rows
+MixedModel.df = bind_rows(DataList1) %>%
+ separate(variable, into=c("variable", "Month"), sep = "_") %>%
+ mutate(Month = plyr::revalue(Month,
+ c("4" = "April" , "5" = "May", "6" = "June",
+ "7" = "July", "8" = "August", "9" = "September")),
+ Month = factor(Month, levels = c("April","May",'June','July','August','September')))
+
+monthly.df = bind_rows(DataList2) %>%
+ separate(variable, into=c("variable", "Month"), sep = "_") %>%
+ mutate(equation.variable = paste(phenophase, variable, sep='_'))
+
+coefficients.df = monthly.df %>%
+ mutate(Month = plyr::revalue(Month,
+ c("4" = "April" , "5" = "May", "6" = "June",
+ "7" = "July", "8" = "August", "9" = "September")),
+ Month = factor(Month, levels = c("April","May",'June','July','August','September')))
+
+fitted.df = bind_rows(DataList3) %>%
+ separate(variable, into=c("variable", "Month"), sep = "_") %>%
+ mutate(Month = plyr::revalue(Month,
+ c("4" = "April" , "5" = "May", "6" = "June",
+ "7" = "July", "8" = "August", "9" = "September")),
+ Month = factor(Month, levels = c("April","May",'June','July','August','September')))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################################
+## Interpolation of monthly estimates ##
+########################################
+
+
+
+#Interpolation function
+lin_interp = function(x, y, length.out=100) {
+ approx(x, y, xout=seq(min(x), max(x), length.out=length.out))$y
+}
+
+monthly.df = monthly.df %>%
+ mutate(Month = as.numeric(Month))
+
+
+#create identifier
+equation.variable = unique(monthly.df$equation.variable)
+
+#create interpolation dataframe
+df.interp = data.frame()
+df.AUC = data.frame()
+
+#loop over variable x equation x species vector
+for (variable.name in equation.variable){
+
+ #subset table
+ df.sub = monthly.df %>%
+ filter(equation.variable == variable.name)
+
+ # Interpolate data
+ created.interp = lin_interp(df.sub$Month, df.sub$Month)
+ score.interp = lin_interp(df.sub$Month, df.sub$Coefficient)
+ df.interp.sub = data.frame(created=created.interp, score=score.interp)
+ # Make a grouping variable for each pos/neg segment
+ cat.rle = rle(df.interp.sub$score < 0)
+ df.interp.sub = df.interp.sub %>%
+ mutate(group = rep.int(1:length(cat.rle$lengths), times=cat.rle$lengths),
+ variable = unique(df.sub$variable),
+ equation = unique(df.sub$phenophase),
+ equation.variable = paste(phenophase, variable, sep='_') )
+ #rbind sub dataframes
+ df.interp = rbind(df.interp, df.interp.sub)
+
+ #get Area under curve (%)
+ df.AUC.sub = df.interp.sub %>%
+ mutate(positive = ifelse(score<0, 0, score),
+ negative = ifelse(score>0, 0, score))%>%
+ summarise(sum.pos = trapz(created, positive),
+ sum.neg = abs(pracma::trapz(created, negative)))%>%
+ mutate(percent.neg = round(sum.neg/(sum.pos+sum.neg)*100),
+ percent.pos = round(sum.pos/(sum.pos+sum.neg)*100),
+ variable = unique(df.sub$variable),
+ equation = unique(df.sub$phenophase),
+ equation.variable = paste(phenophase, variable, sep='_') )
+ #rbind sub dataframes
+ df.AUC = rbind(df.AUC, df.AUC.sub)
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#########################
+## Publication figures ##
+#########################
+
+
+
+variables = unique(MixedModel.df$variable)
+
+#loop
+for (variable.name in variables){
+
+
+ ###########################
+ # Summary of monthly models
+ ###########################
+
+
+ # subset the table
+ ##################
+
+ Monthly.df.EOS10.sub = monthly.df %>%
+ filter(variable == variable.name,
+ phenophase=="pd10")
+ Monthly.df.EOS25.sub = monthly.df %>%
+ filter(variable == variable.name,
+ phenophase=="pd25")
+ Monthly.df.EOS50.sub = monthly.df %>%
+ filter(variable == variable.name,
+ phenophase=="pd50")
+
+ df.interp.EOS10.sub = df.interp %>%
+ filter(variable == variable.name,
+ equation=="pd10")
+ df.interp.EOS25.sub = df.interp %>%
+ filter(variable == variable.name,
+ equation=="pd25")
+ df.interp.EOS50.sub = df.interp %>%
+ filter(variable == variable.name,
+ equation=="pd50")
+
+ df.AUC.EOS10.sub = df.AUC %>%
+ filter(variable == variable.name,
+ equation=="pd10")
+ df.AUC.EOS25.sub = df.AUC %>%
+ filter(variable == variable.name,
+ equation=="pd25")
+ df.AUC.EOS50.sub = df.AUC %>%
+ filter(variable == variable.name,
+ equation=="pd50")
+
+ # EOS10 Plot
+ ############
+
+ EOS10.Monthly.plot = ggplot() +
+ geom_area(data = df.interp.EOS10.sub, aes(x = created, y = score, fill=score>0, group=group)) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+ geom_point(data=Monthly.df.EOS10.sub,
+ aes(x=Month, y=Coefficient))+
+ geom_errorbar(data=Monthly.df.EOS10.sub,
+ aes(x=Month, ymin=CI.lo, ymax=CI.hi), width=.2,
+ position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ geom_vline(xintercept=6.3, size=2, alpha=0.4)+
+ geom_text(data = df.AUC.EOS10.sub, mapping = aes(x = -Inf, y = Inf,
+ hjust = -0.1, vjust = 1.5,
+ label = paste0(percent.neg,'% / ',percent.pos, '%')))+
+ coord_cartesian(xlim=c(4.1, 8.9)) +
+ xlab("")+ylab("Days per unit")+
+ scale_x_continuous(breaks = seq(3,10,by=1),
+ labels = c('Mar','Apr','May','Jun','Jul','Aug','Sep','Oct'))+
+ plotTheme1
+
+ # EOS25 Plot
+ ############
+
+ EOS25.Monthly.plot = ggplot() +
+ geom_area(data = df.interp.EOS25.sub, aes(x = created, y = score, fill=score>0, group=group)) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+ geom_point(data=Monthly.df.EOS25.sub,
+ aes(x=Month, y=Coefficient))+
+ geom_errorbar(data=Monthly.df.EOS25.sub,
+ aes(x=Month, ymin=CI.lo, ymax=CI.hi), width=.2,
+ position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ geom_vline(xintercept=6.3, size=2, alpha=0.4)+
+ geom_text(data = df.AUC.EOS25.sub, mapping = aes(x = -Inf, y = Inf,
+ hjust = -0.1, vjust = 1.5,
+ label = paste0(percent.neg,'% / ',percent.pos, '%')))+
+ coord_cartesian(xlim=c(4.1, 8.9)) +
+ xlab("")+ylab("Days per unit")+
+ scale_x_continuous(breaks = seq(3,10,by=1),
+ labels = c('Mar','Apr','May','Jun','Jul','Aug','Sep','Oct'))+
+ plotTheme1
+
+ # EOS50 Plot
+ ############
+
+ EOS50.Monthly.plot = ggplot() +
+ geom_area(data = df.interp.EOS50.sub, aes(x = created, y = score, fill=score>0, group=group)) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+ geom_point(data=Monthly.df.EOS50.sub,
+ aes(x=Month, y=Coefficient))+
+ geom_errorbar(data=Monthly.df.EOS50.sub,
+ aes(x=Month, ymin=CI.lo, ymax=CI.hi), width=.2,
+ position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ geom_vline(xintercept=6.3, size=2, alpha=0.4)+
+ geom_text(data = df.AUC.EOS50.sub, mapping = aes(x = -Inf, y = Inf,
+ hjust = -0.1, vjust = 1.5,
+ label = paste0(percent.neg,'% / ',percent.pos, '%')))+
+ coord_cartesian(xlim=c(4.1, 8.9)) +
+ xlab("")+ylab("Days per unit")+
+ scale_x_continuous(breaks = seq(3,10,by=1),
+ labels = c('Mar','Apr','May','Jun','Jul','Aug','Sep','Oct'))+
+ plotTheme1
+
+
+ ##############################################################################################################################################
+
+
+ ###################
+ # Univariate models
+ ###################
+
+
+ #Driver plots
+ MixedModel.df.sub = MixedModel.df %>%
+ filter(variable == variable.name)
+
+ coefficients.df.sub = coefficients.df %>%
+ filter(variable == variable.name)
+
+ fitted.df.sub = fitted.df %>%
+ filter(variable == variable.name)
+
+ # EOS10
+ #######
+
+ EOS10uni = ggplot() +
+
+ geom_point(data=fitted.df.sub[fitted.df.sub$phenophase=="pd10",],
+ aes(y= fitted, x= x, color=Month),size=0.15) +
+
+ geom_ribbon(data = MixedModel.df.sub[MixedModel.df.sub$phenophase=="pd10",],
+ aes(x = xval, ymin = lower, ymax = upper, fill=Month),
+ alpha = 0.5) +
+
+ geom_line(data=MixedModel.df.sub[MixedModel.df.sub$phenophase=="pd10",],
+ aes(xval, off, color = Month)) +
+
+ geom_text(data=coefficients.df.sub[coefficients.df.sub$phenophase=="pd10",],
+ aes(label=paste0(round(Coefficient,2),
+ " ± ",
+ round(1.96*std.error,2),
+ " days per unit\nR2 = ",
+ round(R2,2),
+ Sig),
+ x=Inf, y=Inf, hjust = 1.05, vjust = 1.5), size=3) +
+
+ scale_color_manual(values = c('#F21A00','#F21A00','#F21A00','#3B9AB2','#3B9AB2','#3B9AB2'))+
+ scale_fill_manual(values = c('#F21A00','#F21A00','#F21A00','#3B9AB2','#3B9AB2','#3B9AB2'))+
+
+ coord_cartesian(ylim = c(160,250)) +
+
+ labs(x = variable.name, y = expression(PD[10]~(DOY))) +
+
+ plotTheme1 +
+
+ facet_wrap(~Month, scales="free_x", ncol=2, dir="v")
+
+
+ # EOS25
+ #######
+
+ EOS25uni = ggplot() +
+
+ geom_point(data=fitted.df.sub[fitted.df.sub$phenophase=="pd25",],
+ aes(y= fitted, x= x, color=Month),size=0.15) +
+
+ geom_ribbon(data = MixedModel.df.sub[MixedModel.df.sub$phenophase=="pd25",],
+ aes(x = xval, ymin = lower, ymax = upper, fill = Month),
+ alpha = 0.5) +
+
+ geom_line(data=MixedModel.df.sub[MixedModel.df.sub$phenophase=="pd25",],
+ aes(xval, off, color=Month)) +
+
+ geom_text(data=coefficients.df.sub[coefficients.df.sub$phenophase=="pd25",],
+ aes(label=paste0(round(Coefficient,2),
+ " ± ",
+ round(2*std.error,2),
+ " days per unit\nR2 = ",
+ round(R2,2),
+ Sig),
+ x=Inf, y=Inf, hjust = 1.1, vjust = 1.5), size=3) +
+
+ scale_color_manual(values = c('#F21A00','#F21A00','#F21A00','#3B9AB2','#3B9AB2','#3B9AB2'))+
+ scale_fill_manual(values = c('#F21A00','#F21A00','#F21A00','#3B9AB2','#3B9AB2','#3B9AB2'))+
+
+ coord_cartesian(ylim = c(190,275)) +
+
+ labs(x = variable.name, y = expression(PD[25]~(DOY))) +
+
+ plotTheme1 +
+
+ facet_wrap(~Month, scales="free_x", ncol=2, dir="v")
+
+
+ # EOS50
+ #######
+
+ EOS50uni = ggplot() +
+
+ geom_point(data=fitted.df.sub[fitted.df.sub$phenophase=="pd50",],
+ aes(y= fitted, x= x, color=Month),size=0.15) +
+
+ geom_ribbon(data = MixedModel.df.sub[MixedModel.df.sub$phenophase=="pd50",],
+ aes(x = xval, ymin = lower, ymax = upper, fill = Month),
+ alpha = 0.5) +
+
+ geom_line(data=MixedModel.df.sub[MixedModel.df.sub$phenophase=="pd50",],
+ aes(xval, off, color=Month)) +
+
+ geom_text(data=coefficients.df.sub[coefficients.df.sub$phenophase=="pd50",],
+ aes(label=paste0(round(Coefficient,2),
+ " ± ",
+ round(2*std.error,2),
+ " days per unit\nR2 = ",
+ round(R2,2),
+ Sig),
+ x=Inf, y=Inf, hjust = 1.1, vjust = 1.5), size=3) +
+
+ scale_color_manual(values = c('#F21A00','#F21A00','#F21A00','#3B9AB2','#3B9AB2','#3B9AB2'))+
+ scale_fill_manual(values = c('#F21A00','#F21A00','#F21A00','#3B9AB2','#3B9AB2','#3B9AB2'))+
+
+ coord_cartesian(ylim = c(220,300)) +
+
+ labs(x = variable.name, y = expression(PD[50]~(DOY))) +
+
+ plotTheme1 +
+
+ facet_wrap(~Month, scales="free_x", ncol=2, dir="v")
+
+
+ ##############################################################################################################################################
+
+
+ ############
+ # Safe plots
+ ############
+
+
+ #define plot layout
+ layout <- "
+ A
+ B
+ B
+ B"
+
+ #Merge EOS10 plots
+ EOS10.plot = EOS10.Monthly.plot + EOS10uni +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A') &
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plot as .pdf
+ ggsave(EOS10.plot, file=paste('EOS10_',variable.name, "_deciduous.pdf", sep=''), path=output_path,
+ width=4.5, height=9)
+
+ print(EOS10.plot)
+
+
+ #Merge EOS25 plots
+ EOS25.plot = EOS25.Monthly.plot + EOS25uni +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A') &
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plot as .pdf
+ ggsave(EOS25.plot, file=paste('EOS25_',variable.name, "_deciduous.pdf", sep=''), path=output_path,
+ width=4.5, height=9)
+
+ print(EOS25.plot)
+
+
+ #Merge EOS50 plots
+ EOS50.plot = EOS50.Monthly.plot + EOS50uni +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A') &
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plot as .pdf
+ ggsave(EOS50.plot, file=paste('EOS50_',variable.name, "_deciduous.pdf", sep=''), path=output_path,
+ width=4.5, height=9)
+
+ print(EOS50.plot)
+
+
+ ##############################################################################################################################################
+
+
+ #count
+ print(variable.name)
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## date time
+Sys.time()
+
+## session info
+sessionInfo()
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+```
+
diff --git a/R code/Harvard_analysis/Harvard_models.Rmd b/R code/Harvard_analysis/Harvard_models.Rmd
new file mode 100644
index 0000000..3b6b923
--- /dev/null
+++ b/R code/Harvard_analysis/Harvard_models.Rmd
@@ -0,0 +1,511 @@
+---
+title: Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice
+author: Constantin Zohner
+date: "last updated March 29, 2023"
+
+subtitle: Ground-sourced American phenology observations - Harvard data (Fig. S4)
+output:
+ html_document:
+ highlight: haddock
+ toc: false
+ use_bookdown: true
+ df_print: paged
+---
+
+
+
+
+
+### Variable names
+- Tmean 1-12...monthly mean temperatures
+- Tpre...Pre-solstice (May-June) temperature
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(
+ class.source = "numberLines lineAnchors"
+ )
+```
+
+
+
+```{r, message=FALSE, warning=FALSE, attr.source='.numberLines'}
+###################
+# Required packages
+###################
+
+
+
+require(tidyverse)
+require(data.table)
+require(pracma)
+require(broom.mixed)
+require(lme4)
+require(lubridate)
+require(patchwork)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Harvard_analysis")
+
+# paths
+drivers_path = "Harvard_forest_data"
+output_path = "R_output"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+# Phenology data
+################
+
+Pheno.df <- fread(paste(drivers_path, "hf003-07-fall-mean-ind.csv", sep="/")) %>%
+ # delete Rosaceae
+ filter(!species %in% c("PRSE","AMSP"),
+ !is.na(lc.doy)) %>%
+ # get genus info
+ mutate(genus = stringr::str_extract(species, "^.{2}")) %>%
+ # remove time series with fewer than 28 years of observations
+ group_by(tree.id) %>%
+ filter(n() >= 28) %>%
+ ungroup() %>%
+ # delete species with fewer than 2 time series
+ group_by(species) %>%
+ filter(!length(unique(tree.id))<2) %>%
+ ungroup()
+
+
+# Temperature data
+##################
+
+Temp.df <- fread(paste(drivers_path, "hf300-05-daily-m.csv", sep="/")) %>%
+ # extract month and year info
+ mutate(month = month(date),
+ year = year(date)) %>%
+ # calculate monthly temperatures
+ group_by(year, month) %>%
+ summarise(Tmean = mean(airt, na.rm=T)) %>%
+ ungroup() %>%
+ #wide format
+ pivot_wider(., names_from = month, values_from = Tmean) %>%
+ rename_at(vars(c(2:13)), ~paste0("Tmean",c(1:12))) %>%
+ # calculate pre-solstice (May-June) temperature
+ rowwise() %>%
+ mutate(Tpre=mean(c(Tmean4,Tmean5,Tmean6)))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+################
+## Plot theme ##
+################
+
+
+
+plotTheme1 = theme(
+ legend.position = "none",
+ legend.background = element_blank(),
+ legend.text = element_text(color="black"),
+ legend.title = element_blank(),
+ legend.key = element_blank(),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black',face = "italic"),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+## VARIABLE EXPLANATION:
+########################
+
+
+
+# Phenology data
+################
+
+# year...observation year
+# tree.id...tree identifier
+# species...species name
+# lc.doy...50% leaf coloration date (DOY)
+# lf.doy...50% leaf fall date (DOY)
+
+
+# Species abbreviations
+#######################
+
+# ACPE: Acer pensylvanicum, striped maple
+# ACRU: Acer rubrum, red maple
+# ACSA: Acer saccharum, sugar maple
+# BEAL: Betula alleghaniensis, yellow birch
+# BELE: Betula lenta, blackbirch
+# FAGR: Fagus grandifolia, beech
+# NYSY: Nyssa sylvatica, blackgum
+# QUAL: Quercus alba, white oak
+# QURU: Quercus rubra, red oak
+# QUVE: Quercus velutina, black oak
+
+
+# Climate data
+##############
+
+# year...observation year
+# Tmean 1-12...monthly mean temperatures
+# Tpre...Pre-solstice (May-June) temperature
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+####################################
+# Merge phenology and climate data #
+####################################
+
+
+
+# Mixed model data
+##################
+
+Pheno.df = Pheno.df %>%
+ left_join(., Temp.df, by="year")
+
+
+# Partial regression data
+#########################
+
+Pheno.df2 = Pheno.df %>%
+ group_by(genus,year) %>%
+ summarise(lc.doy = mean(lc.doy)) %>%
+ ungroup() %>%
+ left_join(., Temp.df, by="year") %>%
+ mutate(Tpost = ifelse(genus == "NY", Tmean8, Tmean9))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################################
+## Partial regression analysis ##
+#################################
+
+
+
+PartialReg.df = Pheno.df2 %>%
+
+ #group by species
+ group_by(genus)%>%
+
+ do({
+
+ #run models
+ ###########
+
+ #Equations
+ model.x = lm(Tpre ~ Tpost, data = .)
+ model.y = lm(lc.doy ~ Tpost, data = .)
+
+ residuals.x = resid(model.x)
+ residuals.y = resid(model.y)
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(resid.x = residuals.x,
+ resid.y = residuals.y)
+
+ }) %>% ungroup()
+
+
+# Duplicate data
+################
+
+PartialReg.df = rbind(PartialReg.df,
+ PartialReg.df %>% mutate(genus="Aall")) %>%
+ mutate(genus = factor(genus, levels=c("Aall","NY","FA","QU","BE","AC")))
+
+
+# Create labels
+###############
+
+# This function returns a data frame with strings representing the regression equation, and the r^2 value.
+lm_labels <- function(dat) {
+ mod <- lm(resid.y ~ resid.x, data = dat)
+ formula <- sprintf("%.2f ~ days~C^-1",
+ round(coef(mod)[2], 1))
+ r <- cor(dat$resid.x, dat$resid.y)
+ r2 <- sprintf("italic(R^2) == %.2f", r^2)
+ data.frame(formula = formula, r2 = r2, stringsAsFactors = FALSE)
+}
+
+# Create label dataframe
+labels <- PartialReg.df %>%
+ group_by(genus) %>%
+ do(lm_labels(.))
+
+
+# Plot
+######
+
+PartialReg.plot = ggplot() +
+ geom_smooth(data=PartialReg.df, aes(x = resid.x, y = resid.y),
+ method = 'lm', color = '#F21A00', fill="#F21A00") +
+ geom_point(data=PartialReg.df, aes(x = resid.x, y = resid.y), size=1) +
+ theme(plot.title = element_text(hjust = 0.5, face = "bold")) +
+ theme(plot.subtitle = element_text(hjust = 0.5)) +
+ xlab(expression(Delta~"Pre-solstice"~T[mean]~"(" * degree * C *")")) +
+ ylab(expression(Delta~EOS[50]~(days)))+
+ coord_cartesian(ylim=c(-8.5,7.5))+
+ facet_wrap(~genus, ncol=1, strip.position = "right",
+ labeller = as_labeller(c("FA" = "Fagus", "BE" = "Betula", "Aall"="All", "NY" = "Nyssa", "QU"="Quercus", "AC"="Acer")))+
+ geom_text(data = labels, aes(label = formula), x = 0.6, y = 4.5, parse = TRUE, hjust = 0, size=3.5) +
+ geom_text(x = 0.6, y = 7, aes(label = r2), data = labels, parse = TRUE, hjust = 0, size=3.5)+
+ plotTheme1
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################################################
+## Monthly correlations (Mixed effects models) ##
+#################################################
+
+
+
+# All species
+#############
+
+ModelResults.df = Pheno.df %>%
+
+ do({
+
+ #run models
+ ###########
+
+ #Equation
+ modelEq = lmer(scale(lc.doy) ~ scale(Tmean3) + scale(Tmean4) + scale(Tmean5) + scale(Tmean6) +
+ scale(Tmean7) + scale(Tmean8) + scale(Tmean9) + scale(Tmean10) +
+ (1|tree.id) + (1|species) + (1|genus), data=.)
+
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(tidy(modelEq, effects="fixed"))
+
+ }) %>%
+
+ #add species name
+ mutate(genus = 'Aall')
+
+#----------------------------------------------------
+
+# Genus-specific mixed effects models
+#####################################
+
+ModelResultsSpecies.df = Pheno.df %>%
+
+ #group by species
+ group_by(genus)%>%
+
+ do({
+
+ #run models
+ ###########
+
+ #Equation
+ modelEq = lmer(scale(lc.doy) ~ scale(Tmean3)+scale(Tmean4) + scale(Tmean5) + scale(Tmean6) +
+ scale(Tmean7) + scale(Tmean8) + scale(Tmean9) + scale(Tmean10) +
+ (1|tree.id), data=.)
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(tidy(modelEq, effects="fixed") )
+
+ }) %>% ungroup()
+
+ #rbind all species and genus-specific results
+ Results.df = bind_rows(ModelResults.df, ModelResultsSpecies.df) %>%
+ #delete intercept
+ filter(!term %in% c("(Intercept)")) %>%
+ #add variable name and keep only numbers in month column
+ mutate(term = readr::parse_number(term),
+ genus = factor(genus, levels=c("Aall","NY","FA","QU","BE","AC")))
+
+
+##############################################################################################################################################
+
+
+# Interpolation of monthly estimates
+####################################
+
+
+#Interpolation function
+lin_interp = function(x, y, length.out=100) {
+ approx(x, y, xout=seq(min(x), max(x), length.out=length.out))$y
+}
+
+#create identifier
+genus = unique(Results.df$genus)
+
+#create interpolation dataframe
+df.interp = data.frame()
+df.AUC = data.frame()
+
+#loop over variable x equation x species vector
+for (variable.name in genus){
+
+ #subset table
+ df.sub = Results.df %>%
+ filter(genus == variable.name)
+
+ # Interpolate data
+ created.interp = lin_interp(df.sub$term, df.sub$term)
+ score.interp = lin_interp(df.sub$term, df.sub$estimate)
+ df.interp.sub = data.frame(created=created.interp, score=score.interp)
+ # Make a grouping variable for each pos/neg segment
+ cat.rle = rle(df.interp.sub$score < 0)
+ df.interp.sub = df.interp.sub %>%
+ mutate(group = rep.int(1:length(cat.rle$lengths), times=cat.rle$lengths),
+ genus = unique(df.sub$genus) )
+ #rbind sub dataframes
+ df.interp = rbind(df.interp, df.interp.sub)
+
+ #get Area under curve (%)
+ df.AUC.sub = df.interp.sub %>%
+ mutate(positive = ifelse(score<0, 0, score),
+ negative = ifelse(score>0, 0, score))%>%
+ summarise(sum.pos = trapz(created, positive),
+ sum.neg = abs(trapz(created, negative)))%>%
+ mutate(percent.neg = round(sum.neg/(sum.pos+sum.neg)*100),
+ percent.pos = round(sum.pos/(sum.pos+sum.neg)*100),
+ genus = unique(df.sub$genus) )
+ #rbind sub dataframes
+ df.AUC = rbind(df.AUC, df.AUC.sub)
+ }
+
+
+##############################################################################################################################################
+
+
+# Plot
+######
+
+Monthly.plot = ggplot() +
+ geom_area(data = df.interp, aes(x = created, y = score, fill=score>0, group=group)) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+ geom_point(data=Results.df,
+ aes(x=term, y=estimate))+
+ geom_errorbar(data=Results.df,
+ aes(x=term, ymin=estimate-2*std.error, ymax=estimate+2*std.error), width=.2,
+ position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ geom_vline(xintercept=6.3, size=2, alpha=0.4)+
+ geom_text(data = df.AUC,
+ mapping = aes(x = -Inf, y = Inf, hjust = -.1, vjust = 1.5,
+ label = paste0(percent.neg,'% / ',percent.pos, '%')) ) +
+ xlab("")+ylab('Standardized effect')+
+ facet_wrap(~genus, scales="free_y", ncol=1)+
+ scale_x_continuous(breaks = seq(1,10,by=2),
+ labels = c('Jan','Mar','May','Jul','Sep'))+
+ plotTheme1+
+ theme(strip.text.x = element_blank())
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+###############
+## Safe plot ##
+###############
+
+
+
+#define plot layout
+layout <- "AB"
+
+#Merge plots
+Harvard_Plot = Monthly.plot + PartialReg.plot +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'a')&
+ theme(plot.tag = element_text(face = 'bold'))
+
+#save plots as .pdf
+ggsave(Harvard_Plot, file="Harvard_results.pdf", path=output_path,
+ width=6, height=10.5)
+
+Harvard_Plot
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## date time
+Sys.time()
+
+## session info
+sessionInfo()
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+```
\ No newline at end of file
diff --git a/R code/PEP_analysis/1_Data_extraction/1.2.1_Python_Code_GLDAS_Data_Extraction_AP_tier2.html b/R code/PEP_analysis/1_Data_extraction/1.2.1_Python_Code_GLDAS_Data_Extraction_AP_tier2.html
new file mode 100644
index 0000000..bc3cd1e
--- /dev/null
+++ b/R code/PEP_analysis/1_Data_extraction/1.2.1_Python_Code_GLDAS_Data_Extraction_AP_tier2.html
@@ -0,0 +1,14594 @@
+
+
+
+
+
+AutaumPhenologyTier02_Python_Code
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
{'type': 'Date', 'value': 1546203600000}
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/R code/PEP_analysis/1_Data_extraction/1.2.2_order_GLDAS_tables_AP_tier2.R b/R code/PEP_analysis/1_Data_extraction/1.2.2_order_GLDAS_tables_AP_tier2.R
new file mode 100644
index 0000000..2b76ea3
--- /dev/null
+++ b/R code/PEP_analysis/1_Data_extraction/1.2.2_order_GLDAS_tables_AP_tier2.R
@@ -0,0 +1,64 @@
+require(data.table)
+require(tidyverse)
+require(dplyr)
+
+## Set directories and get own PEP data
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Analysis")
+# paths
+GLDAS_path = "Analysis_input/Drivers/GLDAS/GLDAS_Extracted_Ver2"
+#PEPcsv_path = "PEP_data/PEPcsv"
+output_path = "Analysis_input/Drivers/GLDAS/GLDAS_Ordered_Ver2"
+
+##----------------------------------------
+
+## Phenology data
+#PEP.df <- fread(paste(PEPcsv_path, "pepData.csv", sep="/")) %>%
+# mutate(site_year = paste0(pep_id, '_', year))
+
+#identifiers
+vn1 <- c('Tair_f_inst.csv','Tair_f_inst.csv','Tair_f_inst.csv',
+ 'Qair_f_inst.csv','Rainf_f_tavg.csv',
+ 'SWdown_f_tavg.csv','Swnet_tavg.csv','Lwnet_tavg.csv',
+ 'SoilMoi0_10cm_inst.csv','SoilMoi10_40cm_inst.csv')
+vn2 <- c('Daily_Min_Data','Daily_Mean_Data','Daily_Max_Data',
+ 'Daily_Data','Daily_Data',
+ 'Daily_Data','Daily_Data','Daily_Data',
+ 'Daily_Data','Daily_Data')
+
+#function to subset last three characters in string
+subsetFunc = function(n) str_sub(n, -3,-1)
+#year vector
+year.vec = c(1948:2019)
+
+## Loop to safe tables (one for each variable)
+for(i in 1:length(vn1)) {
+
+ #create list of files to import
+ list=intersect(list.files(pattern = vn1[i], path=GLDAS_path),
+ list.files(pattern = vn2[i], path=GLDAS_path))
+
+ #list all tables
+ data=lapply(list, function(n) fread(file.path(GLDAS_path, n)))
+
+ #add year to each list element
+ for(x in 1:length(data)){
+ data[[x]]$year=year.vec[x]
+ }
+
+ #rbind them
+ data=rbindlist(data, fill=T)
+
+ #data wrangling
+ data = data %>%
+ dplyr::select(pep_id, year, lat, lon, everything(), -.geo, -`system:index`) %>%
+ rename_at(vars(-(1:4)), subsetFunc) %>% #keep only last three characters in column names
+ rename_at(vars(-(1:4)), readr::parse_number) %>% #keep only numbers in column names
+ #filter(site_year %in% PEP.df$site_year) %>% #match with PEP df
+ filter(!is.na(`180`)) %>%
+ arrange(pep_id,year)
+
+ #safe table
+ write.table(data, paste0(output_path,'/',vn2[i],"_",vn1[i]),sep=",",row.names=FALSE)
+}
diff --git a/R code/PEP_analysis/1_Data_extraction/1.3_Extract_Photoperiod.R b/R code/PEP_analysis/1_Data_extraction/1.3_Extract_Photoperiod.R
new file mode 100644
index 0000000..36e98f7
--- /dev/null
+++ b/R code/PEP_analysis/1_Data_extraction/1.3_Extract_Photoperiod.R
@@ -0,0 +1,73 @@
+# Load libraries
+require(data.table)
+require(geosphere)
+require(zoo)
+require(lubridate)
+require(tidyverse)
+
+
+##############################################################################################################################################
+
+
+######################################
+## Set directories and get PEP data ##
+######################################
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/PEP_analysis/Analysis")
+
+## Paths
+
+#Phenology
+PEPcsv_path = "PEP_data/PEPcsv"
+
+#Output
+PEP_drivers_path = "Analysis_input/Drivers"
+
+
+## load phenology data
+PEP.df <- fread(paste(PEPcsv_path, "pepData.csv", sep="/"))
+
+
+##############################################################################################################################################
+
+
+#################
+## Photoperiod ##
+#################
+
+
+# Get all time-points
+site <- unique(PEP.df$pep_id)
+
+# Initialize data frame to store results
+photo.df <- data.frame()
+i=1
+
+for(id in site) {
+
+ # Subset table according to latitude
+ photo.sub <- PEP.df %>%
+ filter(pep_id==id) %>%
+ dplyr::select(pep_id,lat)
+ photo.sub <- photo.sub[!duplicated(photo.sub$pep_id),]
+
+ # Calculate daily photoperiod for the whole year
+ photo <- daylength(photo.sub$lat,1:366)
+
+ # Add daily photoperiods to the subset table
+ photo.sub[as.character(1:366)] <- 0
+ photo.sub[,3:368] <- photo
+
+ photo.df <- rbind(photo.df,photo.sub)
+ print(paste0(round(i/length(site)*100, 1)," % of photoperiods calculated!"))
+ i=i+1
+}
+rm(photo.sub)
+
+# Export dataset
+write.table(photo.df,paste0(PEP_drivers_path ,"/Photoperiod.csv"),sep=",",row.names=FALSE)
+
+
+##############################################################################################################################################
diff --git a/R code/PEP_analysis/1_Data_extraction/1.4_Extract_CO2.R b/R code/PEP_analysis/1_Data_extraction/1.4_Extract_CO2.R
new file mode 100644
index 0000000..95e2540
--- /dev/null
+++ b/R code/PEP_analysis/1_Data_extraction/1.4_Extract_CO2.R
@@ -0,0 +1,96 @@
+require(data.table)
+require(tidyverse)
+
+##########################################
+## Set directories and get PEP data ##
+##########################################
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/PEP_analysis/Analysis")
+
+## Paths
+
+#CO2
+CO2_path = "Analysis_input/Drivers/CO2"
+
+#Phenology
+PEPcsv_path = "PEP_data/PEPcsv"
+
+
+## load phenology data
+PEP.df <- fread(paste(PEPcsv_path, "pepData.csv", sep="/"))
+
+#load mean of monthly atmospheric CO2 (mole fraction)
+CO2.df = fread(paste(CO2_path, "CO2_monthly.csv", sep="/"))
+
+##############################################################################################################################################
+
+##############
+## CO2 data ##
+##############
+
+#add year 2015 (= 2014 value + 2, based on Mauna Loa observations, https://www.esrl.noaa.gov/gmd/ccgg/trends/data.html)
+CO2_2015.df = CO2.df %>%
+ filter(year %in% 2014) %>% #keep only 2014
+ mutate(data = data+2, #add 2 ppm
+ year = as.integer(2015))
+CO2.df = rbind(CO2.df, CO2_2015.df)
+rm(CO2_2015.df)
+
+#filter latitude and year
+CO2.df = CO2.df %>%
+ filter(lat %in% 52.5 &
+ year %in% unique(PEP.df$year)) %>%
+ rename(CO2=data)%>% #rename columns
+ dplyr::select(-c(datetime, lat))
+
+#PEP site x year data
+PEP.df = PEP.df %>%
+ #add site x year identifier to PEP data
+ mutate(site_year=paste0(PEP.df$pep_id,"_",PEP.df$year)) %>%
+ #delete duplicates
+ filter(!duplicated(site_year))
+
+#create new dataframe
+PEP_CO2.df <- data.frame()
+
+# Loop through observation years
+for(yr in min(PEP.df$year):max(PEP.df$year)) {
+
+ # Subset by year
+ pheno.sub <- PEP.df %>%
+ filter(year == yr)
+ CO2.sub <- CO2.df %>%
+ filter(year == yr)
+
+ # Transpose CO2 monthly values to the phenological subset
+ pheno.sub[as.character(1:12)] <- 0
+ for(r in 1:nrow(pheno.sub)) {
+ pheno.sub[r,as.character(1:12)] <- t(CO2.sub$CO2)
+ }
+
+ # Bind final dataset
+ PEP_CO2.df <- rbind(PEP_CO2.df,pheno.sub)
+
+ print(yr)
+}
+
+# Data wrangling
+PEP_CO2.df <- PEP_CO2.df %>%
+ arrange(pep_id,year) %>%
+ select(pep_id, year, lat, lon, site_year, as.character(1:12))
+
+#Check CO2 data
+CO2.df$date = as.Date(paste0(CO2.df$year,"_15_",CO2.df$month),"%Y_%d_%m")
+ggplot(data=CO2.df, aes(x=date, y=CO2)) +
+ geom_line()+
+ xlab("Year") +
+ ylab("Atmospheric [CO2] (ppm)")
+
+# remove stuff
+rm(CO2.sub, CO2.df, PEP.df, pheno.sub)
+
+#safe CO2 table
+write.csv(PEP_CO2.df, paste(CO2_path, "CO2.csv", sep="/"))
+
+##############################################################################################################################################
diff --git a/R code/PEP_analysis/1_Data_extraction/1.5_Extract_soil_texture.R b/R code/PEP_analysis/1_Data_extraction/1.5_Extract_soil_texture.R
new file mode 100644
index 0000000..f3cbf31
--- /dev/null
+++ b/R code/PEP_analysis/1_Data_extraction/1.5_Extract_soil_texture.R
@@ -0,0 +1,112 @@
+require(rgdal)
+require(raster)
+require(soiltexture)
+require(data.table)
+require(tidyverse)
+
+
+##############################################################################################################################################
+
+
+######################################
+## Set directories and get PEP data ##
+######################################
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/PEP_analysis/Analysis")
+
+## Paths
+
+#Soil texture
+SoilTexture_path = "Analysis_input/Drivers/SoilTexture"
+
+#Phenology
+PEPcsv_path = "PEP_data/PEPcsv"
+
+
+## load phenology data
+PEPsites.df <- fread(paste(PEPcsv_path, "pepData.csv", sep="/")) %>%
+ filter(!duplicated(pep_id)) %>%
+ dplyr::select(pep_id, lat, lon)%>%
+ arrange(pep_id)
+
+
+##############################################################################################################################################
+
+
+###############
+## Soil data ##
+###############
+
+
+#Texture and clay content (for Zani photosynthesis model)
+
+# Get coordinates
+xy <- PEPsites.df %>%
+ dplyr::select(lon,lat)
+
+# Import raster files of soil texture
+
+# Soil images provided by ISRIC (World Soil Information)
+# SoilGrids
+# https://maps.isric.org/
+Soils_coarse <- raster(paste0(SoilTexture_path,'/','Layers/SoilTexture_0cm.tif')) # Coarse Fragments Volumetric in % at surface
+Soils_fine <- raster(paste0(SoilTexture_path,'/',"Layers/ClayContent_0cm.tif")) # Fine "Clay" content Mass Fraction in % at surface
+plot(Soils_coarse)
+plot(Soils_fine)
+
+# Create a spatial object
+spdf <- SpatialPointsDataFrame(coords = xy, data = PEPsites.df)
+
+# Extract fragment values from rasters using coordinates
+proj4string(spdf) <- CRS("+init=epsg:4326")
+Clay <- raster::extract(Soils_fine, spdf, cellnumbers = T)[,2]
+Silt <- raster::extract(Soils_coarse, spdf, cellnumbers = T)[,2]
+Sand <- 100-(Clay+Silt)
+
+fragment.df <- data.frame(
+ "CLAY" = Clay,
+ "SILT" = Silt,
+ "SAND" = Sand
+)
+
+# Get soil texture from fragment percentages
+texture.df <- TT.points.in.classes(
+ tri.data = fragment.df,
+ class.sys = "HYPRES.TT",
+ PiC.type = "l"
+)
+
+# Create dataframe of soil parameters and texture-to-parameter conversion
+# Ref. Sitch, S. et al. Evaluation of ecosystem dynamics, plant geography and terrestrial carbon cycling in the LPJ dynamic global vegetation model. Glob. Chang. Biol. 9, 161-185 (2003).
+soil_pars.df <- data.frame(
+ "w_max" = c(13,13,21,14.8,10),
+ "k_perc" = c(2,3,4,3.5,5),
+ "c_soil" = c(0.1,0.1,0.02,0.02,0.2),
+ row.names = c("VF","F","M","MF","C")
+)
+
+# Find soil parameters based on soil texture for each timeseries
+soil_pars_ts.df <- data.frame()
+for(row in 1:nrow(PEPsites.df)) {
+ sub.df <- texture.df[row,]
+ index <- min(which(sub.df == TRUE))
+ pars_ts <- soil_pars.df[index,]
+ pars_ts$pep_id <- PEPsites.df[row,]$pep_id
+ soil_pars_ts.df <- rbind(soil_pars_ts.df,pars_ts)
+ print(paste0("Soil parameters for ",PEPsites.df[row,]$pep_id," executed!"))
+}
+
+#remove stuff
+rm(PEP_CO2.df, fragment.df, pars_ts, soil_pars.df,
+ Soils_coarse, Soils_fine, xy, texture.df, spdf, data, PEPsites.df)
+
+hist(soil_pars_ts.df$w_max)
+table(soil_pars_ts.df$w_max)
+
+#safe soil texture table
+write.csv(soil_pars_ts.df, paste(SoilTexture_path, "SoilTexture.csv", sep="/"))
+
+
+##############################################################################################################################################
diff --git a/R code/PEP_analysis/1_Data_extraction/1.6_Extract_SPEI_AP_tier2.R b/R code/PEP_analysis/1_Data_extraction/1.6_Extract_SPEI_AP_tier2.R
new file mode 100644
index 0000000..0315e3e
--- /dev/null
+++ b/R code/PEP_analysis/1_Data_extraction/1.6_Extract_SPEI_AP_tier2.R
@@ -0,0 +1,100 @@
+require(data.table)
+require(lubridate)
+require(SPEI)
+require(tidyverse)
+
+##############################################################################################################################################
+
+##########################################
+## Set directories and get own PEP data ##
+##########################################
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Analysis")
+
+## Paths
+
+#1. Input
+GLDAS_path = "Analysis_input/Drivers/GLDAS/GLDAS_Ordered"
+
+#2. Output
+SPEI.df_path = "Analysis_input/Drivers"
+
+##############################################################################################################################################
+
+#################
+## Import data ##
+#################
+
+## Import daily climatic datasets from GLDAS
+vn <- c('Daily_Mean_Data_Tair_f_inst',
+ 'Daily_Data_Rainf_f_tavg')
+DataList <- replicate(length(vn),data.frame())
+for(i in 1:length(vn)) {
+ data <- fread(paste0(GLDAS_path, "/", vn[i],".csv"))
+ DataList[[i]] <- data
+}
+names(DataList)=vn
+
+## Unit conversions
+# Precipitation estimates are given as rate in kg m-2 s-1. We need mm d-1.
+# 1 kg of rain water spread over 1 square meter of surface is 1 mm in thickness
+# there are 60 X 60 X 24 = 86400 seconds in one day. Therefore, 1 kg m-2 s-1 = 86400 mm d-1
+#DataList[[4]][,as.character(1:366)]=DataList[[4]][,as.character(1:366)]*86400
+
+##############################################################################################################################################
+
+################################
+## Get SPEI and water balance ##
+################################
+
+Tmean.df = DataList[[1]] %>%
+ #long format
+ pivot_longer(., -c(pep_id, year, site_year, lat, lon)) %>%
+ #rename
+ rename(Tmean=value)%>%
+ #delete NAs
+ filter(!is.na(Tmean)) %>%
+ #create month-year identifier
+ mutate(doy = as.numeric(name)-1,
+ date = month(as.Date(doy, origin = paste0(year,"-01-01")))) %>%
+ #delete columns
+ select(pep_id, doy, date, year, Tmean, site_year, lat)
+
+Prcp.df = DataList[[2]] %>%
+ #long format
+ pivot_longer(., -c(pep_id, year, site_year, lat, lon)) %>%
+ #rename
+ rename(Prcp=value) %>%
+ #delete NAs
+ filter(!is.na(Prcp)) %>%
+ #create month-year identifier
+ mutate(doy = as.numeric(name)-1,
+ date = month(as.Date(doy, origin = paste0(year,"-01-01"))))%>%
+ #delete columns
+ select(pep_id, doy, date, year, Prcp)
+
+#merge dataframes
+daily.df = inner_join(Tmean.df, Prcp.df, by=c('pep_id','doy','date','year'))
+
+#get monthly values
+SPEI.df = as.data.frame(daily.df %>%
+ group_by(site_year,pep_id,year,date,lat) %>%
+ summarize(Tmonth=mean(Tmean),
+ Prcp=sum(Prcp))%>%
+ mutate(month=as.numeric(gsub(".*-","",date))) %>%
+ ungroup())
+
+#get SPEI, water balance and PET
+SPEI.df = as.data.frame(SPEI.df %>%
+ group_by(pep_id) %>%
+ mutate(PET = thornthwaite(Tmonth, lat[1]),
+ WB = Prcp-PET,
+ SPEI = spei(Prcp-PET,1)$fitted))%>%
+ select(c(site_year,year,month,SPEI,PET,WB))
+
+#Safe table
+write.csv(SPEI.df, paste(SPEI.df_path, "SPEI.csv", sep="/"))
+
+##############################################################################################################################################
+
diff --git a/R code/PEP_analysis/1_Data_extraction/1_PEPdownload_AP_tier2.Rmd b/R code/PEP_analysis/1_Data_extraction/1_PEPdownload_AP_tier2.Rmd
new file mode 100644
index 0000000..753197b
--- /dev/null
+++ b/R code/PEP_analysis/1_Data_extraction/1_PEPdownload_AP_tier2.Rmd
@@ -0,0 +1,236 @@
+---
+title: "Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice"
+subtitle: "R code to download, format, and clean the PEP725 data"
+---
+
+
+
+## 1. Load packages and set directories
+
+get packages
+```{r}
+require(devtools)
+require(phenor)
+require(data.table)
+require(reshape2)
+require(dplyr)
+require(ggplot2)
+require(data.table)
+require(maptools)
+require(maps)
+```
+
+
+set directories
+```{r}
+# set the working directory
+wd="/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/PEP_Analysis/Analysis/PEP_data"
+# paths
+tmp_path = paste(wd, "PEPzip", sep="/")
+PEPcsv_path = paste(wd, "PEPcsv", sep="/")
+```
+
+
+
+
+## 2. Download and merge PEP data
+
+show code
+```{r}
+## Download PEP data from website
+
+# load or download necessary data
+# [create a proper pep725login.txt file first]
+#check manually for errors. These are 1) umlauts and 2) missing phenology file info
+#download_pep725(credentials = "PEPcredentials/PEPcredentials.txt",
+# species= check_pep725_species(list = TRUE)$number,#download everything
+# internal = F,
+# path = tmp_path)
+
+#merge PEP files into one csv (check errors first)
+tidy_pep_data = merge_pep725(path=tmp_path)
+```
+
+
+
+
+## 3. Format and clean PEP data
+
+show code
+```{r, warning=F, message=F}
+#keep only leaf-out and leaf senescence observations
+tidy_pep_data = tidy_pep_data %>%
+ filter(bbch %in% c("10","11","13","94","95")) %>%
+ mutate(day=as.numeric(day))
+
+#check observed phenophases
+barplot(table(tidy_pep_data$bbch), las=2)
+
+#reshape table to short format (each bbch gets separate column)
+tidy_pep_data = dcast(tidy_pep_data, pep_id+year+country+species+lat+lon+alt ~ bbch, value.var = "day")
+
+#Check correlation between BBCH94 and BBCH95
+paste0("Pearson's r = ", round(cor.test(tidy_pep_data$`94`,tidy_pep_data$`95`)$estimate,2))
+paste0("R2 = ", round(summary(lm(tidy_pep_data$`94`~tidy_pep_data$`95`))$r.squared,2))
+
+#how many site x year combinations have both BBCH94 and BBCH95 dates?
+nrow(tidy_pep_data %>% filter(!is.na(`94`),
+ !is.na(`95`)))
+
+#Plot correlation
+ggplot(data=tidy_pep_data, aes(y= `94`, x= `95`)) +
+ geom_hex(bins=200)+
+ scale_fill_gradient2(low="grey95",mid='#E1AF00',"high"='#F21A00', midpoint=350)+
+ geom_smooth(method="lm", color='black') +
+ coord_cartesian(ylim = c(200,360), xlim = c(200,360))+
+ labs(x = 'BBCH95', y = 'BBCH94')+
+ theme_classic()
+
+#table operations
+tidy_pep_data = tidy_pep_data %>%
+ #rename bbch columns
+ rename(leaf_out10 = "10", leaf_out11 = "11", leaf_out13 = "13",
+ leaf_off94 = "94", leaf_off95 = "95") %>%
+
+ #keep only individuals that have leaf-out and leaf-off information
+ filter(complete.cases(leaf_off94 | leaf_off95)) %>%
+ filter(complete.cases(leaf_out10 | leaf_out11 | leaf_out13)) %>%
+ #keep only years after 1950
+ filter(year>1950) %>%
+
+ #create one leaf-out column (prefer bbch 10 for larix, bbch 11 for all other species)
+ mutate(leaf_out = ifelse(species == "Larix decidua" & complete.cases(leaf_out10), leaf_out10,
+ ifelse(species == "Larix decidua" & complete.cases(leaf_out11), leaf_out11,
+ ifelse(species == "Larix decidua" & complete.cases(leaf_out13), leaf_out13,
+ ifelse(species != "Larix decidua" & complete.cases(leaf_out11), leaf_out11,
+ ifelse(species != "Larix decidua" & complete.cases(leaf_out13), leaf_out13, leaf_out10)))))) %>%
+ #group by species and site
+ group_by(species, pep_id) %>%
+
+ #create leaf-off column: which is the most common autumn bbch within each time series?
+ mutate(classifier = ifelse(sum(!is.na(leaf_off94)) < sum(!is.na(leaf_off95)),
+ "useBBCH95", "useBBCH94"),
+ leaf_off = ifelse(classifier=="useBBCH94", leaf_off94, leaf_off95)) %>%
+
+ #delete NAs
+ filter(!is.na(leaf_off)) %>%
+
+ #Data cleaning
+ ##############
+ #delete dates deviating from median more than 4 times MAD
+ filter(!(abs(leaf_off-median(leaf_off))>4*mad(leaf_off) |
+ abs(leaf_out-median(leaf_out, na.rm=T))>4*mad(leaf_out, na.rm=T))) %>%
+ #delete time-series with standard deviation of leaf-off dates > 25
+ filter(!(sd(leaf_off, na.rm=T)>25 | sd(leaf_out, na.rm=T)>20)) %>%
+ #delete time series with less than 15 years
+ filter(n() >= 15) %>%
+
+ mutate(
+ #add mean leaf-out date
+ leaf_out_mean = round(mean(leaf_out)),
+ #add mean leaf-off date
+ leaf_off_mean = round(mean(leaf_off))) %>%
+ ungroup() %>%
+
+ #delete species with less than 35 time series
+ group_by(species) %>%
+ filter(length(unique(pep_id)) >= 35) %>%
+ ungroup() %>%
+
+ mutate(
+ #rename species
+ species = case_when(species == "Aesculus hippocastanum" ~ "Aesculus",
+ species == "Betula(Betula pendula_(B._verrucosa|_B._alba))" ~ "Betula pen.",
+ species == "Betula(Betula pubescens)" ~ "Betula pub.",
+ species == "Fagus(Fagus sylvatica)" ~ "Fagus",
+ species == "Larix decidua" ~ "Larix",
+ species == "Quercus robur_(Q.peduncula)" ~ "Quercus",
+ species == "Sorbus aucuparia" ~ "Sorbus",
+ species == "Tilia(Tilia cordata)" ~ "Tilia",
+ species == "Vitis vinifera" ~ "Vitis"),
+ #add timeseries identifier
+ timeseries = paste0(pep_id, "_", species)) %>%
+
+ #delete columns
+ select(-c(leaf_out10, leaf_out11, leaf_out13, leaf_off94, leaf_off95))#delete columns
+
+#Safe table
+#write.csv(tidy_pep_data, paste(wd, "PEPcsv/pepData.csv", sep="/"))
+
+check.BBCH = tidy_pep_data %>%
+ distinct(pep_id, species, .keep_all = T)
+
+table(check.BBCH$classifier)/nrow(check.BBCH)*100
+```
+
+
+
+
+## 4. Sample sizes
+
+show code
+```{r}
+#total observations
+nrow(tidy_pep_data)
+
+#how many species have data?
+length(unique(tidy_pep_data$species))
+
+#how many sites in total?
+length(unique(tidy_pep_data$pep_id))
+
+#time span
+range(tidy_pep_data$year)
+hist(tidy_pep_data$year, xlab="Year", main="Temporal distribution of data")
+
+#latitudinal gradient
+range(tidy_pep_data$lat)
+hist(tidy_pep_data$lat, xlab="Latitude", main="Latitudinal gradient")
+
+#elevational gradient
+range(tidy_pep_data$alt)
+hist(tidy_pep_data$alt, xlab="Elevation (m)", main="Elevational gradient")
+
+#leaf-out data
+mean(tidy_pep_data$leaf_out)
+sd(tidy_pep_data$leaf_out)
+range(tidy_pep_data$leaf_out)
+hist(tidy_pep_data$leaf_out, xlab="Leaf-out date", main="Leaf-out gradient")
+
+#leaf-off data
+mean(tidy_pep_data$leaf_off)
+sd(tidy_pep_data$leaf_off)
+range(tidy_pep_data$leaf_off)
+hist(tidy_pep_data$leaf_off, xlab="Senescence date", main="Senescence gradient")
+
+#Create summary dataframe
+sample.size = tidy_pep_data %>%
+ group_by(species) %>%
+ summarize(n.time.series = length(unique(pep_id)),
+ n.observations = n())
+
+#Sample sizes within species
+data.frame(sample.size)
+
+#Total amount of times series
+sum(sample.size$n.time.series)
+
+#Bar Plot
+sample.size = melt(sample.size, id.vars = c("species"), measure.vars = c("n.time.series","n.observations"))
+ggplot(sample.size, aes(x=species, y=value)) +
+ geom_bar(stat = "identity")+
+ theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) +
+ facet_wrap(~variable, nrow=2, scales="free_y")
+
+#Map the observations
+mp <- NULL
+mapWorld <- borders("world", colour="gray60", fill="gray60") # create a layer of borders
+mp <- ggplot() + mapWorld
+
+#Now Layer the stations on top
+mp <- mp + geom_point(data=tidy_pep_data[!duplicated(tidy_pep_data[ , c("lat", "lon")]), ],
+ aes(x=lon, y=lat) ,color="blue", size=.3) +
+ coord_cartesian(ylim = c(43, 69), xlim = c(-10, 31))
+mp
+```
+
diff --git a/R code/PEP_analysis/2_Add_drivers/2.1_Add_Drivers_mcLapply_AP_tier2_v4.1.R b/R code/PEP_analysis/2_Add_drivers/2.1_Add_Drivers_mcLapply_AP_tier2_v4.1.R
new file mode 100644
index 0000000..9762404
--- /dev/null
+++ b/R code/PEP_analysis/2_Add_drivers/2.1_Add_Drivers_mcLapply_AP_tier2_v4.1.R
@@ -0,0 +1,1256 @@
+##############################################################################################################################################
+############################################################# Rscript for: ###################################################################
+##############################################################################################################################################
+#### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ####################################
+##############################################################################################################################################
+# This script extracts the climate drivers for the PEP725 data ###############################################################################
+##############################################################################################################################################
+
+
+
+#required packages
+require(data.table)
+require(sf)
+require(ncdf4)
+require(raster)
+require(tidyverse)
+require(sp)
+require(rpmodel)
+require(purrr)
+require(pbmcapply)
+require(zoo)
+require(chillR)
+require(lubridate)
+require(weathermetrics)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################################
+## Set directories and get own PEP data ##
+##########################################
+
+
+
+# Set the working directory
+setwd("/Users/crowtherlabstation02/Desktop/Analysis/PEP_analysis/Analysis")
+
+
+#########
+# Paths #
+#########
+
+
+# 1. Input
+##########
+
+#Climate
+GLDAS_path = "Analysis_input/Drivers/GLDAS"
+
+#CO2
+CO2_path = "Analysis_input/Drivers/CO2"
+
+#Photoperiod and AET/PET
+clim_path = "Analysis_input/Drivers"
+
+#Soil
+SoilTexture_path = "Analysis_input/Drivers/SoilTexture"
+
+#Phenology
+PEPcsv_path = "PEP_data/PEPcsv"
+
+
+# 2. Output
+###########
+
+PEP_drivers_path = "Analysis_input/PEP_drivers_final/Individual_files"
+PEP_drivers_path2 = "Analysis_input/PEP_drivers_final/Merged_file"
+PEP_drivers_path3 = "Analysis_input/PEP_drivers_final/Missing_observations"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+## Phenology data
+#################
+
+PEP.df <- fread(paste(PEPcsv_path, "pepData.csv", sep="/")) %>%
+ #order table
+ arrange(species, pep_id, year) %>%
+ #keep only Aesculus, Betula, Fagus, and Quercus
+ filter(species %in% c('Aesculus','Betula pen.','Fagus','Quercus')) %>%
+ group_by(timeseries) %>%
+ #delete groups with less than 15 rows
+ filter(n() >= 15)%>%
+ #delete timeseries above 65 latitude
+ filter(lat<65) %>%
+ #rename Betula pendula
+ mutate(species = dplyr::recode(species, `Betula pen.`="Betula"),
+ timeseries = paste0(pep_id, '_', species),
+ leaf_off_max = max(leaf_off)) %>%
+ ungroup()
+
+
+## AET/PET map
+##############
+
+#annual AET/PET ratio from SPLASH model
+AET_PET.raster = raster(paste(clim_path, "AET_PET_ratio_global_FULL_MODIS-C006_MOD15A2_v1.alpha_MEANANN.nc", sep="/"))
+
+
+## CO2 data
+###########
+
+CO2.df = fread(paste(CO2_path, "CO2.csv", sep="/"))
+
+
+## Photoperiod
+##############
+
+photo.df = fread(paste(clim_path, "Photoperiod.csv", sep="/"))
+
+
+## Soil Texture
+###############
+
+SoilTexture.df = fread(paste(SoilTexture_path, "SoilTexture.csv", sep="/"))
+
+
+## SPEI
+#######
+
+SPEI.df = fread(paste(clim_path, "SPEI.csv", sep="/"))
+
+
+## Import daily climatic datasets from GLDAS
+############################################
+
+#define climate variables
+vn <- c('Daily_Mean_Data_Tair_f_inst','Daily_Min_Data_Tair_f_inst','Daily_Max_Data_Tair_f_inst',
+ 'Daily_Data_Rainf_f_tavg','Daily_Data_Qair_f_inst',
+ 'Daily_Data_SoilMoi0_10cm_inst','Daily_Data_SoilMoi10_40cm_inst',
+ 'Daily_Data_Swnet_tavg','Daily_Data_Lwnet_tavg','Daily_Data_SWdown_f_tavg')
+#create empty list
+DataList <- replicate(length(vn),data.frame())
+#loop through climate variables
+for(i in 1:length(vn)) {
+ #read data
+ data = fread(paste0(GLDAS_path, "/", vn[i],".csv")) %>%
+ #add site x year identifier
+ mutate(site_year = paste0(pep_id, '_', year)) %>%
+ #order table
+ dplyr::select(site_year, pep_id, year, lat, lon, everything())
+ #add table to list
+ DataList[[i]] <- data
+}
+#add names to list
+names(DataList)=vn
+# Note: Precipitation is given as rate in mm d-1.
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+####################################################
+## Add Soil texture, PFT, and AET/PET (meanalpha) ##
+####################################################
+
+
+
+#Add w_max (soil texture-dependent difference between field capacity and wilting point [%])
+PEP.df = merge(PEP.df, SoilTexture.df[,c('pep_id','w_max')], by='pep_id')
+
+#Add plant functional type info
+PEP.df$PFT <- "TBL" # T-BL-SG: Temperate broad-leaved summergreen tree
+#PEP.df[PEP.df$species=='Larix',]$PFT <- "BNL" # B-NL-SG: Boreal needle-leaved summergreen tree
+
+#Add AET-PET ratio (required for pmodel)
+PEP.df =
+ #both tables together
+ cbind(PEP.df,
+ # intersection
+ data.frame(AET_PET=raster::extract(AET_PET.raster, PEP.df[, c("lon", "lat")])))
+
+#remove stuff
+rm(AET_PET.raster, SoilTexture.df)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+###############
+## Constants ##
+###############
+
+
+
+## Constants in the Photosynthesis module
+po2 <- 20.9e3 #O2 partial pressure in Pa
+p <- 1.0e5 # atmospheric pressure in Pa
+bc3 <- 0.015 # leaf respiration as fraction of Vmax for C3 plants
+theta <- 0.7 # colimitation (shape) parameter
+q10ko <- 1.2 #q10 for temperature-sensitive parameter ko
+q10kc <- 2.1 # q10 for temperature-sensitive parameter kc
+q10tau <- 0.57 # q10 for temperature-sensitive parameter tau
+ko25 <- 3.0e4 # value of ko at 25 deg C
+kc25 <- 30.0 # value of kc at 25 deg C
+tau25 <- 2600.0 # value of tau at 25 deg C
+alphaa <- 0.5 # fraction of PAR assimilated at ecosystem level relative to leaf level
+alphac3 <- 0.08 # intrinsic quantum efficiency of CO2 uptake in C3 plants
+lambdamc3 <- 0.8 # optimal (maximum) lambda in C3 plants
+cmass <- 12.0107 # molecular mass of C [g mol-1]
+cq <- 2.04e-6 # conversion factor for solar radiation from J m-2 to mol m-2
+n0 <- 7.15 # leaf N concentration (mg/g) not involved in photosynthesis
+m <- 25.0 # corresponds to parameter p in Eqn 28, Haxeltine & Prentice 1996
+t0c3 <- 250.0 # base temperature (K) in Arrhenius temperature response function for C3 plants
+e0 <- 308.56 # parameter in Arrhenius temp response function
+tk25 <- 298.15 # 25 deg C in Kelvin
+tmc3 <- 45.0 # maximum temperature for C3 photosynthesis
+## Constants in the Water balance module
+gamma <- 65 # psychrometer constant gamma [Pa/K]
+L <- 2.5*10^6 # latent heat of vaporization of water L [J/kg]
+emissivity <- 0.6 # emissivity for coniferous and deciduous surface type
+k_sb <- 5.670367*10^-8 # Stefan-Boltzman constant [W/m^2 K^4]
+d1 <- 0.5 # thickness of upper soil layer [m]
+d2 <- 1 # thickness of lower soil layer [m]
+a_m <- 1.391 # maximum Priestley-Taylor coefficient a_m
+g_m <- 3.26 # scaling conductance g_m [mm/s]
+k_melt <- 3 # rate of snowmelt [mm/???C d]
+
+## Soil parameters depending on texture [Phenologoy_CO2_soil dataset]
+E_max <- 5 # maximum transpiration rate that can be sustained under well-watered conditions E_max [mm/d] --> depends on plant functional type (same for T-BD-SG and B-NL-SG)
+# w_max = soil texture-dependent difference between field capacity and wilting point w_max [%]
+# c_soil = soil texture-dependent maximum rate of ETA from the bare soil [mm/h]
+# k_perc = soil texture-dependent conductivity cond_soil or percolation rate field capacity [mm/d]
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+######################
+## Helper functions ##
+######################
+
+
+# Temperate inhibition function from LPJ-GUESS
+##############################################
+
+temp_opt.fun <- function(temp) {
+ x1 <- 1
+ x2 <- 18
+ x3 <- 25
+ x4 <- 45
+ k1 <- 2.*log((1/0.99)-1.)/(x1-x2)
+ k2 <- (x1+x2)/2
+ low <- 1/(1+exp(k1*(k2-temp)))
+ k3 <- log(0.99/0.01)/(x4-x3)
+ high <- 1-0.01*exp(k3*(temp-x3))
+ tstress <- low*high
+ if(tstress>=0) {
+ tstress <- tstress
+ } else {
+ tstress <- 0
+ }
+ return(tstress)
+}
+
+
+# convert degC to kPa
+#####################
+degC_to_kPa.fun <- function(temp) {
+ out <- 0.6108*exp((17.27*temp)/(temp+237.3))
+ return(out)
+}
+
+
+# Photoperiod function
+######################
+
+# photo = photoperiod
+# photo_min = minimum value during the growing season --> limited canopy development
+# photo_max = maxmum value during the growing season --> allows canopies to develop unconstrained
+photoperiod.fun <- function(photo, photo_min, photo_max) {
+ if(photo<=photo_min) {
+ photo_resp <- 0
+ }
+ if(photophoto_min) {
+ photo_resp <- (photo-photo_min)/(photo_max-photo_min)
+ }
+ if(photo>=photo_max) {
+ photo_resp <- 1
+ }
+ return(photo_resp)
+}
+
+
+# Vapour Pressure Deficit (VPD) function
+########################################
+
+# VPD = vapour pressure deficit [kPa]
+# T_min & T_max = minimum and maximum daily temperature [C]
+# VPD_min --> at low values, latent heat losses are unlikely to exceed available water
+# little effect on stomata
+# VPD_max --> at high values, particularly if sustained, photosynthesis and growth are likely to be significantly limited
+# complete stomatal closure
+
+VPD.fun <- function(VPD, VPD_min, VPD_max) {
+ if(VPD>=VPD_max) {
+ y <- 0
+ }
+ if(VPDVPD_min) {
+ y <- 1-((VPD-VPD_min)/(VPD_max-VPD_min))
+ }
+ if(VPD<=VPD_min) {
+ y <- 1
+ }
+ return(y)
+}
+
+
+# Convert specific to relative humidity
+#######################################
+
+qair2rh <- function(qair, temp, press = 1013.25){
+ es <- 6.112 * exp((17.67 * temp)/(temp + 243.5))
+ e <- qair * press / (0.378 * qair + 0.622)
+ rh <- e / es
+ rh[rh > 1] <- 1
+ rh[rh < 0] <- 0
+ return(rh)
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#######################################################
+## Calculate climatic predictors using Parallel calc ##
+#######################################################
+
+
+
+# Identifier 1 (all site x year combinations)
+PEP.df$site_year = paste0(PEP.df$pep_id,"_",PEP.df$year)
+
+# Identifier 2 (all timeseries x year combinations)
+PEP.df$ts_yr = paste0(PEP.df$timeseries,"_",PEP.df$year)
+timeseries_year = unique(PEP.df$ts_yr)
+
+# add PEP data (+plant functional type label) and photoperiod to list
+DataList[[11]] = photo.df
+DataList[[12]] = CO2.df
+DataList[[13]] = SPEI.df
+DataList[[14]] = PEP.df
+
+rm(photo.df, CO2.df, data, PEP.df)
+names(DataList)=c(vn,"photoperiod",'CO2','SPEI',"PEP")
+names(DataList)
+#[1] "Daily_Mean_Data_Tair_f_inst" "Daily_Min_Data_Tair_f_inst" "Daily_Max_Data_Tair_f_inst"
+#[4] "Daily_Data_Rainf_f_tavg" "Daily_Data_Qair_f_inst" "Daily_Data_SoilMoi0_10cm_inst"
+#[7] "Daily_Data_SoilMoi10_40cm_inst" "Daily_Data_Swnet_tavg" "Daily_Data_Lwnet_tavg"
+#10] "Daily_Data_SWdown_f_tavg" "photoperiod" "CO2"
+#[13] "SPEI" "PEP"
+
+
+##############################################################################################################################################
+
+
+################################
+# Loop through all time-points #
+################################
+
+
+parallelCalc <- function(timeseries_years){
+
+ # Subset input data by time-point
+ #################################
+
+ #phenology data
+ pheno.sub <- DataList[[14]][which(DataList[[14]]$ts_yr==timeseries_years),]
+
+ #daily mean temperature
+ TMEAN <- DataList[[1]][which(DataList[[1]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #Skip timeseries for which there is no data
+ if (nrow(TMEAN)==0) {
+ write.table(pheno.sub, file=paste0(PEP_drivers_path3, '/', timeseries_years, '.csv'), sep=',', row.names = F, col.names = T)
+ } else {
+
+ #daily minimum temperature
+ TMIN <- DataList[[2]][which(DataList[[2]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #daily maximum temperature
+ TMAX <- DataList[[3]][which(DataList[[3]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #precipitation
+ PRCP <- DataList[[4]][which(DataList[[4]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #air humidity
+ QAIR <- DataList[[5]][which(DataList[[5]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #soil moisture (<10cm)
+ MOIST10 <- DataList[[6]][which(DataList[[6]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #soil moisture (10-40 cm)
+ MOIST40 <- DataList[[7]][which(DataList[[7]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #net short-wave radiation
+ SWRAD <- DataList[[8]][which(DataList[[8]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #net long-wave radiation
+ LWRAD <- DataList[[9]][which(DataList[[9]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #short-wave radiation down
+ SWRADdown <- DataList[[10]][which(DataList[[10]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #day length
+ PHOTO <- DataList[[11]][which(DataList[[11]]$lat==pheno.sub$lat),][1]%>%
+ dplyr::select(as.character(1:366))
+
+ #CO2 (monthly)
+ CO2 <- as.data.frame(t(DataList[[12]][which(DataList[[12]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:12)))) %>%
+ rename(CO2 = V1)%>%
+ mutate(Month = as.numeric(1:12))
+
+
+ ##############################################################################################################################################
+
+
+ # Create table of daily climate
+ ###############################
+
+ # Generate sub-dataframe to store results
+ factors.sub <- pheno.sub %>%
+ dplyr::select(pep_id,species,timeseries,year,lat,lon,alt,leaf_out,leaf_off,leaf_off_mean) %>%
+ mutate(CO2 = CO2$CO2[6])
+
+ # Define the current year in calendar units
+ year <- as.character(pheno.sub$year)
+ start_doy <- paste(year,"-01-01", sep="")
+ end_doy <- paste(year,"-12-31", sep="")
+ days <- seq(as.Date(start_doy), as.Date(end_doy), by="days")
+
+ #create table
+ daily_vals <- data.frame(Year = year,
+ Month = 0,
+ Day = 0,
+ Tmin = as.numeric(TMIN),
+ Tmean = as.numeric(TMEAN),
+ Tmax = as.numeric(TMAX),
+ SWrad = as.numeric(SWRAD),
+ LWrad = as.numeric(LWRAD),
+ SWradDown= as.numeric(SWRADdown),
+ Moist10 = as.numeric(MOIST10),
+ Moist40 = as.numeric(MOIST40),
+ Prcp = as.numeric(PRCP),
+ Qair = as.numeric(QAIR),
+ Photo = as.numeric(PHOTO))
+
+ #Add climate variables and data wrangling
+ daily_vals = daily_vals %>%
+ filter(!is.na(Tmean)) %>%#delete NAs
+ mutate(
+ #add month and day identifiers
+ Month = lubridate::month(as.Date(days,origin=days[1])),
+ Day = lubridate::day(as.Date(days,origin=days[1])),
+ #relative humidity
+ RH = qair2rh(Qair, Tmean)*100,
+ #dewpoint temperature
+ Tdew = weathermetrics::humidity.to.dewpoint(t = Tmean,
+ rh = RH,
+ temperature.metric = "celsius")) %>%
+ #Add CO2
+ left_join(CO2, by = "Month")
+
+ #set NAs to 0
+ daily_vals[is.na(daily_vals)] <- 0.0001
+
+
+ ##############################################################################################################################################
+
+
+ # Get average daytime temperature (chillR package)
+ ##################################################
+
+ #Get hourly values
+ hourly_vals = stack_hourly_temps(daily_vals, latitude=pheno.sub$lat)$hourtemps
+
+ #get daytime temperature
+ daytime_temp = data.frame(hourly_vals %>%
+ group_by_at(vars(-c(Temp,Hour))) %>%
+ #delete night hours
+ filter(between(Hour,
+ daylength(latitude=pheno.sub$lat,JDay=JDay[1])$Sunrise,
+ daylength(latitude=pheno.sub$lat,JDay=JDay[1])$Sunset))%>%
+ #summarise daytime hours
+ summarise(Tday = mean(Temp))%>%
+ ungroup() %>%
+ #order
+ dplyr::select(Tday) )
+
+ #get nighttime temperature
+ nighttime_temp = data.frame(hourly_vals %>%
+ group_by_at(vars(-c(Temp,Hour))) %>%
+ #delete day hours
+ filter(!between(Hour,
+ daylength(latitude=pheno.sub$lat,JDay=JDay[1])$Sunrise,
+ daylength(latitude=pheno.sub$lat,JDay=JDay[1])$Sunset))%>%
+ #summarise daytime hours
+ summarise(Tnight = mean(Temp))%>%
+ ungroup() %>%
+ #order
+ dplyr::select(Tnight) )
+
+ #combine
+ daily_vals = cbind(daily_vals, daytime_temp, nighttime_temp) %>%
+ #growing-degree-days (>0??C)
+ mutate(GDDday = ifelse(Tday < 0 , 0, Tday),
+ GDDnight = ifelse(Tnight < 0 , 0, Tnight))%>%
+ #order
+ dplyr::select(Year, Month, Day, Tmin, Tmean, Tmax, Tday, Tnight, everything())
+
+
+ ##############################################################################################################################################
+
+
+ # Get important dates
+ #####################
+
+ # warmest day of year
+ factors.sub$HottestDOY = mean(which(daily_vals$Tmax==max(daily_vals$Tmax)))
+
+ # day of maximum radiation
+ factors.sub$MaxRadDOY = mean(which(daily_vals$SWrad==max(daily_vals$SWrad)))
+
+ # longest day of year (summer solstice)
+ solstice = which(daily_vals$Photo==max(daily_vals$Photo))[1]
+
+ # March equinox
+ equinox.Mar = solstice - 97
+
+ # September equinox
+ equinox.Sep = solstice + 97
+
+ # Mean leaf senescence
+ DOY_off <- pheno.sub$leaf_off_mean
+
+ # leaf-out
+ DOY_out <- ifelse(pheno.sub$leaf_out >= solstice, solstice-1, pheno.sub$leaf_out)
+
+
+ ##############################################################################################################################################
+
+
+ # Photosynthesis calculation
+ ############################
+
+ # GSI, Daily Net Photosynthesis rate (dA_n) and water stress factor (dw) are calculated daily
+ # and then accumulated by summation
+
+ # Initialize vector to store daily values
+ iGSI_year <- vector()
+ iGSIrad_year <- vector()
+ VPD_year <- vector()
+ iVPD_year <- vector()
+ #dA_tot_year <- vector()
+ dA_totw_year <- vector()
+
+
+ # Loop through days of the growing season
+ for(i in 1:nrow(daily_vals)) {
+
+
+ ############################################
+ ## Cumulative Growing Season Index (cGSI) ##
+ ############################################
+
+ # modified from Jolly et al. 2005
+
+ # GSI...photoperiod-based growing-season index
+ # GSI...irradiance-based growing-season index
+ # VPD...vapor pressure deficit
+ # iVPD...vapor pressure deficit function values
+
+ # set VPD min and max
+ #####################
+
+ # Reference: White MA, Thornton PE, Running SW et al. (2000) Parameterization and sensitivity analysis of
+ # the BIOME???BGC terrestrial ecosystem model: net primary production controls. Earth Interactions, 4, 1???85.
+ if(pheno.sub$species=="Betula") {
+ VPD_min <- 1.0
+ VPD_max <- 4.0
+ } else {
+ if(pheno.sub$species=="Fagus") {
+ VPD_min <- 0.6
+ VPD_max <- 3.0
+ } else {
+ #median of all broadleaf tree species in White et al. 2000
+ VPD_min <- 1.0
+ VPD_max <- 3.5
+ } }
+
+ # Estimate photoperiod thresholds based on the maximum and minimum values of the growing season
+ photo_min <- min(daily_vals$Photo)
+ photo_max <- max(daily_vals$Photo)
+
+ # e_s: saturation vapour pressure [kPa]
+ e_s <- (degC_to_kPa.fun(temp=daily_vals$Tmax[i]) + degC_to_kPa.fun(temp=daily_vals$Tmin[i])) / 2
+
+ # e_a: derived from dewpoint temperature [kPa]
+ e_a <- degC_to_kPa.fun(temp=daily_vals$Tdew[i])
+
+ # VPD: Vapour pressure deficit [kPa]
+ VPD <- e_s-e_a
+ VPD_year <- c(VPD_year,VPD)
+
+ # apply vapor pressure deficit funtion
+ iVPD <- VPD.fun(VPD, VPD_min, VPD_max)
+ iVPD_year <- c(iVPD_year, iVPD)
+
+ # iOpt_temp: response to optimal temperature (Gompertz function)
+ iOpt <- temp_opt.fun(daily_vals$Tday[i])
+
+ # iPhoto: photoperiod response
+ iPhoto <- photoperiod.fun(daily_vals$Photo[i], photo_min, photo_max)
+
+ # iRadiation
+ # get maximum radiation at the site (field capacity)
+ max.rad = max(DataList[[8]][which(DataList[[8]]$pep_id==pheno.sub$pep_id), c(as.character(1:365))], na.rm=T)
+ iRad <- daily_vals$SWrad[i] / max.rad
+
+ # Calculate daily GSI
+ iGSI <- as.numeric(iVPD*iOpt*iPhoto)
+ iGSIrad <- as.numeric(iVPD*iOpt*iRad)
+
+ # Add to the cumulative cGSI
+ iGSI_year <- c(iGSI_year,iGSI)
+ iGSIrad_year <- c(iGSIrad_year,iGSIrad)
+
+ #----------------------------------------------------------------------------------------------
+
+ ############################
+ ## Zani et al. 2020 model ##
+ ############################
+
+ # Net photosynthesis rate (PHOTOSYNTHESIS-CONDUCTANCE MODEL, ref. Sitch et al. 2003)
+
+ # apar: daily integral of absorbed photosynthetically active radiation (PAR), J m-2 d-1
+ # Eqn 4, Haxeltine & Prentice 1996
+ # alphaa: scaling factor for absorbed PAR at ecosystem, versus leaf, scale
+ # nearly half of short-wave radiation is PAR --> mean annual value of 0.473 observed for the irradiance ratio
+ # in the PAR (ref. Papaioannou et al. 1993) plus 8% reflected and transmitted
+ # convert in J/m^-2 day: the power in watts (W) is equal to the energy in joules (J), divided by the time period in seconds (s):
+ # --> 1 Watt = 1 Joule/second, therefore j = W*86400
+ apar <- alphaa * daily_vals$SWrad[i] * 60 * 60 * 24
+
+ # Calculate temperature inhibition function limiting photosynthesis at low and high temperatures (ref. Sitch et al. 2002)
+ tstress <- temp_opt.fun(daily_vals$Tday[i])
+
+ # Calculate catalytic capacity of rubisco, Vm, assuming optimal (non-water-stressed) value for lambda, i.e. lambdamc3
+ # adjust kinetic parameters for their dependency on temperature
+ # i.e. relative change in the parameter for a 10 degC change in temperature
+ # Eqn 22, Haxeltine & Prentice 1996a
+
+ ko <- ko25*q10ko**((daily_vals$Tday[i]-25.0)/10.0) # Michaelis constant of rubisco for O2
+ kc <- kc25*q10kc**((daily_vals$Tday[i]-25.0)/10.0) # Michaelis constant for CO2
+ tau <- tau25*q10tau**((daily_vals$Tday[i]-25.0)/10.0)# CO2/O2 specificity ratio
+
+ # gammastar: CO_2 compensation point [CO2 partial pressure, Pa]
+ # Eqn 8, Haxeltine & Prentice 1996
+ gammastar <- po2/(2.0*tau)
+
+ # Convert ambient CO2 level from mole fraction to partial pressure, Pa
+ pa <- daily_vals$CO2[i]*p
+
+ # p_i: non-water-stressed intercellular CO2 partial pressure, Pa
+ # Eqn 7, Haxeltine & Prentice 1996
+ p_i <- pa*lambdamc3
+
+ # Calculate coefficients
+ # Eqn 4, Haxeltine & Prentice 1996
+ c1 <- tstress*alphac3*((p_i-gammastar)/(p_i+2.0*gammastar))
+
+ # Eqn 6, Haxeltine & Prentice 1996
+ c2 <- (p_i-gammastar)/(p_i+kc*(1.0+po2/ko))
+ b <- bc3 # choose C3 value of b for Eqn 10, Haxeltine & Prentice 1996
+ t0 <- t0c3 # base temperature for temperature response of rubisco
+
+ # Eqn 13, Haxeltine & Prentice 1996
+ s <- (24.0 / daily_vals$Photo[i] ) * b
+
+ # Eqn 12, Haxeltine & Prentice 1996
+ sigma <- sqrt(max(0.0,1.0-(c2-s)/(c2-theta*s)))
+
+ # vm: optimal rubisco capacity, gC m-2 d-1
+ # Eqn 11, Haxeltine & Prentice 1996
+ # cmass: the atomic weight of carbon, used in unit conversion from molC to g
+ # cq: conversion factor from apar [J m-2] to photosynthetic photon flux density [mol m-2]
+ vm <- (1.0/b)*(c1/c2)*((2.0*theta-1.0)*s-(2.0*theta*s-c2)*sigma)*apar*cmass*cq
+
+ # je: PAR-limited photosynthesis rate, gC m-2 h-1
+ # Eqn 3, Haxeltine & Prentice 1996
+ # Convert je from daytime to hourly basis
+ if(daily_vals$Photo[i]==0) {
+ je <- 0
+ } else {
+ je <- c1*apar*cmass*cq / daily_vals$Photo[i]
+ }
+
+ # jc: rubisco-activity-limited photosynthesis rate, gC m-2 h-1
+ # Eqn 5, Haxeltine & Prentice 1996
+ jc <- c2*vm/24.0
+
+ # agd: daily gross photosynthesis, gC m-2 d-1
+ # Eqn 2, modified with k_shape (theta)
+ if(je<1e-10 | jc<=1e-10) {
+ agd <- 0
+ } else {
+ agd <- (je+jc-sqrt((je+jc)**2.0-4.0*theta*je*jc))/(2.0*theta) * daily_vals$Photo[i]
+ }
+
+ # rd: daily leaf respiration, gC m-2 d-1
+ # Eqn 10, Haxeltine & Prentice 1996
+ rd <- b*vm
+
+ # and: daily net photosynthesis (at leaf level), gC m-2 d-1
+ and <- agd-rd
+
+ # adt: total daytime net photosynthesis, gC m-2 d-1
+ # Eqn 19, Haxeltine & Prentice 1996
+ adt <- and + (1.0 - daily_vals$Photo[i] / 24.0) * rd
+
+ # Convert adt from gC m-2 d-1 to mm m-2 d-1 using ideal gas equation
+ #adtmm <- adt / cmass * 8.314 * (daily_vals$TMEAN[i] + 273.3) / p * 1000.0
+
+ # Store the daily result in the yearly vector
+ #dA_tot_year <- c(dA_tot_year,adt) #daytime net photosynthesis
+
+
+ ## Water Stress Factor (ref. Gerten et al. 2004)
+ ################################################
+
+ # soil is treated as a simple bucket consisting of two layers with fixed thickness
+
+ # Calculate potential evapotranspiration (ETA) rate, E_pot, mm d-1
+
+ # delta: rate of increase of the saturation vapour pressure with temperature
+ delta <- (2.503*10^6 * exp((17.269 * daily_vals$Tday[i]) / (237.3 + daily_vals$Tday[i]))) / (237.3 + daily_vals$Tday[i])^2
+
+ # R_n: istantaneous net radiation, W m-2 = R_s net short-wave radiation flux + R_l net long-wave flux
+ R_n <- daily_vals$SWrad[i] + daily_vals$LWrad[i]
+
+ # E_eq: equilibrium EvapoTranspiration
+ # from seconds to day
+ E_eq <- 24 * 3600 * (delta / (delta + gamma)) * (R_n / L)
+
+ # E_pot: potential EvapoTranspiration = equilibrium ETA * Priestley-Taylor coefficient
+ E_pot <- E_eq*a_m
+
+ # ratio: stomata-controlled ratio between intercellular and ambient CO2 partial pressure in the absence of water limitation
+ ratio <- p_i/pa # ca. 0.8
+
+ # g_min: minimum canopy conductance, mm s-1
+ # depends on PFT
+ if(pheno.sub$PFT=="TBL") {
+ g_min <- 0.5*3600*24 # from seconds to day
+ } else {
+ g_min <- 0.3*3600*24
+ }
+
+ # g_pot: nonwater-stressed potential canopy conductance, mm s-1
+ g_pot <- g_min + ((1.6*adt)/((pa/p)*(1-ratio)))
+
+ # E_demand: atmoshperic demand
+ # unstressed transpiration which occurs when stomatal opening is not limited by reduced water potential in the plant
+ E_demand <- E_pot/(1+(g_m/g_pot))
+
+ # root1/2: fraction of roots present in the respective layers
+ # depends on PFT
+ if (pheno.sub$PFT=="TBL") {
+ root1 <- 0.7
+ root2 <- 0.3
+ } else {
+ root1 <- 0.9
+ root2 <- 0.1
+ }
+
+ # relative soil moisture wr:
+ # ratio between current soil water content and plant-available water capacity
+ # wr ratio is computed for both soil layers by
+ # weighting their relative soil water contents (w1, w2)
+ # with the fraction of roots present in the respective layer
+ w1 <- daily_vals$Moist10[i]
+ w2 <- daily_vals$Moist40[i]
+
+ # soil texture-dependent difference between field capacity and wilting point w_max [%]
+ w_max <- pheno.sub$w_max
+ wr <- root1*(w1/w_max) + root2*(w2/w_max)
+
+ # E_supply: plant- and soil-limited supply function
+ E_supply <- as.numeric(E_max*wr)
+
+ # dw: daily water stress factor
+ dw <- min(1,(E_supply/E_demand))
+
+ # dA_totw: daily net photosynthesis modified by water stress factor
+ dA_totw <- adt*dw
+
+ # Add daily result to the yearly vector
+ dA_totw_year <- c(dA_totw_year, dA_totw)
+
+ } # END loop through days of the growing season
+
+ #set values before leaf-out to zero
+ iGSI_year[1:DOY_out] = 0
+ iGSIrad_year[1:DOY_out] = 0
+ dA_totw_year[1:DOY_out] = 0
+
+ #set negative values to zero
+ VPD_year[VPD_year<=0] = 0.001
+ dA_totw_year[dA_totw_year<0] = 0
+
+ #add VPD to daily table
+ daily_vals$VPD = VPD_year *1000 #VPD in Pa
+
+ #----------------------------------------------------------------------------------------------
+
+ ##################
+ ## P-model v1.0 ##
+ ##################
+
+ ## Benjamin D. Stocker et al. 2020
+ ## optimality-based light use efficiency model
+ ## for simulating ecosystem gross primary production
+
+ # constant variables
+ alt = as.numeric(pheno.sub$alt) # elevation z [m a.s.l.]
+ meana = pheno.sub$AET_PET # Local annual mean ratio of actual over potential evapotranspiration
+
+ ## Calculate Photosynthetic Photon Flux Density, ppfd [mol m-2]
+ # PAR as irradiance [W m-2] is given by incoming short-wave radiation
+ ppfd = 60 * 60 * 24 * 10^-6 * 2.04 * (daily_vals$SWradDown)
+
+ ## get maximum soil moisture at the site (field capacity)
+ field.capacity = max(DataList[[7]][which(DataList[[7]]$pep_id==pheno.sub$pep_id), c(as.character(1:365))], na.rm=T)
+
+ ## P-model v1.0
+ pmodel.df <- tibble(
+ tc = daily_vals$Tday,
+ vpd = daily_vals$VPD, #VPD in Pa
+ co2 = daily_vals$CO2,
+ fapar = 1,
+ ppfd = ppfd,
+ soilm = daily_vals$Moist40 / field.capacity
+ ) %>%
+ mutate(out_pmodel = purrr::pmap(., rpmodel,
+ elv = alt,
+ kphio = 0.087,
+ beta = 146,
+ method_optci = "prentice14",
+ method_jmaxlim = "wang17",
+ do_ftemp_kphio = T,
+ do_soilmstress = T,
+ meanalpha=meana
+ ))
+ pmodel.df = do.call(rbind.data.frame, pmodel.df$out_pmodel)
+
+ #set Photosynthesis before leaf-out to zero
+ pmodel.df[1:DOY_out,]=0
+
+ ## Dark respiration, rd [mol C m-2]
+ rd = pmodel.df$rd
+ rd = rd * cmass # convert (carbon mass)
+
+ #get daily values of net daytime photosynthesis [g C m-2]
+ Apm = (pmodel.df$gpp - rd) + (1.0-daily_vals$Photo/24.0)*rd
+
+ #set negative values to zero
+ Apm[Apm<0] = 0
+
+ #----------------------------------------------------------------------------------------------
+
+ #Store the results
+ ##################
+
+ daily_vals = daily_vals %>%
+ mutate(GSI = iGSI_year, #photoperiod-influenced GSI
+ GSIrad = iGSIrad_year, #radiation-influenced GSI
+ Azani = dA_totw_year, #net daytime photosynthesis (Zani et al., water-stressed)
+ Apm = Apm, #net daytime photosynthesis (p model)
+ ) %>%
+ rename(Moist=Moist40)
+
+
+ ##############################################################################################################################################
+
+
+ ###################
+ ## Store drivers ##
+ ###################
+
+
+ ######################
+ ## Seasonal drivers ##
+ ######################
+
+ #define variables
+ variable.names = c('Azani', 'Apm',
+ 'GSI', 'GSIrad',
+ 'GDDday', 'GDDnight',
+ 'SWrad',
+ 'Tday', 'Tnight',
+ 'Moist', 'Prcp', 'VPD')
+
+ #---------------------------------------------------------------------------------------------------------
+
+ for(i in 1:length(variable.names)) {
+
+ #choose variable (daily values)
+ variable = daily_vals[,variable.names[i]]
+
+ #---------------------------------------------------------------------------------------------------------
+
+ # Name variables
+ ################
+
+ # Seasonal
+ ##########
+
+ # LO...leaf-out date
+ # SE...mean senescence date
+ # SO...Summer solstice (~22 June)
+ # SOm30...Summer solstice -30 (~22 May)
+ # SOp30...Summer solstice +30 (~21 July)
+ # SOp60...Summer solstice +60 (~22 August)
+ varname.LO.SO <- paste(variable.names[i], "LO.SO", sep=".")
+
+ varname.LO.p30 <- paste(variable.names[i], "LO.p30", sep=".")
+ varname.LO.p60 <- paste(variable.names[i], "LO.p60", sep=".")
+ varname.LO.p90 <- paste(variable.names[i], "LO.p90", sep=".")
+
+ varname.LO.SOm10 <- paste(variable.names[i], "LO.SOm10", sep=".")
+ varname.LO.SOm20 <- paste(variable.names[i], "LO.SOm20", sep=".")
+ varname.LO.SOm30 <- paste(variable.names[i], "LO.SOm30", sep=".")
+ varname.LO.SOm40 <- paste(variable.names[i], "LO.SOm40", sep=".")
+ varname.LO.SOm50 <- paste(variable.names[i], "LO.SOm50", sep=".")
+ varname.LO.SOm60 <- paste(variable.names[i], "LO.SOm60", sep=".")
+
+ varname.LO.SOp10 <- paste(variable.names[i], "LO.SOp10", sep=".")
+ varname.LO.SOp20 <- paste(variable.names[i], "LO.SOp20", sep=".")
+ varname.LO.SOp30 <- paste(variable.names[i], "LO.SOp30", sep=".")
+ varname.LO.SOp40 <- paste(variable.names[i], "LO.SOp40", sep=".")
+ varname.LO.SOp50 <- paste(variable.names[i], "LO.SOp50", sep=".")
+ varname.LO.SOp60 <- paste(variable.names[i], "LO.SOp60", sep=".")
+
+ varname.LO.SE <- paste(variable.names[i], "LO.SE", sep=".")
+ varname.SO.SE <- paste(variable.names[i], "SO.SE", sep=".")
+ varname.SOm30.SE <- paste(variable.names[i], "SOm30.SE", sep=".")
+ varname.SOp30.SE <- paste(variable.names[i], "SOp30.SE", sep=".")
+ varname.SOp60.SE <- paste(variable.names[i], "SOp60.SE", sep=".")
+
+ # Solstice
+ ##########
+
+ # solstice1...sum of 40 to 10 days before solstice
+ # solstice2...sum of 30 to 0 days before solstice
+ # solstice3...sum of 20 days before to 10 days after solstice
+ # solstice4...sum of 10 days before to 20 days after solstice
+ # solstice5...sum of 0 to 30 days after solstice
+ # solstice6...sum of 10 to 40 days after solstice
+ varname.solstice1 <- paste(variable.names[i], "solstice1", sep=".")
+ varname.solstice2 <- paste(variable.names[i], "solstice2", sep=".")
+ varname.solstice3 <- paste(variable.names[i], "solstice3", sep=".")
+ varname.solstice4 <- paste(variable.names[i], "solstice4", sep=".")
+ varname.solstice5 <- paste(variable.names[i], "solstice5", sep=".")
+ varname.solstice6 <- paste(variable.names[i], "solstice6", sep=".")
+
+ #---------------------------------------------------------------------------------------------------------
+
+ # Create columns
+ ################
+
+ if(variable.names[i] %in% c('Azani', 'Apm',
+ 'GSI', 'GSIrad', 'GDDday', 'GDDnight')){
+
+ # Sums
+ ######
+
+ factors.sub = factors.sub %>%
+ mutate(
+ #seasonal
+ !!varname.LO.SO := sum(variable[DOY_out:solstice]),
+
+ !!varname.LO.p30 := sum(variable[DOY_out:(DOY_out+30)]),
+ !!varname.LO.p60 := sum(variable[DOY_out:(DOY_out+60)]),
+ !!varname.LO.p90 := sum(variable[DOY_out:(DOY_out+90)]),
+
+ !!varname.LO.SOm10 := ifelse(DOY_out<(solstice-10), sum(variable[DOY_out:(solstice-10)]), 0),
+ !!varname.LO.SOm20 := ifelse(DOY_out<(solstice-20), sum(variable[DOY_out:(solstice-20)]), 0),
+ !!varname.LO.SOm30 := ifelse(DOY_out<(solstice-30), sum(variable[DOY_out:(solstice-30)]), 0),
+ !!varname.LO.SOm40 := ifelse(DOY_out<(solstice-40), sum(variable[DOY_out:(solstice-40)]), 0),
+ !!varname.LO.SOm50 := ifelse(DOY_out<(solstice-50), sum(variable[DOY_out:(solstice-50)]), 0),
+ !!varname.LO.SOm60 := ifelse(DOY_out<(solstice-60), sum(variable[DOY_out:(solstice-60)]), 0),
+
+ !!varname.LO.SOp10 := sum(variable[DOY_out:(solstice+10)]),
+ !!varname.LO.SOp20 := sum(variable[DOY_out:(solstice+20)]),
+ !!varname.LO.SOp30 := sum(variable[DOY_out:(solstice+30)]),
+ !!varname.LO.SOp40 := sum(variable[DOY_out:(solstice+40)]),
+ !!varname.LO.SOp50 := sum(variable[DOY_out:(solstice+50)]),
+ !!varname.LO.SOp60 := sum(variable[DOY_out:(solstice+60)]),
+
+ !!varname.LO.SE := sum(variable[DOY_out:DOY_off]),
+ !!varname.SO.SE := sum(variable[solstice:DOY_off]),
+ !!varname.SOm30.SE := sum(variable[(solstice-30):DOY_off]),
+ !!varname.SOp30.SE := sum(variable[(solstice+30):DOY_off]),
+ !!varname.SOp60.SE := sum(variable[(solstice+60):DOY_off]),
+
+ #solstice
+ !!varname.solstice1 := sum(variable[(solstice-39):(solstice-10)]),
+ !!varname.solstice2 := sum(variable[(solstice-29):solstice]),
+ !!varname.solstice3 := sum(variable[(solstice-19):(solstice+10)]),
+ !!varname.solstice4 := sum(variable[(solstice-9):(solstice+20)]),
+ !!varname.solstice5 := sum(variable[(solstice+1):(solstice+30)]),
+ !!varname.solstice6 := sum(variable[(solstice+11):(solstice+40)]) )
+
+ }
+
+ if(variable.names[i] %in% c("Tday","Tnight","Moist","SWrad","VPD")){
+
+ # Means from fixed date
+ #######################
+
+ factors.sub = factors.sub %>%
+ mutate(
+ #seasonal
+ !!varname.LO.SO := mean(variable[equinox.Mar:solstice]),
+
+ !!varname.LO.p30 := mean(variable[DOY_out:(DOY_out+30)]),
+ !!varname.LO.p60 := mean(variable[DOY_out:(DOY_out+60)]),
+ !!varname.LO.p90 := mean(variable[DOY_out:(DOY_out+90)]),
+
+ !!varname.LO.SOm10 := mean(variable[equinox.Mar:(solstice-10)]),
+ !!varname.LO.SOm20 := mean(variable[equinox.Mar:(solstice-20)]),
+ !!varname.LO.SOm30 := mean(variable[equinox.Mar:(solstice-30)]),
+ !!varname.LO.SOm40 := mean(variable[equinox.Mar:(solstice-40)]),
+ !!varname.LO.SOm50 := mean(variable[equinox.Mar:(solstice-50)]),
+ !!varname.LO.SOm60 := mean(variable[equinox.Mar:(solstice-60)]),
+
+ !!varname.LO.SOp10 := mean(variable[equinox.Mar:(solstice+10)]),
+ !!varname.LO.SOp20 := mean(variable[equinox.Mar:(solstice+20)]),
+ !!varname.LO.SOp30 := mean(variable[equinox.Mar:(solstice+30)]),
+ !!varname.LO.SOp40 := mean(variable[equinox.Mar:(solstice+40)]),
+ !!varname.LO.SOp50 := mean(variable[equinox.Mar:(solstice+50)]),
+ !!varname.LO.SOp60 := mean(variable[equinox.Mar:(solstice+60)]),
+
+ !!varname.LO.SE := mean(variable[equinox.Mar:DOY_off]),
+ !!varname.SO.SE := mean(variable[solstice:DOY_off]),
+ !!varname.SOm30.SE := mean(variable[(solstice-30):DOY_off]),
+ !!varname.SOp30.SE := mean(variable[(solstice+30):DOY_off]),
+ !!varname.SOp60.SE := mean(variable[(solstice+60):DOY_off]),
+
+ #solstice
+ !!varname.solstice1 := mean(variable[(solstice-39):(solstice-10)]),
+ !!varname.solstice2 := mean(variable[(solstice-29):solstice]),
+ !!varname.solstice3 := mean(variable[(solstice-19):(solstice+10)]),
+ !!varname.solstice4 := mean(variable[(solstice-9):(solstice+20)]),
+ !!varname.solstice5 := mean(variable[(solstice+1):(solstice+30)]),
+ !!varname.solstice6 := mean(variable[(solstice+11):(solstice+40)]) )
+ }
+
+ if(variable.names[i] %in% c("Prcp")){
+
+ # Sums from fixed date
+ #######################
+
+ factors.sub = factors.sub %>%
+ mutate(
+ #seasonal
+ !!varname.LO.SO := sum(variable[equinox.Mar:solstice]),
+ !!varname.LO.SOm30 := sum(variable[equinox.Mar:(solstice-30)]),
+ !!varname.LO.SOp30 := sum(variable[equinox.Mar:(solstice+30)]),
+ !!varname.LO.SOp60 := sum(variable[equinox.Mar:(solstice+60)]),
+ !!varname.LO.SE := sum(variable[equinox.Mar:DOY_off]),
+ !!varname.SO.SE := sum(variable[solstice:DOY_off]),
+ !!varname.SOm30.SE := sum(variable[(solstice-30):DOY_off]),
+ !!varname.SOp30.SE := sum(variable[(solstice+30):DOY_off]),
+ !!varname.SOp60.SE := sum(variable[(solstice+60):DOY_off]),
+
+ #solstice
+ !!varname.solstice1 := sum(variable[(solstice-39):(solstice-10)]),
+ !!varname.solstice2 := sum(variable[(solstice-29):solstice]),
+ !!varname.solstice3 := sum(variable[(solstice-19):(solstice+10)]),
+ !!varname.solstice4 := sum(variable[(solstice-9):(solstice+20)]),
+ !!varname.solstice5 := sum(variable[(solstice+1):(solstice+30)]),
+ !!varname.solstice6 := sum(variable[(solstice+11):(solstice+40)]) )
+ }
+ }
+
+
+ #---------------------------------------------------------------------------------------------------------
+
+
+ ####################################
+ ## Calculate the monthly averages ##
+ ####################################
+
+ #create variable vectors
+ VariableMeanVector = c("Tday","Tnight","Moist","VPD","SWrad")
+ VariableSumVector = c('Azani', 'Apm',
+ 'GSI', 'GSIrad',
+ 'GDDday', 'GDDnight',
+ 'Prcp')
+
+ #get means and sums
+ monthly_means = data.frame(daily_vals %>%
+ group_by(Month) %>%
+ summarize_at(VariableMeanVector, mean, na.rm = TRUE))
+ monthly_sums = data.frame(daily_vals %>%
+ group_by(Month) %>%
+ summarize_at(VariableSumVector, sum, na.rm = TRUE))
+
+ #merge
+ monthly_vals = cbind(monthly_means,monthly_sums[,-c(1)])
+
+ #Transform data
+ monthly_vals = as.data.frame(t(monthly_vals))
+
+ #Add to table
+ #############
+
+ #loop through variables
+ for(i in 1:length(variable.names)) {
+ #select variable
+ MONTHLY.DF = monthly_vals[variable.names[i],]
+ #add column names
+ names(MONTHLY.DF)=paste0(row.names(MONTHLY.DF), c(1:12))
+ #cbind with table
+ factors.sub = cbind(factors.sub, MONTHLY.DF)
+ }
+
+
+ #--------------------------------------------------------------------------
+
+
+ ################################
+ ## Get preseason temperatures ##
+ ################################
+
+ ## Calculate the average preseason temperatures prior to mean senescence date
+
+ #get preseason length vector (10 to 120 days with 10-day steps)
+ preseason.lengths = seq(10, 120, 10)
+
+ #loop through preseasons
+ for(preseason.length in preseason.lengths) {
+ #name columns
+ preseason.Tday <- paste("Tday.PS", preseason.length, sep=".")
+ preseason.Tnight <- paste("Tnight.PS", preseason.length, sep=".")
+ #add columns to table
+ factors.sub = factors.sub %>%
+ mutate(!!preseason.Tday := mean(daily_vals$Tday[(DOY_off-preseason.length):DOY_off]),
+ !!preseason.Tnight := mean(daily_vals$Tnight[(DOY_off-preseason.length):DOY_off]) )
+ }
+
+
+ ##############################################################################################################################################
+
+
+ # Safe the table
+ write.table(factors.sub, file=paste0(PEP_drivers_path, '/', timeseries_years, '.csv'), sep=',', row.names =F, col.names = T)
+
+ }
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##################
+## Run the Loop ##
+##################
+
+
+
+#initialize the loop
+outputlist <- pbmclapply(timeseries_year, parallelCalc, mc.cores=5, mc.preschedule=T)
+
+#check how many files there are
+length(list.files(path=PEP_drivers_path, pattern='.csv'))
+length(list.files(path=PEP_drivers_path3, pattern='.csv'))
+
+#Rbind files
+climate.factors.table = rbindlist(lapply(list.files(path = PEP_drivers_path)[1:200000],
+ function(n) fread(file.path(PEP_drivers_path, n))))
+climate.factors.table2 = rbindlist(lapply(list.files(path = PEP_drivers_path)[200001:length(list.files(path=PEP_drivers_path, pattern='.csv'))],
+ function(n) fread(file.path(PEP_drivers_path, n))))
+climate.factors.table = rbind(climate.factors.table,climate.factors.table2)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+###################
+## Safe the data ##
+###################
+
+
+
+#Safe table
+write.csv(climate.factors.table, paste(PEP_drivers_path2, "pep_drivers_data.csv", sep="/"))
+
+#Remove individual files
+do.call(file.remove, list(list.files(PEP_drivers_path,
+ full.names = TRUE)))
+
+do.call(file.remove, list(list.files(PEP_drivers_path3,
+ full.names = TRUE)))
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/PEP_analysis/3_Analysis/3.1_Sample_sizes/3.1_Sample_sizes.Rmd b/R code/PEP_analysis/3_Analysis/3.1_Sample_sizes/3.1_Sample_sizes.Rmd
new file mode 100644
index 0000000..58b9c5f
--- /dev/null
+++ b/R code/PEP_analysis/3_Analysis/3.1_Sample_sizes/3.1_Sample_sizes.Rmd
@@ -0,0 +1,106 @@
+---
+title: "Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice"
+subtitle: "PEP725 data: sample size check"
+---
+
+
+
+## 1. Load packages and data
+
+get packages
+```{r}
+require(data.table)
+require(ggplot2)
+require(tidyverse)
+```
+
+
+get data
+```{r}
+## set working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/PEP_analysis/Analysis")
+# paths
+PEP_drivers_path = "Analysis_input/PEP_drivers_final/Merged_file"
+
+## Import data
+PEP.df <- fread(paste(PEP_drivers_path, "pep_drivers_data.csv", sep="/"))
+```
+
+
+
+
+## 2. Check sample sizes
+show code
+```{r}
+#total observations
+nrow(PEP.df)
+
+#how many species have data?
+length(unique(PEP.df$species))
+
+#how many sites in total?
+length(unique(PEP.df$pep_id))
+
+#time span
+range(PEP.df$year)
+hist(PEP.df$year, xlab="Year", main="Temporal distribution of data", col='lightblue')
+
+#latitudinal gradient
+range(PEP.df$lat)
+hist(PEP.df$lat, xlab="Latitude", main="Latitudinal gradient", col='lightblue')
+
+#elevational gradient
+range(PEP.df$alt)
+hist(PEP.df$alt, xlab="Elevation (m)", main="Elevational gradient", col='lightblue')
+
+#leaf-out data
+mean(PEP.df$leaf_out)
+sd(PEP.df$leaf_out)
+range(PEP.df$leaf_out)
+hist(PEP.df$leaf_out, xlab="Leaf-out date", main="Leaf-out gradient", col='lightblue')
+
+#leaf-off data
+mean(PEP.df$leaf_off)
+sd(PEP.df$leaf_off)
+range(PEP.df$leaf_off)
+hist(PEP.df$leaf_off, xlab="Senescence date", main="Senescence gradient", col='lightblue')
+
+#Create summary dataframe by time series
+n.years = PEP.df %>%
+ group_by(timeseries) %>%
+ summarise(count = n())
+mean(n.years$count)
+max(n.years$count)
+min(n.years$count)
+
+#Create summary dataframe by species
+sample.size = PEP.df %>%
+ group_by(species) %>%
+ summarize(n.time.series = length(unique(pep_id)),
+ n.observations = n())
+
+#Sample sizes within species
+data.frame(sample.size)
+
+#Total amount of times series
+sum(sample.size$n.time.series)
+
+#Bar Plot
+sample.size = reshape2::melt(sample.size, id.vars = c("species"), measure.vars = c("n.time.series","n.observations"))
+ggplot(sample.size, aes(x=species, y=value)) +
+ geom_bar(stat = "identity")+
+ theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) +
+ facet_wrap(~variable, nrow=2, scales="free_y")
+
+#Map the observations
+mp <- NULL
+mapWorld <- borders("world", colour="gray60", fill="gray60") # create a layer of borders
+mp <- ggplot() + mapWorld
+
+#Now Layer the stations on top
+mp <- mp + geom_point(data=PEP.df[!duplicated(PEP.df[ , c("lat", "lon")]), ],
+ aes(x=lon, y=lat) ,color="blue", size=.3) +
+ coord_cartesian(ylim = c(43, 69), xlim = c(-10, 31))
+mp
+```
+
\ No newline at end of file
diff --git a/R code/PEP_analysis/3_Analysis/3.2_Add_preseasons_PEP.R b/R code/PEP_analysis/3_Analysis/3.2_Add_preseasons_PEP.R
new file mode 100644
index 0000000..a89c807
--- /dev/null
+++ b/R code/PEP_analysis/3_Analysis/3.2_Add_preseasons_PEP.R
@@ -0,0 +1,367 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Run autumn temperature (preseason) models for the PEP725 data set #########################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(data.table)
+require(broom)
+require(gmodels)
+require(patchwork)
+require(MASS)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################################
+## Set directories and get own PEP data ##
+##########################################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/PEP_analysis/Analysis")
+
+# paths
+PEP_drivers_path = "Analysis_input/PEP_drivers_final/Merged_file"
+output_path = "Analysis_output/Autumn/Preseason_temperatures"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+PEP.df <- fread(paste(PEP_drivers_path, "pep_drivers_data.csv", sep="/")) %>%
+ dplyr::select(-V1)
+
+
+#define plot themes
+plotTheme1 = theme(legend.position = "none",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+## Get best preseason ##
+########################
+
+
+
+#reshape table to long format
+#############################
+
+preseason.df = PEP.df %>%
+ #select columns
+ dplyr::select(timeseries,year,species,pep_id,leaf_off,
+ Tday.PS.10,Tday.PS.20,Tday.PS.30,
+ Tday.PS.40,Tday.PS.50,Tday.PS.60,
+ Tday.PS.70,Tday.PS.80,Tday.PS.90,
+ Tday.PS.100,Tday.PS.110,Tday.PS.120,
+ Tnight.PS.10,Tnight.PS.20,Tnight.PS.30,
+ Tnight.PS.40,Tnight.PS.50,Tnight.PS.60,
+ Tnight.PS.70,Tnight.PS.80,Tnight.PS.90,
+ Tnight.PS.100,Tnight.PS.110,Tnight.PS.120)%>%
+ #long format
+ pivot_longer(.,cols=starts_with(c("Td","Tn")), names_to = "preseason", values_to = "temp") %>%
+ #create preseason length and temperature class columns
+ mutate(preseason_length = readr::parse_number(gsub("[.]", "", preseason)), #keep only numbers in string
+ temp_class = gsub("\\..*","", preseason)) %>%
+ dplyr::select(-preseason)
+
+
+#Run linear models
+##################
+
+resultsLM = preseason.df %>%
+ group_by(timeseries, species, pep_id, temp_class, preseason_length) %>%
+ do({model = lm(scale(leaf_off) ~ scale(temp), data=.) # linear model
+ data.frame(tidy(model), # coefficient info
+ glance(model))}) %>% # model info
+ filter(!term %in% c("(Intercept)")) %>%
+ dplyr::select(timeseries,species,pep_id,temp_class,preseason_length,estimate,r.squared)%>%
+ ungroup()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+############################################
+## Plot preseason-senescence correlations ##
+############################################
+
+
+
+#R2
+###
+
+plot.R2 = resultsLM %>%
+ ggplot()+
+ aes(x=preseason_length, y=r.squared,
+ colour=temp_class, group=temp_class) +
+
+ stat_summary(fun = mean, geom="line", size = .7) +
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.5, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = 1) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+
+ xlab("Preseason length (days)") +
+ ylab("Coefficient of determination (R2)") +
+ coord_cartesian(ylim = c(0.0045, 0.11))+
+ facet_wrap(~species, ncol=1) +
+ plotTheme1+
+ theme(strip.text.x = element_blank())
+
+
+#Correlation coefficient
+########################
+
+plot.estimate = resultsLM %>%
+ ggplot()+
+ aes(x=preseason_length, y=estimate,
+ colour=temp_class, group=temp_class) +
+ stat_summary(fun = mean, geom="line", size = .7) +
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.5, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = 1) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+ xlab("Preseason length (days)") +
+ ylab("Standardized coefficient") +
+ coord_cartesian(ylim = c(0.01, 0.21))+
+ facet_wrap(~species, ncol=1) +
+ plotTheme1+
+ theme(strip.text.x = element_blank())
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################################################
+## Plot best preseason length for each temperature ##
+#####################################################
+
+
+
+#keep only models with best predictions
+resultsLM2 = resultsLM %>%
+ group_by(timeseries,temp_class) %>%
+ top_n(1, r.squared) %>%
+ ungroup()
+
+#plot
+plot.length = resultsLM2 %>%
+ dplyr::select(species,temp_class,preseason_length)%>%
+ ggplot()+
+ aes(x=temp_class, y=preseason_length, colour=temp_class) +
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+ stat_summary(fun = mean,
+ fun.min = function(x) mean(x) - sd(x),
+ fun.max = function(x) mean(x) + sd(x),
+ geom = "pointrange") +
+ scale_fill_manual(values = c('#F21A00','#3B9AB2'))+
+ coord_cartesian(ylim = c(10, 97))+
+ xlab("Daily temperature") +
+ ylab("Best preseason length (days)") +
+ facet_wrap(~species, ncol=1) +
+ plotTheme1+
+ theme(strip.text.x = element_blank(),
+ axis.text.x = element_text(angle = 45, hjust=1))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################################
+#Add best preseason temps to PEP data
+#####################################
+
+
+
+PEP.df = PEP.df %>%
+ inner_join(., preseason.df %>%
+ #filter by model data
+ semi_join(resultsLM2, by=c('timeseries','temp_class','preseason_length')) %>%
+ dplyr::select(c(timeseries,year,temp_class,temp))%>%
+ pivot_wider(.,names_from = temp_class, values_from = temp),
+ by = c("year", "timeseries"))%>%
+ dplyr::select(-(cols=starts_with(c("Tday.PS","Tnight.PS"))))
+
+#Safe table
+write.csv(PEP.df, paste(PEP_drivers_path, "pep_drivers_data_preseason.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##################################
+#Run linear ridge regression model
+##################################
+
+
+
+resultsLM3 = PEP.df %>%
+ group_by(timeseries,species) %>%
+ do({model = lm.ridge(scale(leaf_off) ~ scale(Tday)+scale(Tnight), data=.) # linear model
+ data.frame(tidy(model), # coefficient info
+ glance(model))}) %>% # model info
+ filter(!term %in% c("(Intercept)")) %>%
+ ungroup()%>%
+ #rename temperature class
+ mutate(term=recode(term, `scale(Tday)`="Tday", `scale(Tnight)`="Tnight"))
+
+#plot preseason-senescence correlations
+plot.ridge = resultsLM3 %>%
+ ggplot()+
+ aes(x=term, y=estimate,
+ colour=term) +
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.9, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = 1.5) +
+ geom_hline(yintercept = 0)+
+ xlab("Daily temperature") +
+ ylab("Standardized coefficient (ridge regression)") +
+ coord_cartesian(ylim = c(-0.2, 0.2))+
+ facet_wrap(~species, ncol=1,strip.position = "right") +
+ plotTheme1+
+ theme(axis.text.x = element_text(angle = 45, hjust=1))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################
+# Arrange and safe plots #
+##########################
+
+
+
+#define plot layout
+layout <- "AABBCD"
+
+#Merge plots
+PreseasonPlot = plot.R2 + plot.estimate + plot.length + plot.ridge +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'a')&
+ theme(plot.tag = element_text(face = 'bold'))
+
+#Safe plot
+pdf(paste(output_path,"Preseason_sensitivity.pdf",sep="/"), width=9, height=8, useDingbats=FALSE)
+PreseasonPlot
+dev.off()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## datetime
+Sys.time()
+#[1] "2023-04-01 08:53:46 CEST"
+
+## session info
+sessionInfo()
+#R version 4.1.0 (2021-05-18)
+#Platform: x86_64-apple-darwin17.0 (64-bit)
+#Running under: macOS 12.5.1
+
+#Matrix products: default
+#LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+#locale:
+# [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+#attached base packages:
+# [1] stats graphics grDevices utils datasets methods base
+
+#other attached packages:
+# [1] MASS_7.3-54 patchwork_1.1.1 gmodels_2.18.1 broom_0.7.8 data.table_1.14.0 forcats_0.5.1
+#[7] stringr_1.4.0 dplyr_1.0.10 purrr_0.3.4 readr_1.4.0 tidyr_1.2.0 tibble_3.1.8
+#[13] ggplot2_3.3.6 tidyverse_1.3.1
+
+#loaded via a namespace (and not attached):
+# [1] fs_1.5.2 lubridate_1.7.10 RColorBrewer_1.1-3 httr_1.4.2 tools_4.1.0
+#[6] backports_1.2.1 utf8_1.2.2 R6_2.5.1 rpart_4.1-15 Hmisc_4.5-0
+#[11] DBI_1.1.2 colorspace_2.0-3 nnet_7.3-16 withr_2.5.0 tidyselect_1.1.2
+#[16] gridExtra_2.3 compiler_4.1.0 cli_3.3.0 rvest_1.0.2 htmlTable_2.2.1
+#[21] xml2_1.3.3 labeling_0.4.2 scales_1.2.0 checkmate_2.0.0 digest_0.6.29
+#[26] foreign_0.8-81 rmarkdown_2.9 base64enc_0.1-3 jpeg_0.1-8.1 pkgconfig_2.0.3
+#[31] htmltools_0.5.2 dbplyr_2.1.1 fastmap_1.1.0 htmlwidgets_1.5.3 rlang_1.0.4
+#[36] readxl_1.3.1 rstudioapi_0.13 generics_0.1.3 farver_2.1.1 jsonlite_1.8.0
+#[41] gtools_3.9.2 magrittr_2.0.3 Formula_1.2-4 Matrix_1.3-3 Rcpp_1.0.9
+#[46] munsell_0.5.0 fansi_1.0.3 lifecycle_1.0.1 stringi_1.7.6 yaml_2.2.2
+#[51] plyr_1.8.6 grid_4.1.0 gdata_2.18.0 crayon_1.5.1 lattice_0.20-44
+#[56] haven_2.4.1 splines_4.1.0 hms_1.1.0 knitr_1.33 pillar_1.8.0
+#[61] reshape2_1.4.4 weathermetrics_1.2.2 reprex_2.0.0 glue_1.6.2 evaluate_0.15
+#[66] latticeExtra_0.6-29 modelr_0.1.8 png_0.1-7 vctrs_0.4.1 cellranger_1.1.0
+#[71] gtable_0.3.0 assertthat_0.2.1 xfun_0.24 survival_3.2-11 cluster_2.1.2
+#[76] ellipsis_0.3.2
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.1_Mixed_models.R b/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.1_Mixed_models.R
new file mode 100644
index 0000000..848b82e
--- /dev/null
+++ b/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.1_Mixed_models.R
@@ -0,0 +1,833 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Monthly and seasonal mixed effects models for the PEP725 data set #########################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(data.table)
+require(broom.mixed)
+require(gmodels)
+require(sjmisc)
+require(lme4)
+require(MuMIn)
+require(car)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/PEP_analysis/Analysis")
+
+# paths
+PEP_drivers_path = "Analysis_input/PEP_drivers_final/Merged_file"
+output_path = "Analysis_output/Autumn/Data"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology dataframe
+####################
+
+PEP.df <- fread(paste(PEP_drivers_path, "pep_drivers_data_preseason.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+## VARIABLE EXPLANATION:
+########################
+
+#General
+########
+
+#pep_id...site identifuer
+#species...speces name
+#year...observation year
+#timeseries...unique site x species identifier
+#site_year...unique site x year identifier
+#ts_year...unique site x species x year identifier
+#lat...site latitude (decimal degrees)
+#lon...site longitude (decomal degrees)
+#alt...site altitude (m a.s.l.)
+
+#---------------------------------------------------
+
+#Phenology
+##########
+
+#leaf_out...leaf-out date (DOY)
+#leaf_out_mean...mean timeseries leaf-out date (DOY)
+#leaf_off...senescence date (DOY)
+#leaf_off_mean...mean timeseries senescence date (DOY)
+
+#---------------------------------------------------
+
+#Day-of-year maximum temperature and radiation
+##############################################
+
+#HottestDOY...DOY with maximum annual temperature
+#MaxRadDOY...DOY with maximum irradiance
+
+#---------------------------------------------------
+
+#Seasonal drivers
+#################
+
+#SUMS (flexible start = leaf-out):
+#---------------------------------
+#Azani...Daily net photosynthesis Zani model
+
+#MEANS (fixed start = March equinox):
+#------------------------------------
+#Tday...mean daytime temperature
+#Tnight...mean nighttime temperature
+#Moist...mean soil moisture (10-40cm)
+#Prcp...precipitation sum
+
+#-----------------
+
+#PERIODS
+
+#seasonal
+#--------
+#LO.SOm30...leaf-out to 30 days before summer solstice
+#LO.SO...leaf-out to summer solstice
+#LO.SOp30...leaf-out to 30 days after solstice
+#LO.SOp60...leaf-out to 60 days after solstice
+#LO.SE...leaf-out to mean senescence
+#SOm30.SE...30 days before solstice to mean senescence
+#SO.SE...solstice to mean senescence
+#SOp30.SE...30 days after solstice to mean senescence
+#SOp60.SE...60 days after solstice to mean senescence
+
+#around summer solstice
+#----------------------
+#solstice1...40 to 10 days before solstice
+#solstice2...30 days before solstice
+#solstice3...20 days before until 10 days after solstice
+#solstice4...10 days before until 20 days after solstice
+#solstice5...30 days after solstice
+#solstice6...10 to 40 days after solstice
+
+#---------------------------------------------------
+
+#Monthly drivers
+################
+
+#Tday1-12...mean of daytime temperatures in January (1) to December (12)
+#Azani1-12...sum of daily net photosynthesis in January (1) to December (12)
+
+#---------------------------------------------------
+
+#Preseason temperatures
+#######################
+
+#Tday...time series-specific best preseason (R2-based) for daytime temperatures
+#Tnight...time series-specific best preseason (R2-based) for nighttime temperatures
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+######################################
+## Check variance inflation factors ##
+######################################
+
+
+# No multicollinearity among explanatory variables (all VIFs <2)
+
+#Full model:
+VIFfull = vif(lmer(scale(leaf_off) ~
+ scale(Azani.LO.SO) + scale(Azani.SO.SE) + scale(Tnight) + scale(CO2)+ scale(Prcp.LO.SO)+ scale(Prcp.SO.SE)+
+ (1|timeseries) + (1|species), data=PEP.df, control = lmerControl(optimizer ="Nelder_Mead")))
+
+#Monthly models:
+
+#Photosynthesis
+VIFphot = vif(lmer(scale(leaf_off) ~
+ scale(Azani3) + scale(Azani4) + scale(Azani5) + scale(Azani6) +
+ scale(Azani7) + scale(Azani8) + scale(Azani9) + scale(Azani10) +
+ (1|timeseries) + (1|species), data=PEP.df,
+ control = lmerControl(optimizer ="Nelder_Mead")))
+
+#Temperature
+VIFtemp = vif(lmer(scale(leaf_off) ~
+ scale(Tday1) + scale(Tday2) + scale(Tday3) + scale(Tday4) + scale(Tday5)+
+ scale(Tday6) + scale(Tday7) + scale(Tday8) + scale(Tday9) + scale(Tday10)+
+ (1|timeseries) + (1|species), data=PEP.df,
+ control = lmerControl(optimizer ="Nelder_Mead")))
+
+#look at maximum VIFs per model
+max(VIFfull) #1.6
+max(VIFphot) #1.4
+max(VIFtemp) #1.5
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Full models ##
+#################
+
+
+
+#Define variables
+variables = c('Azani', 'Tday')
+
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+##############################################################################################################################################
+
+
+#Loop through variables
+#######################
+
+for (i in 1:length(variables)){
+
+ #set equations
+ ##############
+
+ #define variable names
+ covariates = paste0(variables[i], c('.LO.SO','.SO.SE'))
+
+
+ #full models
+ equation.scaled = as.formula(paste("scale(leaf_off) ~ ", paste0('scale(',covariates[1], ') + scale(', covariates[2], ')',
+ collapse="+"),
+ '+ scale(Prcp.LO.SO) + scale(Prcp.SO.SE) + scale(CO2) + scale(Tnight) + (1|timeseries) + (1|species)', collapse=""))
+
+ equation.species = as.formula(paste("scale(leaf_off) ~ ", paste0('scale(',covariates[1], ') + scale(', covariates[2], ')',
+ collapse="+"),
+ '+ scale(Prcp.LO.SO) + scale(Prcp.SO.SE) + scale(CO2) + scale(Tnight) + (1|timeseries)', collapse=""))
+
+ #Prediction equations
+ equation.full = as.formula(paste("leaf_off ~ ", paste0(covariates[1], '+', covariates[2], collapse="+"),
+ '+ Prcp.LO.SO + Prcp.SO.SE + CO2 + Tnight + (1|timeseries) + (1|species)', collapse=""))
+
+ equation.preSolstice = as.formula(paste("leaf_off ~ ", paste0(covariates[1], collapse="+"),
+ '+ Prcp.LO.SO + CO2 + (1|timeseries) + (1|species)', collapse=""))
+
+ equation.postSolstice = as.formula(paste("leaf_off ~ ", paste0(covariates[2], collapse="+"),
+ '+ Prcp.SO.SE + CO2 + Tnight + (1|timeseries) + (1|species)', collapse=""))
+
+
+ ##############################################################################################################################################
+
+
+ #########################
+ #Predict senescence dates
+ #########################
+
+
+ PEP.df = PEP.df %>%
+ #run predictions
+ mutate(Prediction.Full = predict(lmer(equation.full, data=PEP.df, control = lmerControl(optimizer ="Nelder_Mead"))),
+ Prediction.PreSolstice = predict(lmer(equation.preSolstice, data=PEP.df, control = lmerControl(optimizer ="Nelder_Mead"))),
+ Prediction.PostSolstice = predict(lmer(equation.postSolstice, data=PEP.df, control = lmerControl(optimizer ="Nelder_Mead"))) )%>%
+ #rename columns
+ plyr::rename(replace = c(Prediction.Full = paste0('Prediction.Full.', variables[i]),
+ Prediction.PreSolstice = paste0('Prediction.PreSolstice.', variables[i]),
+ Prediction.PostSolstice = paste0('Prediction.PostSolstice.', variables[i]) ))
+
+
+ ##############################################################################################################################################
+
+
+ ######################
+ # Mixed effects models
+ ######################
+
+
+ # All species
+ #############
+
+ ModelResults.df = PEP.df %>%
+ do({
+
+ #run model
+ ##########
+
+ model = lmer(equation.scaled, data=., control = lmerControl(optimizer ="Nelder_Mead"))
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(tidy(model, effects="fixed") %>%
+ mutate(species = 'Aall') )
+
+ })
+
+ #----------------------------------------------------
+
+ # Species-specific
+ ##################
+
+ ModelResultsSpecies.df = PEP.df %>%
+ group_by(species)%>%
+ do({
+
+ #run model
+ ##########
+
+ model = lmer(equation.species, data=., control = lmerControl(optimizer ="Nelder_Mead"))
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(tidy(model, effects="fixed"))
+
+ }) %>% ungroup()
+
+
+ #rbind all species and species-specific results
+ Results.df = bind_rows(ModelResults.df, ModelResultsSpecies.df) %>%
+ #add model and variable name and delete "scale()" from term column
+ mutate(equation = 'full model',
+ variable = variables[i],
+ term = gsub("scale","",term),
+ term = gsub("\\(|\\)","",term) ) %>%
+ #delete intercept
+ filter(!term %in% c("Intercept"))
+
+
+ ##############################################################################################################################################
+
+
+ #store dataframe in variable list
+ DataList[[i]] = Results.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+FullModelAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################
+## Monthly correlations ##
+##########################
+
+
+
+#Get sums for January to March photosynthesis parameters
+PEP.monthly.df = PEP.df %>%
+ mutate(Azani3 = rowSums(select(.,c("Azani1","Azani2","Azani3"))) )
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+##############################################################################################################################################
+
+
+#Loop through covariate groups
+##############################
+
+for (i in 1:length(variables)){
+
+ #create explanatory variables
+ #############################
+
+ covariates.monthly = paste0(variables[i], c(1:10))
+
+ #---------------------------------------------------------
+
+ #set equations
+ ##############
+
+
+ # Type 1: Temporal
+ ##################
+
+ if(variables[i] %in% c('Azani')) {
+ equation1 = as.formula(paste("leaf_off ~ ", paste(covariates.monthly[3:10], collapse="+"),
+ '+ (1|timeseries) + (1|species)',
+ collapse=""))
+ equation1.species = as.formula(paste("leaf_off ~ ", paste(covariates.monthly[3:10], collapse="+"),
+ '+ (1|timeseries)',
+ collapse=""))
+ } else {
+ equation1 = as.formula(paste("leaf_off ~ ", paste(covariates.monthly, collapse="+"),
+ '+ (1|timeseries) + (1|species)',
+ collapse=""))
+ equation1.species = as.formula(paste("leaf_off ~ ", paste(covariates.monthly, collapse="+"),
+ '+ (1|timeseries)',
+ collapse="")) }
+
+
+ # Type 2: Temporal scaled
+ #########################
+
+ if(variables[i] %in% c('Azani')) {
+ equation2.scaled = as.formula(paste("scale(leaf_off) ~ ", paste('scale(', covariates.monthly[3:10], ')', collapse="+"),
+ '+ (1|timeseries) + (1|species)',
+ collapse=""))
+ equation2.species.scaled = as.formula(paste("scale(leaf_off) ~ ", paste('scale(', covariates.monthly[3:10], ')', collapse="+"),
+ '+ (1|timeseries)',
+ collapse=""))
+ } else {
+ equation2.scaled = as.formula(paste("scale(leaf_off) ~ ", paste('scale(', covariates.monthly, ')', collapse="+"),
+ '+ (1|timeseries) + (1|species)',
+ collapse=""))
+ equation2.species.scaled = as.formula(paste("scale(leaf_off) ~ ", paste('scale(', covariates.monthly, ')', collapse="+"),
+ '+ (1|timeseries)',
+ collapse="")) }
+
+
+ #---------------------------------------------------------
+
+ #####################
+ #mixed effects models
+ #####################
+
+ ModelResults.df = PEP.monthly.df %>%
+ do({
+
+ #run models
+ ###########
+
+ #Equation 1
+ modelEq1 = lmer(equation1, data=.,
+ control = lmerControl(optimizer ="Nelder_Mead"))
+
+ #Equation 2 (scaled)
+ modelEq2 = lmer(equation2.scaled, data=.,
+ control = lmerControl(optimizer ="Nelder_Mead"))
+
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(rbind(
+
+ #Equation 1
+ tidy(modelEq1, effects="fixed") %>%
+ mutate(equation = 'monthly'),
+
+ #Equation 2 (scaled)
+ tidy(modelEq2, effects="fixed") %>%
+ mutate(equation = 'monthly.scaled') ) )
+
+ }) %>%
+
+ #add species name
+ mutate(species = 'Aall')
+
+ #----------------------------------------------------
+
+ ######################################
+ #species-specific mixed effects models
+ ######################################
+
+ ModelResultsSpecies.df = PEP.df %>%
+
+ #group by species
+ group_by(species)%>%
+
+ do({
+
+ #run models
+ ###########
+
+ #Equation 1
+ modelEq1 = lmer(equation1.species, data=.,
+ control = lmerControl(optimizer ="Nelder_Mead"))
+
+ #Equation 2 (scaled)
+ modelEq2 = lmer(equation2.species.scaled, data=.,
+ control = lmerControl(optimizer ="Nelder_Mead"))
+
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(rbind(
+
+ #Equation 1
+ tidy(modelEq1, effects="fixed") %>%
+ add_column(equation = 'monthly'),
+
+ #Equation 2 (scaled)
+ tidy(modelEq2, effects="fixed") %>%
+ add_column(equation = 'monthly.scaled') ) )
+
+ }) %>% ungroup()
+
+ #rbind all species and species-specific results
+ Results.df = bind_rows(ModelResults.df, ModelResultsSpecies.df) %>%
+ #delete intercept
+ filter(!term %in% c("(Intercept)")) %>%
+ #add variable name and keep only numbers in month column
+ mutate(variable = variables[i],
+ term = readr::parse_number(term))
+
+ #---------------------------------------------------------
+
+ #store dataframe in variable list
+ DataList[[i]] = Results.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+MonthlyAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+######################
+## Seasonal drivers ##
+######################
+
+
+#Covariates
+###########
+
+#Variable length (leaf-out influenced):
+#--------------------------------------
+#Azani...Daily net photosynthesis (Zani model)
+
+#Fixed length:
+#-------------
+#Tday...mean daytime temperature
+
+
+#-------------------------------------------------------------
+
+
+## Define covariate groups
+seasons = c('LO.SOm30', 'LO.SO', 'LO.SOp30', 'LO.SOp60', 'LO.SE', 'SOm30.SE', 'SO.SE', 'SOp30.SE', 'SOp60.SE')
+solstice = c('solstice1', 'solstice2', 'solstice3', 'solstice4', 'solstice5', 'solstice6')
+
+covariates1 = paste(rep(variables, each=length(seasons)), seasons, sep = '.')
+covariates2 = paste(rep(variables, each=length(solstice)), solstice, sep = '.')
+covariates = c(covariates1,covariates2)
+
+#Check if all variables are in dataframe
+table(names(PEP.df) %in% covariates)[2]/length(covariates)==1
+
+#-------------------------------------------------------------
+
+## Create List object to store results
+DataList = replicate(length(covariates), data.frame())
+names(DataList) = covariates
+i=1
+
+
+##############################################################################################################################################
+
+
+#Loop through covariates
+########################
+
+for (covariate in covariates){
+
+ #---------------------------------------------------------
+
+ #set equations
+ ##############
+
+ #univariate scaled
+ equation1 = as.formula(paste("scale(leaf_off) ~ ", paste('scale(', covariate, ')', collapse="+"),
+ '+ (1|timeseries) + (1|species)', collapse=""))
+ equation1.species = as.formula(paste("scale(leaf_off) ~ ", paste('scale(', covariate, ')', collapse="+"),
+ '+ (1|timeseries)', collapse=""))
+
+ #univariate
+ equation2 = as.formula(paste("leaf_off ~ ", paste(covariate, collapse="+"),
+ '+ (1|timeseries) + (1|species)', collapse=""))
+ equation2.species = as.formula(paste("leaf_off ~ ", paste(covariate, collapse="+"),
+ '+ (1|timeseries)', collapse=""))
+
+ #autumn-temperature controlled scaled
+ equation3 = as.formula(paste("scale(leaf_off) ~ ", paste('scale(', covariate, ')', collapse="+"),
+ '+ scale(Tnight) + (1|timeseries) + (1|species)', collapse=""))
+ equation3.species = as.formula(paste("scale(leaf_off) ~ ", paste('scale(', covariate, ')', collapse="+"),
+ '+ scale(Tnight) + (1|timeseries)', collapse=""))
+
+ #autumn-temperature controlled
+ equation4 = as.formula(paste("leaf_off ~ ", paste(covariate, collapse="+"),
+ '+ Tnight + (1|timeseries) + (1|species)', collapse=""))
+ equation4.species = as.formula(paste("leaf_off ~ ", paste(covariate, collapse="+"),
+ '+ Tnight + (1|timeseries)', collapse=""))
+
+
+ ##############################################################################################################################################
+
+
+ ########################
+ #Run mixed effect models
+ ########################
+
+
+ #All species
+ ############
+
+ ModelResults.df = PEP.df %>%
+
+ do({
+
+ #run models
+ ###########
+
+ model1 = lmer(equation1, data=.,
+ control = lmerControl(optimizer ="Nelder_Mead"))
+
+ model2 = lmer(equation2, data=.,
+ control = lmerControl(optimizer ="Nelder_Mead"))
+
+ model3 = lmer(equation3, data=.,
+ control = lmerControl(optimizer ="Nelder_Mead"))
+
+ model4 = lmer(equation4, data=.,
+ control = lmerControl(optimizer ="Nelder_Mead"))
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(rbind(
+
+ #Equation 1
+ tidy(model1, effects="fixed") %>%
+ add_column(equation = paste0(ifelse(str_contains(covariate, c("solstice"), logic="or"),"Solstice","Seasonal"),
+ '.scaled') ) %>%
+ filter(term %in% paste0('scale(',covariate,')')), #delete intercept
+
+ #Equation 2
+ tidy(model2, effects="fixed") %>%
+ add_column(equation = ifelse(str_contains(covariate, c("solstice"), logic="or"),"Solstice","Seasonal") ) %>%
+ filter(term %in% covariate),
+
+ #Equation 3
+ tidy(model3, effects="fixed") %>%
+ add_column(equation = paste0(ifelse(str_contains(covariate, c("solstice"), logic="or"),"Solstice","Seasonal"),
+ '.tempCon.scaled') ) %>%
+ filter(term %in% paste0('scale(',covariate,')')),
+
+ #Equation 4
+ tidy(model4, effects="fixed") %>%
+ add_column(equation = paste0(ifelse(str_contains(covariate, c("solstice"), logic="or"),"Solstice","Seasonal"),
+ '.tempCon') ) %>%
+ filter(term %in% covariate) ))
+
+ }) %>%
+
+ #add variable and species name
+ mutate(term = covariate,
+ variable = sub("\\..*", "", covariate),
+ species = 'Aall')
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ #Species-specific
+ #################
+
+ ModelResultsSpecies.df = PEP.df %>%
+
+ #group by species
+ group_by(species)%>%
+
+ do({
+
+ #run models
+ ###########
+
+ model1 = lmer(equation1.species, data=.,
+ control = lmerControl(optimizer ="Nelder_Mead"))
+
+ model2 = lmer(equation2.species, data=.,
+ control = lmerControl(optimizer ="Nelder_Mead"))
+
+ model3 = lmer(equation3.species, data=.,
+ control = lmerControl(optimizer ="Nelder_Mead"))
+
+ model4 = lmer(equation4.species, data=.,
+ control = lmerControl(optimizer ="Nelder_Mead"))
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(rbind(
+
+ #Equation 1
+ tidy(model1, effects="fixed") %>%
+ mutate(equation = paste0(ifelse(str_contains(covariate, c("solstice"), logic="or"),"Solstice","Seasonal"),
+ '.scaled') ) %>%
+ filter(term %in% paste0('scale(',covariate,')')),
+
+ #Equation 2
+ tidy(model2, effects="fixed") %>%
+ mutate(equation = ifelse(str_contains(covariate, c("solstice"), logic="or"),"Solstice","Seasonal") ) %>%
+ filter(term %in% covariate),
+
+ #Equation 3
+ tidy(model3, effects="fixed") %>%
+ mutate(equation = paste0(ifelse(str_contains(covariate, c("solstice"), logic="or"),"Solstice","Seasonal"),
+ '.tempCon.scaled') ) %>%
+ filter(term %in% paste0('scale(',covariate,')')),
+
+ #Equation 4
+ tidy(model4, effects="fixed") %>%
+ mutate(equation = paste0(ifelse(str_contains(covariate, c("solstice"), logic="or"),"Solstice","Seasonal"),
+ '.tempCon') ) %>%
+ filter(term %in% covariate)
+ ))
+ }) %>%
+
+ #add variable and species name
+ mutate(term = covariate,
+ variable = sub("\\..*", "", covariate) ) %>%
+ ungroup()
+
+
+ #rbind all species and species-specific results
+ Results.df = bind_rows(ModelResults.df, ModelResultsSpecies.df)
+
+
+ ##############################################################################################################################################
+
+
+ #store dataframe in variable list
+ DataList[[i]] = Results.df
+
+ print(paste0('..... ',i, ' out of ', length(covariates), ' done'))
+ i=i+1
+}
+
+#bind tables
+SeasonalAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########
+## Safe ##
+##########
+
+
+
+#bind full model, monthly and seasonal analyses
+Analysis.df = rbind(FullModelAnalysis.df,MonthlyAnalysis.df,SeasonalAnalysis.df)
+
+#Safe tables
+write.csv(Analysis.df, paste(output_path, "Mixed_effect_data.csv", sep="/"))
+write.csv(PEP.df %>% dplyr::select(-V1), paste(PEP_drivers_path, "pep_drivers_data_preseason_predictions.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+## date time
+Sys.time()
+#"2023-04-01 09:38:55 CEST"
+
+## session info
+sessionInfo()
+#R version 4.1.0 (2021-05-18)
+#Platform: x86_64-apple-darwin17.0 (64-bit)
+#Running under: macOS 12.5.1
+
+#Matrix products: default
+#LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+#locale:
+# [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+#attached base packages:
+# [1] stats graphics grDevices utils datasets methods base
+
+#other attached packages:
+# [1] car_3.0-11 carData_3.0-4 MuMIn_1.43.17 lme4_1.1-30 Matrix_1.3-3 sjmisc_2.8.7
+#[7] gmodels_2.18.1 broom.mixed_0.2.6 data.table_1.14.0 forcats_0.5.1 stringr_1.4.0 dplyr_1.0.10
+#[13] purrr_0.3.4 readr_1.4.0 tidyr_1.2.0 tibble_3.1.8 ggplot2_3.3.6 tidyverse_1.3.1
+
+#loaded via a namespace (and not attached):
+# [1] httr_1.4.2 jsonlite_1.8.0 splines_4.1.0 modelr_0.1.8 gtools_3.9.2 assertthat_0.2.1
+#[7] stats4_4.1.0 cellranger_1.1.0 pillar_1.8.0 backports_1.2.1 lattice_0.20-44 glue_1.6.2
+#[13] rvest_1.0.2 minqa_1.2.4 colorspace_2.0-3 plyr_1.8.6 pkgconfig_2.0.3 broom_0.7.8
+#[19] haven_2.4.1 scales_1.2.0 gdata_2.18.0 openxlsx_4.2.4 rio_0.5.27 generics_0.1.3
+#[25] sjlabelled_1.1.8 ellipsis_0.3.2 withr_2.5.0 TMB_1.7.20 cli_3.3.0 magrittr_2.0.3
+#[31] crayon_1.5.1 readxl_1.3.1 fs_1.5.2 fansi_1.0.3 nlme_3.1-152 MASS_7.3-54
+#[37] xml2_1.3.3 foreign_0.8-81 tools_4.1.0 hms_1.1.0 lifecycle_1.0.1 munsell_0.5.0
+#[43] reprex_2.0.0 zip_2.2.0 compiler_4.1.0 rlang_1.0.4 grid_4.1.0 nloptr_2.0.3
+#[49] rstudioapi_0.13 boot_1.3-28 gtable_0.3.0 abind_1.4-5 DBI_1.1.2 curl_4.3.2
+#[55] reshape2_1.4.4 R6_2.5.1 lubridate_1.7.10 utf8_1.2.2 insight_0.14.2 stringi_1.7.6
+#[61] Rcpp_1.0.9 vctrs_0.4.1 dbplyr_2.1.1 tidyselect_1.1.2 coda_0.19-4
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.2_Model_comparison_CV_PEP725.R b/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.2_Model_comparison_CV_PEP725.R
new file mode 100644
index 0000000..6232ad6
--- /dev/null
+++ b/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.2_Model_comparison_CV_PEP725.R
@@ -0,0 +1,157 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Multivariate pre-/post-solstice models (PEP725 data) - Leave-one-out cross validation #####################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(data.table)
+require(broom)
+require(caret)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/PEP_analysis/Analysis")
+
+# paths
+PEP_drivers_path = "Analysis_input/PEP_drivers_final/Merged_file"
+output_path = "Analysis_output/Autumn/Data"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology dataframe
+####################
+
+PEP.df <- fread(paste(PEP_drivers_path, "pep_drivers_data_preseason.csv", sep="/")) %>%
+ mutate(SWrad.LO.SO = rowSums(.[,363:365]))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#######################################
+## Timeseries-level model assessment ##
+#######################################
+
+
+
+#set equations
+##############
+
+equation.full = as.formula("leaf_off ~ Azani.LO.SO + Tday.LO.SO + SWrad.LO.SO + Moist.LO.SO + leaf_out +
+ Azani.SO.SE + Tnight + SWrad.SO.SE + Moist.SO.SE")
+equation.pre = as.formula("leaf_off ~ Azani.LO.SO + Tday.LO.SO + SWrad.LO.SO + Moist.LO.SO + leaf_out")
+equation.post = as.formula("leaf_off ~ Azani.SO.SE + Tnight + SWrad.SO.SE + Moist.SO.SE")
+
+#---------------------------------------------------------
+
+###############
+#Get model info
+###############
+
+ModelResults.df = PEP.df %>%
+ group_by(species, timeseries)%>%
+ do({
+
+ #run models
+ ###########
+
+ modelFull = lm(equation.full, data=.)
+ modelPre = lm(equation.pre, data=.)
+ modelPost = lm(equation.post, data=.)
+
+ CVmodelFull <- train(
+ equation.full, ., method = "lm",
+ trControl = trainControl(method = "LOOCV") )
+
+ CVmodelPre <- train(
+ equation.pre, ., method = "lm",
+ trControl = trainControl(method = "LOOCV") )
+
+ CVmodelPost <- train(
+ equation.post, ., method = "lm",
+ trControl = trainControl(method = "LOOCV") )
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(rbind(
+
+ #Equation full
+ glance(modelFull) %>%
+ mutate(model = 'full',
+ CV.R2 = as.numeric(CVmodelFull[4]$results[3])),
+
+ #Equation pre-solstice
+ glance(modelPre) %>%
+ mutate(model = 'pre',
+ CV.R2 = as.numeric(CVmodelPre[4]$results[3])),
+
+ #Equation post-solstice
+ glance(modelPost) %>%
+ mutate(model ='post',
+ CV.R2 = as.numeric(CVmodelPost[4]$results[3]))
+ ) )
+ })%>%
+ mutate(CV.R2 = ifelse(CV.R2 > r.squared, r.squared, CV.R2)) %>%
+ ungroup()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########
+## Safe ##
+##########
+
+
+
+write.csv(ModelResults.df, paste(output_path, "Model_R2_CV_data.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.2_Model_comparison_PEP725.R b/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.2_Model_comparison_PEP725.R
new file mode 100644
index 0000000..3cd718d
--- /dev/null
+++ b/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.2_Model_comparison_PEP725.R
@@ -0,0 +1,210 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses at the summer solstice #####
+#############################################################################################################
+
+
+#############################################################################################################
+# Driver comparison for the PEP725 data set #################################################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(data.table)
+require(broom)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/PEP_analysis/Analysis")
+
+# paths
+PEP_drivers_path = "Analysis_input/PEP_drivers_final/Merged_file"
+output_path = "Analysis_output/Autumn/Data"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology dataframe
+####################
+
+PEP.df <- fread(paste(PEP_drivers_path, "pep_drivers_data_preseason.csv", sep="/")) %>%
+ mutate(SWrad.LO.SO = rowSums(.[,363:365]))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#######################################
+## Timeseries-level model assessment ##
+#######################################
+
+
+
+#variable vector
+variables=c("Azani","Tday","SWrad","Moist","leaf_out")
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+#Loop through variables
+#######################
+
+for (i in 1:length(variables)){
+
+ #define variable names
+ if (variables[i] == "leaf_out") {covariates = c('leaf_out','CO2')}
+ else {covariates = paste0(variables[i], c('.LO.SO','.SO.SE')) }
+
+
+ #set equations
+ ##############
+
+ equation.pre = as.formula(paste("leaf_off ~ ", paste0(covariates[1])))
+ equation.post = as.formula(paste("leaf_off ~ ", paste0(covariates[2])))
+
+ #---------------------------------------------------------
+
+ ###############
+ #Get model info
+ ###############
+
+ ModelResults.df = PEP.df %>%
+ group_by(timeseries)%>%
+ do({
+
+ #run models
+ ###########
+
+ modelPre = lm(equation.pre, data=.)
+ modelPost = lm(equation.post, data=.)
+
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(rbind(
+
+ #Equation pre-solstice
+ glance(modelPre) %>%
+ mutate(model='pre'),
+
+ #Equation post-solstice
+ glance(modelPost) %>%
+ mutate(model='post') ) )
+ })%>%
+ mutate(variable = variables[i]) %>%
+ ungroup()
+
+ #---------------------------------------------------------
+
+ #store dataframe in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+Analysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########
+## Safe ##
+##########
+
+
+
+write.csv(Analysis.df, paste(output_path, "Model_R2_data.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+## date time
+Sys.time()
+#"2021-07-12 15:37:26 CEST"
+
+## session info
+sessionInfo()
+#R version 4.1.0 (2021-05-18)
+#Platform: x86_64-apple-darwin17.0 (64-bit)
+#Running under: macOS Big Sur 11.2.3
+
+#Matrix products: default
+#LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+#locale:
+# [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+#attached base packages:
+# [1] stats graphics grDevices utils datasets methods base
+
+#other attached packages:
+# [1] broom_0.7.8 data.table_1.14.0 forcats_0.5.1 stringr_1.4.0 dplyr_1.0.7 purrr_0.3.4
+#[7] readr_1.4.0 tidyr_1.1.3 tibble_3.1.2 ggplot2_3.3.4 tidyverse_1.3.1
+
+#loaded via a namespace (and not attached):
+# [1] tidyselect_1.1.1 xfun_0.24 haven_2.4.1 colorspace_2.0-1 vctrs_0.3.8 generics_0.1.0
+#[7] htmltools_0.5.1.1 yaml_2.2.1 utf8_1.2.1 rlang_0.4.11 pillar_1.6.1 glue_1.4.2
+#[13] withr_2.4.2 DBI_1.1.1 dbplyr_2.1.1 modelr_0.1.8 readxl_1.3.1 lifecycle_1.0.0
+#[19] plyr_1.8.6 munsell_0.5.0 gtable_0.3.0 cellranger_1.1.0 rvest_1.0.0 evaluate_0.14
+#[25] knitr_1.33 fansi_0.5.0 Rcpp_1.0.6 backports_1.2.1 scales_1.1.1 jsonlite_1.7.2
+#[31] fs_1.5.0 hms_1.1.0 digest_0.6.27 stringi_1.6.2 grid_4.1.0 cli_2.5.0
+#[37] tools_4.1.0 magrittr_2.0.1 crayon_1.4.1 pkgconfig_2.0.3 ellipsis_0.3.2 xml2_1.3.2
+#[43] reprex_2.0.0 lubridate_1.7.10 assertthat_0.2.1 rmarkdown_2.9 httr_1.4.2 rstudioapi_0.13
+#[49] R6_2.5.0 compiler_4.1.0
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.3_Moving_windows.R b/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.3_Moving_windows.R
new file mode 100644
index 0000000..57a8120
--- /dev/null
+++ b/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.3_Moving_windows.R
@@ -0,0 +1,703 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Moving window analysis for the PEP725 data set ############################################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(data.table)
+require(broom)
+require(broom)
+require(broom.mixed)
+require(gmodels)
+require(sjmisc)
+require(pbmcapply)
+require(pracma)
+require(raster)
+require(lme4)
+require(car)
+require(ggplot2)
+require(wesanderson)
+require(patchwork)
+
+
+#plot theme
+plotTheme1 = theme(
+ legend.position = "none",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.grid.major = element_line(colour = "lightgrey"),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working dirctory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/PEP_analysis/Analysis")
+
+# paths
+PEP_drivers_path = "Analysis_input/PEP_drivers_final/Merged_file"
+GLDAS_path = "Analysis_input/Drivers/GLDAS"
+CO2_path = "Analysis_input/Drivers/CO2"
+output_path = "Analysis_output/Autumn/Data"
+output_path_figure = "Analysis_output/Autumn/Moving_window"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology dataframe
+####################
+
+PEP.df <- as.data.frame(fread(paste(PEP_drivers_path, "pep_drivers_data_preseason.csv", sep="/"))) %>%
+ #Get sums for photosynthesis parameters
+ mutate(Apm5 = rowSums(.[c("Apm1","Apm2","Apm3","Apm4",'Apm5')]),
+ ApmJmaxA5 = rowSums(.[c("ApmJmaxA1","ApmJmaxA2","ApmJmaxA3","ApmJmaxA4","ApmJmaxA5")]),
+ ApmJmaxB5 = rowSums(.[c("ApmJmaxB1","ApmJmaxB2","ApmJmaxB3","ApmJmaxB4","ApmJmaxB5")]),
+ Azani5 = rowSums(.[c("Azani1","Azani2","Azani3","Azani4","Azani5")]),
+ AzaniJmaxA5 = rowSums(.[c("AzaniJmaxA1","AzaniJmaxA2","AzaniJmaxA3","AzaniJmaxA4","AzaniJmaxA5")]),
+ AzaniJmaxB5 = rowSums(.[c("AzaniJmaxB1","AzaniJmaxB2","AzaniJmaxB3","AzaniJmaxB4","AzaniJmaxB5")]),
+ GSI5 = rowSums(.[c("GSI1","GSI2","GSI3","GSI4","GSI5")]),
+ GSIrad5 = rowSums(.[c("GSIrad1","GSIrad2","GSIrad3","GSIrad4","GSIrad5")]),
+
+ Apm8 = rowSums(.[c("Apm8","Apm9")]),
+ ApmJmaxA8 = rowSums(.[c("ApmJmaxA8","ApmJmaxA9")]),
+ ApmJmaxB8 = rowSums(.[c("ApmJmaxB8","ApmJmaxB9")]),
+ Azani8 = rowSums(.[c("Azani8","Azani9")]),
+ AzaniJmaxA8 = rowSums(.[c("AzaniJmaxA8","AzaniJmaxA9")]),
+ AzaniJmaxB8 = rowSums(.[c("AzaniJmaxB8","AzaniJmaxB9")]),
+ GSI8 = rowSums(.[c("GSI8","GSI9")]),
+ GSIrad8 = rowSums(.[c("GSIrad8","GSIrad9")])
+ )
+
+#------------------------------------------
+
+#Strong filter dataframe
+########################
+PEPshort.df <- PEP.df %>%
+ #delete years before 1980
+ filter(!year<1980)%>%
+ #delete groups with less than 30 years
+ group_by(timeseries)%>%
+ filter(n() >= 30)%>%
+ ungroup()
+
+#------------------------------------------
+
+#delete high elevation (>600 m) sites in full dataframe
+PEPlong.df = PEP.df %>% filter(!alt>600)
+
+
+##############################################################################################################################################
+
+
+## Daily climatic data from GLDAS averaged to site-level annual mean over all years (1948-2015)
+###############################################################################################
+
+#list of climate variables (Daily air temp, rainfall and short-wave radiation)
+vn <- c('Daily_Mean_Data_Tair_f_inst','Daily_Data_Rainf_f_tavg','Daily_Data_Swnet_tavg')
+
+#create empty dataframe
+Climate.df <- data.frame()
+
+#loop
+for(i in 1:length(vn)) {
+
+ data <- fread(paste0(GLDAS_path, "/", vn[i],".csv"))%>%
+ #get annual means
+ mutate(Climate = rowMeans(dplyr::select(., -c(pep_id,year,lat,lon)),na.rm=T))%>%
+ dplyr::select(pep_id,year,lat,lon,Climate)%>%
+ #average across all years (1948-2015)
+ group_by(pep_id)%>%
+ summarise(Climate = ci(Climate)[1])%>%
+ #rename variable
+ mutate(variable = vn[i])
+
+ #Rbind climate variables
+ Climate.df = rbind(Climate.df, data)
+}
+
+#Wide format
+Climate.df = pivot_wider(Climate.df, names_from = variable, values_from = Climate)%>%
+ rename(MAT = Daily_Mean_Data_Tair_f_inst, MAP = Daily_Data_Rainf_f_tavg, RAD = Daily_Data_Swnet_tavg)%>%
+ mutate(MAP = MAP*365)
+
+#merge with PEP.df
+PEPlong.df = PEPlong.df %>%
+ left_join(., Climate.df, by='pep_id')
+
+#remove stuff
+rm(Climate.df, data)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+############################
+## Moving window analysis ##
+############################
+
+
+
+#create year vector for loop
+year.vector.long = c(1966:(max(PEPlong.df$year)-19))
+year.vector.short = c(min(PEPshort.df$year):(max(PEPshort.df$year)-14))
+
+#Define covariate groups
+variables = c('Apm', 'ApmJmaxA', 'ApmJmaxB',
+ 'Azani', 'AzaniJmaxA', 'AzaniJmaxB',
+ 'GSI', 'GSIrad',
+ 'GDDday', 'GDDnight',
+ 'Tday', 'Tnight', 'SWrad')
+
+#create List object to store results
+DataList = replicate(2*length(variables), data.frame())
+names(DataList) = rep(variables,2)
+
+#create List object of dataframes
+PEPdataList = list(PEPlong.df, PEPshort.df)
+#list of year vectors
+YearList = list(year.vector.long, year.vector.short)
+#moving window length (20 / 15 years)
+MovingWindowLength = c(20,15)
+
+
+
+#########################################################################################################################
+#########################################################################################################################
+
+
+
+###########################################
+# get sample sizes for each moving window #
+###########################################
+
+
+#get full data sample sizes per year and species
+################################################
+
+FullSampleData.df = PEP.df %>%
+ group_by(species, year)%>%
+ summarise(count = n())
+
+
+#get sample sizes per year and species for moving windows
+#########################################################
+
+#empty dataframe
+SampleData.df = data.frame()
+
+#loop
+for(k in 1:length(PEPdataList)){
+
+ #loop through years (moving windwows)
+ for (year in YearList[[k]]){
+
+ #create table subset
+ PEP.sub = PEPdataList[[k]][PEPdataList[[k]]$year>=year & PEPdataList[[k]]$year< year+MovingWindowLength[k],] %>%
+ #delete time series with less than 15/12 years
+ group_by(timeseries) %>%
+ filter(if (k==1) {n() >= 15} else {n() >= 12} ) %>%
+ ungroup()%>%
+ #get sample size info
+ group_by(species)%>%
+ summarise(count = n())%>%
+ #add identifiers
+ mutate(year=year,
+ dataset = ifelse(k==1, 'Long', 'Short'))
+
+ #rbind
+ SampleData.df = rbind(SampleData.df, PEP.sub)
+
+ #count
+ print(paste0('year ', year,', dataset ', k))
+ }
+}
+
+#------------------------------------------------------------------------------------------------
+
+#Plots
+######
+
+#Map of the observations
+mp <- NULL
+mapWorld <- borders("world", colour="gray60", fill="gray60") # create a layer of borders
+mp <- ggplot() + mapWorld + plotTheme1
+#Layer the stations on top
+mp <- mp + geom_point(data=PEP.df[!duplicated(PEP.df[ , c("lat", "lon")]), ],
+ aes(x=lon, y=lat) ,color="blue", size=.3) +
+ coord_cartesian(ylim = c(43, 60), xlim = c(-8, 28))+
+ xlab("") + ylab('')
+
+#Full data
+SampleSizePlot = ggplot(FullSampleData.df,
+ aes(x = year, y = count,
+ group=species, color=species)) +
+ geom_line(size = 1) +
+ scale_color_manual(values = rev(wes_palette("Darjeeling2", n = 4))) +
+ xlab("") + ylab('Sample size')+
+ plotTheme1+
+ coord_cartesian(xlim=c(1954,2012), ylim=c(115,2500))+
+ theme(axis.text.x = element_text(angle = 45, hjust=1))
+
+#Long data
+SampleSizeLongPlot = ggplot(SampleData.df[SampleData.df$dataset=='Long',],
+ aes(x = year, y = count/20,
+ group=species, color=species)) +
+ geom_line(size = 1) +
+ scale_color_manual(values = rev(wes_palette("Darjeeling2", n = 4))) +
+ xlab("") + ylab('Sample size')+
+ plotTheme1+
+ scale_x_continuous(breaks = seq(1966,1996,by=5),
+ labels = c('1966-1985','1971-1990','1976-1995','1981-2000','1986-2005','1991-2010','1996-2015'))+
+ coord_cartesian(xlim=c(1967.35,1994.65), ylim=c(115,2500))+
+ theme(axis.text.x = element_text(angle = 45, hjust=1))
+
+#Short data
+SampleSizeShortPlot = ggplot(SampleData.df[SampleData.df$dataset=='Short',],
+ aes(x = year, y = count/15,
+ group=species, color=species)) +
+ geom_line(size = 1) +
+ scale_color_manual(values = rev(wes_palette("Darjeeling2", n = 4))) +
+ xlab("") + ylab('')+
+ plotTheme1+
+ theme(legend.position = 'right')+
+ scale_x_continuous(breaks = seq(1981,2001,by=5),
+ labels = c('1981-1995','1986-2000','1991-2005','1996-2010','2001-2015'))+
+ coord_cartesian(xlim=c(1981.5,2000.08), ylim=c(115,2500))+
+ theme(axis.text.x = element_text(angle = 45, hjust=1))
+
+#define plot layout
+layout <- "AB
+CD"
+
+#Merge plots
+SampleSize_Plot = mp + SampleSizePlot + SampleSizeLongPlot + SampleSizeShortPlot +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'a')&
+ theme(plot.tag = element_text(face = 'bold'))
+
+#save plots as .pdf
+ggsave(SampleSize_Plot, file="SampleSizes.pdf", path=output_path_figure,
+ width=8, height=6)
+
+#remove stuff
+rm(PEP.df, SampleData.df, PEP.sub, SampleSize_Plot, SampleSizePlot, SampleSizeLongPlot, SampleSizeShortPlot, mp, FullSampleData.df, mapWorld)
+
+
+
+#########################################################################################################################
+#########################################################################################################################
+
+
+
+######################################################
+# CHECK bias in site-level average climate over time #
+######################################################
+
+
+
+#create data frame to store results
+site.mw.df = data.frame()
+
+#choose long moving window analysis
+k=1
+
+#loop through years (moving windwows)
+for (year in YearList[[k]]){
+
+ #create table subset
+ PEP.df.sub = PEPdataList[[k]][PEPdataList[[k]]$year >= year & PEPdataList[[k]]$year < year+MovingWindowLength[k],] %>%
+ #delete time series with less than 15/12 years
+ group_by(timeseries) %>%
+ filter(if (k==1) {n() >= 15} else {n() >= 12}
+ ) %>%
+ ungroup() %>%
+ #delete duplicates (unique site/species per moving window)
+ distinct(pep_id, species, .keep_all = T)
+
+ #get means
+ ResultsMean.df = PEP.df.sub %>%
+ summarise(MAT = ci(MAT)[1],
+ MAP = ci(MAP)[1],
+ RAD = ci(RAD)[1],
+ ELE = ci(alt)[1])%>%
+ mutate(year=year)%>%
+ pivot_longer(., cols = -year)%>%
+ rename(mean.climate = value)
+
+ #get SDs
+ ResultsSD.df = PEP.df.sub %>%
+ summarise(MAT = sd(MAT),
+ MAP = sd(MAP),
+ RAD = sd(RAD),
+ ELE = sd(alt))%>%
+ mutate(year=year)%>%
+ pivot_longer(., cols = -year)%>%
+ rename(sd.climate = value)
+
+ #Merge
+ Results.df = inner_join(ResultsMean.df, ResultsSD.df, by=c('year','name'))
+
+ #Rbind loop subsets
+ site.mw.df = rbind(site.mw.df, Results.df)
+
+ #count
+ print(paste0('year ', year, ' done (', min(year.vector.long),'-',max(year.vector.long),')'))
+}
+
+#order variables
+site.mw.df = site.mw.df%>%
+ mutate(name = factor(name, levels=c("MAT", "MAP", 'RAD',"ELE"), ordered=T))
+
+#create unique site dataframe
+PEP.sites.df = PEPlong.df%>%
+ filter(!duplicated(pep_id))
+
+#Run linear model (in response to year)
+SiteModelResults.df = site.mw.df %>%
+ group_by(name)%>%
+ do({
+ model = lm(mean.climate ~ year, data=.)
+ #create combined dataframe
+ data.frame(tidy(model))}) %>%
+ ungroup() %>%
+ #delete intercept
+ filter(!term %in% c("(Intercept)"))%>%
+ mutate(estimate = estimate*10,
+ mean.climate = NA,
+ sd.climate = NA)%>%
+ #order factors
+ mutate(name = factor(name, levels=c("MAT", "MAP", 'RAD',"ELE"), ordered=T))
+
+#create dummy dataset to control y axis
+dummy <- data.frame(year = c(1965,2015),
+ mean.climate = c(mean(PEP.sites.df$MAT)+2*sd(PEP.sites.df$MAT),
+ mean(PEP.sites.df$MAT)-2*sd(PEP.sites.df$MAT),
+ mean(PEP.sites.df$MAP)+2*sd(PEP.sites.df$MAP),
+ mean(PEP.sites.df$MAP)-2*sd(PEP.sites.df$MAP),
+ mean(PEP.sites.df$RAD)+2*sd(PEP.sites.df$RAD),
+ mean(PEP.sites.df$RAD)-2*sd(PEP.sites.df$RAD),
+ mean(PEP.sites.df$alt)+2*sd(PEP.sites.df$alt),
+ mean(PEP.sites.df$alt)-2*sd(PEP.sites.df$alt)),
+ sd.climate=0,
+ name = rep(c("MAT",'MAP','RAD','ELE'),each=2), stringsAsFactors=FALSE)%>%
+ mutate(name = factor(name, levels=c("MAT", "MAP", 'RAD',"ELE"), ordered=T))
+
+#plot
+SiteClimatePlot = ggplot(site.mw.df, aes(x = year, y = mean.climate, ymin = mean.climate-sd.climate, ymax = mean.climate+sd.climate,
+ group=name, color=name, fill=name)) +
+ geom_ribbon(color=NA) +
+ geom_line(size = 1) +
+ scale_color_manual(values = c('#F21A00','#3B9AB2','#E1AF00','#78B7C5'))+
+ scale_fill_manual(values = alpha(c('#F21A00','#3B9AB2','#E1AF00','#78B7C5'),0.3))+
+ xlab("Year") + ylab('Value')+
+ plotTheme1+
+ geom_text(data = SiteModelResults.df,
+ mapping = aes(x = Inf, y = Inf, hjust = 1.5, vjust = 2.5,
+ label = paste('Trend: ', round(estimate,1), " per decade", sep="")),
+ size=3.5, color="black")+
+ xlab("") + ylab('')+
+ scale_x_continuous(breaks = seq(1966,1996,by=5),
+ labels = c('1966-1985','1971-1990','1976-1995','1981-2000','1986-2005','1991-2010','1996-2015'))+
+ coord_cartesian(xlim=c(1967.3,1994.7))+
+ facet_wrap(~name,ncol=2,scale='free_y', strip.position="top")+
+ geom_blank(data=dummy) +
+ theme(axis.text.x = element_text(angle = 45, hjust=1))
+
+#Save PDFs
+pdf(paste(output_path_figure,"SiteClimateOverTime.pdf",sep="/"), width=6, height=6, useDingbats=FALSE)
+SiteClimatePlot
+dev.off()
+
+#remove stuff
+rm(dummy,PEP.df.sub,PEP.sites.df,SiteClimatePlot,Results.df,ResultsMean.df,ResultsSD.df,site.mw.df,SiteModelResults.df)
+
+
+
+#########################################################################################################################
+#########################################################################################################################
+
+
+
+#######################################
+# Monthly and full model correlations #
+#######################################
+
+
+
+# Run Mixed effects models
+##########################
+
+for(k in 1:length(PEPdataList)){
+
+ #Loop through covariate groups
+ for (i in 1:length(variables)){
+
+ #create explanatory variables
+ #############################
+
+ covariates.monthly = paste0(variables[i], c(1:10))
+ covariates.seasonal = paste0(variables[i], c('.LO.SO','.SO.SE'))
+
+ #---------------------------------------------------------
+
+ #set equations
+ ##############
+
+
+ #################
+ # Type 1: monthly
+ #################
+
+ if(variables[i] %in% c('Apm', 'Azani', 'GSI', 'GSIrad')) {
+ equation1 = as.formula(paste("scale(leaf_off) ~ ", paste('scale(', covariates.monthly[5:8], ')', collapse="+"),
+ '+ (1|timeseries) + (1|species)', collapse=""))
+ equation1.species = as.formula(paste("scale(leaf_off) ~ ", paste('scale(', covariates.monthly[5:8], ')', collapse="+"),
+ '+ (1|timeseries)', collapse=""))
+ } else {
+ equation1 = as.formula(paste("scale(leaf_off) ~ ", paste('scale(', covariates.monthly[3:9], ')', collapse="+"),
+ '+ (1|timeseries) + (1|species)', collapse=""))
+ equation1.species = as.formula(paste("scale(leaf_off) ~ ", paste('scale(', covariates.monthly[3:9], ')', collapse="+"),
+ '+ (1|timeseries)', collapse="")) }
+
+ #####################
+ # Type 2: Full models
+ #####################
+
+ equation2 = as.formula(paste("scale(leaf_off) ~ ", paste0('scale(',covariates.seasonal[1], ') + scale(',covariates.seasonal[2],')', collapse="+"),
+ '+ scale(Prcp.LO.SO) + scale(Prcp.SO.SE) + scale(CO2) + scale(Tnight) + (1|timeseries) + (1|species)', collapse=""))
+ equation2.species = as.formula(paste("scale(leaf_off) ~ ", paste0('scale(',covariates.seasonal[1], ') + scale(',covariates.seasonal[2],')', collapse="+"),
+ '+ scale(Prcp.LO.SO) + scale(Prcp.SO.SE) + scale(CO2) + scale(Tnight) + (1|timeseries)', collapse=""))
+
+ #---------------------------------------------------------
+
+ #create moving window dataframes
+ mw.df = data.frame()
+ mw.species.df = data.frame()
+
+ #loop through years (moving windwows)
+ for (year in YearList[[k]]){
+
+ #create table subset
+ PEP.df.sub = PEPdataList[[k]][PEPdataList[[k]]$year>=year & PEPdataList[[k]]$year< year+MovingWindowLength[k],] %>%
+ group_by(timeseries) %>%
+ filter(if (k==1) {n() >= 15} else {n() >= 12}
+ ) %>% #delete time series with less than 15/12 years
+ ungroup()
+
+ #---------------------------------------------------------
+
+ #################################
+ #mixed effects models all species
+ #################################
+
+ ModelResults.df = PEP.df.sub %>%
+
+ do({
+
+ #run models
+ ###########
+
+ #Equation 1
+ modelEq1 = lmer(equation1, data=., control = lmerControl(optimizer ="Nelder_Mead"))
+
+ #Equation 2
+ modelEq2 = lmer(equation2, data=.,control = lmerControl(optimizer ="Nelder_Mead"))
+
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(rbind(
+
+ #Equation 1
+ tidy(modelEq1, effects="fixed") %>%
+ filter(!term %in% c("(Intercept)")) %>%
+ mutate(equation = 'monthly',
+ term = readr::parse_number(term)),
+
+ #Equation 2
+ tidy(modelEq2, effects="fixed") %>%
+ mutate(equation = 'full model') ) )
+
+ }) %>%
+
+ #add and edit information
+ mutate(species = 'Aall',
+ variable = variables[i],
+ year = year) %>%
+ filter(!term %in% c("(Intercept)"))
+
+ #rbind moving window subsets
+ mw.df = rbind(mw.df, ModelResults.df)
+
+ #----------------------------------------------------
+
+ ######################################
+ #species-specific mixed effects models
+ ######################################
+
+ ModelResults.df = PEP.df.sub %>%
+ group_by(species)%>%
+ do({
+
+ #run models
+ ###########
+
+ #Equation 1
+ modelEq1 = lmer(equation1.species, data=.,control = lmerControl(optimizer ="Nelder_Mead"))
+
+ #Equation 2
+ modelEq2 = lmer(equation2.species, data=.,control = lmerControl(optimizer ="Nelder_Mead"))
+
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(rbind(
+
+ #Equation 1
+ tidy(modelEq1, effects="fixed") %>%
+ filter(!term %in% c("(Intercept)")) %>%
+ mutate(equation = 'monthly',
+ term = readr::parse_number(term)),#rename factors
+
+ #Equation 2
+ tidy(modelEq2, effects="fixed") %>%
+ filter(!term %in% c("(Intercept)")) %>%
+ mutate(equation = 'full model') ) )
+
+ }) %>%
+ mutate(variable = variables[i],
+ year = year) %>%
+ ungroup()
+
+ #rbind moving window subsets
+ mw.species.df = rbind(mw.species.df, ModelResults.df)
+
+ print(paste0('year ', year, ' done (', min(PEPdataList[[k]]$year),'-',(max(PEPdataList[[k]]$year)-19),')'))
+ }
+
+ #rbind all species and species-specific results
+ mw.df = bind_rows(mw.df, mw.species.df) %>%
+ #rename factors
+ mutate(dataset = ifelse(k==1, 'Long', 'Short'),
+ term = gsub("scale","",term),
+ term = gsub("\\(|\\)","",term)) #remove brackets
+
+ #---------------------------------------------------------
+
+ #store dataframe in variable list
+ DataList[[i+(k-1)*length(variables)]] = mw.df
+
+ #count
+ print(paste0(i+(k-1)*length(variables),' out of ',length(DataList), ' (',variables[i],') done'))
+ }
+ }
+
+#bind rows
+MovingWindowAnalysis.df = bind_rows(DataList)
+
+#Safe table
+write.csv(MovingWindowAnalysis.df, paste(output_path, "Moving_window_data.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+## date time
+Sys.time()
+#"2021-07-10 08:42:19 CEST"
+
+
+## session info
+sessionInfo()
+#R version 4.1.0 (2021-05-18)
+#Platform: x86_64-apple-darwin17.0 (64-bit)
+#Running under: macOS Big Sur 11.2.3
+
+#Matrix products: default
+#LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+#locale:
+# [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+#attached base packages:
+# [1] parallel stats graphics grDevices utils datasets methods base
+
+#other attached packages:
+# [1] broom.mixed_0.2.6 patchwork_1.1.1 wesanderson_0.3.6 car_3.0-11 carData_3.0-4 lme4_1.1-27.1
+#[7] Matrix_1.3-3 raster_3.4-13 sp_1.4-5 pbmcapply_1.5.0 sjmisc_2.8.7 gmodels_2.18.1
+#[13] broom_0.7.8 data.table_1.14.0 forcats_0.5.1 stringr_1.4.0 dplyr_1.0.7 purrr_0.3.4
+#[19] readr_1.4.0 tidyr_1.1.3 tibble_3.1.2 ggplot2_3.3.4 tidyverse_1.3.1
+
+#loaded via a namespace (and not attached):
+# [1] nlme_3.1-152 fs_1.5.0 lubridate_1.7.10 insight_0.14.2 httr_1.4.2 TMB_1.7.20
+#[7] tools_4.1.0 backports_1.2.1 utf8_1.2.1 R6_2.5.0 sjlabelled_1.1.8 DBI_1.1.1
+#[13] colorspace_2.0-1 withr_2.4.2 tidyselect_1.1.1 curl_4.3.2 compiler_4.1.0 cli_2.5.0
+#[19] rvest_1.0.0 xml2_1.3.2 labeling_0.4.2 scales_1.1.1 digest_0.6.27 foreign_0.8-81
+#[25] minqa_1.2.4 rmarkdown_2.9 rio_0.5.27 pkgconfig_2.0.3 htmltools_0.5.1.1 maps_3.3.0
+#[31] dbplyr_2.1.1 rlang_0.4.11 readxl_1.3.1 rstudioapi_0.13 farver_2.1.0 generics_0.1.0
+#[37] jsonlite_1.7.2 gtools_3.9.2 zip_2.2.0 magrittr_2.0.1 Rcpp_1.0.6 munsell_0.5.0
+#[43] fansi_0.5.0 abind_1.4-5 lifecycle_1.0.0 stringi_1.6.2 yaml_2.2.1 MASS_7.3-54
+#[49] plyr_1.8.6 grid_4.1.0 gdata_2.18.0 crayon_1.4.1 lattice_0.20-44 haven_2.4.1
+#[55] splines_4.1.0 hms_1.1.0 knitr_1.33 pillar_1.6.1 boot_1.3-28 reshape2_1.4.4
+#[61] codetools_0.2-18 reprex_2.0.0 glue_1.4.2 evaluate_0.14 modelr_0.1.8 vctrs_0.3.8
+#[67] nloptr_1.2.2.2 cellranger_1.1.0 gtable_0.3.0 assertthat_0.2.1 xfun_0.24 openxlsx_4.2.4
+#[73] coda_0.19-4 ellipsis_0.3.2
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
+
diff --git a/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.4.1_Moving_windows_preseason_sensitivity.R b/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.4.1_Moving_windows_preseason_sensitivity.R
new file mode 100644
index 0000000..9117f0e
--- /dev/null
+++ b/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.4.1_Moving_windows_preseason_sensitivity.R
@@ -0,0 +1,286 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Autumn temperature (preseason) moving-window analysis for the PEP725 data set #############################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(data.table)
+require(broom)
+require(gmodels)
+require(patchwork)
+require(MASS)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################################
+## Set directories and get own PEP data ##
+##########################################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/PEP_analysis/Analysis")
+
+# paths
+PEP_drivers_path = "Analysis_input/PEP_drivers_final/Merged_file"
+output_path = "Analysis_output/Autumn/Data"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+PEP.df <- fread(paste(PEP_drivers_path, "pep_drivers_data.csv", sep="/"))%>%
+ dplyr::select(-V1)
+
+#------------------------------------------
+
+#Strong filter dataframe
+########################
+PEPshort.df <- PEP.df %>%
+ #delete years before 1980
+ filter(!year<1980)%>%
+ #delete groups with less than 30 years
+ group_by(timeseries)%>%
+ filter(n() >= 30)%>%
+ ungroup()
+
+#------------------------------------------
+
+#delete high elevation (>600 m) sites in full dataframe
+PEPlong.df = PEP.df %>% filter(!alt>600)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+############################
+## Moving window analysis ##
+############################
+
+
+
+#create year vector for loop
+year.vector.long = c(1966:(max(PEPlong.df$year)-19))
+year.vector.short = c(min(PEPshort.df$year):(max(PEPshort.df$year)-14))
+
+#create List object to store results
+DataList = replicate(2, data.frame())
+names(DataList) = c("Long","Short")
+
+#create List object of dataframes
+PEPdataList = list(PEPlong.df, PEPshort.df)
+#list of year vectors
+YearList = list(year.vector.long, year.vector.short)
+#moving window length (20 / 15 years)
+MovingWindowLength = c(20,15)
+
+
+
+#########################################################################################################################
+#########################################################################################################################
+
+
+
+################################
+# Run univariate linear models #
+################################
+
+
+
+for(k in 1:length(PEPdataList)){
+
+ #create moving window dataframes
+ mw.df = data.frame()
+ mw.all.df = data.frame()
+
+ #loop through years (moving windwows)
+ for (Year in YearList[[k]]){
+
+ #create table subset
+ PEP.df.sub = PEPdataList[[k]] %>%
+ filter(year >= Year,
+ year < Year+MovingWindowLength[k]) %>%
+ group_by(timeseries) %>%
+ filter(if (k==1) {n() >= 15} else {n() >= 12}
+ ) %>% #delete time series with less than 15/12 years
+ ungroup()
+
+
+ #reshape table to long format
+ #############################
+
+ preseason.df = PEP.df.sub %>%
+ #select columns
+ dplyr::select(timeseries,year,species,pep_id,leaf_off,leaf_off_mean,
+ Tnight.PS.10,Tnight.PS.20,Tnight.PS.30,
+ Tnight.PS.40,Tnight.PS.50,Tnight.PS.60,
+ Tnight.PS.70,Tnight.PS.80,Tnight.PS.90,
+ Tnight.PS.100,Tnight.PS.110,Tnight.PS.120)%>%
+ #long format
+ pivot_longer(.,cols=starts_with(c("Td","Tn")), names_to = "preseason", values_to = "temp") %>%
+ #create preseason length and temperature class columns
+ mutate(preseason_length = readr::parse_number(gsub("[.]", "", preseason)) #keep only numbers in string
+ #,temp_class = gsub("\\..*","", preseason)
+ ) %>%
+ dplyr::select(-preseason)
+
+
+ #Run linear models
+ ##################
+
+ resultsLM = preseason.df %>%
+ group_by(timeseries, species, pep_id, preseason_length, leaf_off_mean) %>%
+ do({model = lm(scale(leaf_off) ~ scale(temp), data=.) # linear model
+ data.frame(tidy(model), # coefficient info
+ glance(model))}) %>% # model info
+ filter(!term %in% c("(Intercept)")) %>%
+ dplyr::select(timeseries,species,pep_id,preseason_length,leaf_off_mean,estimate,r.squared)%>%
+ ungroup()
+
+ #--------------------------------------------------------------------------------------------------------------------
+
+ #keep only models with best R2 predictions
+ ##########################################
+
+ #Species-specific
+ resultsLM2 = resultsLM %>%
+ group_by(timeseries) %>%
+ top_n(1, r.squared) %>%
+ ungroup() %>%
+ mutate(preseason_start = leaf_off_mean - preseason_length) %>%
+ #Summarize by species
+ group_by(species) %>%
+ summarise(length = mean(preseason_length),
+ length.lowCI = t.test(preseason_length)$conf.int[1],
+ length.hiCI = t.test(preseason_length)$conf.int[2],
+ start = mean(preseason_start),
+ start.lowCI = t.test(preseason_start)$conf.int[1],
+ start.hiCI = t.test(preseason_start)$conf.int[2]) %>%
+ ungroup()
+
+ #All species
+ resultsLM2all = resultsLM %>%
+ group_by(timeseries) %>%
+ top_n(1, r.squared) %>%
+ ungroup() %>%
+ mutate(preseason_start = leaf_off_mean - preseason_length) %>%
+ #summarize all
+ summarise(length = mean(preseason_length),
+ length.lowCI = t.test(preseason_length)$conf.int[1],
+ length.hiCI = t.test(preseason_length)$conf.int[2],
+ start = mean(preseason_start),
+ start.lowCI = t.test(preseason_start)$conf.int[1],
+ start.hiCI = t.test(preseason_start)$conf.int[2]) %>%
+ mutate(species="Aall")
+
+ #rbind species-specific and all species results
+ resultsLM2 = rbind(resultsLM2, resultsLM2all) %>%
+ mutate(variable = "R2",
+ year=Year)
+
+ #--------------------------------------------------------------------------------------------------------------------
+
+ #keep only models with highest coefficients
+ ###########################################
+
+ #Species-specific
+ resultsLM3 = resultsLM %>%
+ group_by(timeseries) %>%
+ top_n(1, estimate) %>%
+ ungroup() %>%
+ #Summarize by species
+ mutate(preseason_start = leaf_off_mean - preseason_length) %>%
+ group_by(species) %>%
+ summarise(length = mean(preseason_length),
+ length.lowCI = t.test(preseason_length)$conf.int[1],
+ length.hiCI = t.test(preseason_length)$conf.int[2],
+ start = mean(preseason_start),
+ start.lowCI = t.test(preseason_start)$conf.int[1],
+ start.hiCI = t.test(preseason_start)$conf.int[2]) %>%
+ ungroup()
+
+ #All species
+ resultsLM3all = resultsLM %>%
+ group_by(timeseries) %>%
+ top_n(1, estimate) %>%
+ ungroup() %>%
+ mutate(preseason_start = leaf_off_mean - preseason_length) %>%
+ #summarize all
+ summarise(length = mean(preseason_length),
+ length.lowCI = t.test(preseason_length)$conf.int[1],
+ length.hiCI = t.test(preseason_length)$conf.int[2],
+ start = mean(preseason_start),
+ start.lowCI = t.test(preseason_start)$conf.int[1],
+ start.hiCI = t.test(preseason_start)$conf.int[2]) %>%
+ mutate(species="Aall")
+
+ #rbind species-specific and all species results
+ resultsLM3 = rbind(resultsLM3, resultsLM3all) %>%
+ mutate(variable = "coefficient",
+ year=Year)
+
+ #--------------------------------------------------------------------------------------------------------------------
+
+ #rbind moving window subsets
+ mw.df = rbind(mw.df, resultsLM2, resultsLM3)
+
+ #--------------------------------------------------------------------------------------------------------------------
+
+ print(paste0('year ', Year, ' done (', min(PEPdataList[[k]]$year),'-',(max(PEPdataList[[k]]$year)-19),') [Dataset ', k, ' of ', length(DataList),']'))
+ }
+
+ #rbind all data
+ mw.all.df = bind_rows(mw.all.df, mw.df) %>%
+ #rename factors
+ mutate(dataset = ifelse(k==1, 'Long', 'Short'))
+
+ #---------------------------------------------------------
+
+ #store dataframe in variable list
+ DataList[[k]] = mw.all.df
+ }
+
+
+#bind rows
+MovingWindowAnalysis.df = bind_rows(DataList)
+
+#Safe table
+write.csv(MovingWindowAnalysis.df, paste(output_path, "Moving_window_data_preseason.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
+
\ No newline at end of file
diff --git a/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.4.2_Moving_windows_pre_solstice_effect.R b/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.4.2_Moving_windows_pre_solstice_effect.R
new file mode 100644
index 0000000..f07d412
--- /dev/null
+++ b/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.4.2_Moving_windows_pre_solstice_effect.R
@@ -0,0 +1,289 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Pre-solstice effect moving-window analysis for the PEP725 data set ########################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(data.table)
+require(broom)
+require(gmodels)
+require(patchwork)
+require(MASS)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################################
+## Set directories and get own PEP data ##
+##########################################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/PEP_analysis/Analysis")
+
+# paths
+PEP_drivers_path = "Analysis_input/PEP_drivers_final/Merged_file"
+output_path = "Analysis_output/Autumn/Data"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+PEP.df <- fread(paste(PEP_drivers_path, "pep_drivers_data_new.csv", sep="/"))%>%
+ dplyr::select(-V1)
+
+#------------------------------------------
+
+#Strong filter dataframe
+########################
+PEPshort.df <- PEP.df %>%
+ #delete years before 1980
+ filter(!year<1980)%>%
+ #delete groups with less than 30 years
+ group_by(timeseries)%>%
+ filter(n() >= 30)%>%
+ ungroup()
+
+#------------------------------------------
+
+#delete high elevation (>600 m) sites in full dataframe
+PEPlong.df = PEP.df %>% filter(!alt>600)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+############################
+## Moving window analysis ##
+############################
+
+
+
+#create year vector for loop
+year.vector.long = c(1966:(max(PEPlong.df$year)-19))
+year.vector.short = c(min(PEPshort.df$year):(max(PEPshort.df$year)-14))
+
+#Define covariate groups
+variables = c('Azani','Tday','Tnight','SWrad')
+
+#create List object to store results
+DataList = replicate(2, data.frame())
+names(DataList) = c("Long","Short")
+
+#create List object of dataframes
+PEPdataList = list(PEPlong.df, PEPshort.df)
+#list of year vectors
+YearList = list(year.vector.long, year.vector.short)
+#moving window length (20 / 15 years)
+MovingWindowLength = c(20,15)
+
+
+
+#########################################################################################################################
+#########################################################################################################################
+
+
+
+################################
+# Run univariate linear models #
+################################
+
+
+
+for(k in 1:length(PEPdataList)){
+
+ mw.all.df = data.frame()
+ mw.variable.df = data.frame()
+
+ #Loop through covariate groups
+ for (i in 1:length(variables)){
+
+ #create moving window dataframes
+ mw.year.df = data.frame()
+
+ variable.names=c(paste0(variables[i],".LO.SOm60"),
+ paste0(variables[i],".LO.SOm50"),
+ paste0(variables[i],".LO.SOm40"),
+ paste0(variables[i],".LO.SOm30"),
+ paste0(variables[i],".LO.SOm20"),
+ paste0(variables[i],".LO.SOm10"),
+ paste0(variables[i],".LO.SO"),
+ paste0(variables[i],".LO.SOp10"),
+ paste0(variables[i],".LO.SOp20"),
+ paste0(variables[i],".LO.SOp30"),
+ paste0(variables[i],".LO.SOp40"),
+ paste0(variables[i],".LO.SOp50"),
+ paste0(variables[i],".LO.SOp60"))
+
+
+ #loop through years (moving windwows)
+ for (Year in YearList[[k]]){
+
+ #create table subset
+ PEP.df.sub = PEPdataList[[k]] %>%
+ filter(year >= Year,
+ year < Year+MovingWindowLength[k]) %>%
+ group_by(timeseries) %>%
+ filter(if (k==1) {n() >= 15} else {n() >= 12}
+ ) %>% #delete time series with less than 15/12 years
+ ungroup()
+
+
+ #reshape table to long format
+ #############################
+
+ presolstice.df = PEP.df.sub %>%
+ #select columns
+ dplyr::select(timeseries,year,species,pep_id,leaf_out,leaf_off,leaf_off_mean,
+ all_of(variable.names)) %>%
+ #long format
+ pivot_longer(.,cols=starts_with(variables[i]), names_to = "period", values_to = "value")%>%
+ #create preseason length and temperature class columns
+ mutate(period_end = ifelse(period == paste0(variables[i],".LO.SOm60"), 172-60,
+ ifelse(period == paste0(variables[i],".LO.SOm50"), 172-50,
+ ifelse(period == paste0(variables[i],".LO.SOm40"), 172-40,
+ ifelse(period == paste0(variables[i],".LO.SOm30"), 172-30,
+ ifelse(period == paste0(variables[i],".LO.SOm20"), 172-20,
+ ifelse(period == paste0(variables[i],".LO.SOm10"), 172-10,
+ ifelse(period == paste0(variables[i],".LO.SO"), 172,
+ ifelse(period == paste0(variables[i],".LO.SOp10"), 172+10,
+ ifelse(period == paste0(variables[i],".LO.SOp20"), 172+20,
+ ifelse(period == paste0(variables[i],".LO.SOp30"), 172+30,
+ ifelse(period == paste0(variables[i],".LO.SOp40"), 172+40,
+ ifelse(period == paste0(variables[i],".LO.SOp50"), 172+50,172+60)))))))))))))
+
+
+ #Run models
+ ###########
+
+ resultsLM = presolstice.df %>%
+ group_by(species, timeseries, period_end) %>%
+ do({coeff = cor(.$leaf_off, .$value)
+ leafout = mean(.$leaf_out)
+ data.frame(estimate = coeff,
+ leaf_out = leafout)}) %>% # model info
+ dplyr::select(species,leaf_out,period_end,timeseries,estimate)%>%
+ ungroup()
+
+
+ #--------------------------------------------------------------------------------------------------------------------
+
+ #keep only models with lowest estimates
+ #######################################
+
+ #Species-specific
+ resultsLM2 = resultsLM %>%
+ group_by(timeseries) %>%
+ top_n(-1, estimate) %>%
+ ungroup() %>%
+ mutate(length = period_end - leaf_out) %>%
+ #Summarize by species
+ group_by(species) %>%
+ summarise(start = mean(leaf_out),
+ start.lowCI = t.test(leaf_out)$conf.int[1],
+ start.hiCI = t.test(leaf_out)$conf.int[2],
+
+ end = mean(period_end),
+ end.lowCI = t.test(period_end)$conf.int[1],
+ end.hiCI = t.test(period_end)$conf.int[2],
+
+ duration = mean(length),
+ duration.lowCI = t.test(length)$conf.int[1],
+ duration.hiCI = t.test(length)$conf.int[2]) %>%
+ ungroup()
+
+ #All species
+ resultsLM2all = resultsLM %>%
+ group_by(timeseries) %>%
+ top_n(-1, estimate) %>%
+ ungroup() %>%
+ mutate(length = period_end - leaf_out) %>%
+ #summarize all
+ summarise(start = mean(leaf_out),
+ start.lowCI = t.test(leaf_out)$conf.int[1],
+ start.hiCI = t.test(leaf_out)$conf.int[2],
+
+ end = mean(period_end),
+ end.lowCI = t.test(period_end)$conf.int[1],
+ end.hiCI = t.test(period_end)$conf.int[2],
+
+ duration = mean(length),
+ duration.lowCI = t.test(length)$conf.int[1],
+ duration.hiCI = t.test(length)$conf.int[2]) %>%
+ mutate(species="Aall")
+
+ #rbind species-specific and all species results
+ resultsLM2 = rbind(resultsLM2, resultsLM2all) %>%
+ mutate(year = Year,
+ variable = variables[i],
+ )
+
+ #--------------------------------------------------------------------------------------------------------------------
+
+ #rbind moving window subsets
+ mw.year.df = rbind(mw.year.df, resultsLM2)
+
+ #--------------------------------------------------------------------------------------------------------------------
+
+ print(paste0('year ', Year, ' done (', min(PEPdataList[[k]]$year),'-',(max(PEPdataList[[k]]$year)-19),') ', variables[i], ' [Dataset ', k, ' of ', length(DataList),']'))
+ }
+
+ #rbind all data
+ mw.variable.df = bind_rows(mw.variable.df, mw.year.df)
+ }
+
+ #rbind all data
+ mw.all.df = bind_rows(mw.all.df, mw.variable.df) %>%
+ #rename factors
+ mutate(dataset = ifelse(k==1, 'Long', 'Short'))
+
+ #---------------------------------------------------------
+
+ #store dataframe in variable list
+ DataList[[k]] = mw.all.df
+}
+
+
+#bind rows
+MovingWindowAnalysis.df = bind_rows(DataList)
+
+#Safe table
+write.csv(MovingWindowAnalysis.df, paste(output_path, "Moving_window_data_pre_solstice.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
+
\ No newline at end of file
diff --git a/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.4.3_Moving_windows_solstice_effect.R b/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.4.3_Moving_windows_solstice_effect.R
new file mode 100644
index 0000000..88d22b1
--- /dev/null
+++ b/R code/PEP_analysis/3_Analysis/3.3_Modeling/3.3.4.3_Moving_windows_solstice_effect.R
@@ -0,0 +1,268 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Solstice effect moving-window analysis for the PEP725 data set ############################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(data.table)
+require(broom)
+require(gmodels)
+require(patchwork)
+require(MASS)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################################
+## Set directories and get own PEP data ##
+##########################################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/PEP_analysis/Analysis")
+
+# paths
+PEP_drivers_path = "Analysis_input/PEP_drivers_final/Merged_file"
+output_path = "Analysis_output/Autumn/Data"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+PEP.df <- fread(paste(PEP_drivers_path, "pep_drivers_data_preseason.csv", sep="/"))%>%
+ dplyr::select(-V1)
+
+#------------------------------------------
+
+#Strong filter dataframe
+########################
+PEPshort.df <- PEP.df %>%
+ #delete years before 1980
+ filter(!year<1980)%>%
+ #delete groups with less than 30 years
+ group_by(timeseries)%>%
+ filter(n() >= 30)%>%
+ ungroup()
+
+#------------------------------------------
+
+#delete high elevation (>600 m) sites in full dataframe
+PEPlong.df = PEP.df %>% filter(!alt>600)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+############################
+## Moving window analysis ##
+############################
+
+
+
+#create year vector for loop
+year.vector.long = c(1966:(max(PEPlong.df$year)-19))
+year.vector.short = c(min(PEPshort.df$year):(max(PEPshort.df$year)-14))
+
+#Define covariate groups
+variables = c('Tday','Tnight','SWrad')
+
+#create List object to store results
+DataList = replicate(2, data.frame())
+names(DataList) = c("Long","Short")
+
+#create List object of dataframes
+PEPdataList = list(PEPlong.df, PEPshort.df)
+#list of year vectors
+YearList = list(year.vector.long, year.vector.short)
+#moving window length (20 / 15 years)
+MovingWindowLength = c(20,15)
+
+
+
+#########################################################################################################################
+#########################################################################################################################
+
+
+
+################################
+# Run moving window analysis to get correlation #
+################################
+
+
+
+for(k in 1:length(PEPdataList)){
+
+ mw.all.df = data.frame()
+ mw.variable.df = data.frame()
+
+ #Loop through covariate groups
+ for (i in 1:length(variables)){
+
+ #create moving window dataframes
+ mw.year.df = data.frame()
+
+ variable.names=c(paste0(variables[i],c(".solstice1",".solstice2",".solstice3",".solstice4",".solstice5",".solstice6")))
+
+ #loop through years (moving windwows)
+ for (Year in YearList[[k]]){
+
+ #create table subset
+ PEP.df.sub = PEPdataList[[k]] %>%
+ filter(year >= Year,
+ year < Year+MovingWindowLength[k]) %>%
+ group_by(timeseries) %>%
+ filter(if (k==1) {n() >= 15} else {n() >= 12}
+ ) %>% #delete time series with less than 15/12 years
+ ungroup()
+
+
+ #reshape table to long format
+ #############################
+
+ presolstice.df = PEP.df.sub %>%
+ #select columns
+ dplyr::select(timeseries,year,species,pep_id,leaf_out,leaf_off,leaf_off_mean,
+ all_of(variable.names)) %>%
+ #long format
+ pivot_longer(.,cols=starts_with(variables[i]), names_to = "period", values_to = "value")%>%
+ #create period end column (DOY)
+ mutate(period_end = ifelse(period == paste0(variables[i],".solstice1"), 172-10,
+ ifelse(period == paste0(variables[i],".solstice2"), 172,
+ ifelse(period == paste0(variables[i],".solstice3"), 172+10,
+ ifelse(period == paste0(variables[i],".solstice4"), 172+20,
+ ifelse(period == paste0(variables[i],".solstice5"), 172+30, 172+40))))))
+
+
+ #Run linear models
+ ##################
+
+ resultsLM = presolstice.df %>%
+ group_by(species, timeseries, period_end) %>%
+ do({coeff = cor(.$leaf_off, .$value)
+ leafout = mean(.$leaf_out)
+ data.frame(estimate = coeff,
+ leaf_out = leafout)}) %>% # model info
+ dplyr::select(species,leaf_out,period_end,timeseries,estimate)%>%
+ ungroup()
+
+ #--------------------------------------------------------------------------------------------------------------------
+
+ #keep only models with lowest estimates
+ #######################################
+
+ #Species-specific
+ resultsLM2 = resultsLM %>%
+ group_by(timeseries) %>%
+ top_n(-1, estimate) %>%
+ ungroup() %>%
+ mutate(length = period_end - leaf_out) %>%
+ #Summarize by species
+ group_by(species) %>%
+ summarise(start = mean(leaf_out),
+ start.lowCI = t.test(leaf_out)$conf.int[1],
+ start.hiCI = t.test(leaf_out)$conf.int[2],
+
+ end = mean(period_end),
+ end.lowCI = t.test(period_end)$conf.int[1],
+ end.hiCI = t.test(period_end)$conf.int[2],
+
+ duration = mean(length),
+ duration.lowCI = t.test(length)$conf.int[1],
+ duration.hiCI = t.test(length)$conf.int[2]) %>%
+ ungroup()
+
+ #All species
+ resultsLM2all = resultsLM %>%
+ group_by(timeseries) %>%
+ top_n(-1, estimate) %>%
+ ungroup() %>%
+ mutate(length = period_end - leaf_out) %>%
+ #summarize all
+ summarise(start = mean(leaf_out),
+ start.lowCI = t.test(leaf_out)$conf.int[1],
+ start.hiCI = t.test(leaf_out)$conf.int[2],
+
+ end = mean(period_end),
+ end.lowCI = t.test(period_end)$conf.int[1],
+ end.hiCI = t.test(period_end)$conf.int[2],
+
+ duration = mean(length),
+ duration.lowCI = t.test(length)$conf.int[1],
+ duration.hiCI = t.test(length)$conf.int[2]) %>%
+ mutate(species="Aall")
+
+ #rbind species-specific and all species results
+ resultsLM2 = rbind(resultsLM2, resultsLM2all) %>%
+ mutate(year = Year,
+ variable = variables[i],
+ )
+
+ #--------------------------------------------------------------------------------------------------------------------
+
+ #rbind moving window subsets
+ mw.year.df = rbind(mw.year.df, resultsLM2)
+
+ #--------------------------------------------------------------------------------------------------------------------
+
+ print(paste0('year ', Year, ' done (', min(PEPdataList[[k]]$year),'-',(max(PEPdataList[[k]]$year)-19),') ', variables[i], ' [Dataset ', k, ' of ', length(DataList),']'))
+ }
+
+ #rbind all data
+ mw.variable.df = bind_rows(mw.variable.df, mw.year.df)
+ }
+
+ #rbind all data
+ mw.all.df = bind_rows(mw.all.df, mw.variable.df) %>%
+ #rename factors
+ mutate(dataset = ifelse(k==1, 'Long', 'Short'))
+
+ #---------------------------------------------------------
+
+ #store dataframe in variable list
+ DataList[[k]] = mw.all.df
+}
+
+
+#bind rows
+MovingWindowAnalysis.df = bind_rows(DataList)
+
+#Safe table
+write.csv(MovingWindowAnalysis.df, paste(output_path, "Moving_window_data_solstice.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
+
\ No newline at end of file
diff --git a/R code/PEP_analysis/3_Analysis/3.4_Figures/3.4.1_Main_figures.Rmd b/R code/PEP_analysis/3_Analysis/3.4_Figures/3.4.1_Main_figures.Rmd
new file mode 100644
index 0000000..19d2c84
--- /dev/null
+++ b/R code/PEP_analysis/3_Analysis/3.4_Figures/3.4.1_Main_figures.Rmd
@@ -0,0 +1,1209 @@
+---
+title: Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice
+author: Constantin Zohner
+date: "last updated March 30, 2023"
+
+subtitle: PEP725 data (Figs. 4, S15, S16 and S19)
+output:
+ html_document:
+ highlight: haddock
+ toc: false
+ use_bookdown: true
+ df_print: paged
+---
+
+
+
+
+
+### Figure descriptions
+- Fig. 4: The seasonal effects of temperature on inter-annual variation in mid-senescence (EOS50 dates) from European long-term observations (PEP725 data)
+- Fig. S15: Relationships between seasonal photosynthesis and the timing of mid-senescence (EOS50) from European long-term observations (PEP725 data; same as Fig. 4 but using photosynthesis as predictor variable)
+- Fig. S16: Predicted mid-senescence (EOS50) anomalies in response to mean annual temperature (MAT) anomalies from European long-term observations (PEP725 data)
+- Fig. S19: Moving window analyses of EOS50 dates using the local PEP725 observations and covering each 20-year time period from 1966 to 2015 (left panels) or each 15-year time period from 1980 to 2015 (right panels)
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(
+ class.source = "numberLines lineAnchors"
+ )
+```
+
+
+
+```{r, message=FALSE, warning=FALSE, attr.source='.numberLines'}
+###################
+# Required packages
+###################
+
+
+
+require(tidyverse)
+require(data.table)
+require(ggplot2)
+require(pracma)
+require(wesanderson)
+require(patchwork)
+require(broom)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/PEP_analysis/Analysis")
+
+
+# Paths
+
+#input
+PEP_drivers_path = "Analysis_input/PEP_drivers_final/Merged_file"
+PEP_analysis_path = "Analysis_output/Autumn/Data"
+photo_path = "Analysis_input/Drivers" #Photoperiod file
+
+#output
+output_path = "Analysis_output/Autumn/Publication_figures"
+output_path_monthly = "Analysis_output/Autumn/Monthly_correlations"
+output_path_seasonal = "Analysis_output/Autumn/Seasonal_correlations"
+output_path_movingWindow = "Analysis_output/Autumn/Moving_window"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Predictions dataframe
+######################
+
+Predictions.df = as.data.frame(fread(paste(PEP_drivers_path, "pep_drivers_data_preseason_predictions.csv", sep="/"))) %>%
+ #get mean annual temperature
+ mutate(MAT = rowMeans(.[c("Tday1","Tday2","Tday3","Tday4","Tday5","Tday6",
+ "Tday7","Tday8","Tday9","Tday10","Tday11","Tday12")])) %>%
+ #get timeries-level MAT and leaf-off anomalies
+ group_by(timeseries)%>%
+ mutate(MATanomaly = MAT - mean(MAT),
+ leaf_off_anomaly = leaf_off - mean(leaf_off)) %>%
+ ungroup()
+
+
+#Mixed models dataframe
+#######################
+
+MM.df = fread(paste(PEP_analysis_path, "Mixed_effect_data.csv", sep="/"))
+#term: monthly coefficients (1-10) and seasonal coeffcients
+#estimate: slopes or standardized coefficients of mixed effects models
+#std.error: std.error of coefficients
+#statisitc:
+#variable: climate variable (Apm, Azani, GSI, GSIrad, GDDday, GDDday, Tday, Tnight, SWrad)
+#equation: full model 1/2, monthly/seasonal/solstice, scaled/unscaled, tempCon (Tnight controlled)
+#species: All, Fagus, Betula, Quercus, Aesculus
+
+
+# get full model correlations
+#############################
+
+FullMM.df = MM.df %>%
+ #filter monthly models
+ filter(equation == 'full model')
+
+
+# get monthly correlations
+##########################
+
+MonthlyMM.df = MM.df %>%
+ #filter monthly models
+ filter(grepl("monthly",equation)) %>%
+ #Add variable x equation identifier
+ mutate(variable.equation.species = paste(variable, equation, species, sep='.'),
+ variable.equation = paste(variable, equation, sep='.'),
+ term = as.numeric(term))
+
+
+# get seasonal correlations
+###########################
+
+SeasonalMM.df = MM.df %>%
+ #filter monthly models
+ filter(!grepl("monthly",equation),
+ !equation == 'full model') %>%
+ #Add variable x equation identifier
+ mutate(variable.equation = paste(variable, equation, sep='.'),
+ variable.class = gsub("^.*?\\.","", term) ) %>%
+ filter(!variable.class == "SOp60.SE")
+
+
+#Moving window dataframe
+########################
+
+MW.df = fread(paste(PEP_analysis_path, "Moving_window_data.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+################
+## Plot theme ##
+################
+
+
+#Color.palette: col=c('#F21A00','#E1AF00','#EBCC2A','#78B7C5','#3B9AB2')
+
+plotTheme1 = theme(
+ legend.position = "none",
+ legend.background = element_blank(),
+ legend.text = element_text(color="black"),
+ legend.title = element_blank(),
+ legend.key = element_blank(),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black',face = "italic"),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+###################################################################################
+## Get date of reversal of climate-phenology relationship for moving window data ##
+###################################################################################
+
+
+
+#Data wrangling
+MWreversal.df = MW.df %>%
+ #keep only monthly estimates
+ filter(equation == 'monthly') %>%
+ #convert term (months) to numeric and keep only May to Sep
+ mutate(term = as.numeric(term)) %>%
+ filter(term %in% c(4:9))
+
+#-------------------------------------------------------------
+
+#get reversal date for mean estimate
+####################################
+
+MWreversalMean.df = MWreversal.df %>%
+ #group
+ group_by(dataset, species, variable, year)%>%
+ #get difference in estimate between month and preceding month
+ mutate(Diff.autumn = estimate - lag(estimate),
+ Diff.spring = estimate - lead(estimate))%>%
+ #delete autumn months for which the correlation decreases realtive to previous month
+ filter(! (Diff.autumn < 0 & term %in% c(8:10)),
+ ! (Diff.spring > 0 & term %in% c(1:5)))%>%
+ #redo 2 times
+ mutate(Diff.autumn = estimate - lag(estimate),
+ Diff.spring = estimate - lead(estimate))%>%
+ filter(! (Diff.autumn < 0 & term %in% c(8:10))&
+ ! (Diff.spring > 0 & term %in% c(1:5)))%>%
+ mutate(Diff.autumn = estimate - lag(estimate),
+ Diff.spring = estimate - lead(estimate))%>%
+ filter(! (Diff.autumn < 0 & term %in% c(8:10)),
+ ! (Diff.spring > 0 & term %in% c(1:5)))%>%
+ #convert months to date
+ mutate(date = as.Date((paste0('2000-',term,'-15'))))%>%
+ #approximate date of reversal
+ summarize(date0 = as.Date(approx(estimate, date, .0)$y, origin="1970-01-01"))%>%
+ ungroup()
+
+#-------------------------------------------------------------
+
+#get reversal date for upper estimate
+#####################################
+
+MWreversalUpper.df = MWreversal.df %>%
+ #get upper confidence value
+ mutate(upper.estimate = estimate + 2*std.error)%>%
+ #group
+ group_by(dataset, species, variable, year)%>%
+ #get difference in estimate between month and preceding month
+ mutate(Diff.autumn = upper.estimate - lag(upper.estimate),
+ Diff.spring = upper.estimate - lead(upper.estimate))%>%
+ #delete autumn months for which the correlation decreases realtive to previous month
+ filter(! (Diff.autumn < 0 & term %in% c(8:10)),
+ ! (Diff.spring > 0 & term %in% c(1:5)))%>%
+ #redo 2 times
+ mutate(Diff.autumn = upper.estimate - lag(upper.estimate),
+ Diff.spring = upper.estimate - lead(upper.estimate))%>%
+ filter(! (Diff.autumn < 0 & term %in% c(8:10))&
+ ! (Diff.spring > 0 & term %in% c(1:5)))%>%
+ mutate(Diff.autumn = upper.estimate - lag(upper.estimate),
+ Diff.spring = upper.estimate - lead(upper.estimate))%>%
+ filter(! (Diff.autumn < 0 & term %in% c(8:10)),
+ ! (Diff.spring > 0 & term %in% c(1:5)))%>%
+ #convert months to date
+ mutate(date = as.Date((paste0('2000-',term,'-15'))))%>%
+ #approximate date of reversal
+ summarize(date0.upper = as.Date(approx(upper.estimate, date, .0)$y, origin="1970-01-01"))%>%
+ ungroup()
+
+#-------------------------------------------------------------
+
+#get reversal date for lower estimate
+#####################################
+
+MWreversalLower.df = MWreversal.df %>%
+ #get lower confidence value
+ mutate(lower.estimate = estimate - 2*std.error)%>%
+ #group
+ group_by(dataset, species, variable, year)%>%
+ #get difference in estimate between month and preceding month
+ mutate(Diff.autumn = lower.estimate - lag(lower.estimate),
+ Diff.spring = lower.estimate - lead(lower.estimate))%>%
+ #delete autumn months for which the correlation decreases realtive to previous month
+ filter(! (Diff.autumn < 0 & term %in% c(8:10)),
+ ! (Diff.spring > 0 & term %in% c(1:5)))%>%
+ #redo 2 times
+ mutate(Diff.autumn = lower.estimate - lag(lower.estimate),
+ Diff.spring = lower.estimate - lead(lower.estimate))%>%
+ filter(! (Diff.autumn < 0 & term %in% c(8:10))&
+ ! (Diff.spring > 0 & term %in% c(1:5)))%>%
+ mutate(Diff.autumn = lower.estimate - lag(lower.estimate),
+ Diff.spring = lower.estimate - lead(lower.estimate))%>%
+ filter(! (Diff.autumn < 0 & term %in% c(8:10)),
+ ! (Diff.spring > 0 & term %in% c(1:5)))%>%
+ #convert months to date
+ mutate(date = as.Date((paste0('2000-',term,'-15'))))%>%
+ #approximate date of reversal
+ summarize(date0.lower = as.Date(approx(lower.estimate, date, .0)$y, origin="1970-01-01"))%>%
+ ungroup()
+
+#-------------------------------------------------------------
+
+#cbind
+MWreversal.df = cbind(MWreversalMean.df, date0.upper=MWreversalUpper.df$date0.upper, date0.lower=MWreversalLower.df$date0.lower)
+rm(MWreversalMean.df, MWreversalUpper.df, MWreversalLower.df)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################################
+## Interpolation of monthly estimates ##
+########################################
+
+
+
+#Interpolation function
+lin_interp = function(x, y, length.out=100) {
+ approx(x, y, xout=seq(min(x), max(x), length.out=length.out))$y
+}
+
+#create identifier
+variable.equation.species = unique(MonthlyMM.df$variable.equation.species)
+
+#create interpolation dataframe
+df.interp = data.frame()
+df.AUC = data.frame()
+
+#loop over variable x equation x species vector
+for (variable.name in variable.equation.species){
+
+ #subset table
+ df.sub = MonthlyMM.df %>%
+ filter(variable.equation.species == variable.name)
+
+ # Interpolate data
+ created.interp = lin_interp(df.sub$term, df.sub$term)
+ score.interp = lin_interp(df.sub$term, df.sub$estimate)
+ df.interp.sub = data.frame(created=created.interp, score=score.interp)
+ # Make a grouping variable for each pos/neg segment
+ cat.rle = rle(df.interp.sub$score < 0)
+ df.interp.sub = df.interp.sub %>%
+ mutate(group = rep.int(1:length(cat.rle$lengths), times=cat.rle$lengths),
+ species = unique(df.sub$species),
+ variable = unique(df.sub$variable),
+ equation = unique(df.sub$equation),
+ variable.equation = paste(variable, equation, sep='.') )
+ #rbind sub dataframes
+ df.interp = rbind(df.interp, df.interp.sub)
+
+ #get Area under curve (%)
+ df.AUC.sub = df.interp.sub %>%
+ mutate(positive = ifelse(score<0, 0, score),
+ negative = ifelse(score>0, 0, score))%>%
+ summarise(sum.pos = trapz(created, positive),
+ sum.neg = abs(trapz(created, negative)))%>%
+ mutate(percent.neg = round(sum.neg/(sum.pos+sum.neg)*100),
+ percent.pos = round(sum.pos/(sum.pos+sum.neg)*100),
+ species = unique(df.sub$species),
+ variable = unique(df.sub$variable),
+ equation = unique(df.sub$equation),
+ variable.equation = paste(variable, equation, sep='.') )
+ #rbind sub dataframes
+ df.AUC = rbind(df.AUC, df.AUC.sub)
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#########################
+## Publication figures ##
+#########################
+
+
+
+######################
+# Photoperiod figure #
+######################
+
+
+# dataframe of photoperiods
+photo.df = fread(paste(photo_path, "Photoperiod.csv", sep="/"))
+phot.sub=photo.df[1,3:367]
+phot.sub=rbind(as.data.frame(t(phot.sub)), as.data.frame(t(phot.sub)))
+phot.sub$X = as.Date(1:nrow(phot.sub), origin = "2016-12-31")
+
+
+# Plot of periods around solstice
+#################################
+
+#dataframe of periods
+solstice.data = rbind(
+ data.frame(X=as.Date(c("2017-05-14","2017-06-12")), Y=10, season = "A"),
+ data.frame(X=as.Date(c("2017-05-24","2017-06-22")), Y=11, season = "B"),
+ data.frame(X=as.Date(c("2017-06-02","2017-07-01")), Y=12, season = "C"),
+ data.frame(X=as.Date(c("2017-06-12","2017-07-11")), Y=13, season = "D"),
+ data.frame(X=as.Date(c("2017-06-22","2017-07-21")), Y=14, season = "E"),
+ data.frame(X=as.Date(c("2017-07-03","2017-08-01")), Y=15, season = "F") )
+
+#Plot
+PhotoSolstice = ggplot() +
+ #day length line
+ geom_line(data=phot.sub, aes(x=X, y=V1, group=1),col="black") +
+ #solstice
+ geom_vline(xintercept = as.Date("2017-06-22"), size=1, alpha=0.4)+
+ #periods
+ geom_line(data=solstice.data, aes(x=X, y=Y, color=season), size=2.75)+
+ scale_color_manual(values = rev(wes_palette(6, name = "Zissou1", type = "continuous")))+
+
+ #plot settings
+ coord_cartesian(xlim=c(as.Date(c('2017-03-01','2017-10-31'))), ylim=c(10,16))+
+ ylab("Day length")+xlab("")+
+ plotTheme1
+
+
+# Plot of seasonal periods
+##########################
+
+#dataframe of periods
+seasonal.data = rbind(data.frame(X=as.Date(c("2017-04-25","2017-05-24")), Y=10.25, season = 'A'),
+ data.frame(X=as.Date(c("2017-04-25","2017-06-22")), Y=11, season = 'B'),
+ data.frame(X=as.Date(c("2017-04-25","2017-07-21")), Y=11.75, season = 'C'),
+ data.frame(X=as.Date(c("2017-04-25","2017-08-20")), Y=12.5, season = 'D'),
+ data.frame(X=as.Date(c("2017-04-25","2017-10-08")), Y=13.25, season = 'E'),
+ data.frame(X=as.Date(c("2017-05-24","2017-10-08")), Y=14, season = 'F'),
+ data.frame(X=as.Date(c("2017-06-22","2017-10-08")), Y=14.75, season = 'G'),
+ data.frame(X=as.Date(c("2017-07-21","2017-10-08")), Y=15.5, season = 'H')
+ #data.frame(X=as.Date(c("2017-08-20","2017-10-08")), Y=16, season = 'I')
+ )
+
+#Plot
+PhotoSeasonal = ggplot() +
+ #day length line
+ geom_line(data=phot.sub, aes(x=X, y=V1, group=1),col="black") +
+ #periods
+ geom_line(data=seasonal.data, aes(x=X, y=Y, color=season), size=2)+
+ scale_color_manual(values = rev(wes_palette(8, name = "Zissou1", type = "continuous")))+
+ #solstice
+ geom_vline(xintercept = as.Date("2017-06-22"), size=1, alpha=0.4)+
+ #plot settings
+ coord_cartesian(xlim=c(as.Date(c('2017-03-01','2017-10-31'))), ylim=c(10,16))+
+ ylab("Day length")+xlab("")+
+ plotTheme1
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+###########
+# Figures #
+###########
+
+
+#create identifier
+variable = c("Azani", "Tday")
+
+#loop
+for (variable.name in variable){
+
+ ##############################################################################################################################################
+ ##############################################################################################################################################
+
+
+ ###############
+ # Monthly plots
+ ###############
+
+
+ #subset the table
+ #################
+
+ MonthlyMM.df.sub = MonthlyMM.df %>%
+ filter(variable == variable.name,
+ grepl("monthly.scaled",equation) )
+
+ df.interp.sub = df.interp %>%
+ filter(variable == variable.name,
+ grepl("monthly.scaled",equation) )
+
+ df.AUC.sub = df.AUC %>%
+ filter(variable == variable.name,
+ grepl("monthly.scaled",equation) )
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ # Plots
+ #######
+
+ #set x and y ranges
+ if(variable.name %in% c("Azani")){
+ xRange=c(3.2, 9.9)
+ yRange=c(-0.1,0.1)
+ yRange2=c(-0.14,0.14)} else {
+ xRange=c(1.3, 9.7)
+ yRange=c(-0.14, 0.14)
+ yRange2=c(-0.2, 0.2) }
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ #All species
+ plotA = ggplot() +
+ geom_area(data = df.interp.sub[df.interp.sub$species=='Aall',], aes(x = created, y = score, fill=score>0, group=group)) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+ geom_point(data=MonthlyMM.df.sub[MonthlyMM.df.sub$species=='Aall',],
+ aes(x=term, y=estimate))+
+ geom_errorbar(data=MonthlyMM.df.sub[MonthlyMM.df.sub$species=='Aall',],
+ aes(x=term, ymin=estimate-2*std.error, ymax=estimate+2*std.error), width=.2,
+ position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ geom_vline(xintercept=6.3, size=2, alpha=0.4)+
+ geom_text(data = df.AUC.sub[df.AUC.sub$species=='Aall',], mapping = aes(x = -Inf, y = Inf,
+ hjust = -0.1, vjust = 1.5,
+ label = paste0(percent.neg,'% / ',percent.pos, '%')))+
+ coord_cartesian(xlim=xRange, ylim=yRange)+
+ xlab("")+ylab("Standardized effect")+
+ scale_x_continuous(breaks = seq(1,10,by=1),
+ labels = c('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct'))+
+ plotTheme1
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ #Species-specific
+ plotB = ggplot() +
+ geom_area(data = df.interp.sub[df.interp.sub$species!='Aall',], aes(x = created, y = score, fill=score>0, group=group)) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+ geom_point(data=MonthlyMM.df.sub[MonthlyMM.df.sub$species!='Aall',],
+ aes(x=term, y=estimate))+
+ geom_errorbar(data=MonthlyMM.df.sub[MonthlyMM.df.sub$species!='Aall',],
+ aes(x=term, ymin=estimate-2*std.error, ymax=estimate+2*std.error), width=.2,
+ position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ geom_vline(xintercept=6.3, size=2, alpha=0.4)+
+ geom_text(data = df.AUC.sub[df.AUC.sub$species!='Aall',],
+ mapping = aes(x = -Inf, y = Inf, hjust = -.1, vjust = 1.5,
+ label = paste0(percent.neg,'% / ',percent.pos, '%')) ) +
+ coord_cartesian(xlim=xRange,ylim=yRange2)+
+ xlab("")+ylab('')+
+ facet_wrap(~species,ncol=2)+
+ scale_x_continuous(breaks = seq(1,10,by=2),
+ labels = c('Jan','Mar','May','Jul','Sep'))+
+ plotTheme1
+
+
+ ##############################################################################################################################################
+ ##############################################################################################################################################
+
+
+ #################
+ # Prediction plot
+ #################
+
+
+ #create variables
+ variable.full = paste0('Prediction.Full.', variable.name)
+ variable.post = paste0('Prediction.PostSolstice.', variable.name)
+ variable.pre = paste0('Prediction.PreSolstice.', variable.name)
+
+ #data wrangling
+ Predictions.df2 = Predictions.df %>%
+ #get time series-level prediction anomalies
+ group_by(timeseries)%>%
+ mutate(Prediction.Full = !!as.name(variable.full) - mean(!!as.name(variable.full)),
+ Prediction.Post = !!as.name(variable.post) - mean(!!as.name(variable.post)),
+ Prediction.Pre = !!as.name(variable.pre) - mean(!!as.name(variable.pre)) ) %>%
+ ungroup() %>%
+ dplyr::select(c(leaf_off_anomaly,MATanomaly,Prediction.Full,Prediction.Post,Prediction.Pre))%>%
+ pivot_longer(-MATanomaly)%>%
+ mutate(name = plyr::revalue(name, c("leaf_off_anomaly" = "Observed",
+ "Prediction.Full" = "Full model",
+ "Prediction.Post" = "Post-solstice model",
+ "Prediction.Pre" = "Pre-solstice model")),
+ name = factor(name, levels=c("Observed", "Full model", "Pre-solstice model", "Post-solstice model"), ordered=T))
+
+ #get linear model coefficients
+ resultsLM = Predictions.df2 %>%
+ group_by(name) %>%
+ do({model = lm(value ~ MATanomaly, data=.) # create your model
+ data.frame(tidy(model))})%>% # get model info
+ filter(!term %in% c("(Intercept)"))
+
+ #Plot
+ plotForeacst = ggplot(data=Predictions.df2, aes(y=value, x=MATanomaly, color=name, linetype=name)) +
+ geom_hline(yintercept=0)+
+ geom_smooth(method = "gam", formula = y ~ s(x, k = 3),level=0.99, size=1.25)+
+ scale_color_manual(values=c('black','black','#F21A00','#3B9AB2'))+
+ scale_linetype_manual(values=c('dotted','solid','solid','solid'))+
+ ylab("Senescence anomaly (days)")+xlab("MAT anomaly (C)")+
+ annotate(geom="text", x=Inf, y = Inf, vjust=1.5, hjust=1.5,
+ label=paste0(round(resultsLM[resultsLM$name=='Observed',]$estimate,1),' days/C'))+
+ annotate(geom="text", x=Inf, y = Inf, vjust=3.5, hjust=1.5,
+ label=paste0(round(resultsLM[resultsLM$name=='Full model',]$estimate,1),' days/C'))+
+ annotate(geom="text", x=Inf, y = Inf, vjust=5.5, hjust=1.5, color='#F21A00',
+ label=paste0(round(resultsLM[resultsLM$name=='Pre-solstice model',]$estimate,1),' days/C'))+
+ annotate(geom="text", x=Inf, y = Inf, vjust=7.5, hjust=1.5, color='#3B9AB2',
+ label=paste0(round(resultsLM[resultsLM$name=='Post-solstice model',]$estimate,1),' days/C'))+
+ coord_cartesian(xlim=c(-2.3,2.1), ylim = c(-3.5,3.5))+
+ plotTheme1+
+ theme(legend.position = c(0.27, 0),
+ legend.justification = c(0, 0))+
+ guides(color=guide_legend(override.aes=list(fill=NA)))
+
+
+ ##############################################################################################################################################
+ ##############################################################################################################################################
+
+
+ ################
+ # Seasonal plots
+ ################
+
+
+ #subset the data
+ ################
+
+ #Solstice
+ SolsticeMM.df.sub = SeasonalMM.df %>%
+ filter(variable == variable.name &
+ species == 'Aall' &
+ grepl("Solstice.scaled",equation) )
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ #Seasonal
+ SeasonalMM.df.sub = SeasonalMM.df %>%
+ filter(variable == variable.name,
+ species == 'Aall',
+ grepl("Seasonal.scaled",equation) ) %>%
+ #order variables
+ mutate(variable.class=factor(variable.class,
+ levels = c("LO.SOm30","LO.SO","LO.SOp30","LO.SOp60","LO.SE","SOm30.SE","SO.SE","SOp30.SE","SOp60.SE"), ordered=T))
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ # Plot
+ ######
+
+ #set y ranges
+ if(variable.name %in% c("Azani", 'Tday')){
+ yRange=c(-0.15,0.15)} else {
+ yRange=c(-0.27, 0.27)}
+
+ #Solstice
+ plotD = ggplot(data = SolsticeMM.df.sub, aes(x = variable.class, y = estimate, fill=variable.class)) +
+ geom_bar(stat = "identity")+
+ geom_errorbar(aes(ymin = estimate - 2*std.error, ymax = estimate + 2*std.error), width=.2,
+ position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ xlab("") + ylab("Standardized effect") +
+ coord_cartesian(ylim = yRange) +
+ scale_fill_manual(values = rev(wes_palette(6, name = "Zissou1", type = "continuous")))+
+ scale_x_discrete(labels=c("solstice1" = "May 13\nJun 11", "solstice2" = "May 23\nJun 21",
+ "solstice3" = "Jun 2\nJul 1", "solstice4"="Jun 12\nJul 11",
+ "solstice5"="Jun 22\nJul 21", "solstice6"="Jul 2\nJul 31"))+
+ plotTheme1 +
+ annotation_custom(ggplotGrob(PhotoSolstice),
+ xmin = 0.5, xmax = 4.5,
+ ymin = 0.01, ymax = yRange[2])
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ #Seasonal
+ plotE = ggplot(data = SeasonalMM.df.sub, aes(x = variable.class, y = estimate, fill=variable.class)) +
+ geom_bar(stat = "identity")+
+ geom_errorbar(aes(ymin = estimate - 2*std.error, ymax = estimate + 2*std.error), width=.2,
+ position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ xlab("") + ylab("") +
+ coord_cartesian(ylim = yRange) +
+ scale_fill_manual(values = rev(wes_palette(8, name = "Zissou1", type = "continuous")))+
+ scale_x_discrete(labels=c("LO.SOm30" = "Out-May", "LO.SO" = "Out-Sol", "LO.SOp30" = "Out-Jul",
+ "LO.SOp60" = "Out-Aug", "LO.SE"="Out-Off","SOm30.SE"="May-Off",
+ "SO.SE" = "Sol-Off", "SOp30.SE"="Jul-Off"))+
+ plotTheme1+
+ theme(axis.text.x = element_text(angle = 45, hjust=1)) +
+ #add photoperiod graph
+ annotation_custom(ggplotGrob(PhotoSeasonal),
+ xmin = 0.5, xmax = 5.5,
+ ymin = 0.01, ymax = yRange[2])
+
+
+ ##############################################################################################################################################
+ ##############################################################################################################################################
+
+
+ ##################
+ # Full model plots
+ ##################
+
+
+ #subset
+ FullMM.df.sub = FullMM.df %>%
+ filter(variable == variable.name &
+ species == 'Aall') %>%
+ #order variables
+ mutate(term = factor(term, levels=c(paste0(variable.name,".LO.SO"), "Prcp.LO.SO", "Prcp.SO.SE",
+ 'CO2',paste0(variable.name,".SO.SE"),'Tnight'), ordered=T))
+
+ # Plot
+ plotC = ggplot(data = FullMM.df.sub, aes(x = term, y = estimate, fill=term)) +
+ geom_bar(stat = "identity")+
+ geom_errorbar(aes(ymin = estimate - 2*std.error, ymax = estimate + 2*std.error), width=.2,
+ position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ xlab("") + ylab("") +
+ coord_cartesian(ylim = c(-0.24,0.24)) +
+ scale_fill_manual(values = c('#F21A00','grey60','grey35','black','#3B9AB2','#78B7C5'))+
+ scale_x_discrete(labels = c(paste0(variable.name," pre"),
+ 'Prcp pre','Prcp post','CO2',
+ paste0(variable.name," post"),
+ 'Autumn Tnight'))+
+ plotTheme1 +
+ theme(axis.text.x = element_text(angle = 45, hjust=1))
+
+
+ ##############################################################################################################################################
+ ##############################################################################################################################################
+
+
+ #####################
+ # Moving window plots
+ #####################
+
+
+ ###############################################
+ # Climate-phenology relationship reversal dates
+ ###############################################
+
+
+ # 20-year moving window
+ #######################
+
+ #subset
+ MWreversal.df.sub = MWreversal.df %>%
+ filter(variable == variable.name,
+ dataset == 'Long')
+
+ #get linear model coefficients
+ resultsLM = MWreversal.df.sub %>%
+ filter(species == 'Aall') %>%
+ do({model = lm(as.numeric(date0) ~ year, data=.) # create your model
+ data.frame(tidy(model), # get coefficient info
+ glance(model))})%>% # get model info
+ filter(!term %in% c("(Intercept)"))
+
+ #plot
+ plotF = ggplot(MWreversal.df.sub, aes(x = year, y = date0, group=species, color=species)) +
+
+ geom_hline(yintercept=as.Date('2000-06-21'),size=1.5, alpha=0.2)+
+
+ geom_line(size = 0.75) +
+
+ geom_ribbon(data=MWreversal.df.sub[MWreversal.df.sub$species=='Aall',],
+ aes(ymin = date0.lower, ymax = date0.upper,),
+ fill = "darkgrey", color=NA, alpha = 0.7) +
+
+ geom_smooth(data=MWreversal.df.sub[MWreversal.df.sub$species=='Aall',],
+ aes(x = year, y = date0),
+ method='lm', formula = y~x, se = FALSE, linetype="dashed")+
+
+ geom_line(data=MWreversal.df.sub[MWreversal.df.sub$species=='Aall',],
+ aes(x = year, y = date0), size = 1.25) +
+
+ scale_color_manual(values = rev(wes_palette("Darjeeling2", n = 5))) +
+
+ coord_cartesian(xlim=c(1967.3,1994.7), ylim=c(as.Date('2000-05-31'),as.Date('2000-07-31')))+
+
+ annotate(geom="text", x=Inf, y = as.Date(Inf, origin="1970-01-01"), vjust=1.5, hjust=1.05,
+ label=paste0(round(resultsLM$estimate,1),' days per year, R2 = ', round(resultsLM$r.squared,2)))+
+
+ xlab("") + ylab('Date')+
+ scale_y_date(date_labels = "%b %d")+
+ scale_x_continuous(breaks = seq(1966,1996,by=5),
+ labels = c('1966-1985','1971-1990','1976-1995','1981-2000','1986-2005','1991-2010','1996-2015'))+
+ plotTheme1+
+ guides(col = guide_legend(ncol = 2))+
+ theme(axis.text.x = element_text(angle = 45, hjust=1),
+ legend.position = c(0.00, 0.00),
+ legend.justification = c("left", "bottom"))
+
+ plotF.Supp = plotF +
+ scale_x_continuous(breaks = seq(1966,1996,by=5),
+ labels = c('','','','','','',''))
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ # 15-year moving window
+ #######################
+
+ #subset
+ MWreversal.df.sub = MWreversal.df %>%
+ filter(variable == variable.name,
+ dataset == 'Short')
+
+ #get linear model coefficients
+ resultsLM = MWreversal.df.sub %>%
+ filter(species == 'Aall') %>%
+ do({model = lm(as.numeric(date0) ~ year, data=.) # create your model
+ data.frame(tidy(model), # get coefficient info
+ glance(model))})%>% # get model info
+ filter(!term %in% c("(Intercept)"))
+
+ #plot
+ plotF.short = ggplot(MWreversal.df.sub, aes(x = year, y = date0, group=species, color=species)) +
+
+ geom_hline(yintercept=as.Date('2000-06-21'),size=1.5, alpha=0.2)+
+
+ geom_line(size = 0.75) +
+
+ geom_ribbon(data=MWreversal.df.sub[MWreversal.df.sub$species=='Aall',],
+ aes(ymin = date0.lower, ymax = date0.upper,),
+ fill = "darkgrey", color=NA, alpha = 0.7) +
+
+ geom_smooth(data=MWreversal.df.sub[MWreversal.df.sub$species=='Aall',],
+ aes(x = year, y = date0),
+ method='lm', formula = y~x, se = FALSE, linetype="dashed")+
+
+ geom_line(data=MWreversal.df.sub[MWreversal.df.sub$species=='Aall',],
+ aes(x = year, y = date0), size = 1.25) +
+
+ scale_color_manual(values = rev(wes_palette("Darjeeling2", n = 5))) +
+
+ coord_cartesian(xlim=c(1981.5,2000.08), ylim=c(as.Date('2000-05-31'),as.Date('2000-07-31')))+
+
+ annotate(geom="text", x=Inf, y = as.Date(Inf, origin="1970-01-01"), vjust=1.5, hjust=1.05,
+ label=paste0(round(resultsLM$estimate,1),' days per year, R2 = ', round(resultsLM$r.squared,2)))+
+
+ xlab("") + ylab('')+
+ scale_y_date(date_labels = "%b %d")+
+ scale_x_continuous(breaks = seq(1981,2001,by=5),
+ labels = c('','','','',''))+
+ plotTheme1+
+ theme(legend.position = 'right')
+
+
+ ##############################################################################################################################################
+
+
+ ######################
+ # Monthly correlations
+ ######################
+
+
+ # All species
+ #############
+
+ #subset
+ MW.df.sub = MW.df %>%
+ filter(variable == variable.name,
+ dataset == 'Long',
+ equation == 'monthly',
+ species == 'Aall')%>%
+ filter(term %in% c('4','5','6','7','8','9'))%>%
+ #rename factors
+ mutate(term = if(variable.name %in% c("Apm", "ApmJmaxA", "ApmJmaxB",
+ "Azani", "AzaniJmaxA", "AzaniJmaxB",
+ 'GSI','GSIrad')){
+ plyr::revalue(term, c("5"="May", '6'='Jun','7'='Jul','8'='Aug'))} else {
+ plyr::revalue(term, c('4'='Apr',"5"="May", '6'='Jun','7'='Jul','8'='Aug','9'='Sep'))
+ } ) %>%
+ #order factors
+ mutate(term = factor(term, levels=c('Apr',"May", 'Jun',"Jul", "Aug",'Sep'), ordered=T))
+
+ #define color scale
+ if(variable.name %in% c("Apm", "ApmJmaxA", "ApmJmaxB",
+ "Azani", "AzaniJmaxA", "AzaniJmaxB",
+ 'GSI','GSIrad')){
+ col.scale = c('#F21A00','#E1AF00','#78B7C5','#3B9AB2')
+ } else {
+ col.scale = c('darkred','#F21A00','#E1AF00','#EBCC2A','#78B7C5','#3B9AB2')
+ }
+
+ #plot
+ plotMWmonth =
+ ggplot(MW.df.sub, aes(x = year, y = estimate, ymin = estimate-2*std.error, ymax = estimate+2*std.error,
+ group=term, color=term)) +
+ geom_hline(yintercept=0)+
+ geom_ribbon(fill = "darkgrey", color=NA, alpha = 0.6) +
+ geom_line(size = 1) +
+ scale_color_manual(values = col.scale)+
+ coord_cartesian(xlim=c(1967.3,1994.7),ylim=c(-0.22,0.22))+
+ xlab("") + ylab('Standardized effect')+
+ scale_x_continuous(breaks = seq(1966,1996,by=5),
+ labels = c('','','','','','',''))+
+ plotTheme1
+
+ #Arrange legend horizontally
+ if(variable.name %in% c("Apm", "ApmJmaxA", "ApmJmaxB",
+ "Azani", "AzaniJmaxA", "AzaniJmaxB",
+ 'GSI','GSIrad')){
+ plotMWmonth = plotMWmonth +
+ guides(col = guide_legend(nrow = 1, byrow = TRUE)) }
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ # Species-specific
+ ##################
+
+ #subset
+ MW.df.sub = MW.df %>%
+ filter(variable == variable.name,
+ dataset == 'Long',
+ equation == 'monthly',
+ species != 'Aall')%>%
+ filter(term %in% c('4','5','6','7','8','9'))%>%
+ #rename factors
+ mutate(term = if(variable.name %in% c("Apm", "ApmJmaxA", "ApmJmaxB",
+ "Azani", "AzaniJmaxA", "AzaniJmaxB",
+ 'GSI','GSIrad')){
+ plyr::revalue(term, c("5"="May", '6'='Jun','7'='Jul','8'='Aug'))} else {
+ plyr::revalue(term, c('4'='Apr',"5"="May", '6'='Jun','7'='Jul','8'='Aug','9'='Sep'))
+ } ) %>%
+ #order factors
+ mutate(term = factor(term, levels=c('Apr',"May",'Jun',"Jul", "Aug",'Sep'), ordered=T))
+
+ #plot
+ plotMWmonth.species =
+ ggplot(MW.df.sub, aes(x = year, y = estimate, ymin = estimate-2*std.error, ymax = estimate+2*std.error,
+ group=term, color=term)) +
+ geom_hline(yintercept=0)+
+ geom_ribbon(fill = "darkgrey", color=NA, alpha = 0.6) +
+ geom_line(size = 1) +
+ scale_color_manual(values=col.scale)+
+ coord_cartesian(xlim=c(1967.3,1994.7),ylim=c(-0.28,0.28))+
+ xlab("") + ylab('Standardized effect')+
+ scale_x_continuous(breaks = seq(1966,1996,by=5),
+ labels = c('1966-1985','1971-1990','1976-1995','1981-2000','1986-2005','1991-2010','1996-2015'))+
+ plotTheme1+
+ theme(axis.text.x = element_text(angle = 45, hjust=1),
+ legend.position = 'bottom',
+ legend.title = element_blank(),
+ strip.text.x = element_blank())+
+ facet_wrap(~species,ncol=1)+
+ guides(col = guide_legend(nrow = 2, byrow = TRUE))
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ # 15-year moving window
+ #######################
+
+ #subset
+ MW.df.sub = MW.df %>%
+ filter(variable == variable.name,
+ dataset == 'Short',
+ equation == 'monthly',
+ species == 'Aall') %>%
+ filter(term %in% c('4','5','6','7','8','9'))%>%
+ #rename factors
+ mutate(term = if(variable.name %in% c("Apm", "ApmJmaxA", "ApmJmaxB",
+ "Azani", "AzaniJmaxA", "AzaniJmaxB",
+ 'GSI','GSIrad')){
+ plyr::revalue(term, c("5"="May", '6'='Jun','7'='Jul','8'='Aug'))} else {
+ plyr::revalue(term, c('4'='Apr',"5"="May", '6'='Jun','7'='Jul','8'='Aug','9'='Sep'))
+ } ) %>%
+ #order factors
+ mutate(term = factor(term, levels=c('Apr',"May",'Jun',"Jul", "Aug",'Sep'), ordered=T))
+
+ #plot
+ plotMWmonth.short = ggplot(MW.df.sub, aes(x = year, y = estimate, ymin = estimate-2*std.error, ymax = estimate+2*std.error,
+ group=term, color=term)) +
+ geom_hline(yintercept=0)+
+ geom_ribbon(fill = "darkgrey", color=NA, alpha = 0.6) +
+ geom_line(size = 1) +
+ scale_color_manual(values=col.scale)+
+ xlab("") + ylab('')+
+ scale_x_continuous(breaks = seq(1981,2001,by=5),
+ labels = c('','','','',''))+
+ coord_cartesian(xlim=c(1981.5,2000.08), ylim=c(-0.22,0.22))+
+ plotTheme1+
+ theme(legend.position = 'right',
+ legend.title = element_blank())
+
+
+ ##############################################################################################################################################
+
+
+ ######################
+ # Full model over time
+ ######################
+
+
+ # All species
+ #############
+
+ #subset
+ MW.df.full = MW.df %>%
+ filter(variable == variable.name,
+ dataset == 'Long',
+ equation == 'full model',
+ species == 'Aall') %>%
+ #order factors
+ mutate(term = factor(term, levels=c(paste0(variable.name,".LO.SO"), "Prcp.LO.SO", "Prcp.SO.SE",
+ 'CO2',paste0(variable.name,".SO.SE"),'Tnight'), ordered=T))
+
+ #set y ranges
+ if(variable.name %in% c("Apm", "ApmJmaxA", "ApmJmaxB",
+ "Azani", "AzaniJmaxA", "AzaniJmaxB",
+ 'GSIrad','SWrad','Tday','Tnight')){
+ yRange = c(-0.24,0.24)} else {yRange = c(-0.28, 0.28)}
+
+ #plot
+ plotMWfull = ggplot(MW.df.full, aes(x = year, y = estimate, ymin = estimate-2*std.error, ymax = estimate+2*std.error,
+ group=term, color=term)) +
+ geom_hline(yintercept=0)+
+ geom_ribbon(fill = "darkgrey", color=NA, alpha = 0.6) +
+ geom_line(size = 1) +
+ scale_color_manual(values=c('#F21A00','grey60','grey35','black','#3B9AB2','#78B7C5'))+
+ coord_cartesian(xlim = c(1967.3,1994.7), ylim = yRange)+
+ xlab("") + ylab('Standardized effect')+
+ scale_x_continuous(breaks = seq(1966,1996,by=5),
+ labels = c('1966-1985','1971-1990','1976-1995','1981-2000','1986-2005','1991-2010','1996-2015'))+
+ plotTheme1+
+ theme(axis.text.x = element_text(angle = 45, hjust=1))
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ # Species-specific
+ ##################
+
+ #subset
+ MW.df.full = MW.df %>%
+ filter(variable == variable.name,
+ dataset == 'Long',
+ equation == 'full model',
+ species != 'Aall') %>%
+ #order factors
+ mutate(term = factor(term, levels=c(paste0(variable.name,".LO.SO"), "Prcp.LO.SO", "Prcp.SO.SE",
+ 'CO2',paste0(variable.name,".SO.SE"),'Tnight'), ordered=T))
+
+ #set y ranges
+ if(variable.name %in% c("Apm", "ApmJmaxA", "ApmJmaxB",
+ "Azani", "AzaniJmaxA", "AzaniJmaxB",
+ 'GSIrad','SWrad','Tday','Tnight')){
+ yRange = c(-0.28,0.28)} else {yRange = c(-0.33, 0.33)}
+
+ #plot
+ plotMWfull.species = ggplot(MW.df.full, aes(x = year, y = estimate, ymin = estimate-2*std.error, ymax = estimate+2*std.error,
+ group=term, color=term)) +
+ geom_hline(yintercept=0)+
+ geom_ribbon(fill = "darkgrey", color=NA, alpha = 0.6) +
+ geom_line(size = 1) +
+ scale_color_manual(values=c('#F21A00','grey60','grey35','black','#3B9AB2','#78B7C5'))+
+ coord_cartesian(xlim = c(1967.3,1994.7), ylim = yRange)+
+ xlab("") + ylab('')+
+ scale_x_continuous(breaks = seq(1966,1996,by=5),
+ labels = c('1966-1985','1971-1990','1976-1995','1981-2000','1986-2005','1991-2010','1996-2015'))+
+ plotTheme1+
+ theme(axis.text.x = element_text(angle = 45, hjust=1),
+ legend.position = 'bottom')+
+ facet_wrap(~species,ncol=1,strip.position = "right")+
+ guides(col = guide_legend(nrow = 3, byrow = TRUE))
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ # 15-year moving window
+ #######################
+
+ #subset
+ MW.df.full = MW.df %>%
+ filter(variable == variable.name,
+ dataset == 'Short',
+ equation == 'full model',
+ species == 'Aall')%>%
+ #order factors
+ mutate(term = factor(term, levels=c(paste0(variable.name,".LO.SO"), "Prcp.LO.SO", "Prcp.SO.SE",
+ 'CO2',paste0(variable.name,".SO.SE"),'Tnight'), ordered=T))
+
+ #set y ranges
+ if(variable.name %in% c("Apm", "ApmJmaxA", "ApmJmaxB",
+ "Azani", "AzaniJmaxA", "AzaniJmaxB",
+ 'GSIrad','SWrad','Tday','Tnight')){
+ yRange = c(-0.24,0.24)} else {yRange = c(-0.33, 0.33)}
+
+ #plot
+ plotMWfull.short = ggplot(MW.df.full, aes(x = year, y = estimate, ymin = estimate-2*std.error, ymax = estimate+2*std.error,
+ group=term, color=term)) +
+ geom_hline(yintercept=0)+
+ geom_ribbon(fill = "darkgrey", color=NA, alpha = 0.6) +
+ geom_line(size = 1) +
+ scale_color_manual(values=c('#F21A00','grey60','grey35','black','#3B9AB2','#78B7C5'))+
+ xlab("") + ylab('')+
+ scale_x_continuous(breaks = seq(1981,2001,by=5),
+ labels = c('1981-1995','1986-2000','1991-2005','1996-2010','2001-2015'))+
+ coord_cartesian(xlim = c(1981.5,2000.08), ylim = yRange)+
+ plotTheme1+
+ theme(axis.text.x = element_text(angle = 45, hjust=1),
+ legend.position = 'right',)
+
+
+ ##############################################################################################################################################
+ ##############################################################################################################################################
+
+
+ ##########################
+ # Arrange and safe plots #
+ ##########################
+
+
+ #################
+ # Figs. 4 and S15
+ #################
+
+ #define plot layout
+ layout <- "
+ ABC
+ DEF"
+
+ #Merge plots
+ Fig4_Plot = plotA + plotB + plotC + plotD + plotE + plotF +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A') &
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plots as .pdf
+ ggsave(Fig4_Plot, file=paste('Fig4_',variable.name, ".pdf", sep=''), path=output_path,
+ width=11, height=8)
+
+ print(Fig4_Plot)
+
+
+ ######################################
+ # Temperature response plot (Fig. S16)
+ ######################################
+
+ ggsave(plotForeacst, file=paste('FigS16_TempResponse.',variable.name, ".pdf", sep=''), path=output_path,
+ width=4, height=4)
+
+ print(plotForeacst)
+
+
+ ################################
+ # Species-specific moving window
+ ################################
+
+ #define plot layout
+ layout <- "AB"
+
+ #Merge plots
+ Supp_Plot = plotMWmonth.species + plotMWfull.species +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A')&
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plots as .pdf
+ ggsave(Supp_Plot, file=paste('MW.species.',variable.name, ".pdf", sep=''), path=output_path,
+ width=7, height=10)
+
+ print(Supp_Plot)
+
+
+ ###########################
+ # Moving windows (Fig. S19)
+ ###########################
+
+ #define plot layout
+ layout <- "
+ AB
+ CD
+ EF"
+
+ #Merge plots
+ Supp_Plot2 =
+ plotF.Supp + plotF.short +
+ plotMWmonth + plotMWmonth.short +
+ plotMWfull + plotMWfull.short +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A')&
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plots as .pdf
+ ggsave(Supp_Plot2, file=paste('FigS19_MW.',variable.name, ".pdf", sep=''), path=output_path,
+ width=8.5, height=9)
+
+ print(Supp_Plot2)
+
+
+ ##############################################################################################################################################
+
+ #count
+ print(variable.name)
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## date time
+Sys.time()
+
+
+## session info
+sessionInfo()
+```
\ No newline at end of file
diff --git a/R code/PEP_analysis/3_Analysis/3.4_Figures/3.4.2_Mixed_model_plots_temporal.Rmd b/R code/PEP_analysis/3_Analysis/3.4_Figures/3.4.2_Mixed_model_plots_temporal.Rmd
new file mode 100644
index 0000000..95d5a4b
--- /dev/null
+++ b/R code/PEP_analysis/3_Analysis/3.4_Figures/3.4.2_Mixed_model_plots_temporal.Rmd
@@ -0,0 +1,326 @@
+---
+title: Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice
+author: Constantin Zohner
+date: "last updated March 30, 2023"
+
+subtitle: PEP725 data (Figure S17)
+output:
+ html_document:
+ highlight: haddock
+ toc: false
+ use_bookdown: true
+ df_print: paged
+---
+
+
+
+
+
+### Figure descriptions
+- Fig. S17: Relationships among pre-solstice carbon uptake (Anetday), year and phenological dates using the local PEP725 observations
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(
+ class.source = "numberLines lineAnchors"
+ )
+```
+
+
+
+```{r, message=FALSE, warning=FALSE, attr.source='.numberLines'}
+#required packages
+require(tidyverse)
+require(data.table)
+require(lme4)
+require(effects) #plot effects
+
+
+
+#Plot theme
+plotTheme1 = theme(
+ legend.position = "none",
+ legend.background = element_blank(),
+ legend.text = element_text(color="black"),
+ legend.title = element_blank(),
+ legend.key = element_blank(),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_blank(),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/PEP_analysis/Analysis")
+
+# paths
+PEP_drivers_path = "Analysis_input/PEP_drivers_final/Merged_file"
+output_path = "Analysis_output/Autumn/Mixed_model_plots"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology dataframe
+####################
+
+PEP.df <- fread(paste(PEP_drivers_path, "pep_drivers_data_preseason.csv", sep="/")) %>%
+ mutate(SWrad.LO.SO = rowSums(.[,363:365]))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+# Mixed effects models #
+########################
+
+
+
+# Preseason-variable + year
+###########################
+
+#Photosynthesis
+fit_multi_Azani = lmer(leaf_off ~ Azani.LO.SO + year + (1|timeseries) + (1|species), data = PEP.df,
+ na.action = "na.exclude", control = lmerControl(optimizer ="Nelder_Mead"))
+summary(fit_multi_Azani)
+plot(allEffects(fit_multi_Azani))
+#Temperature
+fit_multi_Tday = lmer(leaf_off ~ Tday.LO.SO + year + (1|timeseries) + (1|species), data = PEP.df,
+ na.action = "na.exclude", control = lmerControl(optimizer ="Nelder_Mead"))
+#Radiation
+fit_multi_SWrad = lmer(leaf_off ~ SWrad.LO.SO + year + (1|timeseries) + (1|species), data = PEP.df,
+ na.action = "na.exclude", control = lmerControl(optimizer ="Nelder_Mead"))
+#Leaf-out
+fit_multi_out = lmer(leaf_off ~ leaf_out + year + (1|timeseries) + (1|species), data = PEP.df,
+ na.action = "na.exclude", control = lmerControl(optimizer ="Nelder_Mead"))
+
+
+# year-only
+###########
+
+#EOS
+fit_year = lmer(leaf_off ~ year + (1|timeseries) + (1|species), data = PEP.df, na.action = "na.exclude")
+summary(fit_year)
+plot(allEffects(fit_year))
+#SOS
+fit_year_out = lmer(leaf_out ~ year + (1|timeseries) + (1|species), data = PEP.df, na.action = "na.exclude")
+summary(fit_year_out)
+plot(allEffects(fit_year_out))
+
+
+# Extract information for plotting
+plotMultiAzani = allEffects(fit_multi_Azani)
+plotMultiTday = allEffects(fit_multi_Tday)
+plotMultiSWrad = allEffects(fit_multi_SWrad)
+plotMultiOut = allEffects(fit_multi_out)
+plotYear = allEffects(fit_year)
+plotYearOut = allEffects(fit_year_out)
+
+
+# Extract coefficients
+df.coefficients = tibble(Coefficient = coef(summary(fit_multi_Azani))[ , "Estimate"][2:3],
+ variable = c("Pre-solstice","Year"),
+ class = "2.Azani") %>%
+ bind_rows(tibble(Coefficient = coef(summary(fit_multi_Tday))[ , "Estimate"][2:3],
+ variable = c("Pre-solstice","Year"),
+ class = "3.Tday")) %>%
+ bind_rows(tibble(Coefficient = coef(summary(fit_multi_SWrad))[ , "Estimate"][2:3],
+ variable = c("Pre-solstice","Year"),
+ class = "4.SWrad")) %>%
+ bind_rows(tibble(Coefficient = coef(summary(fit_multi_out))[ , "Estimate"][2:3],
+ variable = c("Pre-solstice","Year"),
+ class = "5.Out")) %>%
+ bind_rows(tibble(Coefficient = coef(summary(fit_year))[ , "Estimate"][2],
+ variable = c("Year"),
+ class = "1.Univariate")) %>%
+ bind_rows(tibble(Coefficient = coef(summary(fit_year_out))[ , "Estimate"][2],
+ variable = c("Pre-solstice"),
+ class = "1.Univariate")) %>%
+ #Increase in expected delay over time after controlling for pre-solstice conditions
+ mutate(SlopeIncrease = Coefficient / coef(summary(fit_year))[ , "Estimate"][2])
+
+
+# Final table
+df <- tibble(upper = plotYear$year$upper[,1],
+ lower = plotYear$year$lower[,1],
+ off = plotYear$year$fit[,1],
+ xval = plotYear$year$x[,1],
+ class = "1.Univariate",
+ variable = "Year") %>%
+ bind_rows(
+ tibble(upper = plotYearOut$year$upper[,1],
+ lower = plotYearOut$year$lower[,1],
+ off = plotYearOut$year$fit[,1],
+ xval = plotYearOut$year$x[,1],
+ class = "1.Univariate",
+ variable = "Pre-solstice"))%>%
+
+ #Photosynthesis
+ bind_rows(
+ tibble(upper = plotMultiAzani$year$upper[,1],
+ lower = plotMultiAzani$year$lower[,1],
+ off = plotMultiAzani$year$fit[,1],
+ xval = plotMultiAzani$year$x[,1],
+ class = "2.Azani",
+ variable = "Year")
+ )%>%
+ bind_rows(
+ tibble(upper = plotMultiAzani$Azani.LO.SO$upper[,1],
+ lower = plotMultiAzani$Azani.LO.SO$lower[,1],
+ off = plotMultiAzani$Azani.LO.SO$fit[,1],
+ xval = plotMultiAzani$Azani.LO.SO$x[,1],
+ class = "2.Azani",
+ variable = "Pre-solstice")
+ )%>%
+
+ #Temperature
+ bind_rows(
+ tibble(upper = plotMultiTday$year$upper[,1],
+ lower = plotMultiTday$year$lower[,1],
+ off = plotMultiTday$year$fit[,1],
+ xval = plotMultiTday$year$x[,1],
+ class = "3.Tday",
+ variable = "Year")
+ )%>%
+ bind_rows(
+ tibble(upper = plotMultiTday$Tday.LO.SO$upper[,1],
+ lower = plotMultiTday$Tday.LO.SO$lower[,1],
+ off = plotMultiTday$Tday.LO.SO$fit[,1],
+ xval = plotMultiTday$Tday.LO.SO$x[,1],
+ class = "3.Tday",
+ variable = "Pre-solstice")
+ )%>%
+
+ #Radiation
+ bind_rows(
+ tibble(upper = plotMultiSWrad$year$upper[,1],
+ lower = plotMultiSWrad$year$lower[,1],
+ off = plotMultiSWrad$year$fit[,1],
+ xval = plotMultiSWrad$year$x[,1],
+ class = "4.SWrad",
+ variable = "Year")
+ )%>%
+ bind_rows(
+ tibble(upper = plotMultiSWrad$SWrad.LO.SO$upper[,1],
+ lower = plotMultiSWrad$SWrad.LO.SO$lower[,1],
+ off = plotMultiSWrad$SWrad.LO.SO$fit[,1],
+ xval = plotMultiSWrad$SWrad.LO.SO$x[,1],
+ class = "4.SWrad",
+ variable = "Pre-solstice")
+ )%>%
+
+ #Leaf-out
+ bind_rows(
+ tibble(upper = plotMultiOut$year$upper[,1],
+ lower = plotMultiOut$year$lower[,1],
+ off = plotMultiOut$year$fit[,1],
+ xval = plotMultiOut$year$x[,1],
+ class = "5.Out",
+ variable = "Year")
+ )%>%
+ bind_rows(
+ tibble(upper = plotMultiOut$leaf_out$upper[,1],
+ lower = plotMultiOut$leaf_out$lower[,1],
+ off = plotMultiOut$leaf_out$fit[,1],
+ xval = plotMultiOut$leaf_out$x[,1],
+ class = "5.Out",
+ variable = "Pre-solstice")
+ )
+
+
+# get phenology anomalies
+df = df %>%
+ group_by(class, variable) %>%
+ mutate(anomaly = off - mean(off),
+ anomaly.upper = upper - mean(off),
+ anomaly.lower = lower - mean(off)) %>%
+ ungroup()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########
+# Plot #
+########
+
+
+
+MixedPlot = ggplot() +
+ geom_hline(yintercept = 0, linetype="dashed")+
+ geom_ribbon(data = df, aes(x = xval, ymin = anomaly.lower, ymax = anomaly.upper, fill=class),
+ alpha = 0.3) +
+ geom_line(data=df, aes(xval, anomaly, color=class)) +
+ theme_classic() +
+ geom_text(data=df.coefficients, aes(label=paste0(round(Coefficient*10,2)," days per decade \n (",
+ round(SlopeIncrease,1)," times)"),
+ x=Inf, y=Inf,hjust = "inward", vjust = "inward"))+
+ coord_cartesian(ylim=c(-15,15))+
+ labs(x = "", y = "Senescence (DOY)")+
+ scale_color_manual(values = c("black","darkblue","darkblue","darkblue","darkblue"))+
+ scale_fill_manual(values = c("black","darkblue","darkblue","darkblue","darkblue"))+
+ facet_wrap(class~variable, scales="free_x", ncol=2) +
+ plotTheme1
+
+
+#save plots as .pdf
+ggsave(MixedPlot, file="FigS17_MixedPlot.pdf", path=output_path,
+ width=5, height=12)
+
+MixedPlot
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## date time
+Sys.time()
+
+
+## session info
+sessionInfo()
+```
\ No newline at end of file
diff --git a/R code/PEP_analysis/3_Analysis/3.4_Figures/3.4.3_Moving_windows_preseason_sensitivity.Rmd b/R code/PEP_analysis/3_Analysis/3.4_Figures/3.4.3_Moving_windows_preseason_sensitivity.Rmd
new file mode 100644
index 0000000..e57ac1a
--- /dev/null
+++ b/R code/PEP_analysis/3_Analysis/3.4_Figures/3.4.3_Moving_windows_preseason_sensitivity.Rmd
@@ -0,0 +1,587 @@
+---
+title: Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice
+author: Constantin Zohner
+date: "last updated March 30, 2023"
+
+subtitle: PEP725 data (Figure S20)
+output:
+ html_document:
+ highlight: haddock
+ toc: false
+ use_bookdown: true
+ df_print: paged
+---
+
+
+
+
+
+### Figure descriptions
+- Fig. S20: Moving-window analysis based on European long-term observations (PEP725 data), showing the average dates when trees became sensitive to autumn temperatures for each 20-year time period from 1966 to 2015 (A) and for each 15-year time period from 1981 to 2015 (B)
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(
+ class.source = "numberLines lineAnchors"
+ )
+```
+
+
+
+```{r, message=FALSE, warning=FALSE, attr.source='.numberLines'}
+###################
+# Required packages
+###################
+
+
+
+require(tidyverse)
+require(data.table)
+require(ggplot2)
+require(pracma)
+require(wesanderson)
+require(patchwork)
+require(broom)
+require(gmodels)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/PEP_analysis/Analysis")
+
+
+# Paths
+
+#input
+PEP_analysis_path = "Analysis_output/Autumn/Data"
+
+#output
+output_path = "Analysis_output/Autumn/Moving_window_preseason_sensitivity"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Autumn temperature period
+post.df = fread(paste(PEP_analysis_path, "Moving_window_data_preseason.csv", sep="/"))%>%
+ filter(variable == 'R2')%>%
+ mutate(start.date = as.Date(start, origin="1970-01-01"),
+ start.date.lowCI = as.Date(start.lowCI, origin="1970-01-01"),
+ start.date.hiCI = as.Date(start.hiCI, origin="1970-01-01"))
+
+#Pre-solstice temperature period
+pre.df = fread(paste(PEP_analysis_path, "Moving_window_data_pre_solstice.csv", sep="/")) %>%
+ filter(variable == 'Tday') %>%
+ mutate(end.date = as.Date(end, origin="1970-01-01"),
+ end.date.lowCI = as.Date(end.lowCI, origin="1970-01-01"),
+ end.date.hiCI = as.Date(end.hiCI, origin="1970-01-01"))
+
+#solstice temperature period
+solstice.df = fread(paste(PEP_analysis_path, "Moving_window_data_solstice.csv", sep="/")) %>%
+ filter(variable == 'Tday') %>%
+ mutate(end.date = as.Date(end, origin="1970-01-01"),
+ end.date.lowCI = as.Date(end.lowCI, origin="1970-01-01"),
+ end.date.hiCI = as.Date(end.hiCI, origin="1970-01-01"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+################
+## Plot theme ##
+################
+
+
+#Color.palette: col=c('#F21A00','#E1AF00','#EBCC2A','#78B7C5','#3B9AB2')
+
+plotTheme1 = theme(
+ legend.position = "none",
+ legend.background = element_blank(),
+ legend.text = element_text(color="black"),
+ legend.title = element_blank(),
+ legend.key = element_blank(),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black',face = "italic"),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+# Moving window plots
+#####################
+
+
+
+# 20-year moving window
+#######################
+
+#subset
+post.df.sub = post.df %>%
+ filter(dataset == 'Long')
+
+#get linear model coefficients
+resultsLM = post.df.sub %>%
+ group_by(variable)%>%
+ filter(species == 'Aall') %>%
+ do({model = lm(start ~ year, data=.) # create your model
+ data.frame(tidy(model), # get coefficient info
+ lowCI=ci(model)[2,2],
+ hiCI=ci(model)[2,3],
+ glance(model))})%>% # get model info
+ filter(!term %in% c("(Intercept)")) %>%
+ mutate(significane = ifelse(p.value<0.001,"***",
+ ifelse(p.value<0.01,"**",
+ ifelse(p.value<0.05,"**",'n.s.'))))%>%
+ ungroup()
+
+#plot
+Long.post = ggplot(post.df.sub, aes(x = year, y = start.date, group=species, color=species)) +
+
+ geom_line(size = 0.75) +
+
+ geom_ribbon(data=post.df.sub[post.df.sub$species=='Aall',],
+ aes(ymin = start.date.lowCI, ymax = start.date.hiCI),
+ fill = "darkgrey", color=NA, alpha = 0.7) +
+
+ {if(resultsLM$p.value<0.05)
+ geom_smooth(data=post.df.sub[post.df.sub$species=='Aall',],
+ aes(x = year, y = start.date),
+ method='lm', formula = y~x, se = FALSE, linetype="dashed")}+
+
+ geom_line(data=post.df.sub[post.df.sub$species=='Aall',],
+ aes(x = year, y = start.date), size = 1.25) +
+
+ scale_color_manual(values = rev(wes_palette("Darjeeling2", n = 5))) +
+
+ coord_cartesian(xlim=c(1967.3,1994.7),ylim=c(as.Date('1970-08-03'),as.Date('1970-08-24')))+
+
+ annotate(geom="text", x=Inf, y = as.Date(Inf, origin="1970-01-01"), vjust=1.5, hjust=1.05,
+ label=
+ if(resultsLM$p.value<0.05){
+ paste0(round(resultsLM$estimate*10,1),' days per decade, R2 = ', round(resultsLM$r.squared,2), resultsLM$significane) } else {
+ paste0(resultsLM$significane)
+ }) +
+
+ xlab("") + ylab('Start temperature-sensitive autumn period')+
+ scale_y_date(date_labels = "%b %d")+
+ scale_x_continuous(breaks = seq(1966,1996,by=5),
+ labels = c('1966-1985','1971-1990','1976-1995','1981-2000','1986-2005','1991-2010','1996-2015'))+
+ plotTheme1+
+ guides(col = guide_legend(ncol = 2))+
+ theme(axis.text.x = element_text(angle = 45, hjust=1))
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ # 15-year moving window
+ #######################
+
+ #subset
+ post.df.sub = post.df %>%
+ filter(dataset == 'Short')
+
+ #get linear model coefficients
+ resultsLM = post.df.sub %>%
+ filter(species == 'Aall') %>%
+ do({model = lm(start ~ year, data=.) # create your model
+ data.frame(tidy(model), # get coefficient info
+ lowCI=ci(model)[2,2],
+ hiCI=ci(model)[2,3],
+ glance(model))})%>% # get model info
+ filter(!term %in% c("(Intercept)")) %>%
+ mutate(significane = ifelse(p.value<0.001,"***",
+ ifelse(p.value<0.01,"**",
+ ifelse(p.value<0.05,"**",'n.s.'))))
+
+ #plot
+ Short.post = ggplot(post.df.sub, aes(x = year, y = start.date, group=species, color=species)) +
+
+ geom_line(size = 0.75) +
+
+ geom_ribbon(data=post.df.sub[post.df.sub$species=='Aall',],
+ aes(ymin = start.date.lowCI, ymax = start.date.hiCI),
+ fill = "darkgrey", color=NA, alpha = 0.7) +
+
+ {if(resultsLM$p.value<0.05)
+ geom_smooth(data=post.df.sub[post.df.sub$species=='Aall',],
+ aes(x = year, y = start.date),
+ method='lm', formula = y~x, se = FALSE, linetype="dashed")}+
+
+ geom_line(data=post.df.sub[post.df.sub$species=='Aall',],
+ aes(x = year, y = start.date), size = 1.25) +
+
+ scale_color_manual(values = rev(wes_palette("Darjeeling2", n = 5))) +
+
+ coord_cartesian(xlim=c(1981.5,2000.08),ylim=c(as.Date('1970-08-03'),as.Date('1970-08-24')))+
+
+ annotate(geom="text", x=Inf, y = as.Date(Inf, origin="1970-01-01"), vjust=1.5, hjust=1.05,
+ label=
+ if(resultsLM$p.value<0.05){
+ paste0(round(resultsLM$estimate*10,1),' days per decade, R2 = ', round(resultsLM$r.squared,2), resultsLM$significane) } else {
+ paste0(resultsLM$significane)
+ }) +
+
+ xlab("") + ylab('')+
+ scale_y_date(date_labels = "%b %d")+
+ scale_x_continuous(breaks = seq(1981,2001,by=5),
+ labels = c('1981-1995','1986-2000','1991-2005','1996-2010','2001-2015'))+
+ plotTheme1+
+ theme(axis.text.x = element_text(angle = 45, hjust=1),
+ axis.text.y = element_blank(),
+ legend.position = 'right')
+
+
+
+ ##############################################################################################################################################
+ ##############################################################################################################################################
+
+
+
+ #####################
+ # Moving window plots
+ #####################
+
+
+
+ # 20-year moving window
+ #######################
+
+ #subset
+ pre.df.sub = pre.df %>%
+ filter(dataset == 'Long')
+
+ #get linear model coefficients
+ resultsLM = pre.df.sub %>%
+ group_by(variable)%>%
+ filter(species == 'Aall') %>%
+ do({model = lm(end ~ year, data=.) # create your model
+ data.frame(tidy(model), # get coefficient info
+ lowCI=ci(model)[2,2],
+ hiCI=ci(model)[2,3],
+ glance(model))})%>% # get model info
+ filter(!term %in% c("(Intercept)")) %>%
+ mutate(significane = ifelse(p.value<0.001,"***",
+ ifelse(p.value<0.01,"**",
+ ifelse(p.value<0.05,"**",'n.s.'))))%>%
+ ungroup()
+
+ #plot
+ Long.pre = ggplot(pre.df.sub, aes(x = year, y = end.date, group=species, color=species)) +
+
+ geom_hline(yintercept = as.Date('1970-06-21'), color="grey", size=2)+
+
+ geom_line(size = 0.75) +
+
+ geom_ribbon(data=pre.df.sub[pre.df.sub$species=='Aall',],
+ aes(ymin = end.date.lowCI, ymax = end.date.hiCI),
+ fill = "darkgrey", color=NA, alpha = 0.7) +
+
+ {if(resultsLM$p.value<0.05)
+ geom_smooth(data=pre.df.sub[pre.df.sub$species=='Aall',],
+ aes(x = year, y = end.date),
+ method='lm', formula = y~x, se = FALSE, linetype="dashed")}+
+
+ geom_line(data=pre.df.sub[pre.df.sub$species=='Aall',],
+ aes(x = year, y = end.date), size = 1.25) +
+
+ scale_color_manual(values = rev(wes_palette("Darjeeling2", n = 5))) +
+
+ coord_cartesian(xlim=c(1967.3,1994.7),ylim=c(as.Date('1970-06-05'),as.Date('1970-08-02')))+
+
+ annotate(geom="text", x=Inf, y = as.Date(Inf, origin="1970-01-01"), vjust=1.5, hjust=1.05,
+ label=
+ if(resultsLM$p.value<0.05){
+ paste0(round(resultsLM$estimate*10,1),' days per decade, R2 = ', round(resultsLM$r.squared,2), resultsLM$significane) } else {
+ paste0(resultsLM$significane)
+ }) +
+
+ xlab("") + ylab('End of negative early-season effect')+
+ scale_y_date(date_labels = "%b %d")+
+ scale_x_continuous(breaks = seq(1966,1996,by=5),
+ labels = c('1966-1985','1971-1990','1976-1995','1981-2000','1986-2005','1991-2010','1996-2015'))+
+ plotTheme1+
+ guides(col = guide_legend(ncol = 2))+
+ theme(axis.text.x = element_text(angle = 45, hjust=1))
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ # 15-year moving window
+ #######################
+
+ #subset
+ pre.df.sub = pre.df %>%
+ filter(dataset == 'Short')
+
+ #get linear model coefficients
+ resultsLM = pre.df.sub %>%
+ filter(species == 'Aall') %>%
+ do({model = lm(end ~ year, data=.) # create your model
+ data.frame(tidy(model), # get coefficient info
+ lowCI=ci(model)[2,2],
+ hiCI=ci(model)[2,3],
+ glance(model))})%>% # get model info
+ mutate(significane = ifelse(p.value<0.001,"***",
+ ifelse(p.value<0.01,"**",
+ ifelse(p.value<0.05,"**",'n.s.'))))%>%
+ filter(!term %in% c("(Intercept)"))
+
+ #plot
+ Short.pre = ggplot(pre.df.sub, aes(x = year, y = end.date, group=species, color=species)) +
+
+ geom_hline(yintercept = as.Date('1970-06-21'), color="grey", size=2)+
+
+ geom_line(size = 0.75) +
+
+ geom_ribbon(data=pre.df.sub[pre.df.sub$species=='Aall',],
+ aes(ymin = end.date.lowCI, ymax = end.date.hiCI),
+ fill = "darkgrey", color=NA, alpha = 0.7) +
+
+ {if(resultsLM$p.value<0.05)
+ geom_smooth(data=pre.df.sub[pre.df.sub$species=='Aall',],
+ aes(x = year, y = end.date),
+ method='lm', formula = y~x, se = FALSE, linetype="dashed")}+
+
+ geom_line(data=pre.df.sub[pre.df.sub$species=='Aall',],
+ aes(x = year, y = end.date), size = 1.25) +
+
+ scale_color_manual(values = rev(wes_palette("Darjeeling2", n = 5))) +
+
+ coord_cartesian(xlim=c(1981.5,2000.08),ylim=c(as.Date('1970-06-05'),as.Date('1970-08-02')))+
+
+ annotate(geom="text", x=Inf, y = as.Date(Inf, origin="1970-01-01"), vjust=1.5, hjust=1.05,
+ label=
+ if(resultsLM$p.value<0.05){
+ paste0(round(resultsLM$estimate*10,1),' days per decade, R2 = ', round(resultsLM$r.squared,2), resultsLM$significane) } else {
+ paste0(resultsLM$significane)
+ }) +
+
+ xlab("") + ylab('')+
+ scale_y_date(date_labels = "%b %d")+
+ scale_x_continuous(breaks = seq(1981,2001,by=5),
+ labels = c('1981-1995','1986-2000','1991-2005','1996-2010','2001-2015'))+
+ plotTheme1+
+ theme(axis.text.x = element_text(angle = 45, hjust=1),
+ axis.text.y = element_blank(),
+ legend.position = 'right')
+
+
+
+ ##############################################################################################################################################
+ ##############################################################################################################################################
+
+
+
+ #####################
+ # Moving window plots
+ #####################
+
+
+
+ # 20-year moving window
+ #######################
+
+ #subset
+ solstice.df.sub = solstice.df %>%
+ filter(dataset == 'Long')
+
+ #get linear model coefficients
+ resultsLM = solstice.df.sub %>%
+ group_by(variable)%>%
+ filter(species == 'Aall') %>%
+ do({model = lm(end ~ year, data=.) # create your model
+ data.frame(tidy(model), # get coefficient info
+ lowCI=ci(model)[2,2],
+ hiCI=ci(model)[2,3],
+ glance(model))})%>% # get model info
+ filter(!term %in% c("(Intercept)")) %>%
+ mutate(significane = ifelse(p.value<0.001,"***",
+ ifelse(p.value<0.01,"**",
+ ifelse(p.value<0.05,"**",'n.s.'))))%>%
+ ungroup()
+
+ #plot
+ Long.solstice = ggplot(solstice.df.sub, aes(x = year, y = end.date, group=species, color=species)) +
+
+ geom_hline(yintercept = as.Date('1970-06-21'), color="grey", size=2)+
+
+ geom_line(size = 0.75) +
+
+ geom_ribbon(data=solstice.df.sub[solstice.df.sub$species=='Aall',],
+ aes(ymin = end.date.lowCI, ymax = end.date.hiCI),
+ fill = "darkgrey", color=NA, alpha = 0.7) +
+
+ {if(resultsLM$p.value<0.05)
+ geom_smooth(data=solstice.df.sub[solstice.df.sub$species=='Aall',],
+ aes(x = year, y = end.date),
+ method='lm', formula = y~x, se = FALSE, linetype="dashed")}+
+
+ geom_line(data=solstice.df.sub[solstice.df.sub$species=='Aall',],
+ aes(x = year, y = end.date), size = 1.25) +
+
+ scale_color_manual(values = rev(wes_palette("Darjeeling2", n = 5))) +
+
+ coord_cartesian(xlim=c(1967.3,1994.7),ylim=c(as.Date('1970-06-11'),as.Date('1970-07-31')))+
+
+ annotate(geom="text", x=Inf, y = as.Date(Inf, origin="1970-01-01"), vjust=1.5, hjust=1.05,
+ label=
+ if(resultsLM$p.value<0.05){
+ paste0(round(resultsLM$estimate*10,1),' days per decade, R2 = ', round(resultsLM$r.squared,2), resultsLM$significane) } else {
+ paste0(resultsLM$significane)
+ }) +
+
+ xlab("") + ylab('End of negative early-season effect')+
+ scale_y_date(date_labels = "%b %d")+
+ scale_x_continuous(breaks = seq(1966,1996,by=5),
+ labels = c('1966-1985','1971-1990','1976-1995','1981-2000','1986-2005','1991-2010','1996-2015'))+
+ plotTheme1+
+ guides(col = guide_legend(ncol = 2))+
+ theme(axis.text.x = element_text(angle = 45, hjust=1))
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ # 15-year moving window
+ #######################
+
+ #subset
+ solstice.df.sub = solstice.df %>%
+ filter(dataset == 'Short')
+
+ #get linear model coefficients
+ resultsLM = solstice.df.sub %>%
+ filter(species == 'Aall') %>%
+ do({model = lm(end ~ year, data=.) # create your model
+ data.frame(tidy(model), # get coefficient info
+ lowCI=ci(model)[2,2],
+ hiCI=ci(model)[2,3],
+ glance(model))})%>% # get model info
+ mutate(significane = ifelse(p.value<0.001,"***",
+ ifelse(p.value<0.01,"**",
+ ifelse(p.value<0.05,"**",'n.s.'))))%>%
+ filter(!term %in% c("(Intercept)"))
+
+ #plot
+ Short.solstice = ggplot(solstice.df.sub, aes(x = year, y = end.date, group=species, color=species)) +
+
+ geom_hline(yintercept = as.Date('1970-06-21'), color="grey", size=2)+
+
+ geom_line(size = 0.75) +
+
+ geom_ribbon(data=solstice.df.sub[solstice.df.sub$species=='Aall',],
+ aes(ymin = end.date.lowCI, ymax = end.date.hiCI),
+ fill = "darkgrey", color=NA, alpha = 0.7) +
+
+ {if(resultsLM$p.value<0.05)
+ geom_smooth(data=solstice.df.sub[solstice.df.sub$species=='Aall',],
+ aes(x = year, y = end.date),
+ method='lm', formula = y~x, se = FALSE, linetype="dashed")}+
+
+ geom_line(data=solstice.df.sub[solstice.df.sub$species=='Aall',],
+ aes(x = year, y = end.date), size = 1.25) +
+
+ scale_color_manual(values = rev(wes_palette("Darjeeling2", n = 5))) +
+
+ coord_cartesian(xlim=c(1981.5,2000.08),ylim=c(as.Date('1970-06-11'),as.Date('1970-07-31')))+
+
+ annotate(geom="text", x=Inf, y = as.Date(Inf, origin="1970-01-01"), vjust=1.5, hjust=1.05,
+ label=
+ if(resultsLM$p.value<0.05){
+ paste0(round(resultsLM$estimate*10,1),' days per decade, R2 = ', round(resultsLM$r.squared,2), resultsLM$significane) } else {
+ paste0(resultsLM$significane)
+ }) +
+
+ xlab("") + ylab('')+
+ scale_y_date(date_labels = "%b %d")+
+ scale_x_continuous(breaks = seq(1981,2001,by=5),
+ labels = c('1981-1995','1986-2000','1991-2005','1996-2010','2001-2015'))+
+ plotTheme1+
+ theme(axis.text.x = element_text(angle = 45, hjust=1),
+ axis.text.y = element_blank(),
+ legend.position = 'right')
+
+
+
+ ##############################################################################################################################################
+ ##############################################################################################################################################
+
+
+
+ ##########################
+ # Arrange and safe plots #
+ ##########################
+
+
+
+ #define plot layout
+ layout <-
+ "AB
+ CD
+ EF"
+
+ #Merge plots
+Plot = Long.post + Short.post + Long.pre + Short.pre + Long.solstice + Short.solstice +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'a')&
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plots as .pdf
+ ggsave(Plot, file="FigS20_Moving_window_preseason_sensitivity.pdf", path=output_path,
+ width=8, height=12)
+
+Plot
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## date time
+Sys.time()
+
+
+## session info
+sessionInfo()
+```
\ No newline at end of file
diff --git a/R code/Remote_sensing/1_Data_extraction/1.1_Extract_Photoperiod.R b/R code/Remote_sensing/1_Data_extraction/1.1_Extract_Photoperiod.R
new file mode 100644
index 0000000..cb7bf56
--- /dev/null
+++ b/R code/Remote_sensing/1_Data_extraction/1.1_Extract_Photoperiod.R
@@ -0,0 +1,74 @@
+# Load libraries
+require(data.table)
+require(geosphere)
+require(zoo)
+require(lubridate)
+require(tidyverse)
+
+
+##############################################################################################################################################
+
+
+######################################
+## Set directories and get PEP data ##
+######################################
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+## Paths
+
+#Phenology
+phenology_path = "Analysis_input/Phenology_data"
+
+#Output
+Drivers_path = "Analysis_input/Drivers"
+
+
+## load phenology data (Rbind files)
+pheno.df = rbindlist(lapply(list.files(path = phenology_path),
+ function(n) fread(file.path(phenology_path, n))))
+
+
+##############################################################################################################################################
+
+
+#################
+## Photoperiod ##
+#################
+
+
+# Get all time-points
+site <- unique(pheno.df$geometry)
+
+# Initialize data frame to store results
+photo.df <- data.frame()
+i=1
+
+for(id in site) {
+
+ # Subset table according to latitude
+ photo.sub <- as.data.frame(pheno.df %>%
+ filter(geometry==id) %>%
+ dplyr::select(geometry, Lat) %>%
+ distinct(Lat, .keep_all = T)) #delete duplicates
+
+ # Calculate daily photoperiod for the whole year
+ photo <- geosphere::daylength(photo.sub$Lat,1:366)
+
+ # Add daily photoperiods to the subset table
+ photo.sub[as.character(1:366)] <- 0
+ photo.sub[,3:368] <- photo
+
+ photo.df <- rbind(photo.df,photo.sub)
+ print(paste0(round(i/length(site)*100, 1),"% of photoperiods calculated!"))
+ i=i+1
+}
+rm(photo.sub)
+
+# Export dataset
+write.table(photo.df, paste0(Drivers_path ,"/Photoperiod.csv"), sep=",", row.names=FALSE)
+
+
+##############################################################################################################################################
diff --git a/R code/Remote_sensing/1_Data_extraction/1.1_Extract_Photoperiod_VNP.R b/R code/Remote_sensing/1_Data_extraction/1.1_Extract_Photoperiod_VNP.R
new file mode 100644
index 0000000..c74badb
--- /dev/null
+++ b/R code/Remote_sensing/1_Data_extraction/1.1_Extract_Photoperiod_VNP.R
@@ -0,0 +1,73 @@
+# Load libraries
+require(data.table)
+require(geosphere)
+require(zoo)
+require(lubridate)
+require(tidyverse)
+
+
+##############################################################################################################################################
+
+
+######################################
+## Set directories and get PEP data ##
+######################################
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+## Paths
+
+#Phenology
+phenology_path = "Analysis_input/Phenology_data"
+
+#Output
+Drivers_path = "Analysis_input/Drivers"
+
+
+## load phenology data (Rbind files)
+pheno.df = fread(paste(phenology_path, "PhenologyData_VNP_2013_2021.csv", sep="/"))
+
+
+##############################################################################################################################################
+
+
+#################
+## Photoperiod ##
+#################
+
+
+# Get all time-points
+site <- unique(pheno.df$geometry)
+
+# Initialize data frame to store results
+photo.df <- data.frame()
+i=1
+
+for(id in site) {
+
+ # Subset table according to latitude
+ photo.sub <- as.data.frame(pheno.df %>%
+ filter(geometry==id) %>%
+ dplyr::select(geometry, Lat) %>%
+ distinct(Lat, .keep_all = T)) #delete duplicates
+
+ # Calculate daily photoperiod for the whole year
+ photo <- geosphere::daylength(photo.sub$Lat,1:366)
+
+ # Add daily photoperiods to the subset table
+ photo.sub[as.character(1:366)] <- 0
+ photo.sub[,3:368] <- photo
+
+ photo.df <- rbind(photo.df,photo.sub)
+ print(paste0(round(i/length(site)*100, 1),"% of photoperiods calculated!"))
+ i=i+1
+}
+rm(photo.sub)
+
+# Export dataset
+write.table(photo.df, paste0(Drivers_path, "/Photoperiod_VNP.csv"), sep=",", row.names=FALSE)
+
+
+##############################################################################################################################################
diff --git a/R code/Remote_sensing/2_Add_drivers/2.1_Add_Drivers_AP_tier2_remote_sensing_EOS10_v1.3.start.R b/R code/Remote_sensing/2_Add_drivers/2.1_Add_Drivers_AP_tier2_remote_sensing_EOS10_v1.3.start.R
new file mode 100644
index 0000000..7711a81
--- /dev/null
+++ b/R code/Remote_sensing/2_Add_drivers/2.1_Add_Drivers_AP_tier2_remote_sensing_EOS10_v1.3.start.R
@@ -0,0 +1,1375 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Climate driver extraction of the remote sensing analysis (EOS10) ##########################################
+#############################################################################################################
+
+
+
+#required packages
+require(data.table)
+require(sf)
+require(ncdf4)
+require(raster)
+require(tidyverse)
+require(sp)
+require(rpmodel)
+require(purrr)
+require(pbmcapply)
+require(zoo)
+require(chillR)
+require(lubridate)
+require(weathermetrics)
+require(rgdal)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#############################
+## Set directory and paths ##
+#############################
+
+
+
+# Set the working dirctory
+setwd("/Users/crowtherlabstation02/Desktop/Analysis")
+
+
+#########
+# Paths #
+#########
+
+
+# 1. Input
+##########
+
+#Climate
+GLDAS_path = "Remote_sensing/Analysis/Analysis_input/Drivers/GLDAS"
+
+#CO2
+CO2_path = "Remote_sensing/Analysis/Analysis_input/Drivers/CO2"
+
+#Photoperiod
+photo_path = "Remote_sensing/Analysis/Analysis_input/Drivers"
+
+# AET/PET
+AET.PET_path = "PEP_analysis/Analysis/Analysis_input/Drivers"
+
+# GPP and LAI
+GPP_path = "Remote_sensing/Analysis/Analysis_input/Drivers/Modis_GPP_LAI"
+
+#Phenology
+Pheno_path = "Remote_sensing/Analysis/Analysis_input/Phenology_data"
+
+
+# 2. Output
+###########
+
+Drivers_path = "Remote_sensing/Analysis/Analysis_input/Drivers_final_EOS10/Individual_files"
+Drivers_path2 = "Remote_sensing/Analysis/Analysis_input/Drivers_final_EOS10/Merged_file"
+Drivers_path3 = "Remote_sensing/Analysis/Analysis_input/Drivers_final_EOS10/Missing_observations"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+## Phenology data
+#################
+
+Pheno.df <- fread(paste(Pheno_path, "PhenologyData_Forests_025_North_Filtered_New.csv", sep="/")) %>%
+ group_by(geometry) %>%
+ #delete pixels with less than 15 years
+ filter(n() >= 15) %>%
+ #get autumn phenology means per pixel
+ mutate(Dormancy_DOY = ifelse(Dormancy_DOY<170,365,Dormancy_DOY),#set dormancy that falls in next year to end of year
+ SenescenceMean = mean(Senesc_DOY),
+ DormancyMax = max(Dormancy_DOY)) %>%
+ ungroup() %>%
+ #delete duplicates
+ distinct(geometry, Year, .keep_all = T)
+
+
+## AET/PET map
+##############
+
+#annual AET/PET ratio from SPLASH model
+AET_PET.raster = raster(paste(AET.PET_path , "AET_PET_ratio_global_FULL_MODIS-C006_MOD15A2_v1.alpha_MEANANN.nc", sep="/"))
+
+
+## Elevation map
+################
+
+elev.raster = raster(paste(photo_path, "topo_elevation.asc", sep="/"))
+
+
+## Biomes map
+#############
+
+biome.raster = raster(paste(photo_path, "WWF_Biomes_HalfDegree.tif", sep="/"))
+
+
+## CO2 data
+###########
+
+CO2.df = fread(paste(CO2_path, "CO2_Annual.csv", sep="/"))
+
+
+## Photoperiod
+##############
+
+photo.df = fread(paste(photo_path, "Photoperiod.csv", sep="/"))
+
+
+## LAI and GPP
+##############
+
+GPP.df = fread(paste(GPP_path, "GppData_Forests_025.csv", sep='/'))%>%
+ #keep only numbers in string
+ mutate(geometry2 = gsub("POINT ","", geometry),
+ geometry2 = gsub("\\(|\\)","", geometry2)) %>%
+ separate(geometry2, into = c("Lat","Lon"), sep=" ") %>%
+ mutate(Lat = as.numeric(Lat),
+ Lon = as.numeric(Lon)) %>%
+ #add site x year identifier
+ mutate(site_year = paste0(geometry, '_', Year)) %>%
+ #order table
+ dplyr::select(Year, geometry, site_year, Lat, Lon, everything())
+#rename columns
+colnames(GPP.df)[6:ncol(GPP.df)] <- seq(1, 366, by=8)
+
+LAI.df = fread(paste(GPP_path, "LaiData_Forests_025.csv", sep='/'))%>%
+ #keep only numbers in string
+ mutate(geometry2 = gsub("POINT ","", geometry),
+ geometry2 = gsub("\\(|\\)","", geometry2)) %>%
+ separate(geometry2, into = c("Lat","Lon"), sep=" ") %>%
+ mutate(Lat = as.numeric(Lat),
+ Lon = as.numeric(Lon)) %>%
+ #add site x year identifier
+ mutate(site_year = paste0(geometry, '_', Year)) %>%
+ #order table
+ dplyr::select(Year, geometry, site_year, Lat, Lon, everything())
+#rename columns
+colnames(LAI.df)[6:ncol(LAI.df)] <- seq(1, 366, by=8)
+
+
+## Import daily climatic datasets from GLDAS
+############################################
+
+#define climate variables
+vn <- c('GLDAS_Daily_Data_Tair_f_inst_Mean',
+ 'GLDAS_Daily_Data_Tair_f_inst_Min',
+ 'GLDAS_Daily_Data_Tair_f_inst_Max',
+ 'GLDAS_Daily_Data_Rainf_f_tavg',
+ 'GLDAS_Daily_Data_Qair_f_inst',
+ 'GLDAS_Daily_Data_SoilMoi0_10cm_inst',
+ 'GLDAS_Daily_Data_SoilMoi10_40cm_inst',
+ 'GLDAS_Daily_Data_Swnet_tavg',
+ 'GLDAS_Daily_Data_Lwnet_tavg',
+ 'GLDAS_Daily_Data_SWdown_f_tavg')
+
+#create empty list
+DataList <- replicate(length(vn),data.frame())
+
+#loop through climate variables
+for(i in 1:length(vn)) {
+ #read data
+ data = fread(paste0(GLDAS_path, "/", vn[i],".csv")) %>%
+ #keep only numbers in string
+ mutate(geometry2 = gsub("POINT ","", geometry),
+ geometry2 = gsub("\\(|\\)","", geometry2)) %>%
+ separate(geometry2, into = c("Lat","Lon"), sep=" ") %>%
+ mutate(Lat = as.numeric(Lat),
+ Lon = as.numeric(Lon)) %>%
+ #add site x year identifier
+ mutate(site_year = paste0(geometry, '_', Year)) %>%
+ #order table
+ dplyr::select(Year, geometry, site_year, Lat, Lon, everything())
+
+ #rename columns
+ colnames(data)[6:ncol(data)] <- as.numeric(1:366)
+
+ #delete NAs
+ data = data %>% filter(!is.na(`170`))
+
+ #add table to list
+ DataList[[i]] <- data
+}
+#add names to list
+names(DataList)=vn
+# Note: Precipitation is given as rate in mm d-1.
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+####################################################
+## Add Soil texture, PFT, and AET/PET (meanalpha) ##
+####################################################
+
+
+
+#Add plant functional type info
+Pheno.df$PFT <- "TBL" # T-BL-SG: Temperate broad-leaved summergreen tree
+#PEP.df[PEP.df$species=='Larix',]$PFT <- "BNL" # B-NL-SG: Boreal needle-leaved summergreen tree
+
+#Add biome information, AET-PET ratio and elevation (required for pmodel)
+Pheno.df =
+ #both tables together
+ cbind(Pheno.df,
+ # intersection
+ data.frame(AET_PET = raster::extract(AET_PET.raster, Pheno.df[, c("Lon", "Lat")])),
+ data.frame(alt = raster::extract(elev.raster, Pheno.df[, c("Lon", "Lat")])),
+ data.frame(biome = raster::extract(biome.raster, Pheno.df[, c("Lon", "Lat")]))
+ )
+
+#remove stuff
+rm(AET_PET.raster, elev.raster, biome.raster)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+###############
+## Constants ##
+###############
+
+
+
+## Constants in the Photosynthesis module
+po2 <- 20.9e3 #O2 partial pressure in Pa
+p <- 1.0e5 # atmospheric pressure in Pa
+bc3 <- 0.015 # leaf respiration as fraction of Vmax for C3 plants
+theta <- 0.7 # colimitation (shape) parameter
+q10ko <- 1.2 #q10 for temperature-sensitive parameter ko
+q10kc <- 2.1 # q10 for temperature-sensitive parameter kc
+q10tau <- 0.57 # q10 for temperature-sensitive parameter tau
+ko25 <- 3.0e4 # value of ko at 25 deg C
+kc25 <- 30.0 # value of kc at 25 deg C
+tau25 <- 2600.0 # value of tau at 25 deg C
+alphaa <- 0.5 # fraction of PAR assimilated at ecosystem level relative to leaf level
+alphac3 <- 0.08 # intrinsic quantum efficiency of CO2 uptake in C3 plants
+lambdamc3 <- 0.8 # optimal (maximum) lambda in C3 plants
+cmass <- 12.0107 # molecular mass of C [g mol-1]
+cq <- 2.04e-6 # conversion factor for solar radiation from J m-2 to mol m-2
+n0 <- 7.15 # leaf N concentration (mg/g) not involved in photosynthesis
+m <- 25.0 # corresponds to parameter p in Eqn 28, Haxeltine & Prentice 1996
+t0c3 <- 250.0 # base temperature (K) in Arrhenius temperature response function for C3 plants
+e0 <- 308.56 # parameter in Arrhenius temp response function
+tk25 <- 298.15 # 25 deg C in Kelvin
+tmc3 <- 45.0 # maximum temperature for C3 photosynthesis
+## Constants in the Water balance module
+gamma <- 65 # psychrometer constant gamma [Pa/K]
+L <- 2.5*10^6 # latent heat of vaporization of water L [J/kg]
+emissivity <- 0.6 # emissivity for coniferous and deciduous surface type
+k_sb <- 5.670367*10^-8 # Stefan-Boltzman constant [W/m^2 K^4]
+d1 <- 0.5 # thickness of upper soil layer [m]
+d2 <- 1 # thickness of lower soil layer [m]
+a_m <- 1.391 # maximum Priestley-Taylor coefficient a_m
+g_m <- 3.26 # scaling conductance g_m [mm/s]
+k_melt <- 3 # rate of snowmelt [mm/???C d]
+
+## Soil parameters depending on texture [Phenologoy_CO2_soil dataset]
+E_max <- 5 # maximum transpiration rate that can be sustained under well-watered conditions E_max [mm/d] --> depends on plant functional type (same for T-BD-SG and B-NL-SG)
+# w_max = soil texture-dependent difference between field capacity and wilting point w_max [%]
+# c_soil = soil texture-dependent maximum rate of ETA from the bare soil [mm/h]
+# k_perc = soil texture-dependent conductivity cond_soil or percolation rate field capacity [mm/d]
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+######################
+## Helper functions ##
+######################
+
+
+# Temperate inhibition function from LPJ-GUESS
+##############################################
+
+temp_opt.fun <- function(temp) {
+ x1 <- 1
+ x2 <- 18
+ x3 <- 25
+ x4 <- 45
+ k1 <- 2.*log((1/0.99)-1.)/(x1-x2)
+ k2 <- (x1+x2)/2
+ low <- 1/(1+exp(k1*(k2-temp)))
+ k3 <- log(0.99/0.01)/(x4-x3)
+ high <- 1-0.01*exp(k3*(temp-x3))
+ tstress <- low*high
+ if(tstress>=0) {
+ tstress <- tstress
+ } else {
+ tstress <- 0
+ }
+ return(tstress)
+}
+
+
+# convert degC to kPa
+#####################
+degC_to_kPa.fun <- function(temp) {
+ out <- 0.6108*exp((17.27*temp)/(temp+237.3))
+ return(out)
+}
+
+
+# Photoperiod function
+######################
+
+# photo = photoperiod
+# photo_min = minimum value during the growing season --> limited canopy development
+# photo_max = maxmum value during the growing season --> allows canopies to develop unconstrained
+photoperiod.fun <- function(photo, photo_min, photo_max) {
+ if(photo<=photo_min) {
+ photo_resp <- 0
+ }
+ if(photophoto_min) {
+ photo_resp <- (photo-photo_min)/(photo_max-photo_min)
+ }
+ if(photo>=photo_max) {
+ photo_resp <- 1
+ }
+ return(photo_resp)
+}
+
+
+# Vapour Pressure Deficit (VPD) function
+########################################
+
+# VPD = vapour pressure deficit [kPa]
+# T_min & T_max = minimum and maximum daily temperature [C]
+# VPD_min --> at low values, latent heat losses are unlikely to exceed available water
+# little effect on stomata
+# VPD_max --> at high values, particularly if sustained, photosynthesis and growth are likely to be significantly limited
+# complete stomatal closure
+
+VPD.fun <- function(VPD, VPD_min, VPD_max) {
+ if(VPD>=VPD_max) {
+ y <- 0
+ }
+ if(VPDVPD_min) {
+ y <- 1-((VPD-VPD_min)/(VPD_max-VPD_min))
+ }
+ if(VPD<=VPD_min) {
+ y <- 1
+ }
+ return(y)
+}
+
+
+# Convert specific to relative humidity
+#######################################
+
+qair2rh <- function(qair, temp, press = 1013.25){
+ es <- 6.112 * exp((17.67 * temp)/(temp + 243.5))
+ e <- qair * press / (0.378 * qair + 0.622)
+ rh <- e / es
+ rh[rh > 1] <- 1
+ rh[rh < 0] <- 0
+ return(rh)
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#######################################################
+## Calculate climatic predictors using Parallel calc ##
+#######################################################
+
+
+
+# Identifier (all site x year combinations)
+Pheno.df$site_year = paste0(Pheno.df$geometry, '_', Pheno.df$Year)
+timeseries_year = unique(Pheno.df$site_year)
+
+# add Pheno, CO2 and photoperiod data to list
+DataList[[11]] = photo.df
+DataList[[12]] = CO2.df
+DataList[[13]] = Pheno.df
+DataList[[14]] = GPP.df
+DataList[[15]] = LAI.df
+
+rm(photo.df, CO2.df, data, Pheno.df, GPP.df, LAI.df)
+names(DataList)=c(vn,"photoperiod",'CO2',"Pheno","GPP","LAI")
+names(DataList)
+#[1] "GLDAS_Daily_Data_Tair_f_inst_Mean" "GLDAS_Daily_Data_Tair_f_inst_Min" "GLDAS_Daily_Data_Tair_f_inst_Max" "GLDAS_Daily_Data_Rainf_f_tavg"
+#[5] "GLDAS_Daily_Data_Qair_f_inst" "GLDAS_Daily_Data_SoilMoi0_10cm_inst" "GLDAS_Daily_Data_SoilMoi10_40cm_inst" "GLDAS_Daily_Data_Swnet_tavg"
+#[9] "GLDAS_Daily_Data_Lwnet_tavg" "GLDAS_Daily_Data_SWdown_f_tavg" "photoperiod" "CO2"
+#[13] "Pheno" "GPP" "LAI"
+
+
+##############################################################################################################################################
+
+
+################################
+# Loop through all time-points #
+################################
+
+
+parallelCalc <- function(timeseries_years){
+
+ # Subset input data by time-point
+ #################################
+
+ #phenology data
+ pheno.sub <- DataList[[13]][which(DataList[[13]]$site_year==timeseries_years),]
+
+ #daily mean temperature
+ TMEAN <- DataList[[1]][which(DataList[[1]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #Skip timeseries for which there is no data
+ if (nrow(TMEAN)==0) {
+ write.table(pheno.sub, file=paste0(Drivers_path3, '/', timeseries_years, '.csv'), sep=',', row.names = F, col.names = T)
+ } else {
+
+ #daily minimum temperature
+ TMIN <- DataList[[2]][which(DataList[[2]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #daily maximum temperature
+ TMAX <- DataList[[3]][which(DataList[[3]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #precipitation
+ PRCP <- DataList[[4]][which(DataList[[4]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #air humidity
+ QAIR <- DataList[[5]][which(DataList[[5]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #soil moisture (<10cm)
+ MOIST10 <- DataList[[6]][which(DataList[[6]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #soil moisture (10-40 cm)
+ MOIST40 <- DataList[[7]][which(DataList[[7]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #net short-wave radiation
+ SWRAD <- DataList[[8]][which(DataList[[8]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #net long-wave radiation
+ LWRAD <- DataList[[9]][which(DataList[[9]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #short-wave radiation down
+ SWRADdown <- DataList[[10]][which(DataList[[10]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #day length
+ PHOTO <- DataList[[11]][which(DataList[[11]]$geometry==pheno.sub$geometry),][1]%>%
+ dplyr::select(as.character(1:366))
+
+ #CO2 (monthly)
+ CO2 <- DataList[[12]][which(DataList[[12]]$Year==pheno.sub$Year),]$CO2
+
+ #GPP
+ GPP <- as.numeric(DataList[[14]][which(DataList[[14]]$site_year==pheno.sub$site_year),] %>%
+ dplyr::select(6:ncol(DataList[[14]])) )
+ GPP = rep(GPP, each=8) / 8
+ GPP = GPP[1:366]
+
+ #LAI
+ LAI <- as.numeric(DataList[[15]][which(DataList[[15]]$site_year==pheno.sub$site_year),] %>%
+ dplyr::select(6:ncol(DataList[[15]])) )
+ LAI = rep(LAI, each=8)
+ LAI = LAI[1:366]
+
+
+ ##############################################################################################################################################
+
+
+ # Create table of daily climate
+ ###############################
+
+ # Generate sub-dataframe to store results
+ factors.sub <- pheno.sub %>%
+ dplyr::select(geometry, Lat, Lon, alt, Year, Greenup_DOY, MidGreenup_DOY, Senesc_DOY) %>%
+ mutate(CO2 = CO2)
+
+ # Define the current year in calendar units
+ year <- as.character(pheno.sub$Year)
+ start_doy <- paste(year,"-01-01", sep="")
+ end_doy <- paste(year,"-12-31", sep="")
+ days <- seq(as.Date(start_doy), as.Date(end_doy), by="days")
+
+ #create table
+ daily_vals <- data.frame(Year = year,
+ Month = 0,
+ Day = 0,
+ Tmin = as.numeric(TMIN),
+ Tmean = as.numeric(TMEAN),
+ Tmax = as.numeric(TMAX),
+ SWrad = as.numeric(SWRAD),
+ LWrad = as.numeric(LWRAD),
+ SWradDown= as.numeric(SWRADdown),
+ Moist10 = as.numeric(MOIST10),
+ Moist40 = as.numeric(MOIST40),
+ Prcp = as.numeric(PRCP),
+ Qair = as.numeric(QAIR),
+ Photo = as.numeric(PHOTO),
+ GPP = GPP,
+ LAI = LAI)
+
+ #Add climate variables and data wrangling
+ daily_vals = daily_vals %>%
+ filter(!is.na(Tmean)) %>%#delete NAs
+ mutate(
+ #add month and day identifiers
+ Month = lubridate::month(as.Date(days,origin=days[1])),
+ Day = lubridate::day(as.Date(days,origin=days[1])),
+ #relative humidity
+ RH = qair2rh(Qair, Tmean)*100,
+ #dewpoint temperature
+ Tdew = weathermetrics::humidity.to.dewpoint(t = Tmean,
+ rh = RH,
+ temperature.metric = "celsius"))
+
+ #set NAs to 0
+ daily_vals[is.na(daily_vals)] <- 0.0001
+
+
+ ##############################################################################################################################################
+
+
+ # Get average daytime temperature (chillR package)
+ ##################################################
+
+ #Get hourly values
+ hourly_vals = stack_hourly_temps(daily_vals, latitude=pheno.sub$Lat)$hourtemps
+
+ #get daytime temperature
+ daytime_temp = data.frame(hourly_vals %>%
+ group_by_at(vars(-c(Temp,Hour))) %>%
+ #delete night hours
+ filter(
+ #filter only if daylength is less than 24 hours
+ if(daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Daylength < 24)
+ between(Hour,daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Sunrise,
+ daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Sunset)
+ else TRUE
+ ) %>%
+ #summarise daytime hours
+ summarise(Tday = mean(Temp))%>%
+ ungroup() %>%
+ #order
+ dplyr::select(Tday) )
+
+ #get nighttime temperature
+ nighttime_temp = data.frame(hourly_vals %>%
+ group_by_at(vars(-c(Temp,Hour))) %>%
+ #delete day hours
+ filter(
+ #filter if daylength is less than 24 hours
+ if(daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Daylength < 24)
+ !between(Hour,daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Sunrise,
+ daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Sunset)
+ #if no darkness select minimum Temp
+ else Temp == min(Temp)
+ )%>%
+ #summarise nighttime hours
+ summarise(Tnight = mean(Temp))%>%
+ ungroup() %>%
+ #order
+ dplyr::select(Tnight) )
+
+ #combine
+ daily_vals = cbind(daily_vals, daytime_temp, nighttime_temp) %>%
+ #growing-degree-days (>0??C)
+ mutate(GDDday = ifelse(Tday < 0 , 0, Tday),
+ GDDnight = ifelse(Tnight < 0 , 0, Tnight))%>%
+ #order
+ dplyr::select(Year, Month, Day, Tmin, Tmean, Tmax, Tday, Tnight, everything())
+
+
+ ##############################################################################################################################################
+
+
+ # Get important dates
+ #####################
+
+ # warmest day of year
+ factors.sub$HottestDOY = mean(which(daily_vals$Tmax==max(daily_vals$Tmax)))
+
+ # day of maximum radiation
+ factors.sub$MaxRadDOY = mean(which(daily_vals$SWrad==max(daily_vals$SWrad)))
+
+ # longest day of year (summer solstice)
+ solstice = which(daily_vals$Photo==max(daily_vals$Photo))[1]
+
+ # March equinox
+ equinox.Mar = solstice - 97
+
+ # September equinox
+ equinox.Sep = solstice + 97
+
+ # Mean leaf senescence
+ DOY_off <- round(pheno.sub$SenescenceMean)
+
+ # Latest dormancy
+ DOY_dorm <- round(pheno.sub$DormancyMax)
+
+ # leaf-out
+ DOY_out <- pheno.sub$Greenup_DOY
+
+ # Greenup
+ DOY_up <- ifelse(pheno.sub$MidGreenup_DOY >= solstice, solstice-1, pheno.sub$MidGreenup_DOY)
+
+
+ ##############################################################################################################################################
+
+
+ # Set GPP and LAI before greenup to zero
+ ########################################
+
+
+ #GPP
+ daily_vals$GPPstart = daily_vals$GPP
+ daily_vals$GPPstart[1:DOY_out]=0
+
+ #LAI
+ daily_vals$LAIstart = daily_vals$LAI
+ daily_vals$LAIstart[1:DOY_out]=0
+
+
+ ##############################################################################################################################################
+
+
+ # Jmax limitation (photoperiod-dependency following Bauerle et al. 2012)
+ #########################################################################
+
+ #Number of days from solstice to mean senescence date
+ PostSolsticeSpan = DOY_dorm-solstice
+
+ #Spring degree-day threshold = 300
+ GDD1 = daily_vals$GDDday #degree-day vector
+ GDD1[1:DOY_out]=0 #set degree-days before leaf-out to zero
+ GDD1 = GDD1[1:solstice] #set degree-days after solstice to zero
+ GDDthreshold = ifelse(sum(GDD1) < 300, ifelse(sum(GDD1)>0, sum(GDD1), 1), 300) #set degree-day threshold
+ GDD1 = cumsum(GDD1) #get cumulative degree-day vector
+ GDD1[GDD1>GDDthreshold] <- GDDthreshold #cut of degree-day vector at threshold
+ GDD1 = GDD1/GDDthreshold #bound between 0 and 1
+
+ GDD2 = daily_vals$GDDday #degree-day vector
+ GDD2[1:DOY_up]=0 #set degree-days before leaf-out to zero
+ GDD2 = GDD2[1:solstice] #set degree-days after solstice to zero
+ GDDthreshold = ifelse(sum(GDD2) < 300, ifelse(sum(GDD2)>0, sum(GDD2), 1), 300) #set degree-day threshold
+ GDD2 = cumsum(GDD2) #get cumulative degree-day vector
+ GDD2[GDD2>GDDthreshold] <- GDDthreshold #cut of degree-day vector at threshold
+ GDD2 = GDD2/GDDthreshold #bound between 0 and 1
+
+ #Daily Jmax vector (degree-day-based Jmax increase after leaf-out and linear Jmax decline after solstice)
+ JmaxSAout = c(
+ GDD1,
+ rev(c(1:PostSolsticeSpan) / PostSolsticeSpan),
+ rep(0, nrow(daily_vals)-DOY_dorm) )
+
+ JmaxSAup = c(
+ GDD2,
+ rev(c(1:PostSolsticeSpan) / PostSolsticeSpan),
+ rep(0, nrow(daily_vals)-DOY_dorm) )
+
+ JmaxAout = c(
+ rep(0,DOY_out),#Jmax=0 before leaf-out
+ rep(1,solstice-DOY_out),#Jmax=1 after leaf-out
+ rev(c(1:PostSolsticeSpan) / PostSolsticeSpan),
+ rep(0, nrow(daily_vals)-DOY_dorm) )
+
+ JmaxAup = c(
+ rep(0,DOY_up),#Jmax=0 before leaf-out
+ rep(1,solstice-DOY_up),#Jmax=1 after leaf-out
+ rev(c(1:PostSolsticeSpan) / PostSolsticeSpan),
+ rep(0, nrow(daily_vals)-DOY_dorm) )
+
+ #Add Jmax vector to daily data
+ daily_vals = daily_vals %>%
+ mutate(JmaxA = JmaxSAout,
+ JmaxB = JmaxSAup,
+ JmaxC = JmaxAout,
+ JmaxD = JmaxAup)
+
+
+
+ ##############################################################################################################################################
+
+
+ # Photosynthesis calculation
+ ############################
+
+
+ # GSI, Daily Net Photosynthesis rate (dA_n) and water stress factor (dw) are calculated daily
+ # and then accumulated by summation
+
+ # Initialize vector to store daily values
+ iGSI_year <- vector()
+ iGSIrad_year <- vector()
+ VPD_year <- vector()
+ iVPD_year <- vector()
+ #dA_tot_year <- vector()
+ dA_totw_year <- vector()
+
+ # Loop through days of the growing season
+ for(i in 1:nrow(daily_vals)) {
+
+ ############################################
+ ## Cumulative Growing Season Index (cGSI) ##
+ ############################################
+
+ # modified from Jolly et al. 2005
+
+ # GSI...photoperiod-based growing-season index
+ # GSI...irradiance-based growing-season index
+ # VPD...vapor pressure deficit
+ # iVPD...vapor pressure deficit function values
+
+ # set VPD min and max
+ #####################
+
+ # Reference: White MA, Thornton PE, Running SW et al. (2000) Parameterization and sensitivity analysis of
+ # the BIOME???BGC terrestrial ecosystem model: net primary production controls. Earth Interactions, 4, 1???85.
+ # mean of all evergreen needleleaf tree species
+ if(pheno.sub$biome %in% c(5,6,11,98,99)) {
+ VPD_min <- 0.61
+ VPD_max <- 3.1
+ } else {
+ #mean of all deciduous broadleaf tree species
+ VPD_min <- 1.1
+ VPD_max <- 3.6 }
+
+ # Estimate phoperiod thresholds based on the maximum and minimum values of the growing season
+ photo_min <- min(daily_vals$Photo)
+ photo_max <- max(daily_vals$Photo)
+
+ # e_s: saturation vapour pressure [kPa]
+ e_s <- (degC_to_kPa.fun(temp=daily_vals$Tmax[i]) + degC_to_kPa.fun(temp=daily_vals$Tmin[i])) / 2
+
+ # e_a: derived from dewpoint temperature [kPa]
+ e_a <- degC_to_kPa.fun(temp=daily_vals$Tdew[i])
+
+ # VPD: Vapour pressure deficit [kPa]
+ VPD <- e_s-e_a
+ VPD_year <- c(VPD_year,VPD)
+
+ # apply vapor pressure deficit funtion
+ iVPD <- VPD.fun(VPD, VPD_min, VPD_max)
+ iVPD_year <- c(iVPD_year, iVPD)
+
+ # iOpt_temp: response to optimal temperature (Gompertz function)
+ iOpt <- temp_opt.fun(daily_vals$Tday[i])
+
+ # iPhoto: photoperiod response
+ iPhoto <- photoperiod.fun(daily_vals$Photo[i], photo_min, photo_max)
+
+ # iRadiation
+ # get maximum radiation at the site (field capacity)
+ max.rad = max(DataList[[8]][which(DataList[[8]]$geometry==pheno.sub$geometry), c(as.character(1:365))], na.rm=T)
+ iRad <- daily_vals$SWrad[i] / max.rad
+
+ # Calculate daily GSI
+ iGSI <- as.numeric(iVPD*iOpt*iPhoto)
+ iGSIrad <- as.numeric(iVPD*iOpt*iRad)
+
+ # Add to the cumulative cGSI
+ iGSI_year <- c(iGSI_year,iGSI)
+ iGSIrad_year <- c(iGSIrad_year,iGSIrad)
+
+ #----------------------------------------------------------------------------------------------
+
+ ############################
+ ## Zani et al. 2020 model ##
+ ############################
+
+ # Net photosynthesis rate (PHOTOSYNTHESIS-CONDUCTANCE MODEL, ref. Sitch et al. 2003)
+
+ # apar: daily integral of absorbed photosynthetically active radiation (PAR), J m-2 d-1
+ # Eqn 4, Haxeltine & Prentice 1996
+ # alphaa: scaling factor for absorbed PAR at ecosystem, versus leaf, scale
+ # nearly half of short-wave radiation is PAR --> mean annual value of 0.473 observed for the irradiance ratio
+ # in the PAR (ref. Papaioannou et al. 1993) plus 8% reflected and transmitted
+ # convert in J/m^-2 day: the power in watts (W) is equal to the energy in joules (J), divided by the time period in seconds (s):
+ # --> 1 Watt = 1 Joule/second, therefore j = W*86400
+ apar <- alphaa * daily_vals$SWrad[i] * 60 * 60 * 24
+
+ # Calculate temperature inhibition function limiting photosynthesis at low and high temperatures (ref. Sitch et al. 2002)
+ tstress <- temp_opt.fun(daily_vals$Tday[i])
+
+ # Calculate catalytic capacity of rubisco, Vm, assuming optimal (non-water-stressed) value for lambda, i.e. lambdamc3
+ # adjust kinetic parameters for their dependency on temperature
+ # i.e. relative change in the parameter for a 10 degC change in temperature
+ # Eqn 22, Haxeltine & Prentice 1996a
+
+ ko <- ko25*q10ko**((daily_vals$Tday[i]-25.0)/10.0) # Michaelis constant of rubisco for O2
+ kc <- kc25*q10kc**((daily_vals$Tday[i]-25.0)/10.0) # Michaelis constant for CO2
+ tau <- tau25*q10tau**((daily_vals$Tday[i]-25.0)/10.0)# CO2/O2 specificity ratio
+
+ # gammastar: CO_2 compensation point [CO2 partial pressure, Pa]
+ # Eqn 8, Haxeltine & Prentice 1996
+ gammastar <- po2/(2.0*tau)
+
+ # Convert ambient CO2 level from mole fraction to partial pressure, Pa
+ pa <- CO2*p
+
+ # p_i: non-water-stressed intercellular CO2 partial pressure, Pa
+ # Eqn 7, Haxeltine & Prentice 1996
+ p_i <- pa*lambdamc3
+
+ # Calculate coefficients
+ # Eqn 4, Haxeltine & Prentice 1996
+ c1 <- tstress*alphac3*((p_i-gammastar)/(p_i+2.0*gammastar))
+
+ # Eqn 6, Haxeltine & Prentice 1996
+ c2 <- (p_i-gammastar)/(p_i+kc*(1.0+po2/ko))
+ b <- bc3 # choose C3 value of b for Eqn 10, Haxeltine & Prentice 1996
+ t0 <- t0c3 # base temperature for temperature response of rubisco
+
+ # Eqn 13, Haxeltine & Prentice 1996
+ s <- (24.0 / daily_vals$Photo[i] ) * b
+
+ # Eqn 12, Haxeltine & Prentice 1996
+ sigma <- sqrt(max(0.0,1.0-(c2-s)/(c2-theta*s)))
+
+ # vm: optimal rubisco capacity, gC m-2 d-1
+ # Eqn 11, Haxeltine & Prentice 1996
+ # cmass: the atomic weight of carbon, used in unit conversion from molC to g
+ # cq: conversion factor from apar [J m-2] to photosynthetic photon flux density [mol m-2]
+ vm <- (1.0/b)*(c1/c2)*((2.0*theta-1.0)*s-(2.0*theta*s-c2)*sigma)*apar*cmass*cq
+
+ # je: PAR-limited photosynthesis rate, gC m-2 h-1
+ # Eqn 3, Haxeltine & Prentice 1996
+ # Convert je from daytime to hourly basis
+ if(daily_vals$Photo[i]==0) {
+ je <- 0
+ } else {
+ je <- c1*apar*cmass*cq / daily_vals$Photo[i]
+ }
+
+ # jc: rubisco-activity-limited photosynthesis rate, gC m-2 h-1
+ # Eqn 5, Haxeltine & Prentice 1996
+ jc <- c2*vm/24.0
+
+ # agd: daily gross photosynthesis, gC m-2 d-1
+ # Eqn 2, modified with k_shape (theta)
+ if(je<1e-10 | jc<=1e-10) {
+ agd <- 0
+ } else {
+ agd <- (je+jc-sqrt((je+jc)**2.0-4.0*theta*je*jc))/(2.0*theta) * daily_vals$Photo[i]
+ }
+
+ # rd: daily leaf respiration, gC m-2 d-1
+ # Eqn 10, Haxeltine & Prentice 1996
+ rd <- b*vm
+
+ # and: daily net photosynthesis (at leaf level), gC m-2 d-1
+ and <- agd-rd
+
+ # adt: total daytime net photosynthesis, gC m-2 d-1
+ # Eqn 19, Haxeltine & Prentice 1996
+ adt <- and + (1.0 - daily_vals$Photo[i] / 24.0) * rd
+
+ # Convert adt from gC m-2 d-1 to mm m-2 d-1 using ideal gas equation
+ #adtmm <- adt / cmass * 8.314 * (daily_vals$TMEAN[i] + 273.3) / p * 1000.0
+
+ # Store the daily result in the yearly vector
+ #dA_tot_year <- c(dA_tot_year,adt) #daytime net photosynthesis
+
+
+ ## Water Stress Factor (ref. Gerten et al. 2004)
+ ################################################
+
+ # soil is treated as a simple bucket consisting of two layers with fixed thickness
+
+ # Calculate potential evapotranspiration (ETA) rate, E_pot, mm d-1
+
+ # delta: rate of increase of the saturation vapour pressure with temperature
+ delta <- (2.503*10^6 * exp((17.269 * daily_vals$Tday[i]) / (237.3 + daily_vals$Tday[i]))) / (237.3 + daily_vals$Tday[i])^2
+
+ # R_n: istantaneous net radiation, W m-2 = R_s net short-wave radiation flux + R_l net long-wave flux
+ R_n <- daily_vals$SWrad[i] + daily_vals$LWrad[i]
+
+ # E_eq: equilibrium EvapoTranspiration
+ # from seconds to day
+ E_eq <- 24 * 3600 * (delta / (delta + gamma)) * (R_n / L)
+
+ # E_pot: potential EvapoTranspiration = equilibrium ETA * Priestley-Taylor coefficient
+ E_pot <- E_eq*a_m
+
+ # ratio: stomata-controlled ratio between intercellular and ambient CO2 partial pressure in the absence of water limitation
+ ratio <- p_i/pa # ca. 0.8
+
+ # g_min: minimum canopy conductance, mm s-1
+ # depends on PFT (broadleaf = 0.5, needleleaf = 0.3)
+ if(pheno.sub$biome %in% c(1,4,8,9,10,12,13)) {
+ g_min <- 0.5*3600*24 # from seconds to day
+ } else {
+ g_min <- 0.3*3600*24
+ }
+
+ # g_pot: nonwater-stressed potential canopy conductance, mm s-1
+ g_pot <- g_min + ((1.6*adt)/((pa/p)*(1-ratio)))
+
+ # E_demand: atmoshperic demand
+ # unstressed transpiration which occurs when stomatal opening is not limited by reduced water potential in the plant
+ E_demand <- E_pot/(1+(g_m/g_pot))
+
+ # root1/2: fraction of roots present in the respective layers
+ # depends on PFT (temperate = 0.7/0.3, boreal = 0.9/0.1)
+ if (pheno.sub$biome %in% c(1,3,4,8,9,10,12,13)) {
+ root1 <- 0.7
+ root2 <- 0.3
+ } else {
+ root1 <- 0.9
+ root2 <- 0.1
+ }
+
+ # relative soil moisture wr:
+ # ratio between current soil water content and plant-available water capacity
+ # wr ratio is computed for both soil layers by
+ # weighting their relative soil water contents (w1, w2)
+ # with the fraction of roots present in the respective layer
+ w1 <- daily_vals$Moist10[i]
+ w2 <- daily_vals$Moist40[i]
+
+ # soil texture-dependent difference between field capacity and wilting point w_max [%]
+ w_max <- 15
+ wr <- root1*(w1/w_max) + root2*(w2/w_max)
+
+ # E_supply: plant- and soil-limited supply function
+ E_supply <- as.numeric(E_max*wr)
+
+ # dw: daily water stress factor
+ dw <- min(1,(E_supply/E_demand))
+
+ # dA_totw: daily net photosynthesis modified by water stress factor
+ dA_totw <- adt*dw
+
+ # Add daily result to the yearly vector
+ dA_totw_year <- c(dA_totw_year, dA_totw)
+
+ } # END loop through days of the growing season
+
+ #set values before leaf-out to zero
+ iGSI_year[1:DOY_out] = 0
+ iGSIrad_year[1:DOY_out] = 0
+ dA_totw_year[1:DOY_out] = 0
+
+ #set negative values to zero
+ VPD_year[VPD_year<=0] = 0.001
+ dA_totw_year[dA_totw_year<0] = 0
+
+ #Jmax corrected photosynthesis
+ dA_totw.JmaxA_year <- dA_totw_year * daily_vals$JmaxA
+ dA_totw.JmaxB_year <- dA_totw_year * daily_vals$JmaxB
+ dA_totw.JmaxC_year <- dA_totw_year * daily_vals$JmaxC
+ dA_totw.JmaxD_year <- dA_totw_year * daily_vals$JmaxD
+
+ #add VPD to daily table
+ daily_vals$VPD = VPD_year *1000 #VPD in Pa
+
+ #----------------------------------------------------------------------------------------------
+
+ ##################
+ ## P-model v1.0 ##
+ ##################
+
+ ## Benjamin D. Stocker et al. 2020
+ ## optimality-based light use efficiency model
+ ## for simulating ecosystem gross primary production
+
+ # constant variables
+ alt = as.numeric(pheno.sub$alt) # elevation z [m a.s.l.]
+ meana = pheno.sub$AET_PET # Local annual mean ratio of actual over potential evapotranspiration
+
+ ## Calculate Photosynthetic Photon Flux Density, ppfd [mol m-2]
+ # PAR as irradiance [W m-2] is given by incoming short-wave radiation
+ ppfd = 60 * 60 * 24 * 10^-6 * 2.04 * (daily_vals$SWradDown)
+
+ ## get maximum soil moisture at the site (field capacity)
+ field.capacity = max(DataList[[7]][which(DataList[[7]]$geometry==pheno.sub$geometry), c(as.character(1:365))], na.rm=T)
+
+ ## P-model v1.0
+ pmodel.df <- tibble(
+ tc = daily_vals$Tday,
+ vpd = daily_vals$VPD, #VPD in Pa
+ co2 = CO2,
+ fapar = 1,
+ ppfd = ppfd,
+ soilm = daily_vals$Moist40 / field.capacity
+ ) %>%
+ mutate(out_pmodel = purrr::pmap(., rpmodel,
+ elv = alt,
+ kphio = 0.087,
+ beta = 146,
+ method_optci = "prentice14",
+ method_jmaxlim = "wang17",
+ do_ftemp_kphio = T,
+ do_soilmstress = T,
+ meanalpha=meana
+ ))
+ pmodel.df = do.call(rbind.data.frame, pmodel.df$out_pmodel)
+
+ #set Photosynthesis before leaf-out to zero
+ pmodel.df[1:DOY_out,]=0
+
+ ## Dark respiration, rd [mol C m-2]
+ rd = pmodel.df$rd
+ rd = rd * cmass # convert (carbon mass)
+
+ #get daily values of net daytime photosynthesis [g C m-2]
+ Apm = (pmodel.df$gpp - rd) + (1.0-daily_vals$Photo/24.0)*rd
+
+ #set negative values to zero
+ Apm[Apm<0] = 0
+
+ # Jmax-limited photosynthesis
+ ApmJmaxA = Apm * daily_vals$JmaxA
+ ApmJmaxB = Apm * daily_vals$JmaxB
+ ApmJmaxC = Apm * daily_vals$JmaxC
+ ApmJmaxD = Apm * daily_vals$JmaxD
+
+ #----------------------------------------------------------------------------------------------
+
+ #Store the results
+ ##################
+
+ daily_vals = daily_vals %>%
+ mutate(GSI = iGSI_year, #photoperiod-influenced GSI
+ GSIrad = iGSIrad_year, #radiation-influenced GSI
+ Azani = dA_totw_year, #net daytime photosynthesis (Zani et al., water-stressed)
+ AzaniJmaxA = dA_totw.JmaxA_year, #net daytime photosynthesis spring and autumn Jmax-limited (Zani et al., water-stressed)
+ AzaniJmaxB = dA_totw.JmaxB_year, #net daytime photosynthesis autumn Jmax-limited (Zani et al., water-stressed)
+ AzaniJmaxC = dA_totw.JmaxC_year,
+ AzaniJmaxD = dA_totw.JmaxD_year,
+ Apm = Apm, #net daytime photosynthesis (p model)
+ ApmJmaxA = ApmJmaxA, #net daytime photosynthesis Jmax-limited (p model)
+ ApmJmaxB = ApmJmaxB,
+ ApmJmaxC = ApmJmaxC,
+ ApmJmaxD = ApmJmaxD
+ ) %>%
+ rename(Moist=Moist40)
+
+
+ ##############################################################################################################################################
+
+
+ ###################
+ ## Store drivers ##
+ ###################
+
+
+ ######################
+ ## Seasonal drivers ##
+ ######################
+
+ #define variables
+ variable.names = c('Azani', 'AzaniJmaxA', 'AzaniJmaxB', 'AzaniJmaxC', 'AzaniJmaxD',
+ 'Apm', 'ApmJmaxA', 'ApmJmaxB', 'ApmJmaxC', 'ApmJmaxD',
+ 'GPP', 'LAI','GPPstart','LAIstart',
+ 'GSI', 'GSIrad',
+ 'GDDday', 'GDDnight', 'SWrad',
+ 'Tday', 'Tnight', 'Moist',
+ 'Prcp')
+
+ #---------------------------------------------------------------------------------------------------------
+
+ for(i in 1:length(variable.names)) {
+
+ #choose variable (daily values)
+ variable = daily_vals[,variable.names[i]]
+
+ #---------------------------------------------------------------------------------------------------------
+
+ # Name variables
+ ################
+
+ # Seasonal
+ ##########
+
+ # LO...leaf-out date
+ # SE...mean senescence date
+ # SO...Summer solstice (~22 June)
+ # SOm30...Summer solstice -30 (~22 May)
+ # SOp30...Summer solstice +30 (~21 July)
+ # SOp60...Summer solstice +60 (~22 August)
+ varname.LO.SO <- paste(variable.names[i], "LO.SO", sep=".")
+ varname.LO.SOm30 <- paste(variable.names[i], "LO.SOm30", sep=".")
+ varname.LO.SOp30 <- paste(variable.names[i], "LO.SOp30", sep=".")
+ varname.LO.SOp60 <- paste(variable.names[i], "LO.SOp60", sep=".")
+ varname.LO.SE <- paste(variable.names[i], "LO.SE", sep=".")
+ varname.SO.SE <- paste(variable.names[i], "SO.SE", sep=".")
+ varname.SOm30.SE <- paste(variable.names[i], "SOm30.SE", sep=".")
+ varname.SOp30.SE <- paste(variable.names[i], "SOp30.SE", sep=".")
+ varname.SOp60.SE <- paste(variable.names[i], "SOp60.SE", sep=".")
+
+ # Solstice
+ ##########
+
+ # solstice1...sum of 40 to 10 days before solstice
+ # solstice2...sum of 30 to 0 days before solstice
+ # solstice3...sum of 20 days before to 10 days after solstice
+ # solstice4...sum of 10 days before to 20 days after solstice
+ # solstice5...sum of 0 to 30 days after solstice
+ # solstice6...sum of 10 to 40 days after solstice
+ varname.solstice1 <- paste(variable.names[i], "solstice1", sep=".")
+ varname.solstice2 <- paste(variable.names[i], "solstice2", sep=".")
+ varname.solstice3 <- paste(variable.names[i], "solstice3", sep=".")
+ varname.solstice4 <- paste(variable.names[i], "solstice4", sep=".")
+ varname.solstice5 <- paste(variable.names[i], "solstice5", sep=".")
+ varname.solstice6 <- paste(variable.names[i], "solstice6", sep=".")
+
+ #---------------------------------------------------------------------------------------------------------
+
+ # Create columns
+ ################
+
+ if(variable.names[i] %in% c('Azani', 'AzaniJmaxA', 'AzaniJmaxB', 'AzaniJmaxC', 'AzaniJmaxD',
+ 'Apm', 'ApmJmaxA', 'ApmJmaxB', 'ApmJmaxC', 'ApmJmaxD',
+ 'GPP', 'LAI','GPPstart','LAIstart',
+ 'GSI', 'GSIrad', 'GDDday', 'GDDnight')){
+
+ # Sums from leaf-out
+ ####################
+
+ factors.sub = factors.sub %>%
+ mutate(
+ #seasonal
+ !!varname.LO.SO := sum(variable[DOY_out:solstice]),
+ !!varname.LO.SOm30 := sum(variable[DOY_out:(solstice-30)]),
+ !!varname.LO.SOp30 := sum(variable[DOY_out:(solstice+30)]),
+ !!varname.LO.SOp60 := sum(variable[DOY_out:(solstice+60)]),
+ !!varname.LO.SE := sum(variable[DOY_out:DOY_off]),
+ !!varname.SO.SE := sum(variable[solstice:DOY_off]),
+ !!varname.SOm30.SE := sum(variable[(solstice-30):DOY_off]),
+ !!varname.SOp30.SE := sum(variable[(solstice+30):DOY_off]),
+ !!varname.SOp60.SE := sum(variable[(solstice+60):DOY_off]),
+
+ #solstice
+ !!varname.solstice1 := sum(variable[(solstice-39):(solstice-10)]),
+ !!varname.solstice2 := sum(variable[(solstice-29):solstice]),
+ !!varname.solstice3 := sum(variable[(solstice-19):(solstice+10)]),
+ !!varname.solstice4 := sum(variable[(solstice-9):(solstice+20)]),
+ !!varname.solstice5 := sum(variable[(solstice+1):(solstice+30)]),
+ !!varname.solstice6 := sum(variable[(solstice+11):(solstice+40)]) )
+ }
+
+ if(variable.names[i] %in% c('Tday','Tnight','Moist','SWrad')){
+
+ # Means from fixed date
+ #######################
+
+ factors.sub = factors.sub %>%
+ mutate(
+ #seasonal
+ !!varname.LO.SO := mean(variable[equinox.Mar:solstice]),
+ !!varname.LO.SOm30 := mean(variable[equinox.Mar:(solstice-30)]),
+ !!varname.LO.SOp30 := mean(variable[equinox.Mar:(solstice+30)]),
+ !!varname.LO.SOp60 := mean(variable[equinox.Mar:(solstice+60)]),
+ !!varname.LO.SE := mean(variable[equinox.Mar:DOY_off]),
+ !!varname.SO.SE := mean(variable[solstice:DOY_off]),
+ !!varname.SOm30.SE := mean(variable[(solstice-30):DOY_off]),
+ !!varname.SOp30.SE := mean(variable[(solstice+30):DOY_off]),
+ !!varname.SOp60.SE := mean(variable[(solstice+60):DOY_off]),
+
+ #solstice
+ !!varname.solstice1 := mean(variable[(solstice-39):(solstice-10)]),
+ !!varname.solstice2 := mean(variable[(solstice-29):solstice]),
+ !!varname.solstice3 := mean(variable[(solstice-19):(solstice+10)]),
+ !!varname.solstice4 := mean(variable[(solstice-9):(solstice+20)]),
+ !!varname.solstice5 := mean(variable[(solstice+1):(solstice+30)]),
+ !!varname.solstice6 := mean(variable[(solstice+11):(solstice+40)]) )
+ }
+
+ if(variable.names[i] %in% c('Prcp')){
+
+ # Sums from fixed date
+ ######################
+
+ factors.sub = factors.sub %>%
+ mutate(
+ #seasonal
+ !!varname.LO.SO := sum(variable[equinox.Mar:solstice]),
+ !!varname.LO.SOm30 := sum(variable[equinox.Mar:(solstice-30)]),
+ !!varname.LO.SOp30 := sum(variable[equinox.Mar:(solstice+30)]),
+ !!varname.LO.SOp60 := sum(variable[equinox.Mar:(solstice+60)]),
+ !!varname.LO.SE := sum(variable[equinox.Mar:DOY_off]),
+ !!varname.SO.SE := sum(variable[solstice:DOY_off]),
+ !!varname.SOm30.SE := sum(variable[(solstice-30):DOY_off]),
+ !!varname.SOp30.SE := sum(variable[(solstice+30):DOY_off]),
+ !!varname.SOp60.SE := sum(variable[(solstice+60):DOY_off]),
+
+ #solstice
+ !!varname.solstice1 := sum(variable[(solstice-39):(solstice-10)]),
+ !!varname.solstice2 := sum(variable[(solstice-29):solstice]),
+ !!varname.solstice3 := sum(variable[(solstice-19):(solstice+10)]),
+ !!varname.solstice4 := sum(variable[(solstice-9):(solstice+20)]),
+ !!varname.solstice5 := sum(variable[(solstice+1):(solstice+30)]),
+ !!varname.solstice6 := sum(variable[(solstice+11):(solstice+40)]) )
+ }
+ }
+
+
+ #---------------------------------------------------------------------------------------------------------
+
+
+ ####################################
+ ## Calculate the monthly averages ##
+ ####################################
+
+ #create variable vectors
+ VariableMeanVector = c('LAI','LAIstart',"Tday","Tnight","Moist","SWrad")
+ VariableSumVector = c('Azani', 'AzaniJmaxA', 'AzaniJmaxB', 'AzaniJmaxC', 'AzaniJmaxD',
+ 'Apm', 'ApmJmaxA', 'ApmJmaxB', 'ApmJmaxC', 'ApmJmaxD',
+ 'GPP','GPPstart',
+ 'GSI', 'GSIrad', 'GDDday', 'GDDnight', 'Prcp')
+
+ #get means and sums
+ monthly_means = data.frame(daily_vals %>%
+ group_by(Month) %>%
+ summarize_at(VariableMeanVector, mean, na.rm = TRUE))
+ monthly_sums = data.frame(daily_vals %>%
+ group_by(Month) %>%
+ summarize_at(VariableSumVector, sum, na.rm = TRUE))
+
+ #merge
+ monthly_vals = cbind(monthly_means,monthly_sums[,-c(1)])
+
+ #Transform data
+ monthly_vals = as.data.frame(t(monthly_vals))
+
+ #Add to table
+ #############
+
+ #loop through variables
+ for(i in 1:length(variable.names)) {
+ #select variable
+ MONTHLY.DF = monthly_vals[variable.names[i],]
+ #add column names
+ names(MONTHLY.DF)=paste0(row.names(MONTHLY.DF), c(1:12))
+ #cbind with table
+ factors.sub = cbind(factors.sub, MONTHLY.DF)
+ }
+
+
+ #--------------------------------------------------------------------------
+
+
+ ################################
+ ## Get preseason temperatures ##
+ ################################
+
+ ## Calculate the average preseason temperatures prior to mean senescence date
+
+ #get preseason length vector (10 to 120 days with 10-day steps)
+ preseason.lengths = seq(10, 120, 10)
+
+ #loop through preseasons
+ for(preseason.length in preseason.lengths) {
+ #name columns
+ preseason.Tday <- paste("Tday.PS", preseason.length, sep=".")
+ preseason.Tnight <- paste("Tnight.PS", preseason.length, sep=".")
+ #add columns to table
+ factors.sub = factors.sub %>%
+ mutate(!!preseason.Tday := mean(daily_vals$Tday[(DOY_off-preseason.length):DOY_off]),
+ !!preseason.Tnight := mean(daily_vals$Tnight[(DOY_off-preseason.length):DOY_off]) )
+ }
+
+
+ ##############################################################################################################################################
+
+
+ # Safe the table
+ write.table(factors.sub, file=paste0(Drivers_path, '/', timeseries_years, '.csv'), sep=',', row.names = F, col.names = T)
+
+ }
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##################
+## Run the Loop ##
+##################
+
+
+
+#initialize the loop
+outputlist <- pbmclapply(timeseries_year, parallelCalc, mc.cores=5, mc.preschedule=T)
+
+#check how many files there are
+length(list.files(path=Drivers_path, pattern='.csv'))
+length(list.files(path=Drivers_path3, pattern='.csv'))
+
+#Rbind files
+climate.factors.table = rbindlist(lapply(list.files(path = Drivers_path),
+ function(n) fread(file.path(Drivers_path, n))))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+###################
+## Safe the data ##
+###################
+
+
+
+#Safe table
+write.csv(climate.factors.table, paste(Drivers_path2, "Remote_sensing_drivers_data_startSen.csv", sep="/"))
+
+#Remove individual files
+do.call(file.remove, list(list.files(Drivers_path,
+ full.names = TRUE)))
+do.call(file.remove, list(list.files(Drivers_path3,
+ full.names = TRUE)))
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/2_Add_drivers/2.1_Add_Drivers_AP_tier2_remote_sensing_EOS50_v1.3.midGreendown.R b/R code/Remote_sensing/2_Add_drivers/2.1_Add_Drivers_AP_tier2_remote_sensing_EOS50_v1.3.midGreendown.R
new file mode 100644
index 0000000..b7dd084
--- /dev/null
+++ b/R code/Remote_sensing/2_Add_drivers/2.1_Add_Drivers_AP_tier2_remote_sensing_EOS50_v1.3.midGreendown.R
@@ -0,0 +1,1375 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Climate driver extraction of the remote sensing analysis (EOS50) ##########################################
+#############################################################################################################
+
+
+
+#required packages
+require(data.table)
+require(sf)
+require(ncdf4)
+require(raster)
+require(tidyverse)
+require(sp)
+require(rpmodel)
+require(purrr)
+require(pbmcapply)
+require(zoo)
+require(chillR)
+require(lubridate)
+require(weathermetrics)
+require(rgdal)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#############################
+## Set directory and paths ##
+#############################
+
+
+
+# Set the working directory
+setwd("/Users/crowtherlabstation02/Desktop/Analysis")
+
+
+#########
+# Paths #
+#########
+
+
+# 1. Input
+##########
+
+#Climate
+GLDAS_path = "Remote_sensing/Analysis/Analysis_input/Drivers/GLDAS"
+
+#CO2
+CO2_path = "Remote_sensing/Analysis/Analysis_input/Drivers/CO2"
+
+#Photoperiod
+photo_path = "Remote_sensing/Analysis/Analysis_input/Drivers"
+
+# AET/PET
+AET.PET_path = "PEP_analysis/Analysis/Analysis_input/Drivers"
+
+# GPP and LAI
+GPP_path = "Remote_sensing/Analysis/Analysis_input/Drivers/Modis_GPP_LAI"
+
+#Phenology
+Pheno_path = "Remote_sensing/Analysis/Analysis_input/Phenology_data"
+
+
+# 2. Output
+###########
+
+Drivers_path = "Remote_sensing/Analysis/Analysis_input/Drivers_final_EOS50/Individual_files"
+Drivers_path2 = "Remote_sensing/Analysis/Analysis_input/Drivers_final_EOS50/Merged_file"
+Drivers_path3 = "Remote_sensing/Analysis/Analysis_input/Drivers_final_EOS50/Missing_observations"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+## Phenology data
+#################
+
+Pheno.df <- fread(paste(Pheno_path, "PhenologyData_Forests_025_North_Filtered_New.csv", sep="/")) %>%
+ group_by(geometry) %>%
+ #delete pixels with less than 15 years
+ filter(n() >= 15) %>%
+ #get autumn phenology means per pixel
+ mutate(Dormancy_DOY = ifelse(Dormancy_DOY<170,365,Dormancy_DOY),#set dormancy that falls in next year to end of year
+ MidGreendownMean = mean(MidGreendown_DOY),
+ DormancyMax = max(Dormancy_DOY)) %>%
+ ungroup() %>%
+ #delete duplicates
+ distinct(geometry, Year, .keep_all = T)
+
+
+## AET/PET map
+##############
+
+#annual AET/PET ratio from SPLASH model
+AET_PET.raster = raster(paste(AET.PET_path , "AET_PET_ratio_global_FULL_MODIS-C006_MOD15A2_v1.alpha_MEANANN.nc", sep="/"))
+
+
+## Elevation map
+################
+
+elev.raster = raster(paste(photo_path, "topo_elevation.asc", sep="/"))
+
+
+## Biomes map
+#############
+
+biome.raster = raster(paste(photo_path, "WWF_Biomes_HalfDegree.tif", sep="/"))
+
+
+## CO2 data
+###########
+
+CO2.df = fread(paste(CO2_path, "CO2_Annual.csv", sep="/"))
+
+
+## Photoperiod
+##############
+
+photo.df = fread(paste(photo_path, "Photoperiod.csv", sep="/"))
+
+
+## LAI and GPP
+##############
+
+GPP.df = fread(paste(GPP_path, "GppData_Forests_025.csv", sep='/'))%>%
+ #keep only numbers in string
+ mutate(geometry2 = gsub("POINT ","", geometry),
+ geometry2 = gsub("\\(|\\)","", geometry2)) %>%
+ separate(geometry2, into = c("Lat","Lon"), sep=" ") %>%
+ mutate(Lat = as.numeric(Lat),
+ Lon = as.numeric(Lon)) %>%
+ #add site x year identifier
+ mutate(site_year = paste0(geometry, '_', Year)) %>%
+ #order table
+ dplyr::select(Year, geometry, site_year, Lat, Lon, everything())
+#rename columns
+colnames(GPP.df)[6:ncol(GPP.df)] <- seq(1, 366, by=8)
+
+LAI.df = fread(paste(GPP_path, "LaiData_Forests_025.csv", sep='/'))%>%
+ #keep only numbers in string
+ mutate(geometry2 = gsub("POINT ","", geometry),
+ geometry2 = gsub("\\(|\\)","", geometry2)) %>%
+ separate(geometry2, into = c("Lat","Lon"), sep=" ") %>%
+ mutate(Lat = as.numeric(Lat),
+ Lon = as.numeric(Lon)) %>%
+ #add site x year identifier
+ mutate(site_year = paste0(geometry, '_', Year)) %>%
+ #order table
+ dplyr::select(Year, geometry, site_year, Lat, Lon, everything())
+#rename columns
+colnames(LAI.df)[6:ncol(LAI.df)] <- seq(1, 366, by=8)
+
+
+## Import daily climatic datasets from GLDAS
+############################################
+
+#define climate variables
+vn <- c('GLDAS_Daily_Data_Tair_f_inst_Mean',
+ 'GLDAS_Daily_Data_Tair_f_inst_Min',
+ 'GLDAS_Daily_Data_Tair_f_inst_Max',
+ 'GLDAS_Daily_Data_Rainf_f_tavg',
+ 'GLDAS_Daily_Data_Qair_f_inst',
+ 'GLDAS_Daily_Data_SoilMoi0_10cm_inst',
+ 'GLDAS_Daily_Data_SoilMoi10_40cm_inst',
+ 'GLDAS_Daily_Data_Swnet_tavg',
+ 'GLDAS_Daily_Data_Lwnet_tavg',
+ 'GLDAS_Daily_Data_SWdown_f_tavg')
+
+#create empty list
+DataList <- replicate(length(vn),data.frame())
+
+#loop through climate variables
+for(i in 1:length(vn)) {
+ #read data
+ data = fread(paste0(GLDAS_path, "/", vn[i],".csv")) %>%
+ #keep only numbers in string
+ mutate(geometry2 = gsub("POINT ","", geometry),
+ geometry2 = gsub("\\(|\\)","", geometry2)) %>%
+ separate(geometry2, into = c("Lat","Lon"), sep=" ") %>%
+ mutate(Lat = as.numeric(Lat),
+ Lon = as.numeric(Lon)) %>%
+ #add site x year identifier
+ mutate(site_year = paste0(geometry, '_', Year)) %>%
+ #order table
+ dplyr::select(Year, geometry, site_year, Lat, Lon, everything())
+
+ #rename columns
+ colnames(data)[6:ncol(data)] <- as.numeric(1:366)
+
+ #delete NAs
+ data = data %>% filter(!is.na(`170`))
+
+ #add table to list
+ DataList[[i]] <- data
+}
+#add names to list
+names(DataList)=vn
+# Note: Precipitation is given as rate in mm d-1.
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+####################################################
+## Add Soil texture, PFT, and AET/PET (meanalpha) ##
+####################################################
+
+
+
+#Add plant functional type info
+Pheno.df$PFT <- "TBL" # T-BL-SG: Temperate broad-leaved summergreen tree
+#PEP.df[PEP.df$species=='Larix',]$PFT <- "BNL" # B-NL-SG: Boreal needle-leaved summergreen tree
+
+#Add biome information, AET-PET ratio and elevation (required for pmodel)
+Pheno.df =
+ #both tables together
+ cbind(Pheno.df,
+ # intersection
+ data.frame(AET_PET = raster::extract(AET_PET.raster, Pheno.df[, c("Lon", "Lat")])),
+ data.frame(alt = raster::extract(elev.raster, Pheno.df[, c("Lon", "Lat")])),
+ data.frame(biome = raster::extract(biome.raster, Pheno.df[, c("Lon", "Lat")]))
+ )
+
+#remove stuff
+rm(AET_PET.raster, elev.raster, biome.raster)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+###############
+## Constants ##
+###############
+
+
+
+## Constants in the Photosynthesis module
+po2 <- 20.9e3 #O2 partial pressure in Pa
+p <- 1.0e5 # atmospheric pressure in Pa
+bc3 <- 0.015 # leaf respiration as fraction of Vmax for C3 plants
+theta <- 0.7 # colimitation (shape) parameter
+q10ko <- 1.2 #q10 for temperature-sensitive parameter ko
+q10kc <- 2.1 # q10 for temperature-sensitive parameter kc
+q10tau <- 0.57 # q10 for temperature-sensitive parameter tau
+ko25 <- 3.0e4 # value of ko at 25 deg C
+kc25 <- 30.0 # value of kc at 25 deg C
+tau25 <- 2600.0 # value of tau at 25 deg C
+alphaa <- 0.5 # fraction of PAR assimilated at ecosystem level relative to leaf level
+alphac3 <- 0.08 # intrinsic quantum efficiency of CO2 uptake in C3 plants
+lambdamc3 <- 0.8 # optimal (maximum) lambda in C3 plants
+cmass <- 12.0107 # molecular mass of C [g mol-1]
+cq <- 2.04e-6 # conversion factor for solar radiation from J m-2 to mol m-2
+n0 <- 7.15 # leaf N concentration (mg/g) not involved in photosynthesis
+m <- 25.0 # corresponds to parameter p in Eqn 28, Haxeltine & Prentice 1996
+t0c3 <- 250.0 # base temperature (K) in Arrhenius temperature response function for C3 plants
+e0 <- 308.56 # parameter in Arrhenius temp response function
+tk25 <- 298.15 # 25 deg C in Kelvin
+tmc3 <- 45.0 # maximum temperature for C3 photosynthesis
+## Constants in the Water balance module
+gamma <- 65 # psychrometer constant gamma [Pa/K]
+L <- 2.5*10^6 # latent heat of vaporization of water L [J/kg]
+emissivity <- 0.6 # emissivity for coniferous and deciduous surface type
+k_sb <- 5.670367*10^-8 # Stefan-Boltzman constant [W/m^2 K^4]
+d1 <- 0.5 # thickness of upper soil layer [m]
+d2 <- 1 # thickness of lower soil layer [m]
+a_m <- 1.391 # maximum Priestley-Taylor coefficient a_m
+g_m <- 3.26 # scaling conductance g_m [mm/s]
+k_melt <- 3 # rate of snowmelt [mm/???C d]
+
+## Soil parameters depending on texture [Phenologoy_CO2_soil dataset]
+E_max <- 5 # maximum transpiration rate that can be sustained under well-watered conditions E_max [mm/d] --> depends on plant functional type (same for T-BD-SG and B-NL-SG)
+# w_max = soil texture-dependent difference between field capacity and wilting point w_max [%]
+# c_soil = soil texture-dependent maximum rate of ETA from the bare soil [mm/h]
+# k_perc = soil texture-dependent conductivity cond_soil or percolation rate field capacity [mm/d]
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+######################
+## Helper functions ##
+######################
+
+
+# Temperate inhibition function from LPJ-GUESS
+##############################################
+
+temp_opt.fun <- function(temp) {
+ x1 <- 1
+ x2 <- 18
+ x3 <- 25
+ x4 <- 45
+ k1 <- 2.*log((1/0.99)-1.)/(x1-x2)
+ k2 <- (x1+x2)/2
+ low <- 1/(1+exp(k1*(k2-temp)))
+ k3 <- log(0.99/0.01)/(x4-x3)
+ high <- 1-0.01*exp(k3*(temp-x3))
+ tstress <- low*high
+ if(tstress>=0) {
+ tstress <- tstress
+ } else {
+ tstress <- 0
+ }
+ return(tstress)
+}
+
+
+# convert degC to kPa
+#####################
+degC_to_kPa.fun <- function(temp) {
+ out <- 0.6108*exp((17.27*temp)/(temp+237.3))
+ return(out)
+}
+
+
+# Photoperiod function
+######################
+
+# photo = photoperiod
+# photo_min = minimum value during the growing season --> limited canopy development
+# photo_max = maxmum value during the growing season --> allows canopies to develop unconstrained
+photoperiod.fun <- function(photo, photo_min, photo_max) {
+ if(photo<=photo_min) {
+ photo_resp <- 0
+ }
+ if(photophoto_min) {
+ photo_resp <- (photo-photo_min)/(photo_max-photo_min)
+ }
+ if(photo>=photo_max) {
+ photo_resp <- 1
+ }
+ return(photo_resp)
+}
+
+
+# Vapour Pressure Deficit (VPD) function
+########################################
+
+# VPD = vapour pressure deficit [kPa]
+# T_min & T_max = minimum and maximum daily temperature [C]
+# VPD_min --> at low values, latent heat losses are unlikely to exceed available water
+# little effect on stomata
+# VPD_max --> at high values, particularly if sustained, photosynthesis and growth are likely to be significantly limited
+# complete stomatal closure
+
+VPD.fun <- function(VPD, VPD_min, VPD_max) {
+ if(VPD>=VPD_max) {
+ y <- 0
+ }
+ if(VPDVPD_min) {
+ y <- 1-((VPD-VPD_min)/(VPD_max-VPD_min))
+ }
+ if(VPD<=VPD_min) {
+ y <- 1
+ }
+ return(y)
+}
+
+
+# Convert specific to relative humidity
+#######################################
+
+qair2rh <- function(qair, temp, press = 1013.25){
+ es <- 6.112 * exp((17.67 * temp)/(temp + 243.5))
+ e <- qair * press / (0.378 * qair + 0.622)
+ rh <- e / es
+ rh[rh > 1] <- 1
+ rh[rh < 0] <- 0
+ return(rh)
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#######################################################
+## Calculate climatic predictors using Parallel calc ##
+#######################################################
+
+
+
+# Identifier (all site x year combinations)
+Pheno.df$site_year = paste0(Pheno.df$geometry, '_', Pheno.df$Year)
+timeseries_year = unique(Pheno.df$site_year)
+
+# add Pheno, CO2 and photoperiod data to list
+DataList[[11]] = photo.df
+DataList[[12]] = CO2.df
+DataList[[13]] = Pheno.df
+DataList[[14]] = GPP.df
+DataList[[15]] = LAI.df
+
+rm(photo.df, CO2.df, data, Pheno.df, GPP.df, LAI.df)
+names(DataList)=c(vn,"photoperiod",'CO2',"Pheno","GPP","LAI")
+names(DataList)
+#[1] "GLDAS_Daily_Data_Tair_f_inst_Mean" "GLDAS_Daily_Data_Tair_f_inst_Min" "GLDAS_Daily_Data_Tair_f_inst_Max" "GLDAS_Daily_Data_Rainf_f_tavg"
+#[5] "GLDAS_Daily_Data_Qair_f_inst" "GLDAS_Daily_Data_SoilMoi0_10cm_inst" "GLDAS_Daily_Data_SoilMoi10_40cm_inst" "GLDAS_Daily_Data_Swnet_tavg"
+#[9] "GLDAS_Daily_Data_Lwnet_tavg" "GLDAS_Daily_Data_SWdown_f_tavg" "photoperiod" "CO2"
+#[13] "Pheno" "GPP" "LAI"
+
+
+##############################################################################################################################################
+
+
+################################
+# Loop through all time-points #
+################################
+
+
+parallelCalc <- function(timeseries_years){
+
+ # Subset input data by time-point
+ #################################
+
+ #phenology data
+ pheno.sub <- DataList[[13]][which(DataList[[13]]$site_year==timeseries_years),]
+
+ #daily mean temperature
+ TMEAN <- DataList[[1]][which(DataList[[1]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #Skip timeseries for which there is no data
+ if (nrow(TMEAN)==0) {
+ write.table(pheno.sub, file=paste0(Drivers_path3, '/', timeseries_years, '.csv'), sep=',', row.names = F, col.names = T)
+ } else {
+
+ #daily minimum temperature
+ TMIN <- DataList[[2]][which(DataList[[2]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #daily maximum temperature
+ TMAX <- DataList[[3]][which(DataList[[3]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #precipitation
+ PRCP <- DataList[[4]][which(DataList[[4]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #air humidity
+ QAIR <- DataList[[5]][which(DataList[[5]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #soil moisture (<10cm)
+ MOIST10 <- DataList[[6]][which(DataList[[6]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #soil moisture (10-40 cm)
+ MOIST40 <- DataList[[7]][which(DataList[[7]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #net short-wave radiation
+ SWRAD <- DataList[[8]][which(DataList[[8]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #net long-wave radiation
+ LWRAD <- DataList[[9]][which(DataList[[9]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #short-wave radiation down
+ SWRADdown <- DataList[[10]][which(DataList[[10]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #day length
+ PHOTO <- DataList[[11]][which(DataList[[11]]$geometry==pheno.sub$geometry),][1]%>%
+ dplyr::select(as.character(1:366))
+
+ #CO2 (monthly)
+ CO2 <- DataList[[12]][which(DataList[[12]]$Year==pheno.sub$Year),]$CO2
+
+ #GPP
+ GPP <- as.numeric(DataList[[14]][which(DataList[[14]]$site_year==pheno.sub$site_year),] %>%
+ dplyr::select(6:ncol(DataList[[14]])) )
+ GPP = rep(GPP, each=8) / 8
+ GPP = GPP[1:366]
+
+ #LAI
+ LAI <- as.numeric(DataList[[15]][which(DataList[[15]]$site_year==pheno.sub$site_year),] %>%
+ dplyr::select(6:ncol(DataList[[15]])) )
+ LAI = rep(LAI, each=8)
+ LAI = LAI[1:366]
+
+
+ ##############################################################################################################################################
+
+
+ # Create table of daily climate
+ ###############################
+
+ # Generate sub-dataframe to store results
+ factors.sub <- pheno.sub %>%
+ dplyr::select(geometry, Lat, Lon, alt, Year, Greenup_DOY, MidGreenup_DOY, MidGreendown_DOY) %>%
+ mutate(CO2 = CO2)
+
+ # Define the current year in calendar units
+ year <- as.character(pheno.sub$Year)
+ start_doy <- paste(year,"-01-01", sep="")
+ end_doy <- paste(year,"-12-31", sep="")
+ days <- seq(as.Date(start_doy), as.Date(end_doy), by="days")
+
+ #create table
+ daily_vals <- data.frame(Year = year,
+ Month = 0,
+ Day = 0,
+ Tmin = as.numeric(TMIN),
+ Tmean = as.numeric(TMEAN),
+ Tmax = as.numeric(TMAX),
+ SWrad = as.numeric(SWRAD),
+ LWrad = as.numeric(LWRAD),
+ SWradDown= as.numeric(SWRADdown),
+ Moist10 = as.numeric(MOIST10),
+ Moist40 = as.numeric(MOIST40),
+ Prcp = as.numeric(PRCP),
+ Qair = as.numeric(QAIR),
+ Photo = as.numeric(PHOTO),
+ GPP = GPP,
+ LAI = LAI)
+
+ #Add climate variables and data wrangling
+ daily_vals = daily_vals %>%
+ filter(!is.na(Tmean)) %>%#delete NAs
+ mutate(
+ #add month and day identifiers
+ Month = lubridate::month(as.Date(days,origin=days[1])),
+ Day = lubridate::day(as.Date(days,origin=days[1])),
+ #relative humidity
+ RH = qair2rh(Qair, Tmean)*100,
+ #dewpoint temperature
+ Tdew = weathermetrics::humidity.to.dewpoint(t = Tmean,
+ rh = RH,
+ temperature.metric = "celsius"))
+
+ #set NAs to 0
+ daily_vals[is.na(daily_vals)] <- 0.0001
+
+
+ ##############################################################################################################################################
+
+
+ # Get average daytime temperature (chillR package)
+ ##################################################
+
+ #Get hourly values
+ hourly_vals = stack_hourly_temps(daily_vals, latitude=pheno.sub$Lat)$hourtemps
+
+ #get daytime temperature
+ daytime_temp = data.frame(hourly_vals %>%
+ group_by_at(vars(-c(Temp,Hour))) %>%
+ #delete night hours
+ filter(
+ #filter only if daylength is less than 24 hours
+ if(daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Daylength < 24)
+ between(Hour,daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Sunrise,
+ daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Sunset)
+ else TRUE
+ ) %>%
+ #summarise daytime hours
+ summarise(Tday = mean(Temp))%>%
+ ungroup() %>%
+ #order
+ dplyr::select(Tday) )
+
+ #get nighttime temperature
+ nighttime_temp = data.frame(hourly_vals %>%
+ group_by_at(vars(-c(Temp,Hour))) %>%
+ #delete day hours
+ filter(
+ #filter if daylength is less than 24 hours
+ if(daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Daylength < 24)
+ !between(Hour,daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Sunrise,
+ daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Sunset)
+ #if no darkness select minimum Temp
+ else Temp == min(Temp)
+ )%>%
+ #summarise nighttime hours
+ summarise(Tnight = mean(Temp))%>%
+ ungroup() %>%
+ #order
+ dplyr::select(Tnight) )
+
+ #combine
+ daily_vals = cbind(daily_vals, daytime_temp, nighttime_temp) %>%
+ #growing-degree-days (>0??C)
+ mutate(GDDday = ifelse(Tday < 0 , 0, Tday),
+ GDDnight = ifelse(Tnight < 0 , 0, Tnight))%>%
+ #order
+ dplyr::select(Year, Month, Day, Tmin, Tmean, Tmax, Tday, Tnight, everything())
+
+
+ ##############################################################################################################################################
+
+
+ # Get important dates
+ #####################
+
+ # warmest day of year
+ factors.sub$HottestDOY = mean(which(daily_vals$Tmax==max(daily_vals$Tmax)))
+
+ # day of maximum radiation
+ factors.sub$MaxRadDOY = mean(which(daily_vals$SWrad==max(daily_vals$SWrad)))
+
+ # longest day of year (summer solstice)
+ solstice = which(daily_vals$Photo==max(daily_vals$Photo))[1]
+
+ # March equinox
+ equinox.Mar = solstice - 97
+
+ # September equinox
+ equinox.Sep = solstice + 97
+
+ # Mean leaf senescence
+ DOY_off <- round(pheno.sub$MidGreendownMean)
+
+ # Latest dormancy
+ DOY_dorm <- round(pheno.sub$DormancyMax)
+
+ # leaf-out
+ DOY_out <- pheno.sub$Greenup_DOY
+
+ # Greenup
+ DOY_up <- ifelse(pheno.sub$MidGreenup_DOY >= solstice, solstice-1, pheno.sub$MidGreenup_DOY)
+
+
+ ##############################################################################################################################################
+
+
+ # Set GPP and LAI before greenup to zero
+ ########################################
+
+
+ #GPP
+ daily_vals$GPPstart = daily_vals$GPP
+ daily_vals$GPPstart[1:DOY_out]=0
+
+ #LAI
+ daily_vals$LAIstart = daily_vals$LAI
+ daily_vals$LAIstart[1:DOY_out]=0
+
+
+ ##############################################################################################################################################
+
+
+ # Jmax limitation (photoperiod-dependency following Bauerle et al. 2012)
+ #########################################################################
+
+ #Number of days from solstice to mean senescence date
+ PostSolsticeSpan = DOY_dorm-solstice
+
+ #Spring degree-day threshold = 300
+ GDD1 = daily_vals$GDDday #degree-day vector
+ GDD1[1:DOY_out]=0 #set degree-days before leaf-out to zero
+ GDD1 = GDD1[1:solstice] #set degree-days after solstice to zero
+ GDDthreshold = ifelse(sum(GDD1) < 300, ifelse(sum(GDD1)>0, sum(GDD1), 1), 300) #set degree-day threshold
+ GDD1 = cumsum(GDD1) #get cumulative degree-day vector
+ GDD1[GDD1>GDDthreshold] <- GDDthreshold #cut of degree-day vector at threshold
+ GDD1 = GDD1/GDDthreshold #bound between 0 and 1
+
+ GDD2 = daily_vals$GDDday #degree-day vector
+ GDD2[1:DOY_up]=0 #set degree-days before leaf-out to zero
+ GDD2 = GDD2[1:solstice] #set degree-days after solstice to zero
+ GDDthreshold = ifelse(sum(GDD2) < 300, ifelse(sum(GDD2)>0, sum(GDD2), 1), 300) #set degree-day threshold
+ GDD2 = cumsum(GDD2) #get cumulative degree-day vector
+ GDD2[GDD2>GDDthreshold] <- GDDthreshold #cut of degree-day vector at threshold
+ GDD2 = GDD2/GDDthreshold #bound between 0 and 1
+
+ #Daily Jmax vector (degree-day-based Jmax increase after leaf-out and linear Jmax decline after solstice)
+ JmaxSAout = c(
+ GDD1,
+ rev(c(1:PostSolsticeSpan) / PostSolsticeSpan),
+ rep(0, nrow(daily_vals)-DOY_dorm) )
+
+ JmaxSAup = c(
+ GDD2,
+ rev(c(1:PostSolsticeSpan) / PostSolsticeSpan),
+ rep(0, nrow(daily_vals)-DOY_dorm) )
+
+ JmaxAout = c(
+ rep(0,DOY_out),#Jmax=0 before leaf-out
+ rep(1,solstice-DOY_out),#Jmax=1 after leaf-out
+ rev(c(1:PostSolsticeSpan) / PostSolsticeSpan),
+ rep(0, nrow(daily_vals)-DOY_dorm) )
+
+ JmaxAup = c(
+ rep(0,DOY_up),#Jmax=0 before leaf-out
+ rep(1,solstice-DOY_up),#Jmax=1 after leaf-out
+ rev(c(1:PostSolsticeSpan) / PostSolsticeSpan),
+ rep(0, nrow(daily_vals)-DOY_dorm) )
+
+ #Add Jmax vector to daily data
+ daily_vals = daily_vals %>%
+ mutate(JmaxA = JmaxSAout,
+ JmaxB = JmaxSAup,
+ JmaxC = JmaxAout,
+ JmaxD = JmaxAup)
+
+
+
+ ##############################################################################################################################################
+
+
+ # Photosynthesis calculation
+ ############################
+
+
+ # GSI, Daily Net Photosynthesis rate (dA_n) and water stress factor (dw) are calculated daily
+ # and then accumulated by summation
+
+ # Initialize vector to store daily values
+ iGSI_year <- vector()
+ iGSIrad_year <- vector()
+ VPD_year <- vector()
+ iVPD_year <- vector()
+ #dA_tot_year <- vector()
+ dA_totw_year <- vector()
+
+ # Loop through days of the growing season
+ for(i in 1:nrow(daily_vals)) {
+
+ ############################################
+ ## Cumulative Growing Season Index (cGSI) ##
+ ############################################
+
+ # modified from Jolly et al. 2005
+
+ # GSI...photoperiod-based growing-season index
+ # GSI...irradiance-based growing-season index
+ # VPD...vapor pressure deficit
+ # iVPD...vapor pressure deficit function values
+
+ # set VPD min and max
+ #####################
+
+ # Reference: White MA, Thornton PE, Running SW et al. (2000) Parameterization and sensitivity analysis of
+ # the BIOME???BGC terrestrial ecosystem model: net primary production controls. Earth Interactions, 4, 1???85.
+ # mean of all evergreen needleleaf tree species
+ if(pheno.sub$biome %in% c(5,6,11,98,99)) {
+ VPD_min <- 0.61
+ VPD_max <- 3.1
+ } else {
+ #mean of all deciduous broadleaf tree species
+ VPD_min <- 1.1
+ VPD_max <- 3.6 }
+
+ # Estimate phoperiod thresholds based on the maximum and minimum values of the growing season
+ photo_min <- min(daily_vals$Photo)
+ photo_max <- max(daily_vals$Photo)
+
+ # e_s: saturation vapour pressure [kPa]
+ e_s <- (degC_to_kPa.fun(temp=daily_vals$Tmax[i]) + degC_to_kPa.fun(temp=daily_vals$Tmin[i])) / 2
+
+ # e_a: derived from dewpoint temperature [kPa]
+ e_a <- degC_to_kPa.fun(temp=daily_vals$Tdew[i])
+
+ # VPD: Vapour pressure deficit [kPa]
+ VPD <- e_s-e_a
+ VPD_year <- c(VPD_year,VPD)
+
+ # apply vapor pressure deficit funtion
+ iVPD <- VPD.fun(VPD, VPD_min, VPD_max)
+ iVPD_year <- c(iVPD_year, iVPD)
+
+ # iOpt_temp: response to optimal temperature (Gompertz function)
+ iOpt <- temp_opt.fun(daily_vals$Tday[i])
+
+ # iPhoto: photoperiod response
+ iPhoto <- photoperiod.fun(daily_vals$Photo[i], photo_min, photo_max)
+
+ # iRadiation
+ # get maximum radiation at the site (field capacity)
+ max.rad = max(DataList[[8]][which(DataList[[8]]$geometry==pheno.sub$geometry), c(as.character(1:365))], na.rm=T)
+ iRad <- daily_vals$SWrad[i] / max.rad
+
+ # Calculate daily GSI
+ iGSI <- as.numeric(iVPD*iOpt*iPhoto)
+ iGSIrad <- as.numeric(iVPD*iOpt*iRad)
+
+ # Add to the cumulative cGSI
+ iGSI_year <- c(iGSI_year,iGSI)
+ iGSIrad_year <- c(iGSIrad_year,iGSIrad)
+
+ #----------------------------------------------------------------------------------------------
+
+ ############################
+ ## Zani et al. 2020 model ##
+ ############################
+
+ # Net photosynthesis rate (PHOTOSYNTHESIS-CONDUCTANCE MODEL, ref. Sitch et al. 2003)
+
+ # apar: daily integral of absorbed photosynthetically active radiation (PAR), J m-2 d-1
+ # Eqn 4, Haxeltine & Prentice 1996
+ # alphaa: scaling factor for absorbed PAR at ecosystem, versus leaf, scale
+ # nearly half of short-wave radiation is PAR --> mean annual value of 0.473 observed for the irradiance ratio
+ # in the PAR (ref. Papaioannou et al. 1993) plus 8% reflected and transmitted
+ # convert in J/m^-2 day: the power in watts (W) is equal to the energy in joules (J), divided by the time period in seconds (s):
+ # --> 1 Watt = 1 Joule/second, therefore j = W*86400
+ apar <- alphaa * daily_vals$SWrad[i] * 60 * 60 * 24
+
+ # Calculate temperature inhibition function limiting photosynthesis at low and high temperatures (ref. Sitch et al. 2002)
+ tstress <- temp_opt.fun(daily_vals$Tday[i])
+
+ # Calculate catalytic capacity of rubisco, Vm, assuming optimal (non-water-stressed) value for lambda, i.e. lambdamc3
+ # adjust kinetic parameters for their dependency on temperature
+ # i.e. relative change in the parameter for a 10 degC change in temperature
+ # Eqn 22, Haxeltine & Prentice 1996a
+
+ ko <- ko25*q10ko**((daily_vals$Tday[i]-25.0)/10.0) # Michaelis constant of rubisco for O2
+ kc <- kc25*q10kc**((daily_vals$Tday[i]-25.0)/10.0) # Michaelis constant for CO2
+ tau <- tau25*q10tau**((daily_vals$Tday[i]-25.0)/10.0)# CO2/O2 specificity ratio
+
+ # gammastar: CO_2 compensation point [CO2 partial pressure, Pa]
+ # Eqn 8, Haxeltine & Prentice 1996
+ gammastar <- po2/(2.0*tau)
+
+ # Convert ambient CO2 level from mole fraction to partial pressure, Pa
+ pa <- CO2*p
+
+ # p_i: non-water-stressed intercellular CO2 partial pressure, Pa
+ # Eqn 7, Haxeltine & Prentice 1996
+ p_i <- pa*lambdamc3
+
+ # Calculate coefficients
+ # Eqn 4, Haxeltine & Prentice 1996
+ c1 <- tstress*alphac3*((p_i-gammastar)/(p_i+2.0*gammastar))
+
+ # Eqn 6, Haxeltine & Prentice 1996
+ c2 <- (p_i-gammastar)/(p_i+kc*(1.0+po2/ko))
+ b <- bc3 # choose C3 value of b for Eqn 10, Haxeltine & Prentice 1996
+ t0 <- t0c3 # base temperature for temperature response of rubisco
+
+ # Eqn 13, Haxeltine & Prentice 1996
+ s <- (24.0 / daily_vals$Photo[i] ) * b
+
+ # Eqn 12, Haxeltine & Prentice 1996
+ sigma <- sqrt(max(0.0,1.0-(c2-s)/(c2-theta*s)))
+
+ # vm: optimal rubisco capacity, gC m-2 d-1
+ # Eqn 11, Haxeltine & Prentice 1996
+ # cmass: the atomic weight of carbon, used in unit conversion from molC to g
+ # cq: conversion factor from apar [J m-2] to photosynthetic photon flux density [mol m-2]
+ vm <- (1.0/b)*(c1/c2)*((2.0*theta-1.0)*s-(2.0*theta*s-c2)*sigma)*apar*cmass*cq
+
+ # je: PAR-limited photosynthesis rate, gC m-2 h-1
+ # Eqn 3, Haxeltine & Prentice 1996
+ # Convert je from daytime to hourly basis
+ if(daily_vals$Photo[i]==0) {
+ je <- 0
+ } else {
+ je <- c1*apar*cmass*cq / daily_vals$Photo[i]
+ }
+
+ # jc: rubisco-activity-limited photosynthesis rate, gC m-2 h-1
+ # Eqn 5, Haxeltine & Prentice 1996
+ jc <- c2*vm/24.0
+
+ # agd: daily gross photosynthesis, gC m-2 d-1
+ # Eqn 2, modified with k_shape (theta)
+ if(je<1e-10 | jc<=1e-10) {
+ agd <- 0
+ } else {
+ agd <- (je+jc-sqrt((je+jc)**2.0-4.0*theta*je*jc))/(2.0*theta) * daily_vals$Photo[i]
+ }
+
+ # rd: daily leaf respiration, gC m-2 d-1
+ # Eqn 10, Haxeltine & Prentice 1996
+ rd <- b*vm
+
+ # and: daily net photosynthesis (at leaf level), gC m-2 d-1
+ and <- agd-rd
+
+ # adt: total daytime net photosynthesis, gC m-2 d-1
+ # Eqn 19, Haxeltine & Prentice 1996
+ adt <- and + (1.0 - daily_vals$Photo[i] / 24.0) * rd
+
+ # Convert adt from gC m-2 d-1 to mm m-2 d-1 using ideal gas equation
+ #adtmm <- adt / cmass * 8.314 * (daily_vals$TMEAN[i] + 273.3) / p * 1000.0
+
+ # Store the daily result in the yearly vector
+ #dA_tot_year <- c(dA_tot_year,adt) #daytime net photosynthesis
+
+
+ ## Water Stress Factor (ref. Gerten et al. 2004)
+ ################################################
+
+ # soil is treated as a simple bucket consisting of two layers with fixed thickness
+
+ # Calculate potential evapotranspiration (ETA) rate, E_pot, mm d-1
+
+ # delta: rate of increase of the saturation vapour pressure with temperature
+ delta <- (2.503*10^6 * exp((17.269 * daily_vals$Tday[i]) / (237.3 + daily_vals$Tday[i]))) / (237.3 + daily_vals$Tday[i])^2
+
+ # R_n: istantaneous net radiation, W m-2 = R_s net short-wave radiation flux + R_l net long-wave flux
+ R_n <- daily_vals$SWrad[i] + daily_vals$LWrad[i]
+
+ # E_eq: equilibrium EvapoTranspiration
+ # from seconds to day
+ E_eq <- 24 * 3600 * (delta / (delta + gamma)) * (R_n / L)
+
+ # E_pot: potential EvapoTranspiration = equilibrium ETA * Priestley-Taylor coefficient
+ E_pot <- E_eq*a_m
+
+ # ratio: stomata-controlled ratio between intercellular and ambient CO2 partial pressure in the absence of water limitation
+ ratio <- p_i/pa # ca. 0.8
+
+ # g_min: minimum canopy conductance, mm s-1
+ # depends on PFT (broadleaf = 0.5, needleleaf = 0.3)
+ if(pheno.sub$biome %in% c(1,4,8,9,10,12,13)) {
+ g_min <- 0.5*3600*24 # from seconds to day
+ } else {
+ g_min <- 0.3*3600*24
+ }
+
+ # g_pot: nonwater-stressed potential canopy conductance, mm s-1
+ g_pot <- g_min + ((1.6*adt)/((pa/p)*(1-ratio)))
+
+ # E_demand: atmoshperic demand
+ # unstressed transpiration which occurs when stomatal opening is not limited by reduced water potential in the plant
+ E_demand <- E_pot/(1+(g_m/g_pot))
+
+ # root1/2: fraction of roots present in the respective layers
+ # depends on PFT (temperate = 0.7/0.3, boreal = 0.9/0.1)
+ if (pheno.sub$biome %in% c(1,3,4,8,9,10,12,13)) {
+ root1 <- 0.7
+ root2 <- 0.3
+ } else {
+ root1 <- 0.9
+ root2 <- 0.1
+ }
+
+ # relative soil moisture wr:
+ # ratio between current soil water content and plant-available water capacity
+ # wr ratio is computed for both soil layers by
+ # weighting their relative soil water contents (w1, w2)
+ # with the fraction of roots present in the respective layer
+ w1 <- daily_vals$Moist10[i]
+ w2 <- daily_vals$Moist40[i]
+
+ # soil texture-dependent difference between field capacity and wilting point w_max [%]
+ w_max <- 15
+ wr <- root1*(w1/w_max) + root2*(w2/w_max)
+
+ # E_supply: plant- and soil-limited supply function
+ E_supply <- as.numeric(E_max*wr)
+
+ # dw: daily water stress factor
+ dw <- min(1,(E_supply/E_demand))
+
+ # dA_totw: daily net photosynthesis modified by water stress factor
+ dA_totw <- adt*dw
+
+ # Add daily result to the yearly vector
+ dA_totw_year <- c(dA_totw_year, dA_totw)
+
+ } # END loop through days of the growing season
+
+ #set values before leaf-out to zero
+ iGSI_year[1:DOY_out] = 0
+ iGSIrad_year[1:DOY_out] = 0
+ dA_totw_year[1:DOY_out] = 0
+
+ #set negative values to zero
+ VPD_year[VPD_year<=0] = 0.001
+ dA_totw_year[dA_totw_year<0] = 0
+
+ #Jmax corrected photosynthesis
+ dA_totw.JmaxA_year <- dA_totw_year * daily_vals$JmaxA
+ dA_totw.JmaxB_year <- dA_totw_year * daily_vals$JmaxB
+ dA_totw.JmaxC_year <- dA_totw_year * daily_vals$JmaxC
+ dA_totw.JmaxD_year <- dA_totw_year * daily_vals$JmaxD
+
+ #add VPD to daily table
+ daily_vals$VPD = VPD_year *1000 #VPD in Pa
+
+ #----------------------------------------------------------------------------------------------
+
+ ##################
+ ## P-model v1.0 ##
+ ##################
+
+ ## Benjamin D. Stocker et al. 2020
+ ## optimality-based light use efficiency model
+ ## for simulating ecosystem gross primary production
+
+ # constant variables
+ alt = as.numeric(pheno.sub$alt) # elevation z [m a.s.l.]
+ meana = pheno.sub$AET_PET # Local annual mean ratio of actual over potential evapotranspiration
+
+ ## Calculate Photosynthetic Photon Flux Density, ppfd [mol m-2]
+ # PAR as irradiance [W m-2] is given by incoming short-wave radiation
+ ppfd = 60 * 60 * 24 * 10^-6 * 2.04 * (daily_vals$SWradDown)
+
+ ## get maximum soil moisture at the site (field capacity)
+ field.capacity = max(DataList[[7]][which(DataList[[7]]$geometry==pheno.sub$geometry), c(as.character(1:365))], na.rm=T)
+
+ ## P-model v1.0
+ pmodel.df <- tibble(
+ tc = daily_vals$Tday,
+ vpd = daily_vals$VPD, #VPD in Pa
+ co2 = CO2,
+ fapar = 1,
+ ppfd = ppfd,
+ soilm = daily_vals$Moist40 / field.capacity
+ ) %>%
+ mutate(out_pmodel = purrr::pmap(., rpmodel,
+ elv = alt,
+ kphio = 0.087,
+ beta = 146,
+ method_optci = "prentice14",
+ method_jmaxlim = "wang17",
+ do_ftemp_kphio = T,
+ do_soilmstress = T,
+ meanalpha=meana
+ ))
+ pmodel.df = do.call(rbind.data.frame, pmodel.df$out_pmodel)
+
+ #set Photosynthesis before leaf-out to zero
+ pmodel.df[1:DOY_out,]=0
+
+ ## Dark respiration, rd [mol C m-2]
+ rd = pmodel.df$rd
+ rd = rd * cmass # convert (carbon mass)
+
+ #get daily values of net daytime photosynthesis [g C m-2]
+ Apm = (pmodel.df$gpp - rd) + (1.0-daily_vals$Photo/24.0)*rd
+
+ #set negative values to zero
+ Apm[Apm<0] = 0
+
+ # Jmax-limited photosynthesis
+ ApmJmaxA = Apm * daily_vals$JmaxA
+ ApmJmaxB = Apm * daily_vals$JmaxB
+ ApmJmaxC = Apm * daily_vals$JmaxC
+ ApmJmaxD = Apm * daily_vals$JmaxD
+
+ #----------------------------------------------------------------------------------------------
+
+ #Store the results
+ ##################
+
+ daily_vals = daily_vals %>%
+ mutate(GSI = iGSI_year, #photoperiod-influenced GSI
+ GSIrad = iGSIrad_year, #radiation-influenced GSI
+ Azani = dA_totw_year, #net daytime photosynthesis (Zani et al., water-stressed)
+ AzaniJmaxA = dA_totw.JmaxA_year, #net daytime photosynthesis spring and autumn Jmax-limited (Zani et al., water-stressed)
+ AzaniJmaxB = dA_totw.JmaxB_year, #net daytime photosynthesis autumn Jmax-limited (Zani et al., water-stressed)
+ AzaniJmaxC = dA_totw.JmaxC_year,
+ AzaniJmaxD = dA_totw.JmaxD_year,
+ Apm = Apm, #net daytime photosynthesis (p model)
+ ApmJmaxA = ApmJmaxA, #net daytime photosynthesis Jmax-limited (p model)
+ ApmJmaxB = ApmJmaxB,
+ ApmJmaxC = ApmJmaxC,
+ ApmJmaxD = ApmJmaxD
+ ) %>%
+ rename(Moist=Moist40)
+
+
+ ##############################################################################################################################################
+
+
+ ###################
+ ## Store drivers ##
+ ###################
+
+
+ ######################
+ ## Seasonal drivers ##
+ ######################
+
+ #define variables
+ variable.names = c('Azani', 'AzaniJmaxA', 'AzaniJmaxB', 'AzaniJmaxC', 'AzaniJmaxD',
+ 'Apm', 'ApmJmaxA', 'ApmJmaxB', 'ApmJmaxC', 'ApmJmaxD',
+ 'GPP', 'LAI','GPPstart','LAIstart',
+ 'GSI', 'GSIrad',
+ 'GDDday', 'GDDnight', 'SWrad',
+ 'Tday', 'Tnight', 'Moist',
+ 'Prcp')
+
+ #---------------------------------------------------------------------------------------------------------
+
+ for(i in 1:length(variable.names)) {
+
+ #choose variable (daily values)
+ variable = daily_vals[,variable.names[i]]
+
+ #---------------------------------------------------------------------------------------------------------
+
+ # Name variables
+ ################
+
+ # Seasonal
+ ##########
+
+ # LO...leaf-out date
+ # SE...mean senescence date
+ # SO...Summer solstice (~22 June)
+ # SOm30...Summer solstice -30 (~22 May)
+ # SOp30...Summer solstice +30 (~21 July)
+ # SOp60...Summer solstice +60 (~22 August)
+ varname.LO.SO <- paste(variable.names[i], "LO.SO", sep=".")
+ varname.LO.SOm30 <- paste(variable.names[i], "LO.SOm30", sep=".")
+ varname.LO.SOp30 <- paste(variable.names[i], "LO.SOp30", sep=".")
+ varname.LO.SOp60 <- paste(variable.names[i], "LO.SOp60", sep=".")
+ varname.LO.SE <- paste(variable.names[i], "LO.SE", sep=".")
+ varname.SO.SE <- paste(variable.names[i], "SO.SE", sep=".")
+ varname.SOm30.SE <- paste(variable.names[i], "SOm30.SE", sep=".")
+ varname.SOp30.SE <- paste(variable.names[i], "SOp30.SE", sep=".")
+ varname.SOp60.SE <- paste(variable.names[i], "SOp60.SE", sep=".")
+
+ # Solstice
+ ##########
+
+ # solstice1...sum of 40 to 10 days before solstice
+ # solstice2...sum of 30 to 0 days before solstice
+ # solstice3...sum of 20 days before to 10 days after solstice
+ # solstice4...sum of 10 days before to 20 days after solstice
+ # solstice5...sum of 0 to 30 days after solstice
+ # solstice6...sum of 10 to 40 days after solstice
+ varname.solstice1 <- paste(variable.names[i], "solstice1", sep=".")
+ varname.solstice2 <- paste(variable.names[i], "solstice2", sep=".")
+ varname.solstice3 <- paste(variable.names[i], "solstice3", sep=".")
+ varname.solstice4 <- paste(variable.names[i], "solstice4", sep=".")
+ varname.solstice5 <- paste(variable.names[i], "solstice5", sep=".")
+ varname.solstice6 <- paste(variable.names[i], "solstice6", sep=".")
+
+ #---------------------------------------------------------------------------------------------------------
+
+ # Create columns
+ ################
+
+ if(variable.names[i] %in% c('Azani', 'AzaniJmaxA', 'AzaniJmaxB', 'AzaniJmaxC', 'AzaniJmaxD',
+ 'Apm', 'ApmJmaxA', 'ApmJmaxB', 'ApmJmaxC', 'ApmJmaxD',
+ 'GPP', 'LAI','GPPstart','LAIstart',
+ 'GSI', 'GSIrad', 'GDDday', 'GDDnight')){
+
+ # Sums from leaf-out
+ ####################
+
+ factors.sub = factors.sub %>%
+ mutate(
+ #seasonal
+ !!varname.LO.SO := sum(variable[DOY_out:solstice]),
+ !!varname.LO.SOm30 := sum(variable[DOY_out:(solstice-30)]),
+ !!varname.LO.SOp30 := sum(variable[DOY_out:(solstice+30)]),
+ !!varname.LO.SOp60 := sum(variable[DOY_out:(solstice+60)]),
+ !!varname.LO.SE := sum(variable[DOY_out:DOY_off]),
+ !!varname.SO.SE := sum(variable[solstice:DOY_off]),
+ !!varname.SOm30.SE := sum(variable[(solstice-30):DOY_off]),
+ !!varname.SOp30.SE := sum(variable[(solstice+30):DOY_off]),
+ !!varname.SOp60.SE := sum(variable[(solstice+60):DOY_off]),
+
+ #solstice
+ !!varname.solstice1 := sum(variable[(solstice-39):(solstice-10)]),
+ !!varname.solstice2 := sum(variable[(solstice-29):solstice]),
+ !!varname.solstice3 := sum(variable[(solstice-19):(solstice+10)]),
+ !!varname.solstice4 := sum(variable[(solstice-9):(solstice+20)]),
+ !!varname.solstice5 := sum(variable[(solstice+1):(solstice+30)]),
+ !!varname.solstice6 := sum(variable[(solstice+11):(solstice+40)]) )
+ }
+
+ if(variable.names[i] %in% c('Tday','Tnight','Moist','SWrad')){
+
+ # Means from fixed date
+ #######################
+
+ factors.sub = factors.sub %>%
+ mutate(
+ #seasonal
+ !!varname.LO.SO := mean(variable[equinox.Mar:solstice]),
+ !!varname.LO.SOm30 := mean(variable[equinox.Mar:(solstice-30)]),
+ !!varname.LO.SOp30 := mean(variable[equinox.Mar:(solstice+30)]),
+ !!varname.LO.SOp60 := mean(variable[equinox.Mar:(solstice+60)]),
+ !!varname.LO.SE := mean(variable[equinox.Mar:DOY_off]),
+ !!varname.SO.SE := mean(variable[solstice:DOY_off]),
+ !!varname.SOm30.SE := mean(variable[(solstice-30):DOY_off]),
+ !!varname.SOp30.SE := mean(variable[(solstice+30):DOY_off]),
+ !!varname.SOp60.SE := mean(variable[(solstice+60):DOY_off]),
+
+ #solstice
+ !!varname.solstice1 := mean(variable[(solstice-39):(solstice-10)]),
+ !!varname.solstice2 := mean(variable[(solstice-29):solstice]),
+ !!varname.solstice3 := mean(variable[(solstice-19):(solstice+10)]),
+ !!varname.solstice4 := mean(variable[(solstice-9):(solstice+20)]),
+ !!varname.solstice5 := mean(variable[(solstice+1):(solstice+30)]),
+ !!varname.solstice6 := mean(variable[(solstice+11):(solstice+40)]) )
+ }
+
+ if(variable.names[i] %in% c('Prcp')){
+
+ # Sums from fixed date
+ ######################
+
+ factors.sub = factors.sub %>%
+ mutate(
+ #seasonal
+ !!varname.LO.SO := sum(variable[equinox.Mar:solstice]),
+ !!varname.LO.SOm30 := sum(variable[equinox.Mar:(solstice-30)]),
+ !!varname.LO.SOp30 := sum(variable[equinox.Mar:(solstice+30)]),
+ !!varname.LO.SOp60 := sum(variable[equinox.Mar:(solstice+60)]),
+ !!varname.LO.SE := sum(variable[equinox.Mar:DOY_off]),
+ !!varname.SO.SE := sum(variable[solstice:DOY_off]),
+ !!varname.SOm30.SE := sum(variable[(solstice-30):DOY_off]),
+ !!varname.SOp30.SE := sum(variable[(solstice+30):DOY_off]),
+ !!varname.SOp60.SE := sum(variable[(solstice+60):DOY_off]),
+
+ #solstice
+ !!varname.solstice1 := sum(variable[(solstice-39):(solstice-10)]),
+ !!varname.solstice2 := sum(variable[(solstice-29):solstice]),
+ !!varname.solstice3 := sum(variable[(solstice-19):(solstice+10)]),
+ !!varname.solstice4 := sum(variable[(solstice-9):(solstice+20)]),
+ !!varname.solstice5 := sum(variable[(solstice+1):(solstice+30)]),
+ !!varname.solstice6 := sum(variable[(solstice+11):(solstice+40)]) )
+ }
+ }
+
+
+ #---------------------------------------------------------------------------------------------------------
+
+
+ ####################################
+ ## Calculate the monthly averages ##
+ ####################################
+
+ #create variable vectors
+ VariableMeanVector = c('LAI','LAIstart',"Tday","Tnight","Moist","SWrad")
+ VariableSumVector = c('Azani', 'AzaniJmaxA', 'AzaniJmaxB', 'AzaniJmaxC', 'AzaniJmaxD',
+ 'Apm', 'ApmJmaxA', 'ApmJmaxB', 'ApmJmaxC', 'ApmJmaxD',
+ 'GPP','GPPstart',
+ 'GSI', 'GSIrad', 'GDDday', 'GDDnight', 'Prcp')
+
+ #get means and sums
+ monthly_means = data.frame(daily_vals %>%
+ group_by(Month) %>%
+ summarize_at(VariableMeanVector, mean, na.rm = TRUE))
+ monthly_sums = data.frame(daily_vals %>%
+ group_by(Month) %>%
+ summarize_at(VariableSumVector, sum, na.rm = TRUE))
+
+ #merge
+ monthly_vals = cbind(monthly_means,monthly_sums[,-c(1)])
+
+ #Transform data
+ monthly_vals = as.data.frame(t(monthly_vals))
+
+ #Add to table
+ #############
+
+ #loop through variables
+ for(i in 1:length(variable.names)) {
+ #select variable
+ MONTHLY.DF = monthly_vals[variable.names[i],]
+ #add column names
+ names(MONTHLY.DF)=paste0(row.names(MONTHLY.DF), c(1:12))
+ #cbind with table
+ factors.sub = cbind(factors.sub, MONTHLY.DF)
+ }
+
+
+ #--------------------------------------------------------------------------
+
+
+ ################################
+ ## Get preseason temperatures ##
+ ################################
+
+ ## Calculate the average preseason temperatures prior to mean senescence date
+
+ #get preseason length vector (10 to 120 days with 10-day steps)
+ preseason.lengths = seq(10, 120, 10)
+
+ #loop through preseasons
+ for(preseason.length in preseason.lengths) {
+ #name columns
+ preseason.Tday <- paste("Tday.PS", preseason.length, sep=".")
+ preseason.Tnight <- paste("Tnight.PS", preseason.length, sep=".")
+ #add columns to table
+ factors.sub = factors.sub %>%
+ mutate(!!preseason.Tday := mean(daily_vals$Tday[(DOY_off-preseason.length):DOY_off]),
+ !!preseason.Tnight := mean(daily_vals$Tnight[(DOY_off-preseason.length):DOY_off]) )
+ }
+
+
+ ##############################################################################################################################################
+
+
+ # Safe the table
+ write.table(factors.sub, file=paste0(Drivers_path, '/', timeseries_years, '.csv'), sep=',', row.names = F, col.names = T)
+
+ }
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##################
+## Run the Loop ##
+##################
+
+
+
+#initialize the loop
+outputlist <- pbmclapply(timeseries_year, parallelCalc, mc.cores=5, mc.preschedule=T)
+
+#check how many files there are
+length(list.files(path=Drivers_path, pattern='.csv'))
+length(list.files(path=Drivers_path3, pattern='.csv'))
+
+#Rbind files
+climate.factors.table = rbindlist(lapply(list.files(path = Drivers_path),
+ function(n) fread(file.path(Drivers_path, n))))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+###################
+## Safe the data ##
+###################
+
+
+
+#Safe table
+write.csv(climate.factors.table, paste(Drivers_path2, "Remote_sensing_drivers_data.csv", sep="/"))
+
+#Remove individual files
+do.call(file.remove, list(list.files(Drivers_path,
+ full.names = TRUE)))
+do.call(file.remove, list(list.files(Drivers_path3,
+ full.names = TRUE)))
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/2_Add_drivers/2.1_Add_Drivers_AP_tier2_remote_sensing_EOS85_v1.3.dormancy_reduced.R b/R code/Remote_sensing/2_Add_drivers/2.1_Add_Drivers_AP_tier2_remote_sensing_EOS85_v1.3.dormancy_reduced.R
new file mode 100644
index 0000000..16e91ab
--- /dev/null
+++ b/R code/Remote_sensing/2_Add_drivers/2.1_Add_Drivers_AP_tier2_remote_sensing_EOS85_v1.3.dormancy_reduced.R
@@ -0,0 +1,874 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Climate driver extraction of the remote sensing analysis (EOS85) ##########################################
+#############################################################################################################
+
+
+
+#required packages
+require(data.table)
+require(sf)
+require(ncdf4)
+require(raster)
+require(tidyverse)
+require(sp)
+require(rpmodel)
+require(purrr)
+require(pbmcapply)
+require(zoo)
+require(chillR)
+require(lubridate)
+require(weathermetrics)
+require(rgdal)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#############################
+## Set directory and paths ##
+#############################
+
+
+
+# Set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2")
+
+
+#########
+# Paths #
+#########
+
+
+# 1. Input
+##########
+
+#Climate
+GLDAS_path = "Remote_sensing/Analysis/Analysis_input/Drivers/GLDAS"
+
+#CO2
+CO2_path = "Remote_sensing/Analysis/Analysis_input/Drivers/CO2"
+
+#Photoperiod
+photo_path = "Remote_sensing/Analysis/Analysis_input/Drivers"
+
+# GPP and LAI
+GPP_path = "Remote_sensing/Analysis/Analysis_input/Drivers/Modis_GPP_LAI"
+
+#Phenology
+Pheno_path = "Remote_sensing/Analysis/Analysis_input/Phenology_data"
+
+
+# 2. Output
+###########
+
+Drivers_path = "Remote_sensing/Analysis/Analysis_input/Drivers_final_EOS85/Individual_files"
+Drivers_path2 = "Remote_sensing/Analysis/Analysis_input/Drivers_final_EOS85/Merged_file"
+Drivers_path3 = "Remote_sensing/Analysis/Analysis_input/Drivers_final_EOS85/Missing_observations"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+## Phenology data
+#################
+
+Pheno.df <- fread(paste(Pheno_path, "PhenologyData_Forests_025_North_Filtered_New.csv", sep="/")) %>%
+ filter(Dormancy_DOY>230,
+ #delete observation if EOS85 date occurs before EOS50 or EOS10 dates
+ Dormancy_DOY>MidGreendown_DOY,
+ Dormancy_DOY>Senesc_DOY) %>%
+ group_by(geometry) %>%
+ #get autumn phenology means per pixel
+ mutate(DormancyMean = mean(Dormancy_DOY),
+ MidGreendownMean = mean(MidGreendown_DOY),
+ SenescMean = mean(Senesc_DOY),
+ meanDuration_EOS10_50 = round(MidGreendownMean-SenescMean),
+ meanDuration_EOS10_85 = round(DormancyMean-SenescMean),
+ meanDuration_EOS50_85 = round(DormancyMean-MidGreendownMean)) %>%
+ #delete pixels with less than 15 years
+ filter(n() >= 15) %>%
+ ungroup() %>%
+ #delete duplicates
+ distinct(geometry, Year, .keep_all = T)
+
+
+## Elevation map
+################
+
+elev.raster = raster(paste(photo_path, "topo_elevation.asc", sep="/"))
+
+
+## Biomes map
+#############
+
+biome.raster = raster(paste(photo_path, "WWF_Biomes_HalfDegree.tif", sep="/"))
+
+
+## CO2 data
+###########
+
+CO2.df = fread(paste(CO2_path, "CO2_Annual.csv", sep="/"))
+
+
+## Photoperiod
+##############
+
+photo.df = fread(paste(photo_path, "Photoperiod.csv", sep="/"))
+
+
+## LAI and GPP
+##############
+
+GPP.df = fread(paste(GPP_path, "GppData_Forests_025.csv", sep='/'))%>%
+ #keep only numbers in string
+ mutate(geometry2 = gsub("POINT ","", geometry),
+ geometry2 = gsub("\\(|\\)","", geometry2)) %>%
+ separate(geometry2, into = c("Lat","Lon"), sep=" ") %>%
+ mutate(Lat = as.numeric(Lat),
+ Lon = as.numeric(Lon)) %>%
+ #add site x year identifier
+ mutate(site_year = paste0(geometry, '_', Year)) %>%
+ #order table
+ dplyr::select(Year, geometry, site_year, Lat, Lon, everything())
+#rename columns
+colnames(GPP.df)[6:ncol(GPP.df)] <- seq(1, 366, by=8)
+
+LAI.df = fread(paste(GPP_path, "LaiData_Forests_025.csv", sep='/'))%>%
+ #keep only numbers in string
+ mutate(geometry2 = gsub("POINT ","", geometry),
+ geometry2 = gsub("\\(|\\)","", geometry2)) %>%
+ separate(geometry2, into = c("Lat","Lon"), sep=" ") %>%
+ mutate(Lat = as.numeric(Lat),
+ Lon = as.numeric(Lon)) %>%
+ #add site x year identifier
+ mutate(site_year = paste0(geometry, '_', Year)) %>%
+ #order table
+ dplyr::select(Year, geometry, site_year, Lat, Lon, everything())
+#rename columns
+colnames(LAI.df)[6:ncol(LAI.df)] <- seq(1, 366, by=8)
+
+
+## Import daily climatic datasets from GLDAS
+############################################
+
+#define climate variables
+vn <- c('GLDAS_Daily_Data_Tair_f_inst_Mean',
+ 'GLDAS_Daily_Data_Tair_f_inst_Min',
+ 'GLDAS_Daily_Data_Tair_f_inst_Max',
+ 'GLDAS_Daily_Data_Rainf_f_tavg',
+ 'GLDAS_Daily_Data_Qair_f_inst',
+ 'GLDAS_Daily_Data_SoilMoi0_10cm_inst',
+ 'GLDAS_Daily_Data_SoilMoi10_40cm_inst',
+ 'GLDAS_Daily_Data_Swnet_tavg',
+ 'GLDAS_Daily_Data_Lwnet_tavg',
+ 'GLDAS_Daily_Data_SWdown_f_tavg')
+
+#create empty list
+DataList <- replicate(length(vn),data.frame())
+
+#loop through climate variables
+for(i in 1:length(vn)) {
+ #read data
+ data = fread(paste0(GLDAS_path, "/", vn[i],".csv")) %>%
+ #keep only numbers in string
+ mutate(geometry2 = gsub("POINT ","", geometry),
+ geometry2 = gsub("\\(|\\)","", geometry2)) %>%
+ separate(geometry2, into = c("Lat","Lon"), sep=" ") %>%
+ mutate(Lat = as.numeric(Lat),
+ Lon = as.numeric(Lon)) %>%
+ #add site x year identifier
+ mutate(site_year = paste0(geometry, '_', Year)) %>%
+ #order table
+ dplyr::select(Year, geometry, site_year, Lat, Lon, everything())
+
+ #rename columns
+ colnames(data)[6:ncol(data)] <- as.numeric(1:366)
+
+ #delete NAs
+ data = data %>% filter(!is.na(`170`))
+
+ #add table to list
+ DataList[[i]] <- data
+}
+#add names to list
+names(DataList)=vn
+# Note: Precipitation is given as rate in mm d-1.
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#########################################################
+## Add biome information, AET-PET ratio and elevation ##
+#########################################################
+
+
+
+Pheno.df =
+ #cbind tables
+ cbind(Pheno.df,
+ # intersection
+ data.frame(alt = raster::extract(elev.raster, Pheno.df[, c("Lon", "Lat")])),
+ data.frame(biome = raster::extract(biome.raster, Pheno.df[, c("Lon", "Lat")]))
+ )
+
+#remove stuff
+rm(elev.raster, biome.raster)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#######################################################
+## Calculate climatic predictors using Parallel calc ##
+#######################################################
+
+
+
+# Identifier (all site x year combinations)
+Pheno.df$site_year = paste0(Pheno.df$geometry, '_', Pheno.df$Year)
+timeseries_year = unique(Pheno.df$site_year)
+
+# add Pheno, CO2 and photoperiod data to list
+DataList[[11]] = photo.df
+DataList[[12]] = CO2.df
+DataList[[13]] = Pheno.df
+DataList[[14]] = GPP.df
+DataList[[15]] = LAI.df
+
+rm(photo.df, CO2.df, data, Pheno.df, GPP.df, LAI.df)
+names(DataList)=c(vn,"photoperiod",'CO2',"Pheno","GPP","LAI")
+names(DataList)
+#[1] "GLDAS_Daily_Data_Tair_f_inst_Mean" "GLDAS_Daily_Data_Tair_f_inst_Min" "GLDAS_Daily_Data_Tair_f_inst_Max" "GLDAS_Daily_Data_Rainf_f_tavg"
+#[5] "GLDAS_Daily_Data_Qair_f_inst" "GLDAS_Daily_Data_SoilMoi0_10cm_inst" "GLDAS_Daily_Data_SoilMoi10_40cm_inst" "GLDAS_Daily_Data_Swnet_tavg"
+#[9] "GLDAS_Daily_Data_Lwnet_tavg" "GLDAS_Daily_Data_SWdown_f_tavg" "photoperiod" "CO2"
+#[13] "Pheno" "GPP" "LAI"
+
+
+##############################################################################################################################################
+
+
+################################
+# Loop through all time-points #
+################################
+
+
+parallelCalc <- function(timeseries_years){
+
+ # Subset input data by time-point
+ #################################
+
+ #phenology data
+ pheno.sub <- DataList[[13]][which(DataList[[13]]$site_year==timeseries_years),]
+
+ #daily mean temperature
+ TMEAN <- DataList[[1]][which(DataList[[1]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #Skip timeseries for which there is no data
+ if (nrow(TMEAN)==0) {
+ write.table(pheno.sub, file=paste0(Drivers_path3, '/', timeseries_years, '.csv'), sep=',', row.names = F, col.names = T)
+ } else {
+
+ #daily minimum temperature
+ TMIN <- DataList[[2]][which(DataList[[2]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #daily maximum temperature
+ TMAX <- DataList[[3]][which(DataList[[3]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #precipitation
+ PRCP <- DataList[[4]][which(DataList[[4]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #soil moisture (10-40 cm)
+ MOIST <- DataList[[7]][which(DataList[[7]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #net short-wave radiation
+ SWRAD <- DataList[[8]][which(DataList[[8]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #day length
+ PHOTO <- DataList[[11]][which(DataList[[11]]$geometry==pheno.sub$geometry),][1]%>%
+ dplyr::select(as.character(1:366))
+
+ #CO2 (monthly)
+ CO2 <- DataList[[12]][which(DataList[[12]]$Year==pheno.sub$Year),]$CO2
+
+ #GPP
+ GPP <- as.numeric(DataList[[14]][which(DataList[[14]]$site_year==pheno.sub$site_year),] %>%
+ dplyr::select(6:ncol(DataList[[14]])) )
+ GPP = rep(GPP, each=8) / 8
+ GPP = GPP[1:366]
+
+ #LAI
+ LAI <- as.numeric(DataList[[15]][which(DataList[[15]]$site_year==pheno.sub$site_year),] %>%
+ dplyr::select(6:ncol(DataList[[15]])) )
+ LAI = rep(LAI, each=8)
+ LAI = LAI[1:366]
+
+
+ ##############################################################################################################################################
+
+
+ # Create table of daily climate
+ ###############################
+
+ # Generate sub-dataframe to store results
+ factors.sub <- pheno.sub %>%
+ dplyr::select(geometry, Lat, Lon, alt, Year, Greenup_DOY, MidGreenup_DOY, Senesc_DOY, MidGreendown_DOY, Dormancy_DOY) %>%
+ mutate(CO2 = CO2)
+
+ # Define the current year in calendar units
+ year <- as.character(pheno.sub$Year)
+ start_doy <- paste(year,"-01-01", sep="")
+ end_doy <- paste(year,"-12-31", sep="")
+ days <- seq(as.Date(start_doy), as.Date(end_doy), by="days")
+
+ #create table
+ daily_vals <- data.frame(Year = year,
+ Month = 0,
+ Day = 0,
+ Tmin = as.numeric(TMIN),
+ Tmean = as.numeric(TMEAN),
+ Tmax = as.numeric(TMAX),
+ SWrad = as.numeric(SWRAD),
+ Moist = as.numeric(MOIST),
+ Prcp = as.numeric(PRCP),
+ Photo = as.numeric(PHOTO),
+ GPP = GPP,
+ LAI = LAI)
+
+ #Add climate variables and data wrangling
+ daily_vals = daily_vals %>%
+ filter(!is.na(Tmean)) %>%#delete NAs
+ mutate(
+ #add month and day identifiers
+ Month = lubridate::month(as.Date(days,origin=days[1])),
+ Day = lubridate::day(as.Date(days,origin=days[1])))
+
+ #set NAs to 0
+ daily_vals[is.na(daily_vals)] <- 0.0001
+
+
+ ##############################################################################################################################################
+
+
+ # Get average daytime temperature (chillR package)
+ ##################################################
+
+ #Get hourly values
+ hourly_vals = stack_hourly_temps(daily_vals, latitude=pheno.sub$Lat)$hourtemps
+
+ #get daytime temperature
+ daytime_temp = data.frame(hourly_vals %>%
+ group_by_at(vars(-c(Temp,Hour))) %>%
+ #delete night hours
+ filter(
+ #filter only if daylength is less than 24 hours
+ if(daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Daylength < 24)
+ between(Hour,daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Sunrise,
+ daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Sunset)
+ else TRUE
+ ) %>%
+ #summarise daytime hours
+ summarise(Tday = mean(Temp))%>%
+ ungroup() %>%
+ #order
+ dplyr::select(Tday) )
+
+ #get nighttime temperature
+ nighttime_temp = data.frame(hourly_vals %>%
+ group_by_at(vars(-c(Temp,Hour))) %>%
+ #delete day hours
+ filter(
+ #filter if daylength is less than 24 hours
+ if(daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Daylength < 24)
+ !between(Hour,daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Sunrise,
+ daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Sunset)
+ #if no darkness select minimum Temp
+ else Temp == min(Temp)
+ )%>%
+ #summarise nighttime hours
+ summarise(Tnight = mean(Temp))%>%
+ ungroup() %>%
+ #order
+ dplyr::select(Tnight) )
+
+ #combine
+ daily_vals = cbind(daily_vals, daytime_temp, nighttime_temp) %>%
+ #order
+ dplyr::select(Year, Month, Day, Tmin, Tmean, Tmax, Tday, Tnight, everything())
+
+
+ ##############################################################################################################################################
+
+
+ # Get important dates
+ #####################
+
+ # warmest day of year
+ factors.sub$HottestDOY = mean(which(daily_vals$Tmax==max(daily_vals$Tmax)))
+
+ # day of maximum radiation
+ factors.sub$MaxRadDOY = mean(which(daily_vals$SWrad==max(daily_vals$SWrad)))
+
+ # longest day of year (summer solstice)
+ solstice = which(daily_vals$Photo==max(daily_vals$Photo))[1]
+
+ # March equinox
+ equinox.Mar = solstice - 97
+
+ # September equinox
+ equinox.Sep = solstice + 97
+
+ # Mean EOS85
+ Mean_EOS85 <- round(pheno.sub$DormancyMean)
+
+ # Mean EOS50
+ Mean_EOS50 <- round(pheno.sub$MidGreendownMean)
+
+ # Mean EOS10
+ Mean_EOS10 <- round(pheno.sub$SenescMean)
+
+ # EOS10
+ DOY_EOS10 <- pheno.sub$Senesc_DOY
+
+ # EOS50
+ DOY_EOS50 <- pheno.sub$MidGreendown_DOY
+
+ # leaf-out
+ DOY_out <- pheno.sub$Greenup_DOY
+
+
+ ##############################################################################################################################################
+
+
+ # Set GPP and LAI before greenup to zero
+ ########################################
+
+
+ #GPP
+ daily_vals$GPPstart = daily_vals$GPP
+ daily_vals$GPPstart[1:DOY_out]=0
+
+ #LAI
+ daily_vals$LAIstart = daily_vals$LAI
+ daily_vals$LAIstart[1:DOY_out]=0
+
+
+ ##############################################################################################################################################
+
+
+ ###################
+ ## Store drivers ##
+ ###################
+
+
+ ######################
+ ## Seasonal drivers ##
+ ######################
+
+ #define variables
+ variable.names = c('GPPstart',
+ 'SWrad',
+ 'Tday', 'Tnight', 'Moist',
+ 'Prcp')
+
+ #---------------------------------------------------------------------------------------------------------
+
+ for(i in 1:length(variable.names)) {
+
+ #choose variable (daily values)
+ variable = daily_vals[,variable.names[i]]
+
+ #---------------------------------------------------------------------------------------------------------
+
+ # Name variables
+ ################
+
+ # Seasonal
+ ##########
+
+ # LO...leaf-out date
+ # SE...mean senescence date
+ # SO...Summer solstice (~22 June)
+ # SOm30...Summer solstice -30 (~22 May)
+ # SOp30...Summer solstice +30 (~21 July)
+ # SOp60...Summer solstice +60 (~22 August)
+ varname.LO.SO <- paste(variable.names[i], "LO.SO", sep=".")
+ varname.LO.SOm30 <- paste(variable.names[i], "LO.SOm30", sep=".")
+ varname.LO.SOp30 <- paste(variable.names[i], "LO.SOp30", sep=".")
+ varname.LO.SOp60 <- paste(variable.names[i], "LO.SOp60", sep=".")
+ varname.LO.SE <- paste(variable.names[i], "LO.SE", sep=".")
+ varname.SO.SE <- paste(variable.names[i], "SO.SE", sep=".")
+ varname.SOm30.SE <- paste(variable.names[i], "SOm30.SE", sep=".")
+ varname.SOp30.SE <- paste(variable.names[i], "SOp30.SE", sep=".")
+ varname.SOp60.SE <- paste(variable.names[i], "SOp60.SE", sep=".")
+
+ # Solstice
+ ##########
+
+ # solstice1...sum of 40 to 10 days before solstice
+ # solstice2...sum of 30 to 0 days before solstice
+ # solstice3...sum of 20 days before to 10 days after solstice
+ # solstice4...sum of 10 days before to 20 days after solstice
+ # solstice5...sum of 0 to 30 days after solstice
+ # solstice6...sum of 10 to 40 days after solstice
+ varname.solstice1 <- paste(variable.names[i], "solstice1", sep=".")
+ varname.solstice2 <- paste(variable.names[i], "solstice2", sep=".")
+ varname.solstice3 <- paste(variable.names[i], "solstice3", sep=".")
+ varname.solstice4 <- paste(variable.names[i], "solstice4", sep=".")
+ varname.solstice5 <- paste(variable.names[i], "solstice5", sep=".")
+ varname.solstice6 <- paste(variable.names[i], "solstice6", sep=".")
+
+ #---------------------------------------------------------------------------------------------------------
+
+ # Create columns
+ ################
+
+ if(variable.names[i] %in% c('GPPstart')){
+
+ # Sums from leaf-out
+ ####################
+
+ factors.sub = factors.sub %>%
+ mutate(
+ #seasonal
+ !!varname.LO.SO := sum(variable[DOY_out:solstice]),
+ !!varname.LO.SOm30 := sum(variable[DOY_out:(solstice-30)]),
+ !!varname.LO.SOp30 := sum(variable[DOY_out:(solstice+30)]),
+ !!varname.LO.SOp60 := sum(variable[DOY_out:(solstice+60)]),
+ !!varname.LO.SE := sum(variable[DOY_out:Mean_EOS85]),
+ !!varname.SO.SE := sum(variable[solstice:Mean_EOS85]),
+ !!varname.SOm30.SE := sum(variable[(solstice-30):Mean_EOS85]),
+ !!varname.SOp30.SE := sum(variable[(solstice+30):Mean_EOS85]),
+ !!varname.SOp60.SE := sum(variable[(solstice+60):Mean_EOS85]),
+
+ #solstice
+ !!varname.solstice1 := sum(variable[(solstice-39):(solstice-10)]),
+ !!varname.solstice2 := sum(variable[(solstice-29):solstice]),
+ !!varname.solstice3 := sum(variable[(solstice-19):(solstice+10)]),
+ !!varname.solstice4 := sum(variable[(solstice-9):(solstice+20)]),
+ !!varname.solstice5 := sum(variable[(solstice+1):(solstice+30)]),
+ !!varname.solstice6 := sum(variable[(solstice+11):(solstice+40)]) )
+ }
+
+ if(variable.names[i] %in% c('Tday','Tnight','Moist','SWrad')){
+
+ # Means from fixed date
+ #######################
+
+ factors.sub = factors.sub %>%
+ mutate(
+ #seasonal
+ !!varname.LO.SO := mean(variable[equinox.Mar:solstice]),
+ !!varname.LO.SOm30 := mean(variable[equinox.Mar:(solstice-30)]),
+ !!varname.LO.SOp30 := mean(variable[equinox.Mar:(solstice+30)]),
+ !!varname.LO.SOp60 := mean(variable[equinox.Mar:(solstice+60)]),
+ !!varname.LO.SE := mean(variable[equinox.Mar:Mean_EOS85]),
+ !!varname.SO.SE := mean(variable[solstice:Mean_EOS85]),
+ !!varname.SOm30.SE := mean(variable[(solstice-30):Mean_EOS85]),
+ !!varname.SOp30.SE := mean(variable[(solstice+30):Mean_EOS85]),
+ !!varname.SOp60.SE := mean(variable[(solstice+60):Mean_EOS85]),
+
+ #solstice
+ !!varname.solstice1 := mean(variable[(solstice-39):(solstice-10)]),
+ !!varname.solstice2 := mean(variable[(solstice-29):solstice]),
+ !!varname.solstice3 := mean(variable[(solstice-19):(solstice+10)]),
+ !!varname.solstice4 := mean(variable[(solstice-9):(solstice+20)]),
+ !!varname.solstice5 := mean(variable[(solstice+1):(solstice+30)]),
+ !!varname.solstice6 := mean(variable[(solstice+11):(solstice+40)]) )
+ }
+
+ if(variable.names[i] %in% c('Prcp')){
+
+ # Sums from fixed date
+ ######################
+
+ factors.sub = factors.sub %>%
+ mutate(
+ #seasonal
+ !!varname.LO.SO := sum(variable[equinox.Mar:solstice]),
+ !!varname.LO.SOm30 := sum(variable[equinox.Mar:(solstice-30)]),
+ !!varname.LO.SOp30 := sum(variable[equinox.Mar:(solstice+30)]),
+ !!varname.LO.SOp60 := sum(variable[equinox.Mar:(solstice+60)]),
+ !!varname.LO.SE := sum(variable[equinox.Mar:Mean_EOS85]),
+ !!varname.SO.SE := sum(variable[solstice:Mean_EOS85]),
+ !!varname.SOm30.SE := sum(variable[(solstice-30):Mean_EOS85]),
+ !!varname.SOp30.SE := sum(variable[(solstice+30):Mean_EOS85]),
+ !!varname.SOp60.SE := sum(variable[(solstice+60):Mean_EOS85]),
+
+ #solstice
+ !!varname.solstice1 := sum(variable[(solstice-39):(solstice-10)]),
+ !!varname.solstice2 := sum(variable[(solstice-29):solstice]),
+ !!varname.solstice3 := sum(variable[(solstice-19):(solstice+10)]),
+ !!varname.solstice4 := sum(variable[(solstice-9):(solstice+20)]),
+ !!varname.solstice5 := sum(variable[(solstice+1):(solstice+30)]),
+ !!varname.solstice6 := sum(variable[(solstice+11):(solstice+40)]) )
+ }
+ }
+
+
+ #---------------------------------------------------------------------------------------------------------
+
+
+ ####################################
+ ## Calculate the monthly averages ##
+ ####################################
+
+ #create variable vectors
+ VariableMeanVector = c("Tday","Tnight","Moist","SWrad")
+ VariableSumVector = c('GPPstart','Prcp')
+
+ #get means and sums
+ monthly_means = data.frame(daily_vals %>%
+ group_by(Month) %>%
+ summarize_at(VariableMeanVector, mean, na.rm = TRUE))
+ monthly_sums = data.frame(daily_vals %>%
+ group_by(Month) %>%
+ summarize_at(VariableSumVector, sum, na.rm = TRUE))
+
+ #merge
+ monthly_vals = cbind(monthly_means,monthly_sums[,-c(1)])
+
+ #Transform data
+ monthly_vals = as.data.frame(t(monthly_vals))
+
+ #Add to table
+ #############
+
+ #loop through variables
+ for(i in 1:length(variable.names)) {
+ #select variable
+ MONTHLY.DF = monthly_vals[variable.names[i],]
+ #add column names
+ names(MONTHLY.DF)=paste0(row.names(MONTHLY.DF), c(1:12))
+ #cbind with table
+ factors.sub = cbind(factors.sub, MONTHLY.DF)
+ }
+
+
+ #--------------------------------------------------------------------------
+
+
+ ################################
+ ## Get preseason temperatures ##
+ ################################
+
+
+ ## Calculate the average preseason temperatures prior to mean EOS85 date
+ ########################################################################
+
+ #get preseason length vector (10 to 120 days with 10-day steps)
+ preseason.lengths = seq(10, 120, 10)
+
+ #loop through preseasons
+ for(preseason.length in preseason.lengths) {
+ #name columns
+ preseason.Tday <- paste("Tday.PS", preseason.length, sep=".")
+ preseason.Tnight <- paste("Tnight.PS", preseason.length, sep=".")
+ #add columns to table
+ factors.sub = factors.sub %>%
+ mutate(!!preseason.Tday := mean(daily_vals$Tday[(Mean_EOS85-preseason.length):Mean_EOS85], na.rm=T),
+ !!preseason.Tnight := mean(daily_vals$Tnight[(Mean_EOS85-preseason.length):Mean_EOS85], na.rm=T) )
+ }
+
+ #--------------------------------------------------------------------------
+
+ ## Calculate the average temperature after mean EOS10 date
+ ##########################################################
+
+ #get preseason length vector (30 to 120 days with 30-day steps)
+ preseason.lengths = seq(30, 120, 30)
+
+ #loop through preseasons
+ for(preseason.length in preseason.lengths) {
+ #name columns
+ preseason.Tday <- paste("Tday.EOS10mean.PS", preseason.length, sep=".")
+ preseason.Tnight <- paste("Tnight.EOS10mean.PS", preseason.length, sep=".")
+ #add columns to table
+ factors.sub = factors.sub %>%
+ mutate(!!preseason.Tday := mean(daily_vals$Tday[Mean_EOS10:(Mean_EOS10+preseason.length)], na.rm=T),
+ !!preseason.Tnight := mean(daily_vals$Tnight[Mean_EOS10:(Mean_EOS10+preseason.length)], na.rm=T) )
+ }
+
+
+ ## Calculate the average temperature after EOS10 date
+ #####################################################
+
+ #get preseason length vector (30 to 120 days with 30-day steps)
+ preseason.lengths = seq(30, 120, 30)
+
+ #loop through preseasons
+ for(preseason.length in preseason.lengths) {
+ #name columns
+ preseason.Tday <- paste("Tday.EOS10.PS", preseason.length, sep=".")
+ preseason.Tnight <- paste("Tnight.EOS10.PS", preseason.length, sep=".")
+ #add columns to table
+ factors.sub = factors.sub %>%
+ mutate(!!preseason.Tday := mean(daily_vals$Tday[DOY_EOS10:(DOY_EOS10+preseason.length)], na.rm=T),
+ !!preseason.Tnight := mean(daily_vals$Tnight[DOY_EOS10:(DOY_EOS10+preseason.length)], na.rm=T) )
+ }
+
+ #--------------------------------------------------------------------------
+
+ ## Calculate the average temperature after mean EOS50 date
+ ##########################################################
+
+ #get preseason length vector (30 to 120 days with 30-day steps)
+ preseason.lengths = seq(30, 120, 30)
+
+ #loop through preseasons
+ for(preseason.length in preseason.lengths) {
+ #name columns
+ preseason.Tday <- paste("Tday.EOS50mean.PS", preseason.length, sep=".")
+ preseason.Tnight <- paste("Tnight.EOS50mean.PS", preseason.length, sep=".")
+ #add columns to table
+ factors.sub = factors.sub %>%
+ mutate(!!preseason.Tday := mean(daily_vals$Tday[Mean_EOS50:(Mean_EOS50+preseason.length)], na.rm=T),
+ !!preseason.Tnight := mean(daily_vals$Tnight[Mean_EOS50:(Mean_EOS50+preseason.length)], na.rm=T) )
+ }
+
+
+ ## Calculate the average temperature after EOS50 date
+ #####################################################
+
+ #get preseason length vector (30 to 120 days with 30-day steps)
+ preseason.lengths = seq(30, 120, 30)
+
+ #loop through preseasons
+ for(preseason.length in preseason.lengths) {
+ #name columns
+ preseason.Tday <- paste("Tday.EOS50.PS", preseason.length, sep=".")
+ preseason.Tnight <- paste("Tnight.EOS50.PS", preseason.length, sep=".")
+ #add columns to table
+ factors.sub = factors.sub %>%
+ mutate(!!preseason.Tday := mean(daily_vals$Tday[DOY_EOS50:(DOY_EOS50+preseason.length)], na.rm=T),
+ !!preseason.Tnight := mean(daily_vals$Tnight[DOY_EOS50:(DOY_EOS50+preseason.length)], na.rm=T) )
+ }
+
+ #--------------------------------------------------------------------------
+
+ ## Calculate the average temperatures starting at EOS10/50 date with a length of the average duration
+ #####################################################################################################
+
+ factors.sub = factors.sub %>%
+ mutate(Tday.EOS10_50 = mean(daily_vals$Tday[DOY_EOS10:(DOY_EOS10+pheno.sub$meanDuration_EOS10_50)], na.rm=T),
+ Tnight.EOS10_50 = mean(daily_vals$Tnight[DOY_EOS10:(DOY_EOS10+pheno.sub$meanDuration_EOS10_50)], na.rm=T),
+
+ Tday.EOS10_85 = mean(daily_vals$Tday[DOY_EOS10:(DOY_EOS10+pheno.sub$meanDuration_EOS10_85)], na.rm=T),
+ Tnight.EOS10_85 = mean(daily_vals$Tnight[DOY_EOS10:(DOY_EOS10+pheno.sub$meanDuration_EOS10_85)], na.rm=T),
+
+ Tday.EOS50_85 = mean(daily_vals$Tday[DOY_EOS50:(DOY_EOS50+pheno.sub$meanDuration_EOS50_85)], na.rm=T),
+ Tnight.EOS50_85 = mean(daily_vals$Tnight[DOY_EOS50:(DOY_EOS50+pheno.sub$meanDuration_EOS50_85)], na.rm=T)
+ )
+
+
+ ## Calculate the average temperatures starting at mean EOS10/50 date with a length of the average duration
+ ##########################################################################################################
+
+ factors.sub = factors.sub %>%
+ mutate(Tday.EOS10mean_50 = mean(daily_vals$Tday[Mean_EOS10:(Mean_EOS10+pheno.sub$meanDuration_EOS10_50)], na.rm=T),
+ Tnight.EOS10mean_50 = mean(daily_vals$Tnight[Mean_EOS10:(Mean_EOS10+pheno.sub$meanDuration_EOS10_50)], na.rm=T),
+
+ Tday.EOS10mean_85 = mean(daily_vals$Tday[Mean_EOS10:(Mean_EOS10+pheno.sub$meanDuration_EOS10_85)], na.rm=T),
+ Tnight.EOS10mean_85 = mean(daily_vals$Tnight[Mean_EOS10:(Mean_EOS10+pheno.sub$meanDuration_EOS10_85)], na.rm=T),
+
+ Tday.EOS50mean_85 = mean(daily_vals$Tday[Mean_EOS50:(Mean_EOS50+pheno.sub$meanDuration_EOS50_85)], na.rm=T),
+ Tnight.EOS50mean_85 = mean(daily_vals$Tnight[Mean_EOS50:(Mean_EOS50+pheno.sub$meanDuration_EOS50_85)], na.rm=T)
+ )
+
+
+ ##############################################################################################################################################
+
+
+ # Safe the table
+ write.table(factors.sub, file=paste0(Drivers_path, '/', timeseries_years, '.csv'), sep=',', row.names = F, col.names = T)
+
+ }
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##################
+## Run the Loop ##
+##################
+
+
+
+#initialize the loop
+outputlist <- pbmclapply(timeseries_year, parallelCalc, mc.cores=12, mc.preschedule=T)
+
+#check how many files there are
+length(list.files(path=Drivers_path, pattern='.csv'))
+length(list.files(path=Drivers_path3, pattern='.csv'))
+
+#Rbind files
+climate.factors.table = rbindlist(lapply(list.files(path = Drivers_path),
+ function(n) fread(file.path(Drivers_path, n))), fill=T)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+###################
+## Safe the data ##
+###################
+
+
+
+#Safe table
+write.csv(climate.factors.table, paste(Drivers_path2, "Remote_sensing_drivers_data_EOS85.csv", sep="/"))
+
+#Remove individual files
+do.call(file.remove, list(list.files(Drivers_path,
+ full.names = TRUE)))
+do.call(file.remove, list(list.files(Drivers_path3,
+ full.names = TRUE)))
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/2_Add_drivers/2.1_Add_Drivers_AP_tier2_remote_sensing_EOSstart_v1.3.VNP.R b/R code/Remote_sensing/2_Add_drivers/2.1_Add_Drivers_AP_tier2_remote_sensing_EOSstart_v1.3.VNP.R
new file mode 100644
index 0000000..b1b5958
--- /dev/null
+++ b/R code/Remote_sensing/2_Add_drivers/2.1_Add_Drivers_AP_tier2_remote_sensing_EOSstart_v1.3.VNP.R
@@ -0,0 +1,807 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Climate driver extraction of the remote sensing analysis (Senescence onset VNP) ###########################
+#############################################################################################################
+
+
+
+#required packages
+require(data.table)
+require(sf)
+require(ncdf4)
+require(raster)
+require(tidyverse)
+require(sp)
+require(rpmodel)
+require(purrr)
+require(pbmcapply)
+require(zoo)
+require(chillR)
+require(lubridate)
+require(weathermetrics)
+require(rgdal)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#############################
+## Set directory and paths ##
+#############################
+
+
+
+# Set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2")
+
+
+#########
+# Paths #
+#########
+
+
+# 1. Input
+##########
+
+#Climate
+GLDAS_path = "Remote_sensing/Analysis/Analysis_input/Drivers/GLDAS"
+GLDAS19_21_path = "Remote_sensing/Analysis/Analysis_input/Drivers/GLDAS19_21"
+
+#CO2
+CO2_path = "Remote_sensing/Analysis/Analysis_input/Drivers/CO2"
+
+#Photoperiod
+photo_path = "Remote_sensing/Analysis/Analysis_input/Drivers"
+
+# GPP and LAI
+GPP_path = "Remote_sensing/Analysis/Analysis_input/Drivers/Modis_GPP_LAI"
+
+#Phenology
+Pheno_path = "Remote_sensing/Analysis/Analysis_input/Phenology_data"
+
+
+# 2. Output
+###########
+
+Drivers_path = "Remote_sensing/Analysis/Analysis_input/Drivers_final_onset_VNP/Individual_files"
+Drivers_path2 = "Remote_sensing/Analysis/Analysis_input/Drivers_final_onset_VNP/Merged_file"
+Drivers_path3 = "Remote_sensing/Analysis/Analysis_input/Drivers_final_onset_VNP/Missing_observations"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+## Phenology data
+#################
+
+Pheno.df <- fread(paste(Pheno_path, "PhenologyData_VNP_2013_2021.csv", sep="/")) %>%
+ filter(Lat>20,
+ Onset_Greenness_Increase<171,
+ Onset_Greenness_Decrease>180,
+ Onset_Greenness_Decrease<280,
+ Onset_Greenness_Decrease%
+ group_by(geometry) %>%
+ #delete pixels with less than 9 years
+ filter(n() >= 9) %>%
+ #get autumn phenology means per pixel
+ mutate(Onset_Mean = mean(Onset_Greenness_Decrease)) %>%
+ ungroup() %>%
+ #delete duplicates
+ distinct(geometry, Year, .keep_all = T)
+
+
+##############################################################################################################################################
+
+
+## Elevation map
+################
+
+elev.raster = raster(paste(photo_path, "topo_elevation.asc", sep="/"))
+
+
+## Biomes map
+#############
+
+biome.raster = raster(paste(photo_path, "WWF_Biomes_HalfDegree.tif", sep="/"))
+
+
+## CO2 data
+###########
+
+CO2.df = fread(paste(CO2_path, "CO2_Annual.csv", sep="/")) %>%
+ add_row(Year=c(2019,2020,2021), CO2=c(411.7,414.2,416.5))
+
+
+## Photoperiod
+##############
+
+photo.df = fread(paste(photo_path, "Photoperiod_VNP.csv", sep="/"))
+
+
+##############################################################################################################################################
+
+
+## GPP
+######
+
+GPP.df = fread(paste(GPP_path, "GppData_Forests_025.csv", sep='/')) %>%
+ #keep only numbers in string
+ mutate(geometry2 = gsub("POINT ","", geometry),
+ geometry2 = gsub("\\(|\\)","", geometry2)) %>%
+ separate(geometry2, into = c("Lat","Lon"), sep=" ") %>%
+ mutate(Lat = as.numeric(Lat),
+ Lon = as.numeric(Lon)) %>%
+ #add site x year identifier
+ mutate(site_year = paste0(geometry, '_', Year)) %>%
+ #order table
+ dplyr::select(Year, geometry, site_year, Lat, Lon, everything())
+#rename columns
+colnames(GPP.df)[6:ncol(GPP.df)] <- seq(1, 366, by=8)
+
+# get only GPP values
+GPP = GPP.df %>%
+ dplyr::select(-c(Year, geometry, site_year, Lat, Lon))
+#Get only info
+Info = GPP.df %>%
+ dplyr::select(c(Year, geometry, site_year, Lat, Lon))
+#Get empty data frame to store duplicated data
+GPPfinal = tibble(.rows=nrow(GPP))
+
+#Loop to duplicate columns
+for (i in 1:8) {
+ GPPsub = GPP
+ colnames(GPPsub)[1:ncol(GPPsub)] <- seq(i, 368, by=8)
+ GPPfinal = cbind(GPPfinal, GPPsub)
+}
+
+#sort column names
+GPPfinal = GPPfinal %>% select(str_sort(names(.), numeric=T))
+
+#divide GPP values by 8 to obtain daily GPP
+GPPfinal = GPPfinal[,c(1:366)]/8
+
+#Add site info
+GPPfinal = cbind(Info, GPPfinal)
+
+#load 2019 to 2021 data
+GPP19_21.df = fread(paste(GPP_path, "GPP_MODIS_025_2019-21.csv", sep='/')) %>%
+ mutate(site_year = paste(geometry, Year, sep="_")) %>%
+ dplyr::select(c(Year, geometry, site_year, Lat, Lon, everything())) %>%
+ filter(Lat>20)
+#add column names
+colnames(GPP19_21.df)[6:ncol(GPP19_21.df)] <- seq(1, 366, by=1)
+#scale units to kg*C/m^2
+GPP19_21.df[,6:ncol(GPP19_21.df)] = GPP19_21.df[,6:ncol(GPP19_21.df)]/0.0001
+
+#merge data
+GPP.df = rbind(GPPfinal, GPP19_21.df)
+
+
+##############################################################################################################################################
+
+
+## Import daily climatic datasets from GLDAS
+############################################
+
+#define climate variables
+vn <- c('GLDAS_Daily_Data_Tair_f_inst_Mean',
+ 'GLDAS_Daily_Data_Tair_f_inst_Min',
+ 'GLDAS_Daily_Data_Tair_f_inst_Max',
+ 'GLDAS_Daily_Data_Rainf_f_tavg',
+ 'GLDAS_Daily_Data_Qair_f_inst',
+ 'GLDAS_Daily_Data_SoilMoi0_10cm_inst',
+ 'GLDAS_Daily_Data_SoilMoi10_40cm_inst',
+ 'GLDAS_Daily_Data_Swnet_tavg')
+
+vn2 <- c('GLDAS_Daily_Data_of_Tair_f_inst_mean_2019-21',
+ 'GLDAS_Daily_Data_of_Tair_f_inst_min_2019-21',
+ 'GLDAS_Daily_Data_of_Tair_f_inst_max_2019-21',
+ 'GLDAS_Daily_Data_of_Rainf_f_tavg_2019-21',
+ 'GLDAS_Daily_Data_of_Qair_f_inst_2019-21',
+ 'GLDAS_Daily_Data_of_SoilMoi0_10cm_inst_2019-21',
+ 'GLDAS_Daily_Data_of_SoilMoi10_40cm_inst_2019-21',
+ 'GLDAS_Daily_Data_of_Swnet_tavg_2019-21')
+
+#create empty list
+DataList <- replicate(length(vn),data.frame())
+
+#loop through climate variables
+for(i in 1:length(vn)) {
+
+ #read data
+ ##########
+
+ data = fread(paste0(GLDAS_path, "/", vn[i],".csv")) %>%
+ #keep only numbers in string
+ mutate(geometry2 = gsub("POINT ","", geometry),
+ geometry2 = gsub("\\(|\\)","", geometry2)) %>%
+ separate(geometry2, into = c("Lat","Lon"), sep=" ") %>%
+ mutate(Lat = as.numeric(Lat),
+ Lon = as.numeric(Lon)) %>%
+ #add site x year identifier
+ mutate(site_year = paste0(geometry, '_', Year)) %>%
+ #order table
+ dplyr::select(Year, geometry, site_year, Lat, Lon, everything())
+
+ #rename columns
+ colnames(data)[6:ncol(data)] <- as.numeric(1:366)
+
+ #delete NAs
+ data = data %>% filter(!is.na(`170`))
+
+ #----------------------
+
+ #read 2019 to 2021 data
+ #######################
+
+ data2 = fread(paste0(GLDAS19_21_path, "/", vn2[i],".csv")) %>%
+ #keep only numbers in string
+ mutate(geometry2 = gsub("POINT ","", geometry),
+ geometry2 = gsub("\\(|\\)","", geometry2)) %>%
+ separate(geometry2, into = c("Lat","Lon"), sep=" ") %>%
+ mutate(Lat = as.numeric(Lat),
+ Lon = as.numeric(Lon)) %>%
+ #add site x year identifier
+ mutate(site_year = paste0(geometry, '_', Year)) %>%
+ #order table
+ dplyr::select(Year, geometry, site_year, Lat, Lon, everything())
+
+ #rename columns
+ colnames(data2)[6:ncol(data2)] <- as.numeric(1:366)
+
+ #delete NAs
+ data2 = data2 %>% filter(!is.na(`170`))
+
+ #----------------------
+
+ #merge tables
+ data = rbind(data, data2)
+
+ #add table to list
+ DataList[[i]] <- data
+}
+#add names to list
+names(DataList)=vn
+# Note: Precipitation is given as rate in mm d-1.
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+######################################
+## biome information and elevation ##
+######################################
+
+
+
+#Add biome information and elevation
+Pheno.df =
+ #both tables together
+ cbind(Pheno.df,
+ # intersection
+ data.frame(alt = raster::extract(elev.raster, Pheno.df[, c("Lon", "Lat")])),
+ data.frame(biome = raster::extract(biome.raster, Pheno.df[, c("Lon", "Lat")])) )
+
+#remove stuff
+rm(elev.raster, biome.raster)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#######################################################
+## Calculate climatic predictors using Parallel calc ##
+#######################################################
+
+
+
+# Identifier (all site x year combinations)
+Pheno.df$site_year = paste0(Pheno.df$geometry, '_', Pheno.df$Year)
+timeseries_year = unique(Pheno.df$site_year)
+
+# add Pheno, CO2 and photoperiod data to list
+DataList[[9]] = photo.df
+DataList[[10]] = CO2.df
+DataList[[11]] = Pheno.df
+DataList[[12]] = GPP.df
+
+rm(photo.df, CO2.df, data, Pheno.df, GPP.df)
+names(DataList)=c(vn,"photoperiod",'CO2',"Pheno","GPP")
+names(DataList)
+#[1] "GLDAS_Daily_Data_Tair_f_inst_Mean" "GLDAS_Daily_Data_Tair_f_inst_Min" "GLDAS_Daily_Data_Tair_f_inst_Max"
+#[4] "GLDAS_Daily_Data_Rainf_f_tavg" "GLDAS_Daily_Data_Qair_f_inst" "GLDAS_Daily_Data_SoilMoi0_10cm_inst"
+#[7] "GLDAS_Daily_Data_SoilMoi10_40cm_inst" "GLDAS_Daily_Data_Swnet_tavg" "photoperiod"
+#[10] "CO2" "Pheno" "GPP"
+
+
+##############################################################################################################################################
+
+
+################################
+# Loop through all time-points #
+################################
+
+
+parallelCalc <- function(timeseries_years){
+
+ # Subset input data by time-point
+ #################################
+
+ #phenology data
+ pheno.sub <- DataList[[11]][which(DataList[[11]]$site_year==timeseries_years),]
+
+ #daily mean temperature
+ TMEAN <- DataList[[1]][which(DataList[[1]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #Skip timeseries for which there is no data
+ if (nrow(TMEAN)==0) {
+ write.table(pheno.sub, file=paste0(Drivers_path3, '/', timeseries_years, '.csv'), sep=',', row.names = F, col.names = T)
+ } else {
+
+ #daily minimum temperature
+ TMIN <- DataList[[2]][which(DataList[[2]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #daily maximum temperature
+ TMAX <- DataList[[3]][which(DataList[[3]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #precipitation
+ PRCP <- DataList[[4]][which(DataList[[4]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #soil moisture (10-40 cm)
+ MOIST <- DataList[[7]][which(DataList[[7]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #net short-wave radiation
+ SWRAD <- DataList[[8]][which(DataList[[8]]$site_year==pheno.sub$site_year),]%>%
+ dplyr::select(as.character(1:366))
+
+ #day length
+ PHOTO <- DataList[[9]][which(DataList[[9]]$geometry==pheno.sub$geometry),][1]%>%
+ dplyr::select(as.character(1:366))
+
+ #CO2
+ CO2 <- DataList[[10]][which(DataList[[10]]$Year==pheno.sub$Year),]$CO2
+
+ #GPP
+ GPP <- DataList[[12]][which(DataList[[12]]$site_year==pheno.sub$site_year),] %>%
+ dplyr::select(as.character(1:366))
+
+
+ ##############################################################################################################################################
+
+
+ # Create table of daily climate
+ ###############################
+
+ # Generate sub-dataframe to store results
+ factors.sub <- pheno.sub %>%
+ dplyr::select(geometry, Lat, Lon, alt, Year, Onset_Greenness_Increase, Onset_Greenness_Decrease, Date_Mid_Senescence) %>%
+ mutate(CO2 = CO2)
+
+ # Define the current year in calendar units
+ year <- as.character(pheno.sub$Year)
+ start_doy <- paste(year,"-01-01", sep="")
+ end_doy <- paste(year,"-12-31", sep="")
+ days <- seq(as.Date(start_doy), as.Date(end_doy), by="days")
+
+ #create table
+ daily_vals <- data.frame(Year = year,
+ Month = 0,
+ Day = 0,
+ Tmin = as.numeric(TMIN),
+ Tmean = as.numeric(TMEAN),
+ Tmax = as.numeric(TMAX),
+ SWrad = as.numeric(SWRAD),
+ Moist = as.numeric(MOIST),
+ Prcp = as.numeric(PRCP),
+ Photo = as.numeric(PHOTO),
+ GPP = as.numeric(GPP))
+
+ #Add climate variables and data wrangling
+ daily_vals = daily_vals %>%
+ filter(!is.na(Tmean)) %>%#delete NAs
+ mutate(
+ #add month and day identifiers
+ Month = lubridate::month(as.Date(days,origin=days[1])),
+ Day = lubridate::day(as.Date(days,origin=days[1])) )
+
+ #set NAs to 0
+ daily_vals[is.na(daily_vals)] <- 0.0001
+
+
+ ##############################################################################################################################################
+
+
+ # Get average daytime temperature (chillR package)
+ ##################################################
+
+ #Get hourly values
+ hourly_vals = stack_hourly_temps(daily_vals, latitude=pheno.sub$Lat)$hourtemps
+
+ #get daytime temperature
+ daytime_temp = data.frame(hourly_vals %>%
+ group_by_at(vars(-c(Temp,Hour))) %>%
+ #delete night hours
+ filter(
+ #filter only if daylength is less than 24 hours
+ if(daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Daylength < 24)
+ between(Hour,daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Sunrise,
+ daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Sunset)
+ else TRUE
+ ) %>%
+ #summarise daytime hours
+ summarise(Tday = mean(Temp))%>%
+ ungroup() %>%
+ #order
+ dplyr::select(Tday) )
+
+ #get nighttime temperature
+ nighttime_temp = data.frame(hourly_vals %>%
+ group_by_at(vars(-c(Temp,Hour))) %>%
+ #delete day hours
+ filter(
+ #filter if daylength is less than 24 hours
+ if(daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Daylength < 24)
+ !between(Hour,daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Sunrise,
+ daylength(latitude=pheno.sub$Lat,JDay=JDay[1])$Sunset)
+ #if no darkness select minimum Temp
+ else Temp == min(Temp)
+ )%>%
+ #summarise nighttime hours
+ summarise(Tnight = mean(Temp))%>%
+ ungroup() %>%
+ #order
+ dplyr::select(Tnight) )
+
+ #combine
+ daily_vals = cbind(daily_vals, daytime_temp, nighttime_temp) %>%
+ #order
+ dplyr::select(Year, Month, Day, Tmin, Tmean, Tmax, Tday, Tnight, everything())
+
+
+ ##############################################################################################################################################
+
+
+ # Get important dates
+ #####################
+
+ # warmest day of year
+ factors.sub$HottestDOY = mean(which(daily_vals$Tmax==max(daily_vals$Tmax)))
+
+ # day of maximum radiation
+ factors.sub$MaxRadDOY = mean(which(daily_vals$SWrad==max(daily_vals$SWrad)))
+
+ # longest day of year (summer solstice)
+ solstice = which(daily_vals$Photo==max(daily_vals$Photo))[1]
+
+ # March equinox
+ equinox.Mar = solstice - 97
+
+ # September equinox
+ equinox.Sep = solstice + 97
+
+ # Mean leaf senescence
+ DOY_off <- round(pheno.sub$Onset_Mean)
+
+ # leaf-out
+ DOY_out <- pheno.sub$Onset_Greenness_Increase
+
+
+ ##############################################################################################################################################
+
+
+ # Set GPP and LAI before greenup to zero
+ ########################################
+
+
+ #GPP
+ daily_vals$GPPstart = daily_vals$GPP
+ daily_vals$GPPstart[1:DOY_out]=0
+
+
+ ##############################################################################################################################################
+
+
+ ###################
+ ## Store drivers ##
+ ###################
+
+
+ ######################
+ ## Seasonal drivers ##
+ ######################
+
+ #define variables
+ variable.names = c('GPPstart','Tday', 'Tnight','SWrad','Moist','Prcp')
+
+ #---------------------------------------------------------------------------------------------------------
+
+ for(i in 1:length(variable.names)) {
+
+ #choose variable (daily values)
+ variable = daily_vals[,variable.names[i]]
+
+ #---------------------------------------------------------------------------------------------------------
+
+ # Name variables
+ ################
+
+ # Seasonal
+ ##########
+
+ # LO...leaf-out date
+ # SE...mean senescence date
+ # SO...Summer solstice (~22 June)
+ # SOm30...Summer solstice -30 (~22 May)
+ # SOp30...Summer solstice +30 (~21 July)
+ # SOp60...Summer solstice +60 (~22 August)
+ varname.LO.SO <- paste(variable.names[i], "LO.SO", sep=".")
+ varname.LO.SOm30 <- paste(variable.names[i], "LO.SOm30", sep=".")
+ varname.LO.SOp30 <- paste(variable.names[i], "LO.SOp30", sep=".")
+ varname.LO.SOp60 <- paste(variable.names[i], "LO.SOp60", sep=".")
+ varname.LO.SE <- paste(variable.names[i], "LO.SE", sep=".")
+ varname.SO.SE <- paste(variable.names[i], "SO.SE", sep=".")
+ varname.SOm30.SE <- paste(variable.names[i], "SOm30.SE", sep=".")
+ varname.SOp30.SE <- paste(variable.names[i], "SOp30.SE", sep=".")
+ varname.SOp60.SE <- paste(variable.names[i], "SOp60.SE", sep=".")
+
+ # Solstice
+ ##########
+
+ # solstice1...sum of 40 to 10 days before solstice
+ # solstice2...sum of 30 to 0 days before solstice
+ # solstice3...sum of 20 days before to 10 days after solstice
+ # solstice4...sum of 10 days before to 20 days after solstice
+ # solstice5...sum of 0 to 30 days after solstice
+ # solstice6...sum of 10 to 40 days after solstice
+ varname.solstice1 <- paste(variable.names[i], "solstice1", sep=".")
+ varname.solstice2 <- paste(variable.names[i], "solstice2", sep=".")
+ varname.solstice3 <- paste(variable.names[i], "solstice3", sep=".")
+ varname.solstice4 <- paste(variable.names[i], "solstice4", sep=".")
+ varname.solstice5 <- paste(variable.names[i], "solstice5", sep=".")
+ varname.solstice6 <- paste(variable.names[i], "solstice6", sep=".")
+
+ #---------------------------------------------------------------------------------------------------------
+
+ # Create columns
+ ################
+
+ if(variable.names[i] %in% c('GPPstart','LAIstart')){
+
+ # Sums from leaf-out
+ ####################
+
+ factors.sub = factors.sub %>%
+ mutate(
+ #seasonal
+ !!varname.LO.SO := sum(variable[DOY_out:solstice]),
+ !!varname.LO.SOm30 := sum(variable[DOY_out:(solstice-30)]),
+ !!varname.LO.SOp30 := sum(variable[DOY_out:(solstice+30)]),
+ !!varname.LO.SOp60 := sum(variable[DOY_out:(solstice+60)]),
+ !!varname.LO.SE := sum(variable[DOY_out:DOY_off]),
+ !!varname.SO.SE := sum(variable[solstice:DOY_off]),
+ !!varname.SOm30.SE := sum(variable[(solstice-30):DOY_off]),
+ !!varname.SOp30.SE := sum(variable[(solstice+30):DOY_off]),
+ !!varname.SOp60.SE := sum(variable[(solstice+60):DOY_off]),
+
+ #solstice
+ !!varname.solstice1 := sum(variable[(solstice-39):(solstice-10)]),
+ !!varname.solstice2 := sum(variable[(solstice-29):solstice]),
+ !!varname.solstice3 := sum(variable[(solstice-19):(solstice+10)]),
+ !!varname.solstice4 := sum(variable[(solstice-9):(solstice+20)]),
+ !!varname.solstice5 := sum(variable[(solstice+1):(solstice+30)]),
+ !!varname.solstice6 := sum(variable[(solstice+11):(solstice+40)]) )
+ }
+
+ if(variable.names[i] %in% c('Tday','Tnight','Moist','SWrad')){
+
+ # Means from fixed date
+ #######################
+
+ factors.sub = factors.sub %>%
+ mutate(
+ #seasonal
+ !!varname.LO.SO := mean(variable[equinox.Mar:solstice]),
+ !!varname.LO.SOm30 := mean(variable[equinox.Mar:(solstice-30)]),
+ !!varname.LO.SOp30 := mean(variable[equinox.Mar:(solstice+30)]),
+ !!varname.LO.SOp60 := mean(variable[equinox.Mar:(solstice+60)]),
+ !!varname.LO.SE := mean(variable[equinox.Mar:DOY_off]),
+ !!varname.SO.SE := mean(variable[solstice:DOY_off]),
+ !!varname.SOm30.SE := mean(variable[(solstice-30):DOY_off]),
+ !!varname.SOp30.SE := mean(variable[(solstice+30):DOY_off]),
+ !!varname.SOp60.SE := mean(variable[(solstice+60):DOY_off]),
+
+ #solstice
+ !!varname.solstice1 := mean(variable[(solstice-39):(solstice-10)]),
+ !!varname.solstice2 := mean(variable[(solstice-29):solstice]),
+ !!varname.solstice3 := mean(variable[(solstice-19):(solstice+10)]),
+ !!varname.solstice4 := mean(variable[(solstice-9):(solstice+20)]),
+ !!varname.solstice5 := mean(variable[(solstice+1):(solstice+30)]),
+ !!varname.solstice6 := mean(variable[(solstice+11):(solstice+40)]) )
+ }
+
+ if(variable.names[i] %in% c('Prcp')){
+
+ # Sums from fixed date
+ ######################
+
+ factors.sub = factors.sub %>%
+ mutate(
+ #seasonal
+ !!varname.LO.SO := sum(variable[equinox.Mar:solstice]),
+ !!varname.LO.SOm30 := sum(variable[equinox.Mar:(solstice-30)]),
+ !!varname.LO.SOp30 := sum(variable[equinox.Mar:(solstice+30)]),
+ !!varname.LO.SOp60 := sum(variable[equinox.Mar:(solstice+60)]),
+ !!varname.LO.SE := sum(variable[equinox.Mar:DOY_off]),
+ !!varname.SO.SE := sum(variable[solstice:DOY_off]),
+ !!varname.SOm30.SE := sum(variable[(solstice-30):DOY_off]),
+ !!varname.SOp30.SE := sum(variable[(solstice+30):DOY_off]),
+ !!varname.SOp60.SE := sum(variable[(solstice+60):DOY_off]),
+
+ #solstice
+ !!varname.solstice1 := sum(variable[(solstice-39):(solstice-10)]),
+ !!varname.solstice2 := sum(variable[(solstice-29):solstice]),
+ !!varname.solstice3 := sum(variable[(solstice-19):(solstice+10)]),
+ !!varname.solstice4 := sum(variable[(solstice-9):(solstice+20)]),
+ !!varname.solstice5 := sum(variable[(solstice+1):(solstice+30)]),
+ !!varname.solstice6 := sum(variable[(solstice+11):(solstice+40)]) )
+ }
+ }
+
+
+ #---------------------------------------------------------------------------------------------------------
+
+
+ ####################################
+ ## Calculate the monthly averages ##
+ ####################################
+
+ #create variable vectors
+ VariableMeanVector = c("Tday","Tnight","Moist","SWrad")
+ VariableSumVector = c('GPPstart', 'Prcp')
+
+ #get means and sums
+ monthly_means = data.frame(daily_vals %>%
+ group_by(Month) %>%
+ summarize_at(VariableMeanVector, mean, na.rm = TRUE))
+ monthly_sums = data.frame(daily_vals %>%
+ group_by(Month) %>%
+ summarize_at(VariableSumVector, sum, na.rm = TRUE))
+
+ #merge
+ monthly_vals = cbind(monthly_means,monthly_sums[,-c(1)])
+
+ #Transform data
+ monthly_vals = as.data.frame(t(monthly_vals))
+
+ #Add to table
+ #############
+
+ #loop through variables
+ for(i in 1:length(variable.names)) {
+ #select variable
+ MONTHLY.DF = monthly_vals[variable.names[i],]
+ #add column names
+ names(MONTHLY.DF)=paste0(row.names(MONTHLY.DF), c(1:12))
+ #cbind with table
+ factors.sub = cbind(factors.sub, MONTHLY.DF)
+ }
+
+
+ #--------------------------------------------------------------------------
+
+
+ ################################
+ ## Get preseason temperatures ##
+ ################################
+
+ ## Calculate the average preseason temperatures prior to mean senescence date
+
+ #get preseason length vector (10 to 120 days with 10-day steps)
+ preseason.lengths = seq(10, 120, 10)
+
+ #loop through preseasons
+ for(preseason.length in preseason.lengths) {
+ #name columns
+ preseason.Tday <- paste("Tday.PS", preseason.length, sep=".")
+ preseason.Tnight <- paste("Tnight.PS", preseason.length, sep=".")
+ #add columns to table
+ factors.sub = factors.sub %>%
+ mutate(!!preseason.Tday := mean(daily_vals$Tday[(DOY_off-preseason.length):DOY_off]),
+ !!preseason.Tnight := mean(daily_vals$Tnight[(DOY_off-preseason.length):DOY_off]) )
+ }
+
+
+ ##############################################################################################################################################
+
+
+ # Safe the table
+ write.table(factors.sub, file=paste0(Drivers_path, '/', timeseries_years, '.csv'), sep=',', row.names = F, col.names = T)
+
+ }
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##################
+## Run the Loop ##
+##################
+
+
+
+#initialize the loop
+outputlist <- pbmclapply(timeseries_year, parallelCalc, mc.cores=12, mc.preschedule=T)
+
+#check how many files there are
+length(list.files(path=Drivers_path, pattern='.csv'))
+length(list.files(path=Drivers_path3, pattern='.csv'))
+
+#Rbind files
+climate.factors.table = rbindlist(lapply(list.files(path = Drivers_path),
+ function(n) fread(file.path(Drivers_path, n))))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+###################
+## Safe the data ##
+###################
+
+
+
+#Safe table
+write.csv(climate.factors.table, paste(Drivers_path2, "Remote_sensing_drivers_data_onset_VNP.csv", sep="/"))
+
+#Remove individual files
+do.call(file.remove, list(list.files(Drivers_path,
+ full.names = TRUE)))
+do.call(file.remove, list(list.files(Drivers_path3,
+ full.names = TRUE)))
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.1_Sample_sizes_RS.Rmd b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.1_Sample_sizes_RS.Rmd
new file mode 100644
index 0000000..53ae0c9
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.1_Sample_sizes_RS.Rmd
@@ -0,0 +1,136 @@
+---
+title: "Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice"
+subtitle: "Satellite data (EOS10): sample size check"
+---
+
+
+
+## 1. Load packages and data
+
+get packages
+```{r}
+require(data.table)
+require(ggplot2)
+require(tidyverse)
+require(raster)
+require(viridis)
+
+
+#plot theme
+plotTheme1 = theme(
+ legend.position = "top",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.grid.major = element_line(colour = "lightgrey"),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+```
+
+
+get data
+```{r}
+## set working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+# paths
+Drivers_path = "Analysis_input/Drivers_final_EOS10/Merged_file"
+Land_cover_path = "Analysis_input/Drivers"
+
+## Import data
+Pheno.df <- fread(paste(Drivers_path, "Remote_sensing_drivers_data_startSen.csv", sep="/"))
+
+LandCover.df <- fread(paste(Land_cover_path, "Land_Cover_Type_025.csv", sep="/")) %>%
+ mutate(geometry = gsub("POINT ","", geometry),
+ geometry = gsub("\\(|\\)","", geometry)) %>%
+ separate(geometry, into = c("Lon","Lat"), sep=" ") %>%
+ mutate(Lat = as.numeric(Lat),
+ Lon = as.numeric(Lon))
+```
+
+
+
+
+## 2. Data cleaning
+show code
+```{r}
+Pheno.df = Pheno.df %>%
+ mutate(Year = as.numeric(Year)) %>%
+ filter(
+ #delete senescence dates before DOY 140 and after DOY 290
+ Senesc_DOY>140,Senesc_DOY<290,
+ #delete observation if senescence date occurs before MidGreenup date
+ Senesc_DOY>MidGreenup_DOY)%>%
+ group_by(geometry) %>%
+ #delete pixels with less than 15 years
+ filter(n() >= 15) %>%
+ ungroup() %>%
+ dplyr::select(-c(V1)) %>%
+ left_join(LandCover.df, by=c("Lat","Lon")) %>%
+ #delete evergreen broadleaf pixels
+ filter(!LC_Type == "EvgB")
+```
+
+
+
+
+## 3. Check sample sizes
+show code
+```{r}
+#total observations
+nrow(Pheno.df)
+
+#how many sites in total?
+length(unique(Pheno.df$geometry))
+
+#time span
+range(Pheno.df$Year)
+hist(Pheno.df$Year, xlab="Year", main="Temporal distribution of data", col='lightblue', breaks=40)
+
+#latitudinal gradient
+range(Pheno.df$Lat)
+hist(Pheno.df$Lat, xlab="Latitude", main="Latitudinal gradient", col='lightblue')
+
+#Land cover types
+Pheno.df.unique = Pheno.df %>% distinct(geometry, .keep_all = T)
+barplot(table(Pheno.df.unique$LC_Type))
+table(Pheno.df.unique$LC_Type)
+
+#leaf-out data
+mean(Pheno.df$Greenup_DOY)
+sd(Pheno.df$Greenup_DOY)
+range(Pheno.df$Greenup_DOY)
+hist(Pheno.df$Greenup_DOY, xlab="Leaf-out date", main="Leaf-out gradient", col='lightblue')
+
+#leaf-off data
+mean(Pheno.df$Senesc_DOY)
+sd(Pheno.df$Senesc_DOY)
+quantile(Pheno.df$Senesc_DOY, probs=c(0.05, 0.5, 0.95))
+range(Pheno.df$Senesc_DOY)
+hist(Pheno.df$Senesc_DOY, xlab="Senescence date", main="Senescence gradient", col='lightblue')
+
+#Create summary dataframe by time series
+n.years = Pheno.df %>%
+ group_by(geometry) %>%
+ summarise(count = n())
+mean(n.years$count)
+max(n.years$count)
+min(n.years$count)
+
+#Map the observations
+mp <- NULL
+mapWorld <- borders("world", colour="gray60", fill="gray60") # create a layer of borders
+mp <- ggplot() + mapWorld + plotTheme1
+
+#Now Layer the stations on top
+mp <- mp + geom_tile(data = Pheno.df,
+ aes(x = Lon, y = Lat, fill=LC_Type)) +
+ scale_fill_viridis_d(option = "D") +
+ coord_cartesian(ylim = c(20, 70)) +
+ xlab("") + ylab('')
+mp
+```
+
\ No newline at end of file
diff --git a/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.2_Add_preseasons_RS_EOS10.R b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.2_Add_preseasons_RS_EOS10.R
new file mode 100644
index 0000000..f5ce9db
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.2_Add_preseasons_RS_EOS10.R
@@ -0,0 +1,410 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Run autumn temperature (preseason) models for the satellite data (EOS10) ##################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(data.table)
+require(broom)
+require(gmodels)
+require(patchwork)
+require(MASS)
+
+
+#define plot themes
+plotTheme1 = theme(legend.position = "none",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################################
+## Set directories and get own PEP data ##
+##########################################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+# paths
+Drivers_path = "Analysis_input/Drivers_final_startSen/Merged_file"
+Land_cover_path = "Analysis_input/Drivers"
+output_path = "Analysis_output_startSen/Preseason_temperatures"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology data
+Pheno.df <- fread(paste(Drivers_path, "Remote_sensing_drivers_data_startSen.csv", sep="/"))%>%
+ dplyr::select(-V1) %>%
+ filter(
+ #delete senescence dates before DOY 140 and after DOY 290
+ Senesc_DOY>140,Senesc_DOY<290,
+ #delete observation if senescence date occurs before MidGreenup date
+ Senesc_DOY>MidGreenup_DOY)%>%
+ group_by(geometry) %>%
+ #delete pixels with less than 15 years
+ filter(n() >= 15) %>%
+ ungroup()
+
+#Land cover info
+LandCover.df <- fread(paste(Land_cover_path, "Land_Cover_Type_025.csv", sep="/")) %>%
+ mutate(geometry = gsub("POINT ","", geometry),
+ geometry = gsub("\\(|\\)","", geometry)) %>%
+ separate(geometry, into = c("Lon","Lat"), sep=" ") %>%
+ mutate(Lat = round(as.numeric(Lat),3),
+ Lon = round(as.numeric(Lon),3) )
+
+#Merge tables
+Pheno.df = Pheno.df %>%
+ mutate(Year = as.numeric(Year)) %>%
+ inner_join(LandCover.df, by=c("Lat","Lon")) %>%
+ #delete evergreen broadleaf pixels
+ filter(!LC_Type == "EvgB")
+
+rm(LandCover.df)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+## Get best preseason ##
+########################
+
+
+
+#reshape table to long format
+#############################
+
+preseason.df = Pheno.df %>%
+ #select columns
+ dplyr::select(geometry,Year,LC_Type,Senesc_DOY,
+ Tday.PS.10,Tday.PS.20,Tday.PS.30,
+ Tday.PS.40,Tday.PS.50,Tday.PS.60,
+ Tday.PS.70,Tday.PS.80,Tday.PS.90,
+ Tday.PS.100,Tday.PS.110,Tday.PS.120,
+ Tnight.PS.10,Tnight.PS.20,Tnight.PS.30,
+ Tnight.PS.40,Tnight.PS.50,Tnight.PS.60,
+ Tnight.PS.70,Tnight.PS.80,Tnight.PS.90,
+ Tnight.PS.100,Tnight.PS.110,Tnight.PS.120)%>%
+ #long format
+ pivot_longer(.,cols=starts_with(c("Td","Tn")), names_to = "preseason", values_to = "temp") %>%
+ #create preseason length and temperature class columns
+ mutate(preseason_length = readr::parse_number(gsub("[.]", "", preseason)), #keep only numbers in string
+ temp_class = gsub("\\..*","", preseason)) %>%
+ dplyr::select(-preseason)
+
+
+#Run linear models
+##################
+
+resultsLM = preseason.df %>%
+ group_by(geometry, LC_Type, temp_class, preseason_length) %>%
+ do({
+
+ model = lm(scale(Senesc_DOY) ~ scale(temp), data=.) # linear model
+ data.frame(tidy(model), glance(model) )}) %>% # model info
+
+ filter(!term %in% c("(Intercept)")) %>%
+ dplyr::select(geometry,LC_Type,temp_class,preseason_length,estimate,r.squared)%>%
+ ungroup()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+############################################
+## Plot preseason-senescence correlations ##
+############################################
+
+
+
+#R2
+###
+
+resultsLM = resultsLM %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN"), ordered=T))
+
+plot.R2 = resultsLM %>%
+
+ ggplot()+
+ aes(x=preseason_length, y=r.squared,
+ colour=temp_class) +
+
+ stat_summary(fun=mean, geom="line", size = .7) +
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.5, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = 1) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+
+ xlab("Preseason length (days)") +
+ ylab("Coefficient of determination (R2)") +
+ coord_cartesian(ylim = c(0.01, 0.15))+
+ facet_wrap(~LC_Type, ncol=1) +
+ plotTheme1 +
+ theme(strip.text.x = element_blank())
+
+
+#Correlation coefficient
+########################
+
+plot.estimate = resultsLM %>%
+
+ ggplot()+
+ aes(x=preseason_length, y=estimate,
+ colour=temp_class) +
+
+ geom_hline(yintercept = 0)+
+ stat_summary(fun = mean, geom="line", size = .7) +
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.5, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = 1) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+
+ xlab("Preseason length (days)") +
+ ylab("Standardized coefficient") +
+ #coord_cartesian(ylim = c(0.01, 0.28))+
+ facet_wrap(~LC_Type, ncol=1) +
+ plotTheme1+
+ theme(strip.text.x = element_blank())
+
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################################################
+## Plot best preseason length for each temperature ##
+#####################################################
+
+
+
+#keep only models with best predictions
+resultsLM2 = resultsLM %>%
+ group_by(geometry,temp_class) %>%
+ top_n(1, r.squared) %>%
+ ungroup()
+
+#plot
+plot.length = resultsLM2 %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN"), ordered=T)) %>%
+ dplyr::select(LC_Type,temp_class,preseason_length)%>%
+
+ ggplot() + aes(x=temp_class, y=preseason_length) +
+
+ stat_summary(fun = mean,
+ fun.min = function(x) mean(x) - sd(x),
+ fun.max = function(x) mean(x) + sd(x),
+ geom = "pointrange",
+ size=0.5,
+ aes(colour = temp_class)) +
+
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+
+ coord_cartesian(ylim = c(5, 120))+
+ xlab("Daily temperature") +
+ ylab("Best preseason length (days)") +
+ facet_wrap(~LC_Type, ncol=1) +
+ plotTheme1+
+ theme(strip.text.x = element_blank(),
+ axis.text.x = element_text(angle = 45, hjust=1))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################################
+#Add best preseason temps to PEP data
+#####################################
+
+
+
+Pheno.df = Pheno.df %>%
+ inner_join(., preseason.df %>%
+ #filter by model data
+ semi_join(resultsLM2, by=c('geometry','temp_class','preseason_length')) %>%
+ dplyr::select(c(geometry,Year,temp_class,temp))%>%
+ pivot_wider(.,names_from = temp_class, values_from = temp),
+ by = c("Year", "geometry"))%>%
+ dplyr::select(-(cols=starts_with(c("Tday.PS","Tnight.PS"))))
+
+#Safe table
+write.csv(Pheno.df, paste(Drivers_path, "Remote_sensing_drivers_data_startSen_preseason.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##################################
+#Run linear ridge regression model
+##################################
+
+
+
+resultsLM3 = Pheno.df %>%
+ group_by(geometry,LC_Type) %>%
+ do({model = lm.ridge(scale(Senesc_DOY) ~ scale(Tday)+scale(Tnight), data=.) # linear model
+ data.frame(tidy(model), # coefficient info
+ glance(model))}) %>% # model info
+ ungroup() %>%
+ #rename temperature class
+ mutate(term=dplyr::recode(term, `scale(Tday)`="Tday", `scale(Tnight)`="Tnight"))
+
+#plot preseason-senescence correlations
+plot.ridge = resultsLM3 %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN"), ordered=T) ) %>%
+
+ ggplot()+
+ aes(x=term, y=estimate,
+ colour=term, fill = term) +
+ scale_colour_manual(values = c('#F21A00','#3B9AB2')) +
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.9, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = 1) +
+
+ geom_hline(yintercept = 0)+
+ xlab("Daily temperature") +
+ ylab("Standardized coefficient (ridge regression)") +
+ coord_cartesian(ylim = c(-0.3, 0.3))+
+ facet_wrap(~LC_Type, ncol=1,strip.position = "right") +
+ plotTheme1+
+ theme(axis.text.x = element_text(angle = 45, hjust=1))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################
+# Arrange and safe plots #
+##########################
+
+
+
+#define plot layout
+layout <- "AABBCD"
+
+#Merge plots
+PreseasonPlot = plot.R2 + plot.estimate + plot.length + plot.ridge +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'a')&
+ theme(plot.tag = element_text(face = 'bold'))
+
+#Safe plot
+pdf(paste(output_path,"Preseason_sensitivity_RS_startSen.pdf",sep="/"), width=8, height=7, useDingbats=FALSE)
+PreseasonPlot
+dev.off()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+## datetime
+Sys.time()
+#"2021-12-05 10:24:06 CET"
+
+
+## session info
+sessionInfo()
+#R version 4.1.0 (2021-05-18)
+#Platform: x86_64-apple-darwin17.0 (64-bit)
+#Running under: macOS Big Sur 11.2.3
+
+#Matrix products: default
+#LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+#locale:
+# [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+#attached base packages:
+# [1] stats graphics grDevices utils datasets methods base
+
+#other attached packages:
+# [1] MASS_7.3-54 patchwork_1.1.1 gmodels_2.18.1 broom_0.7.8 data.table_1.14.0 forcats_0.5.1
+#[7] stringr_1.4.0 dplyr_1.0.7 purrr_0.3.4 readr_1.4.0 tidyr_1.1.3 tibble_3.1.2
+#[13] ggplot2_3.3.4 tidyverse_1.3.1
+
+#loaded via a namespace (and not attached):
+# [1] httr_1.4.2 jsonlite_1.7.2 splines_4.1.0 modelr_0.1.8 gtools_3.9.2 Formula_1.2-4
+#[7] assertthat_0.2.1 latticeExtra_0.6-29 cellranger_1.1.0 pillar_1.6.1 backports_1.2.1 lattice_0.20-44
+#[13] glue_1.4.2 digest_0.6.27 RColorBrewer_1.1-2 checkmate_2.0.0 rvest_1.0.0 colorspace_2.0-1
+#[19] htmltools_0.5.1.1 Matrix_1.3-3 pkgconfig_2.0.3 haven_2.4.1 scales_1.1.1 gdata_2.18.0
+#[25] jpeg_0.1-8.1 htmlTable_2.2.1 generics_0.1.0 farver_2.1.0 ellipsis_0.3.2 withr_2.4.2
+#[31] nnet_7.3-16 cli_2.5.0 survival_3.2-11 magrittr_2.0.1 crayon_1.4.1 readxl_1.3.1
+#[37] fs_1.5.0 fansi_0.5.0 xml2_1.3.2 foreign_0.8-81 tools_4.1.0 hms_1.1.0
+#[43] lifecycle_1.0.0 munsell_0.5.0 reprex_2.0.0 cluster_2.1.2 compiler_4.1.0 rlang_0.4.11
+#[49] grid_4.1.0 rstudioapi_0.13 htmlwidgets_1.5.3 base64enc_0.1-3 labeling_0.4.2 gtable_0.3.0
+#[55] DBI_1.1.1 R6_2.5.0 gridExtra_2.3 lubridate_1.7.10 knitr_1.33 utf8_1.2.1
+#[61] Hmisc_4.5-0 stringi_1.6.2 Rcpp_1.0.6 vctrs_0.3.8 rpart_4.1-15 png_0.1-7
+#[67] dbplyr_2.1.1 tidyselect_1.1.1 xfun_0.24
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.3_Modeling/3.3.1_Spatial_models_RS.R b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.3_Modeling/3.3.1_Spatial_models_RS.R
new file mode 100644
index 0000000..fa0042c
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.3_Modeling/3.3.1_Spatial_models_RS.R
@@ -0,0 +1,600 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Linear models for the satellite data (EOS10) ##############################################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(ggplot2)
+require(data.table)
+require(broom)
+require(sjmisc)
+
+
+
+#define plot themes
+plotTheme1 = theme(legend.position = "right",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+# paths
+Drivers_path = "Analysis_input/Drivers_final_EOS10/Merged_file"
+output_path = "Analysis_output_startSen/Data"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology data frame
+#####################
+
+Pheno.df <- fread(paste(Drivers_path, "Remote_sensing_drivers_data_startSen_preseason.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+## VARIABLE EXPLANATION:
+########################
+
+#General
+########
+
+#geometry...site identifier
+#Year...observation year
+#Lat...site latitude (decimal degrees)
+#Lon...site longitude (decomal degrees)
+#alt...site altitude (m a.s.l.)
+
+#---------------------------------------------------
+
+#Phenology
+##########
+
+#Senesc_DOY...senescence date (DOY)
+
+#---------------------------------------------------
+
+#Day-of-year maximum temperature and radiation
+##############################################
+
+#HottestDOY...DOY with maximum annual temperature
+#MaxRadDOY...DOY with maximum irradiance
+
+#---------------------------------------------------
+
+#Seasonal drivers
+#################
+
+#SUMS (flexible start = leaf-out):
+#---------------------------------
+#Apm...Daily net photosynthesis p-model
+#Azani...Daily net photosynthesis Zani model
+#GSI...photoperiod-influenced growing-season index
+#GSIrad...radiation-influenced growing-season index
+#GDDday...daytime degree days
+#GDDnight...nighttime degree days
+#SWrad...Radiation sum
+
+#MEANS (fixed start = March equinox):
+#------------------------------------
+#Tday...mean daytime temperature
+#Tnight...mean nighttime temperature
+#Moist...mean soil moisture (10-40cm)
+#Prcp...precipitation sum
+
+#-----------------
+
+#PERIODS
+
+#seasonal
+#--------
+#LO.SOm30...leaf-out to 30 days before summer solstice
+#LO.SO...leaf-out to summer solstice
+#LO.SOp30...leaf-out to 30 days after solstice
+#LO.SOp60...leaf-out to 60 days after solstice
+#LO.SE...leaf-out to mean senescence
+#SOm30.SE...30 days before solstice to mean senescence
+#SO.SE...solstice to mean senescence
+#SOp30.SE...30 days after solstice to mean senescence
+#SOp60.SE...60 days after solstice to mean senescence
+
+#around summer solstice
+#----------------------
+#solstice1...40 to 10 days before solstice
+#solstice2...30 days before solstice
+#solstice3...20 days before until 10 days after solstice
+#solstice4...10 days before until 20 days after solstice
+#solstice5...30 days after solstice
+#solstice6...10 to 40 days after solstice
+
+#---------------------------------------------------
+
+#Monthly drivers
+################
+
+#Tnight1-12...mean of nighttime temperatures in January (1) to December (12)
+#Tday1-12...mean of daytime temperatures in January (1) to December (12)
+#GDDnight1-12...sum of nighttime degree-days in January (1) to December (12)
+#GDDday1-12...sum of daytime degree-days in January (1) to December (12)
+#SWrad1-12...mean of daily short-wave radiation in January (1) to December (12)
+#Moist1-12...mean of daily soil moisture (10-40cm) in January (1) to December (12)
+#Prcp1-12...sum of daily precipitation in January (1) to December (12)
+#Apm1-12...sum of daily gross photosynthesis in January (1) to December (12)
+#Azani1-12...sum of daily net photosynthesis in January (1) to December (12)
+#GSI...day length-influenced growing-season index
+#GSIrad...radiation-influenced growing-season index
+
+#---------------------------------------------------
+
+#Preseason temperatures
+#######################
+
+#Tday...time series-specific best preseason (R2-based) for daytime temperatures
+#tnight...time series-specific best preseason (R2-based) for nighttime temperatures
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Full models ##
+#################
+
+
+
+#Define variables
+variables = c('GPPstart', 'LAIstart',
+ 'Apm', 'Azani',
+ 'Tnight', 'Tday',
+ 'SWrad')
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+##############################################################################################################################################
+
+
+#Loop through variables
+#######################
+
+for (i in 1:length(variables)){
+
+ #delete pixels with no photosynthesis before solstice
+ if (variables[i] %in% c('GPPstart',"Azani","Apm"))
+ Pheno.df2 = Pheno.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(paste0(variables[i],".LO.SO"))) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.df
+
+
+ #set equations
+ ##############
+
+ #define variable names
+ covariates = paste0(variables[i], c('.LO.SO','.SO.SE'))
+
+
+ #full models
+ equation.scaled1 = as.formula(paste("scale(Senesc_DOY) ~ ", paste0('scale(',covariates[1], ') + scale(', covariates[2], ')',
+ collapse="+"),
+ '+ scale(Prcp.LO.SO) + scale(Prcp.SO.SE) + scale(CO2)', collapse=""))
+
+ equation.scaled2 = as.formula(paste("scale(Senesc_DOY) ~ ", paste0('scale(',covariates[1], ') + scale(', covariates[2], ')',
+ collapse="+")))
+
+
+ ##############################################################################################################################################
+
+
+ ##############
+ #linear models
+ ##############
+
+
+ ModelResults.df = Pheno.df2 %>%
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+ do({
+
+ #run model
+ ##########
+
+ model1 = lm(equation.scaled1, data=.)
+ model2 = lm(equation.scaled2, data=.)
+
+ #create combined data frame
+ ###########################
+
+ data.frame(rbind(
+
+ #Equation 1
+ tidy(model1) %>% mutate(equation = 'full model 1'), #add model name
+
+ #Equation 2
+ tidy(model2) %>% mutate(equation = 'full model 2')
+
+ ))
+ }) %>%
+
+ #add variable name and delete "scale()" from term column
+ mutate(variable = variables[i],
+ term = gsub("scale","",term),
+ term = gsub("\\(|\\)","",term) ) %>%
+ #delete intercept
+ filter(!term %in% c("Intercept")) %>%
+ ungroup()
+
+
+ ##############################################################################################################################################
+
+
+ #store data frame in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+FullAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################
+## Monthly correlations ##
+##########################
+
+
+
+#Get sums for January to April photosynthesis parameters
+Pheno.monthly.df = Pheno.df %>%
+ mutate(LAIstart4 = rowSums(dplyr::select(.,c("LAIstart1","LAIstart2","LAIstart3","LAIstart4"))),
+ GPPstart4 = rowSums(dplyr::select(.,c("GPPstart1","GPPstart2","GPPstart3","GPPstart4"))),
+ Apm4 = rowSums(dplyr::select(.,c("Apm1","Apm2","Apm3","Apm4"))),
+ Azani4 = rowSums(dplyr::select(.,c("Azani1","Azani2","Azani3","Azani4")))
+ )
+
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+##############################################################################################################################################
+
+
+#Loop through covariate groups
+##############################
+
+
+for (i in 1:length(variables)){
+
+ #delete pixels with no photosynthesis before solstice
+ #####################################################
+
+ if (variables[i] %in% c("GPPstart","LAIstart","Azani","Apm"))
+ Pheno.df2 = Pheno.monthly.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(paste0(variables[i],"4"))) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.monthly.df
+
+ #create explanatory variables
+ #############################
+
+ covariates.monthly = paste0(variables[i], c(1:9))
+
+ #---------------------------------------------------------
+
+ #set equations
+ ##############
+
+ if(variables[i] %in% c('GPPstart', 'LAIstart', 'SWrad', 'Apm', 'Azani')) {
+ equation = as.formula(paste("scale(Senesc_DOY) ~ ", paste('scale(', covariates.monthly[4:9], ')', collapse="+"),
+ collapse=""))
+ } else {
+ equation = as.formula(paste("scale(Senesc_DOY) ~ ", paste('scale(', covariates.monthly, ')', collapse="+"),
+ collapse=""))
+ }
+
+ #---------------------------------------------------------
+
+ ###############
+ # Linear models
+ ###############
+
+ ModelResults.df = Pheno.df2 %>%
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+ do({
+
+ #run models
+ ###########
+
+ model = lm(equation, data=.)
+
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(tidy(model) %>% mutate(equation = 'monthly') )
+ }) %>%
+
+ ungroup() %>%
+ #delete intercept
+ filter(!term %in% c("(Intercept)")) %>%
+ #add variable name and keep only numbers in month column
+ mutate(variable = variables[i],
+ term = readr::parse_number(term))
+
+
+ #---------------------------------------------------------
+
+ #store dataframe in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+MonthlyAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+######################
+## Seasonal drivers ##
+######################
+
+
+#Covariates
+###########
+
+#Variable length (leaf-out influenced):
+#--------------------------------------
+#Apm...Daily net photosynthesis (p-model)
+#Azani...Daily net photosynthesis (Zani model)
+#GSI...photoperiod-influenced growing-season index
+#GSIrad...radiation-influenced growing-season index
+#GDDday...daytime degree days
+#GDDnight...nighttime degree days
+#SWrad...Radiation sum
+
+#Fixed length:
+#-------------
+#Tday...mean daytime temperature
+#Tnight...mean daytime temperature
+
+
+#-------------------------------------------------------------
+
+
+## Define covariate groups
+seasons = c('LO.SOm30', 'LO.SO', 'LO.SOp30', 'LO.SOp60', 'LO.SE', 'SOm30.SE', 'SO.SE', 'SOp30.SE')
+solstice = c('solstice1', 'solstice2', 'solstice3', 'solstice4', 'solstice5', 'solstice6')
+
+covariates1 = paste(rep(variables, each=length(seasons)), seasons, sep = '.')
+covariates2 = paste(rep(variables, each=length(solstice)), solstice, sep = '.')
+covariates = c(covariates1,covariates2)
+
+#Check if all variables are in dataframe
+table(names(Pheno.df) %in% covariates)[2]/length(covariates)==1
+
+#-------------------------------------------------------------
+
+## Create List object to store results
+DataList = replicate(length(covariates), data.frame())
+names(DataList) = covariates
+i=1
+
+
+##############################################################################################################################################
+
+
+#Loop through covariates
+########################
+
+for (covariate in covariates){
+
+ #get variable name
+ variable = gsub("\\..*","", covariate)
+
+ #delete pixels with no photosynthesis for the respective period
+ if (variable %in% c("GPPstart","Azani","Apm"))
+ Pheno.df2 = Pheno.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(covariates[i])) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.df
+
+ #---------------------------------------------------------
+
+ #set equations
+ ##############
+
+
+ #univariate scaled
+ equation = as.formula(paste("scale(Senesc_DOY) ~ ", paste('scale(', covariate, ')', collapse="+"), collapse=""))
+
+
+ ##############################################################################################################################################
+
+
+ ##################
+ #Run linear models
+ ##################
+
+
+
+ ModelResults.df = Pheno.df2 %>%
+
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+
+ do({
+
+ #run models
+ ###########
+
+ model = lm(equation, data=.)
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(tidy(model) %>%
+ add_column(equation = paste0(ifelse(str_contains(covariate, c("solstice"), logic="or"),"Solstice","Seasonal"),
+ '.scaled') ) %>%
+ filter(term %in% paste0('scale(',covariate,')')) )#delete intercept
+
+ }) %>%
+
+ #add variable name
+ mutate(term = covariate,
+ variable = sub("\\..*", "", covariate))
+
+
+ ##############################################################################################################################################
+
+
+ #store dataframe in variable list
+ DataList[[i]] = ModelResults.df
+
+ print(paste0('..... ',i, ' out of ', length(covariates), ' done'))
+ i=i+1
+}
+
+#bind tables
+SeasonalAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########
+## Safe ##
+##########
+
+
+
+#bind full model, monthly and seasonal analyses
+Analysis.df = rbind(FullAnalysis.df, MonthlyAnalysis.df, SeasonalAnalysis.df)
+
+#Safe tables
+write.csv(Analysis.df, paste(output_path, "Spatial_effect_data.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## datetime
+Sys.time()
+#"2021-12-05 19:41:36 CET"
+
+
+## session info
+sessionInfo()
+#R version 4.1.0 (2021-05-18)
+#Platform: x86_64-apple-darwin17.0 (64-bit)
+#Running under: macOS Big Sur 11.2.3
+
+#Matrix products: default
+#LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+#locale:
+# [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+#attached base packages:
+# [1] stats graphics grDevices utils datasets methods base
+
+#other attached packages:
+# [1] sjmisc_2.8.7 broom_0.7.8 data.table_1.14.0 forcats_0.5.1 stringr_1.4.0 dplyr_1.0.7
+#[7] purrr_0.3.4 readr_1.4.0 tidyr_1.1.3 tibble_3.1.2 ggplot2_3.3.4 tidyverse_1.3.1
+
+#loaded via a namespace (and not attached):
+# [1] Rcpp_1.0.6 cellranger_1.1.0 pillar_1.6.1 compiler_4.1.0 dbplyr_2.1.1 tools_4.1.0 jsonlite_1.7.2
+#[8] lubridate_1.7.10 lifecycle_1.0.0 gtable_0.3.0 pkgconfig_2.0.3 rlang_0.4.11 reprex_2.0.0 cli_2.5.0
+#[15] rstudioapi_0.13 DBI_1.1.1 haven_2.4.1 xml2_1.3.2 withr_2.4.2 httr_1.4.2 fs_1.5.0
+#[22] generics_0.1.0 vctrs_0.3.8 hms_1.1.0 sjlabelled_1.1.8 grid_4.1.0 tidyselect_1.1.1 glue_1.4.2
+#[29] R6_2.5.0 fansi_0.5.0 readxl_1.3.1 modelr_0.1.8 magrittr_2.0.1 backports_1.2.1 scales_1.1.1
+#[36] ellipsis_0.3.2 insight_0.14.2 rvest_1.0.0 assertthat_0.2.1 colorspace_2.0-1 utf8_1.2.1 stringi_1.6.2
+#[43] munsell_0.5.0 crayon_1.4.1
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.3_Modeling/3.3.1_Spatial_models_RS_no_scaling.R b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.3_Modeling/3.3.1_Spatial_models_RS_no_scaling.R
new file mode 100644
index 0000000..e2425e1
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.3_Modeling/3.3.1_Spatial_models_RS_no_scaling.R
@@ -0,0 +1,474 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Linear models for the satellite data without scaling (EOS10) ##############################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(ggplot2)
+require(data.table)
+require(broom)
+require(sjmisc)
+
+
+
+#define plot themes
+plotTheme1 = theme(legend.position = "right",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+# paths
+Drivers_path = "Analysis_input/Drivers_final_EOS10/Merged_file"
+output_path = "Analysis_output_startSen/Data"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology data frame
+#####################
+
+Pheno.df <- fread(paste(Drivers_path, "Remote_sensing_drivers_data_startSen_preseason.csv", sep="/")) %>%
+ #transform GPP to gCm-2
+ mutate_at(c("GPPstart.LO.SO",
+ "GPPstart.SO.SE",
+ "GPPstart1",
+ "GPPstart2",
+ "GPPstart3",
+ "GPPstart4",
+ "GPPstart5",
+ "GPPstart6",
+ "GPPstart7",
+ "GPPstart8",
+ "GPPstart9",
+ "GPPstart10"),
+ function(x)(x*0.1))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+## VARIABLE EXPLANATION:
+########################
+
+#General
+########
+
+#geometry...site identifier
+#Year...observation year
+#Lat...site latitude (decimal degrees)
+#Lon...site longitude (decomal degrees)
+#alt...site altitude (m a.s.l.)
+
+#---------------------------------------------------
+
+#Phenology
+##########
+
+#Senesc_DOY...senescence date (DOY)
+
+#---------------------------------------------------
+
+#Day-of-year maximum temperature and radiation
+##############################################
+
+#HottestDOY...DOY with maximum annual temperature
+#MaxRadDOY...DOY with maximum irradiance
+
+#---------------------------------------------------
+
+#Seasonal drivers
+#################
+
+#SUMS (flexible start = leaf-out):
+#---------------------------------
+#Apm...Daily net photosynthesis p-model
+#Azani...Daily net photosynthesis Zani model
+#GSI...photoperiod-influenced growing-season index
+#GSIrad...radiation-influenced growing-season index
+#GDDday...daytime degree days
+#GDDnight...nighttime degree days
+#SWrad...Radiation sum
+
+#MEANS (fixed start = March equinox):
+#------------------------------------
+#Tday...mean daytime temperature
+#Tnight...mean nighttime temperature
+#Moist...mean soil moisture (10-40cm)
+#Prcp...precipitation sum
+
+#-----------------
+
+#PERIODS
+
+#seasonal
+#--------
+#LO.SOm30...leaf-out to 30 days before summer solstice
+#LO.SO...leaf-out to summer solstice
+#LO.SOp30...leaf-out to 30 days after solstice
+#LO.SOp60...leaf-out to 60 days after solstice
+#LO.SE...leaf-out to mean senescence
+#SOm30.SE...30 days before solstice to mean senescence
+#SO.SE...solstice to mean senescence
+#SOp30.SE...30 days after solstice to mean senescence
+#SOp60.SE...60 days after solstice to mean senescence
+
+#around summer solstice
+#----------------------
+#solstice1...40 to 10 days before solstice
+#solstice2...30 days before solstice
+#solstice3...20 days before until 10 days after solstice
+#solstice4...10 days before until 20 days after solstice
+#solstice5...30 days after solstice
+#solstice6...10 to 40 days after solstice
+
+#---------------------------------------------------
+
+#Monthly drivers
+################
+
+#Tnight1-12...mean of nighttime temperatures in January (1) to December (12)
+#Tday1-12...mean of daytime temperatures in January (1) to December (12)
+#GDDnight1-12...sum of nighttime degree-days in January (1) to December (12)
+#GDDday1-12...sum of daytime degree-days in January (1) to December (12)
+#SWrad1-12...mean of daily short-wave radiation in January (1) to December (12)
+#Moist1-12...mean of daily soil moisture (10-40cm) in January (1) to December (12)
+#Prcp1-12...sum of daily precipitation in January (1) to December (12)
+#Apm1-12...sum of daily gross photosynthesis in January (1) to December (12)
+#Azani1-12...sum of daily net photosynthesis in January (1) to December (12)
+#GSI...day length-influenced growing-season index
+#GSIrad...radiation-influenced growing-season index
+
+#---------------------------------------------------
+
+#Preseason temperatures
+#######################
+
+#Tday...time series-specific best preseason (R2-based) for daytime temperatures
+#tnight...time series-specific best preseason (R2-based) for nighttime temperatures
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Full models ##
+#################
+
+
+
+#Define variables
+variables = c('GPPstart', 'Tday')
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+##############################################################################################################################################
+
+
+#Loop through variables
+#######################
+
+for (i in 1:length(variables)){
+
+ #delete pixels with no photosynthesis before solstice
+ if (variables[i] %in% c('GPPstart'))
+ Pheno.df2 = Pheno.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(paste0(variables[i],".LO.SO"))) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.df
+
+
+ #set equations
+ ##############
+
+ #define variable names
+ covariates = paste0(variables[i], c('.LO.SO','.SO.SE'))
+
+
+ #full models
+ equation.1 = as.formula(paste("Senesc_DOY ~ ", paste0(covariates[1], '+', covariates[2],
+ collapse="+"),
+ '+ Prcp.LO.SO + Prcp.SO.SE + CO2', collapse=""))
+
+ equation.2 = as.formula(paste("Senesc_DOY ~ ", paste0(covariates[1], '+', covariates[2],
+ collapse="+")))
+
+
+ ##############################################################################################################################################
+
+
+ ##############
+ #linear models
+ ##############
+
+
+ ModelResults.df = Pheno.df2 %>%
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+ do({
+
+ #run model
+ ##########
+
+ model1 = lm(equation.1, data=.)
+ model2 = lm(equation.2, data=.)
+
+ #create combined data frame
+ ###########################
+
+ data.frame(rbind(
+
+ #Equation 1
+ tidy(model1) %>% mutate(equation = 'full model 1'), #add model name
+
+ #Equation 2
+ tidy(model2) %>% mutate(equation = 'full model 2')
+
+ ))
+ }) %>%
+
+ #add variable name
+ mutate(variable = variables[i]) %>%
+ #delete intercept
+ filter(!term %in% c("(Intercept)")) %>%
+ ungroup()
+
+
+ ##############################################################################################################################################
+
+
+ #store data frame in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+FullAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################
+## Monthly correlations ##
+##########################
+
+
+
+#Get sums for January to April photosynthesis parameters
+Pheno.monthly.df = Pheno.df %>%
+ mutate(GPPstart4 = rowSums(dplyr::select(.,c("GPPstart1","GPPstart2","GPPstart3","GPPstart4"))))
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+##############################################################################################################################################
+
+
+#Loop through covariate groups
+##############################
+
+
+for (i in 1:length(variables)){
+
+ #delete pixels with no photosynthesis before solstice
+ #####################################################
+
+ if (variables[i] %in% c("GPPstart"))
+ Pheno.df2 = Pheno.monthly.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(paste0(variables[i],"4"))) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.monthly.df
+
+ #create explanatory variables
+ #############################
+
+ covariates.monthly = paste0(variables[i], c(1:9))
+
+ #---------------------------------------------------------
+
+ #set equations
+ ##############
+
+ if(variables[i] %in% c('GPPstart')) {
+ equation = as.formula(paste("Senesc_DOY ~ ", paste(covariates.monthly[4:9], collapse="+"),
+ collapse=""))
+ } else {
+ equation = as.formula(paste("Senesc_DOY ~ ", paste(covariates.monthly[3:9], collapse="+"),
+ collapse=""))
+ }
+
+ #---------------------------------------------------------
+
+ ###############
+ # Linear models
+ ###############
+
+ ModelResults.df = Pheno.df2 %>%
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+ do({
+
+ #run models
+ ###########
+
+ model = lm(equation, data=.)
+
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(tidy(model) %>% mutate(equation = 'monthly') )
+ }) %>%
+
+ ungroup() %>%
+ #delete intercept
+ filter(!term %in% c("(Intercept)")) %>%
+ #add variable name and keep only numbers in month column
+ mutate(variable = variables[i],
+ term = readr::parse_number(term))
+
+
+ #---------------------------------------------------------
+
+ #store dataframe in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+MonthlyAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+##########
+## Safe ##
+##########
+
+
+
+#bind full model, monthly and seasonal analyses
+Analysis.df = rbind(FullAnalysis.df, MonthlyAnalysis.df)
+
+#Safe tables
+write.csv(Analysis.df, paste(output_path, "Spatial_effect_data_no_scaling.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## datetime
+Sys.time()
+#"2021-12-05 19:41:36 CET"
+
+
+## session info
+sessionInfo()
+#R version 4.1.0 (2021-05-18)
+#Platform: x86_64-apple-darwin17.0 (64-bit)
+#Running under: macOS Big Sur 11.2.3
+
+#Matrix products: default
+#LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+#locale:
+# [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+#attached base packages:
+# [1] stats graphics grDevices utils datasets methods base
+
+#other attached packages:
+# [1] sjmisc_2.8.7 broom_0.7.8 data.table_1.14.0 forcats_0.5.1 stringr_1.4.0 dplyr_1.0.7
+#[7] purrr_0.3.4 readr_1.4.0 tidyr_1.1.3 tibble_3.1.2 ggplot2_3.3.4 tidyverse_1.3.1
+
+#loaded via a namespace (and not attached):
+# [1] Rcpp_1.0.6 cellranger_1.1.0 pillar_1.6.1 compiler_4.1.0 dbplyr_2.1.1 tools_4.1.0 jsonlite_1.7.2
+#[8] lubridate_1.7.10 lifecycle_1.0.0 gtable_0.3.0 pkgconfig_2.0.3 rlang_0.4.11 reprex_2.0.0 cli_2.5.0
+#[15] rstudioapi_0.13 DBI_1.1.1 haven_2.4.1 xml2_1.3.2 withr_2.4.2 httr_1.4.2 fs_1.5.0
+#[22] generics_0.1.0 vctrs_0.3.8 hms_1.1.0 sjlabelled_1.1.8 grid_4.1.0 tidyselect_1.1.1 glue_1.4.2
+#[29] R6_2.5.0 fansi_0.5.0 readxl_1.3.1 modelr_0.1.8 magrittr_2.0.1 backports_1.2.1 scales_1.1.1
+#[36] ellipsis_0.3.2 insight_0.14.2 rvest_1.0.0 assertthat_0.2.1 colorspace_2.0-1 utf8_1.2.1 stringi_1.6.2
+#[43] munsell_0.5.0 crayon_1.4.1
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.3_Modeling/3.3.2_Model_comparison.R b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.3_Modeling/3.3.2_Model_comparison.R
new file mode 100644
index 0000000..79972a6
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.3_Modeling/3.3.2_Model_comparison.R
@@ -0,0 +1,212 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Univariate pre-/post-solstice models (EOS10) ##############################################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(data.table)
+require(broom)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+# paths
+drivers_path = "Analysis_input/Drivers_final_EOS10/Merged_file"
+output_path = "Analysis_output_startSen/Data"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology dataframe
+####################
+
+Pheno.df <- fread(paste(drivers_path, "Remote_sensing_drivers_data_startSen_preseason.csv", sep="/")) %>%
+ #delete pixels with no photosynthesis before solstice
+ group_by(geometry) %>%
+ filter(!(mean(GPPstart.LO.SO)<.1)) %>%
+ ungroup()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#######################################
+## Timeseries-level model assessment ##
+#######################################
+
+
+
+#variable vector
+variables=c("GPPstart","Tday","SWrad","Moist","Greenup_DOY")
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+#Loop through variables
+#######################
+
+for (i in 1:length(variables)){
+
+ #define variable names
+ if (variables[i] == "Greenup_DOY") {
+ covariates = c('Greenup_DOY','CO2')
+ } else {covariates = paste0(variables[i], c('.LO.SO','.SO.SE')) }
+
+
+ #set equations
+ ##############
+
+ equation.pre = as.formula(paste("Senesc_DOY ~ ", paste0(covariates[1])))
+ equation.post = as.formula(paste("Senesc_DOY ~ ", paste0(covariates[2])))
+
+ #---------------------------------------------------------
+
+ ###############
+ #Get model info
+ ###############
+
+ ModelResults.df = Pheno.df %>%
+ group_by(LC_Type, geometry)%>%
+ do({
+
+ #run models
+ ###########
+
+ modelPre = lm(equation.pre, data=.)
+ modelPost = lm(equation.post, data=.)
+
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(rbind(
+
+ #Equation pre-solstice
+ glance(modelPre) %>%
+ mutate(model='pre'),
+
+ #Equation post-solstice
+ glance(modelPost) %>%
+ mutate(model='post') ) )
+ })%>%
+ mutate(variable = variables[i]) %>%
+ ungroup()
+
+ #---------------------------------------------------------
+
+ #store dataframe in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+Analysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########
+## Safe ##
+##########
+
+
+
+write.csv(Analysis.df, paste(output_path, "Model_R2_data.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+## datetime
+Sys.time()
+#"2021-12-05 20:06:47 CET"
+
+## session info
+sessionInfo()
+#R version 4.1.0 (2021-05-18)
+#Platform: x86_64-apple-darwin17.0 (64-bit)
+#Running under: macOS Big Sur 11.2.3
+
+#Matrix products: default
+#LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+#locale:
+# [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+#attached base packages:
+# [1] stats graphics grDevices utils datasets methods base
+
+#other attached packages:
+# [1] broom_0.7.8 data.table_1.14.0 forcats_0.5.1 stringr_1.4.0 dplyr_1.0.7 purrr_0.3.4
+#[7] readr_1.4.0 tidyr_1.1.3 tibble_3.1.2 ggplot2_3.3.4 tidyverse_1.3.1
+
+#loaded via a namespace (and not attached):
+# [1] Rcpp_1.0.6 cellranger_1.1.0 pillar_1.6.1 compiler_4.1.0 dbplyr_2.1.1 tools_4.1.0 jsonlite_1.7.2
+#[8] lubridate_1.7.10 lifecycle_1.0.0 gtable_0.3.0 pkgconfig_2.0.3 rlang_0.4.11 reprex_2.0.0 cli_2.5.0
+#[15] rstudioapi_0.13 DBI_1.1.1 haven_2.4.1 xml2_1.3.2 withr_2.4.2 httr_1.4.2 gtools_3.9.2
+#[22] fs_1.5.0 generics_0.1.0 vctrs_0.3.8 hms_1.1.0 grid_4.1.0 tidyselect_1.1.1 glue_1.4.2
+#[29] R6_2.5.0 fansi_0.5.0 readxl_1.3.1 gdata_2.18.0 modelr_0.1.8 magrittr_2.0.1 MASS_7.3-54
+#[36] gmodels_2.18.1 backports_1.2.1 scales_1.1.1 ellipsis_0.3.2 rvest_1.0.0 assertthat_0.2.1 colorspace_2.0-1
+#[43] utf8_1.2.1 stringi_1.6.2 munsell_0.5.0 crayon_1.4.1
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.3_Modeling/3.3.2_Model_comparison_CV.R b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.3_Modeling/3.3.2_Model_comparison_CV.R
new file mode 100644
index 0000000..4291768
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.3_Modeling/3.3.2_Model_comparison_CV.R
@@ -0,0 +1,214 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Multivariate pre-/post-solstice models (EOS10) - Leave-one-out cross validation ###########################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(data.table)
+require(broom)
+require(caret)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+# paths
+drivers_path = "Analysis_input/Drivers_final_EOS10/Merged_file"
+output_path = "Analysis_output_startSen/Data"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology dataframe
+####################
+
+Pheno.df <- fread(paste(drivers_path, "Remote_sensing_drivers_data_startSen_preseason.csv", sep="/")) %>%
+ #delete pixels with no photosynthesis before solstice
+ group_by(geometry) %>%
+ filter(!(mean(GPPstart.LO.SO)<.1)) %>%
+ ungroup()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#######################################
+## Timeseries-level model assessment ##
+#######################################
+
+
+
+#set equations
+##############
+
+equation.full = as.formula("Senesc_DOY ~ GPPstart.LO.SO + Tday.LO.SO + SWrad.LO.SO + Moist.LO.SO + Greenup_DOY +
+ GPPstart.SO.SE + Tday.SO.SE + SWrad.SO.SE + Moist.SO.SE")
+equation.pre = as.formula("Senesc_DOY ~ GPPstart.LO.SO + Tday.LO.SO + SWrad.LO.SO + Moist.LO.SO + Greenup_DOY")
+equation.post = as.formula("Senesc_DOY ~ GPPstart.SO.SE + Tday.SO.SE + SWrad.SO.SE + Moist.SO.SE")
+
+#---------------------------------------------------------
+
+###############
+#Get model info
+###############
+
+ModelResults.df = Pheno.df %>%
+ group_by(LC_Type, geometry)%>%
+ do({
+
+ #run models
+ ###########
+
+ modelFull = lm(equation.full, data=.)
+ modelPre = lm(equation.pre, data=.)
+ modelPost = lm(equation.post, data=.)
+
+ CVmodelFull <- train(
+ equation.full, ., method = "lm",
+ trControl = trainControl(method = "LOOCV") )
+
+ CVmodelPre <- train(
+ equation.pre, ., method = "lm",
+ trControl = trainControl(method = "LOOCV") )
+
+ CVmodelPost <- train(
+ equation.post, ., method = "lm",
+ trControl = trainControl(method = "LOOCV") )
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(rbind(
+
+ #Equation full
+ glance(modelFull) %>%
+ mutate(model = 'full',
+ CV.R2 = as.numeric(CVmodelFull[4]$results[3])),
+
+ #Equation pre-solstice
+ glance(modelPre) %>%
+ mutate(model = 'pre',
+ CV.R2 = as.numeric(CVmodelPre[4]$results[3])),
+
+ #Equation post-solstice
+ glance(modelPost) %>%
+ mutate(model ='post',
+ CV.R2 = as.numeric(CVmodelPost[4]$results[3]))
+ ) )
+ })%>%
+ mutate(CV.R2 = ifelse(CV.R2 > r.squared, r.squared, CV.R2)) %>%
+ ungroup()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########
+## Safe ##
+##########
+
+
+
+write.csv(ModelResults.df, paste(output_path, "Model_R2_CV_data.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+## datetime
+Sys.time()
+#"2022-06-22 15:05:11 CEST"
+
+## session info
+sessionInfo()
+#R version 4.1.0 (2021-05-18)
+#Platform: x86_64-apple-darwin17.0 (64-bit)
+#Running under: macOS Big Sur 11.6.2
+
+#Matrix products: default
+#LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+#locale:
+# [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+#attached base packages:
+# [1] stats graphics grDevices utils datasets methods base
+
+#other attached packages:
+# [1] caret_6.0-92 lattice_0.20-44 broom_0.7.8 data.table_1.14.0 forcats_0.5.1 stringr_1.4.0
+#[7] dplyr_1.0.8 purrr_0.3.4 readr_1.4.0 tidyr_1.2.0 tibble_3.1.7 ggplot2_3.3.4
+#[13] tidyverse_1.3.1
+
+#loaded via a namespace (and not attached):
+# [1] httr_1.4.2 jsonlite_1.7.3 splines_4.1.0 foreach_1.5.2 prodlim_2019.11.13
+#[6] modelr_0.1.8 assertthat_0.2.1 stats4_4.1.0 cellranger_1.1.0 yaml_2.2.2
+#[11] globals_0.15.0 ipred_0.9-13 pillar_1.7.0 backports_1.2.1 glue_1.6.2
+#[16] pROC_1.18.0 digest_0.6.29 rvest_1.0.2 hardhat_1.1.0 colorspace_2.0-2
+#[21] recipes_0.2.0 htmltools_0.5.2 Matrix_1.3-3 plyr_1.8.6 timeDate_3043.102
+#[26] pkgconfig_2.0.3 listenv_0.8.0 haven_2.4.1 scales_1.1.1 gower_1.0.0
+#[31] lava_1.6.10 generics_0.1.2 ellipsis_0.3.2 withr_2.4.3 nnet_7.3-16
+#[36] cli_3.2.0 survival_3.2-11 magrittr_2.0.2 crayon_1.5.0 readxl_1.3.1
+#[41] evaluate_0.14 parallelly_1.32.0 fs_1.5.2 fansi_1.0.2 future_1.26.1
+#[46] nlme_3.1-152 MASS_7.3-54 xml2_1.3.3 class_7.3-19 tools_4.1.0
+#[51] hms_1.1.0 lifecycle_1.0.1 munsell_0.5.0 reprex_2.0.0 compiler_4.1.0
+#[56] rlang_1.0.2 grid_4.1.0 iterators_1.0.14 rstudioapi_0.13 rmarkdown_2.9
+#[61] ModelMetrics_1.2.2.2 gtable_0.3.0 codetools_0.2-18 DBI_1.1.2 reshape2_1.4.4
+#[66] R6_2.5.1 lubridate_1.7.10 knitr_1.33 fastmap_1.1.0 future.apply_1.9.0
+#[71] utf8_1.2.2 stringi_1.7.6 parallel_4.1.0 Rcpp_1.0.8 vctrs_0.4.1
+#[76] rpart_4.1-15 dbplyr_2.1.1 tidyselect_1.1.1 xfun_0.24
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.1_Mapping_EOS10.Rmd b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.1_Mapping_EOS10.Rmd
new file mode 100644
index 0000000..92bfe72
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.1_Mapping_EOS10.Rmd
@@ -0,0 +1,980 @@
+---
+title: Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice
+author: Constantin Zohner
+date: "last updated March 31, 2023"
+
+subtitle: Satellite-derived EOS10 data (Figs. 2, 3, S1, and S11)
+output:
+ html_document:
+ highlight: haddock
+ toc: false
+ use_bookdown: true
+ df_print: paged
+---
+
+
+
+
+
+### Figure descriptions
+- Fig. 2: Effect of temperature on the timing of autumn senescence in northern forests reverses after the summer solstice
+- Fig. 3: Satellite observations reveal consistent advances in the onset of senescence (EOS10) across northern forests in response to enhanced pre-solstice temperature
+- Fig. S1: Satellite observations reveal consistent advances in the onset of senescence (EOS10) across northern forests in response to enhanced pre-solstice vegetation activity (same as Fig. 3 but using gross primary productivity [GPP] as predictor variable)
+- Fig. S11: Relationships between seasonal day-time temperature (Tday) and the timing of senescence onset (EOS10) within mixed, deciduous broadleaf, deciduous needleleaf, and evergreen needleleaf forests in North America and Eurasia
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(
+ class.source = "numberLines lineAnchors"
+ )
+```
+
+
+
+```{r, message=FALSE, warning=FALSE, attr.source='.numberLines'}
+###################
+# Required packages
+###################
+
+
+
+require(tidyverse)
+require(data.table)
+require(ggplot2)
+require(patchwork)
+require(gmodels)
+require(wesanderson)
+require(pracma)
+require(lme4)
+require(effects) #plot effects
+require(remef)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+
+# Paths
+
+#input
+Drivers_path = "Analysis_input/Drivers_final_EOS10/Merged_file"
+Analysis_path = "Analysis_output_startSen/Data"
+photo_path = "Analysis_input/Drivers" #Photoperiod file
+
+#output
+output_path = "Analysis_output_startSen/Maps"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Spatial (pixel-level) models
+#############################
+
+#scaled
+Analysis.df = fread(paste(Analysis_path, "Spatial_effect_data.csv", sep="/")) %>%
+ mutate(continent = ifelse(Lon < -30, "North America", "Eurasia"),
+ LC_Type = paste(LC_Type, continent, sep="_"))
+
+#unscaled
+AnalysisNoScaling.df = fread(paste(Analysis_path, "Spatial_effect_data_no_scaling.csv", sep="/")) %>%
+ mutate(continent = ifelse(Lon < -30, "North America", "Eurasia"),
+ LC_Type = paste(LC_Type, continent, sep="_"))
+#geometry: unique pixel identifier
+#Lat: Latitude
+#Lon: Longitude
+#LC_type: All, DecB, DecN, EvgN, Mixed (Landcover type)
+#term: monthly coefficients (1-10) and seasonal coefficients
+#estimate: slopes or standardized coefficients of mixed effects models
+#std.error: std.error of coefficients
+#statistic:
+#equation: full model 1/2, monthly/seasonal/solstice, scaled/unscaled, tempCon (Tday controlled)
+#variable: climate variable (LAI, GPP, Apm, Azani, Tday, Tnight, SWrad)
+
+
+# get full model correlations
+#############################
+
+FullModel.df = Analysis.df %>%
+ filter(equation == "full model 1")
+
+ReducedModel.df = AnalysisNoScaling.df %>%
+ filter(equation == "full model 2")
+
+
+#-------------------------------------------------------------------------------------------------------
+
+
+# get monthly correlations
+##########################
+
+#Summarize all pixels
+MonthlyAnalysisAll.df = Analysis.df %>%
+ filter(equation == "monthly") %>%
+ group_by(term, variable) %>%
+ summarise(mean = gmodels::ci(estimate)[1],
+ lowCI = gmodels::ci(estimate)[2],
+ hiCI = gmodels::ci(estimate)[3],
+ lowSD = mean-sd(estimate),
+ hiSD = mean+sd(estimate)) %>%
+ mutate(LC_Type = "All") %>%
+ ungroup()
+
+#Summarize by vegetation type
+MonthlyAnalysisLCtype.df = Analysis.df %>%
+ filter(equation == "monthly") %>%
+ group_by(term, variable, LC_Type) %>%
+ summarise(mean = gmodels::ci(estimate)[1],
+ lowCI = gmodels::ci(estimate)[2],
+ hiCI = gmodels::ci(estimate)[3],
+ lowSD = mean-sd(estimate),
+ hiSD = mean+sd(estimate)) %>%
+ ungroup()
+
+#Rbind
+MonthlyAnalysis.df = rbind(MonthlyAnalysisAll.df, MonthlyAnalysisLCtype.df) %>%
+ #Add variable x equation identifier
+ mutate(variable.type = paste(variable, LC_Type, sep='.'),
+ term = as.numeric(term),
+ LC_Type = factor(LC_Type, levels = c("All",
+ "Mixed_North America", "Mixed_Eurasia",
+ "DecB_North America", "DecB_Eurasia",
+ "EvgN_North America", "EvgN_Eurasia",
+ "DecN_Eurasia"))
+ )
+
+
+#-------------------------------------------------------------------------------------------------------
+
+
+# get seasonal correlations
+###########################
+
+SeasonalModel.df = Analysis.df %>%
+ filter(equation == "Solstice.scaled") %>%
+ #Add variable class identifier
+ mutate(variable.class = gsub("^.*?\\.","", term) )
+
+
+##############################################################################################################################################
+
+
+#Phenology data
+###############
+
+Pheno.df = fread(paste(Drivers_path, "Remote_sensing_drivers_data_startSen_preseason.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+################
+## Plot theme ##
+################
+
+
+#Color.palette: col=c('#F21A00','#E1AF00','#EBCC2A','#78B7C5','#3B9AB2')
+
+plotTheme1 = theme(
+ legend.position = "none",
+ legend.background = element_blank(),
+ legend.text = element_text(color="black"),
+ legend.title = element_blank(),
+ legend.key = element_blank(),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(hjust = 0.5))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+######################
+# Photoperiod figure #
+######################
+
+
+#get mean leaf-out and senescence dates
+leaf_out = as.Date(mean(Pheno.df$Greenup_DOY), origin = "2016-12-31")
+leaf_off = as.Date(mean(Pheno.df$Senesc_DOY), origin = "2016-12-31")
+
+# dataframe of photoperiods
+photo.df = fread(paste(photo_path, "Photoperiod.csv", sep="/"))
+phot.sub = photo.df[475,3:367]
+phot.sub = rbind(as.data.frame(t(phot.sub)), as.data.frame(t(phot.sub)))
+phot.sub$X = as.Date(1:nrow(phot.sub), origin = "2016-12-31")
+
+
+# Plot of periods around solstice
+#################################
+
+#dataframe of periods
+solstice.data = rbind(
+ data.frame(X=as.Date(c("2017-05-14","2017-06-12")), Y=10, season = "A"),
+ data.frame(X=as.Date(c("2017-05-24","2017-06-22")), Y=11, season = "B"),
+ data.frame(X=as.Date(c("2017-06-02","2017-07-01")), Y=12, season = "C"),
+ data.frame(X=as.Date(c("2017-06-12","2017-07-11")), Y=13, season = "D"),
+ data.frame(X=as.Date(c("2017-06-22","2017-07-21")), Y=14, season = "E"),
+ data.frame(X=as.Date(c("2017-07-03","2017-08-01")), Y=15, season = "F") )
+
+#Plot
+PhotoSolstice = ggplot() +
+ #day length line
+ geom_line(data=phot.sub, aes(x=X, y=V1, group=1),col="black") +
+ #solstice
+ geom_vline(xintercept = as.Date("2017-06-22"), size=1, alpha=0.4)+
+ #periods
+ geom_line(data=solstice.data, aes(x=X, y=Y, color=season), size=2.75)+
+ scale_color_manual(values = rev(wes_palette(6, name = "Zissou1", type = "continuous")))+
+ #plot settings
+ coord_cartesian(xlim=c(as.Date(c('2017-03-01','2017-10-31'))), ylim=c(10,16))+
+ ylab("Day length")+xlab("")+
+ scale_x_date(position = "top") +
+ plotTheme1+
+ theme(plot.background = element_rect(fill = "transparent", color = NA),
+ panel.background = element_rect(fill = "white"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################################
+## Interpolation of monthly estimates ##
+########################################
+
+
+
+#Interpolation function
+lin_interp = function(x, y, length.out=100) {
+ approx(x, y, xout=seq(min(x), max(x), length.out=length.out))$y
+}
+
+#create identifier
+variable.type = unique(MonthlyAnalysis.df$variable.type)
+
+#create interpolation dataframe
+df.interp = data.frame()
+df.AUC = data.frame()
+
+#loop over variable x equation x vegetation type vector
+for (variable.name in variable.type){
+
+ #subset table
+ df.sub = MonthlyAnalysis.df %>%
+ filter(variable.type == variable.name)
+
+ # Interpolate data
+ created.interp = lin_interp(df.sub$term, df.sub$term)
+ score.interp = lin_interp(df.sub$term, df.sub$mean)
+ df.interp.sub = data.frame(created=created.interp, score=score.interp)
+ # Make a grouping variable for each pos/neg segment
+ cat.rle = rle(df.interp.sub$score < 0)
+ df.interp.sub = df.interp.sub %>%
+ mutate(group = rep.int(1:length(cat.rle$lengths), times=cat.rle$lengths),
+ LC_Type = unique(df.sub$LC_Type),
+ variable = unique(df.sub$variable) )
+ #rbind sub dataframes
+ df.interp = rbind(df.interp, df.interp.sub)
+
+ #get Area under curve (%)
+ df.AUC.sub = df.interp.sub %>%
+ mutate(positive = ifelse(score<0, 0, score),
+ negative = ifelse(score>0, 0, score))%>%
+ summarise(sum.pos = trapz(created, positive),
+ sum.neg = abs(trapz(created, negative)))%>%
+ mutate(percent.neg = round(sum.neg/(sum.pos+sum.neg)*100),
+ percent.pos = round(sum.pos/(sum.pos+sum.neg)*100),
+ LC_Type = unique(df.sub$LC_Type),
+ variable = unique(df.sub$variable) )
+ #rbind sub dataframes
+ df.AUC = rbind(df.AUC, df.AUC.sub)
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+# Mixed effects models #
+########################
+
+
+
+#Prepare data
+#############
+
+#delete outlier values
+PhenoMixed.df <- Pheno.df %>%
+ filter(GPPstart.LO.SO < quantile(.$GPPstart.LO.SO, 0.999),
+ GPPstart.LO.SO > quantile(.$GPPstart.LO.SO, 0.01))
+
+#get year mean
+YearMean = mean(PhenoMixed.df$Year)
+
+#transform units and center year variable
+PhenoMixed.df <- PhenoMixed.df %>%
+ mutate(GPP.LO.SO = GPP.LO.SO*0.1,
+ GPPstart.LO.SO = GPPstart.LO.SO*0.1,
+ Year = Year - mean(Year)) %>%
+ #delete pixels with less than 15 years
+ group_by(geometry) %>%
+ filter(n() >= 15) %>%
+ ungroup()
+
+
+###############################################################
+#get advance in EOS10 per each 10% increase in pre-solstice GPP
+###############################################################
+
+coefficients = coef(summary(lmer(Senesc_DOY ~ GPPstart.LO.SO + (1 | geometry), data=PhenoMixed.df,
+ na.action = "na.exclude", control = lmerControl(optimizer ="Nelder_Mead"))))[2,1:2]
+
+#relative to overall variation
+coefficients * (max(PhenoMixed.df$GPPstart.LO.SO)-min(PhenoMixed.df$GPPstart.LO.SO))/10
+#Estimate Std. Error
+#-3.61006119 0.02665164
+
+
+##############################################################################################################################################
+
+
+# Models
+########
+
+#list variables to loop through
+#variables = unique(Analysis.df$variable)
+variables = c("Tday","GPPstart")
+
+#create List object to store results
+DataList1 = replicate(length(variables), data.frame())
+DataList2 = replicate(length(variables), data.frame())
+DataList3 = replicate(length(variables), data.frame())
+names(DataList1) = variables
+names(DataList2) = variables
+names(DataList3) = variables
+
+##############################################################################################################################################
+
+
+#Loop through variables
+#######################
+
+for (i in 1:length(variables)){
+
+ #extract variables
+ Year = as.numeric(PhenoMixed.df$Year)
+ Pre.solstice = as.numeric(PhenoMixed.df %>% pull(paste0(variables[i],".LO.SO")))
+ Senesc_DOY = as.numeric(PhenoMixed.df$Senesc_DOY)
+ geometry = PhenoMixed.df$geometry
+
+
+ #Multivariate
+ fit_multi = lmer(Senesc_DOY ~ Pre.solstice + Year + (1 | geometry),
+ na.action = "na.exclude", control = lmerControl(optimizer ="Nelder_Mead"))
+
+ #year-only
+ fit_year = lmer(Senesc_DOY ~ Year + (1 | geometry),
+ na.action = "na.exclude", control = lmerControl(optimizer ="Nelder_Mead"))
+
+ # Extract information for plotting
+ plotMulti = allEffects(fit_multi)
+ plotYear = allEffects(fit_year)
+
+ # Extract coefficients
+ df.coefficients = tibble(Coefficient = coef(summary(fit_multi))[ , "Estimate"][2:3],
+ variable = c(paste0(variables[i]),"Year"),
+ class = paste0(variables[i])) %>%
+ bind_rows(tibble(Coefficient = coef(summary(fit_year))[ , "Estimate"][2],
+ variable = c("Year"),
+ class = "Univariate"))
+
+ # Final table
+ df <- tibble(upper = plotYear$Year$upper[,1],
+ lower = plotYear$Year$lower[,1],
+ off = plotYear$Year$fit[,1],
+ xval = plotYear$Year$x[,1],
+ class = "Univariate",
+ variable = "Year") %>%
+ #Multi
+ bind_rows(
+ tibble(upper = plotMulti$Year$upper[,1],
+ lower = plotMulti$Year$lower[,1],
+ off = plotMulti$Year$fit[,1],
+ xval = plotMulti$Year$x[,1],
+ class = paste0(variables[i]),
+ variable = "Year")
+ )%>%
+ bind_rows(
+ tibble(upper = plotMulti$Pre.solstice$upper[,1],
+ lower = plotMulti$Pre.solstice$lower[,1],
+ off = plotMulti$Pre.solstice$fit[,1],
+ xval = plotMulti$Pre.solstice$x[,1],
+ class = paste0(variables[i]),
+ variable = paste0(variables[i]))
+ )
+
+
+ # get phenology anomalies
+ df = df %>%
+ group_by(class, variable) %>%
+ mutate(anomaly = off - mean(off),
+ anomaly.upper = upper - mean(off),
+ anomaly.lower = lower - mean(off)) %>%
+ ungroup()
+
+ ##############################################################################################################################################
+
+ # get partial Senescence dates, removing effect of year (fixed) and site (random)
+ y_partial = remef(fit_multi, fix="Year", ran="all", keep.intercept = T)
+
+ # Create table
+ df.fitted = tibble(fitted = y_partial,
+ x = Pre.solstice,
+ variable = variables[i])
+
+ ##############################################################################################################################################
+
+ #store data frame in variable list
+ DataList1[[i]] = df
+ DataList2[[i]] = df.coefficients
+ DataList3[[i]] = df.fitted
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+MixedModel.df = bind_rows(DataList1)
+coefficients.df = bind_rows(DataList2)
+fitted.df = bind_rows(DataList3)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##############
+# Map figure #
+##############
+
+
+
+#start loop
+for(variable.name in variables) {
+
+ #subset and reshape data
+ Analysis.df.sub2 = ReducedModel.df %>%
+ filter(variable == variable.name,
+ term %in% c(paste0(variable.name,'.SO.SE'),paste0(variable.name,'.LO.SO'))) %>%
+ mutate(term = factor(term, levels=c(paste0(variable.name,".SO.SE"),
+ paste0(variable.name,".LO.SO") ), ordered=T),
+ positive = ifelse(estimate>0,1,0),
+ negative = ifelse(estimate<0,1,0),
+ positive.sign = ifelse(estimate>0 & p.value<0.05,1,0),
+ negative.sign = ifelse(estimate<0 & p.value<0.05,1,0))
+
+
+ ##############################################################################################################################################
+
+
+ ###########
+ # Histogram
+ ###########
+
+ #create summary info
+ VariablesVector = c("estimate","p.value","positive","negative","positive.sign","negative.sign")
+ data1 = Analysis.df.sub2 %>%
+ group_by(term) %>%
+ summarize_at(VariablesVector, mean, na.rm = TRUE)
+
+ if(variable.name %in% c('GPPstart')){
+ xRange=c(-0.15,0.15)
+ yRange=c(-.08,.08)
+ binw = 0.0018} else {
+ xRange=c(-6,6)
+ yRange=c(-3.5,3.5)
+ binw = .06}
+
+ #Plot
+ HistoPlot = ggplot(Analysis.df.sub2, aes(x=estimate, fill=term, alpha=term)) +
+ geom_histogram(binwidth=binw, position="identity") +
+ geom_vline(xintercept=0, colour="black") +
+ scale_fill_manual(values = c('black','#F21A00'))+
+ scale_alpha_discrete(range = c(0.5, 0.8))+
+ #add pre-solstice text
+ geom_text(data = data1[data1$term==paste0(variable.name,".LO.SO"),],
+ mapping = aes(x = -Inf, y = Inf, hjust = -0.1, vjust = 1.5,
+ label = paste(variable.name, " pre:\nMean = ",round(estimate,2), "\n",
+ round(negative*100), "% (", round(negative.sign*100), '%)', sep="")),
+ size=3.5, color='#F21A00')+
+ #add post-solstice text
+ geom_text(data = data1[data1$term==paste0(variable.name,".SO.SE"),],
+ mapping = aes(x = Inf, y = Inf, hjust = 1.1, vjust = 1.5,
+ label = paste(variable.name, " post:\nMean = ",round(estimate,2), "\n",
+ round(positive*100), "% (", round(positive.sign*100), '%)', sep="")),
+ size=3.5, color='black')+
+ xlab("days per unit") +
+ ylab("Count (number of pixels)") +
+ coord_cartesian(xlim = xRange, ylim = c(12, 270))+
+ plotTheme1
+
+
+ ##############################################################################################################################################
+
+
+ ###################
+ # Latitudinal plots
+ ###################
+
+
+ LatPlot = Analysis.df.sub2 %>%
+ mutate(LatRound = round(Lat)) %>%
+ group_by(term, LatRound) %>%
+ summarise(mean = ci(estimate)[1],
+ lowCI = ci(estimate)[2],
+ highCI = ci(estimate)[3]) %>%
+ ggplot(aes(x = LatRound, y= mean, group=term, color=term, group=term, alpha=term)) +
+ geom_ribbon(aes(ymin=lowCI, ymax=highCI, fill=term), color=NA)+
+ geom_line()+
+ geom_hline(yintercept=0)+
+ scale_color_manual(values = c('black','#F21A00'))+
+ scale_fill_manual(values = c('black','#F21A00'))+
+ scale_alpha_discrete(range = c(0.3, 0.8))+
+ ylab("days per unit") +
+ coord_flip(ylim = yRange, xlim=c(27,75))+
+ plotTheme1 +
+ theme(axis.text.y = element_blank(),
+ axis.title.y = element_blank())
+
+
+ ##############################################################################################################################################
+
+
+ #########
+ # Mapping
+ #########
+
+ #subset and reshape data
+ Analysis.df.sub3 = ReducedModel.df %>%
+ filter(variable == variable.name,
+ term %in% c(paste0(variable.name,'.SO.SE'),paste0(variable.name,'.LO.SO'))) %>%
+ mutate(estimate = if(variable.name == "GPPstart"){ifelse(estimate>.07, .07, ifelse(estimate < -.07, -.07, estimate))} else {
+ ifelse(estimate>3, 3, ifelse(estimate < -3, -3, estimate))} ) %>%
+ dplyr::select(c(Lat, Lon, geometry, variable, term, estimate)) %>%
+ pivot_wider(., names_from = term, values_from = estimate) %>%
+ dplyr::rename('Post' = as.name(paste0(variable.name,'.SO.SE')),
+ 'Pre' = as.name(paste0(variable.name,'.LO.SO')))
+
+ #Get world map
+ mp <- NULL
+ mapWorld <- borders("world", colour="gray40", fill="gray40") # create a layer of borders
+ mp <- ggplot() + mapWorld + plotTheme1
+
+ #Add pre-solstice information
+ MapPre <- mp + geom_tile(data = Analysis.df.sub3,
+ show.legend=T,
+ aes(x = Lon, y = Lat, fill=Pre)) +
+ scale_fill_gradient2(midpoint=0, low='#F21A00', mid="white",
+ high='#3B9AB2', space ="Lab" ) +
+ coord_cartesian(ylim = c(27, 75), xlim = c(-160, 175)) +
+ xlab("") + ylab('Latitude') +
+ theme(legend.position = c(0.08,0.33))
+
+ #Add post-solstice information
+ MapPost <- mp + geom_tile(data = Analysis.df.sub3,
+ show.legend=T,
+ aes(x = Lon, y = Lat, fill=Post)) +
+ scale_fill_gradient2(midpoint=0, low='#F21A00', mid="white",
+ high='#3B9AB2', space ="Lab" ) +
+ coord_cartesian(ylim = c(27, 75), xlim = c(-160, 175)) +
+ xlab("") + ylab('Latitude')
+
+ ##############################################################################################################################################
+
+
+ ################
+ # Solstice plots
+ ################
+
+ #subset the data
+ SolsticeModel.df.sub = SeasonalModel.df %>%
+ filter(variable == variable.name)
+
+ # Plot
+ plotSolstice = ggplot(data = SolsticeModel.df.sub, aes(x = variable.class, y = estimate, fill=variable.class)) +
+ geom_boxplot(outlier.shape = NA, notch=T)+
+ geom_hline(yintercept=0)+
+ xlab("") + ylab("") +
+ coord_cartesian(ylim = c(-.8,.8)) +
+ scale_fill_manual(values = rev(wes_palette(6, name = "Zissou1", type = "continuous")))+
+ scale_x_discrete(labels=c("solstice1" = "May 13\nJun 11", "solstice2" = "May 23\nJun 21",
+ "solstice3" = "Jun 2\nJul 1", "solstice4"="Jun 12\nJul 11",
+ "solstice5"="Jun 22\nJul 21", "solstice6"="Jul 2\nJul 31"))+
+ plotTheme1
+
+ plotSolstice = plotSolstice + annotation_custom(ggplotGrob(PhotoSolstice),
+ xmin = 0.6, xmax = 3.6,
+ ymin = 0.2, ymax = 1.05)
+
+
+ ##############################################################################################################################################
+
+
+ #######################################
+ # Full model plots (Linear model means)
+ #######################################
+
+
+ #All pixels
+ ###########
+
+ plotFull = FullModel.df %>%
+ filter(variable == variable.name) %>%
+ mutate(term = factor(term,
+ levels=c(paste0(variable.name, ".LO.SO"),
+ "Prcp.LO.SO", 'Prcp.SO.SE', "CO2",
+ paste0(variable.name, ".SO.SE")), ordered=T) ) %>%
+ ggplot(aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch=T)+
+ geom_hline(yintercept=0)+
+ xlab("") + ylab("") +
+ coord_cartesian(ylim = c(-.9,.9)) +
+ scale_fill_manual(values = c('#F21A00','grey60','grey35','black','#3B9AB2'))+
+ scale_x_discrete(labels = c(paste0(variable.name, " pre"),
+ 'Prcp pre','Prcp post',
+ expression(CO[2]),
+ paste0(variable.name, " post")))+
+ plotTheme1 +
+ theme(axis.text.x = element_text(angle = 45, hjust=1))
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ #Vegetation-type-specific
+ #########################
+
+ plotFullLC = FullModel.df %>%
+ filter(variable == variable.name) %>%
+ group_by(LC_Type, term) %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed_North America", "Mixed_Eurasia",
+ "DecB_North America", "DecB_Eurasia",
+ "EvgN_North America", "EvgN_Eurasia",
+ "DecN_Eurasia")),
+ term = factor(term,
+ levels=c(paste0(variable.name, ".LO.SO"),
+ "Prcp.LO.SO", 'Prcp.SO.SE', "CO2",
+ paste0(variable.name, ".SO.SE")), ordered=T) ) %>%
+ ggplot(aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch=T)+
+ geom_hline(yintercept=0)+
+ xlab("") + ylab("Standardized effect") +
+ coord_cartesian(ylim = c(-.9,.9)) +
+ scale_fill_manual(values = c('#F21A00','grey60','grey35','black','#3B9AB2'))+
+ scale_x_discrete(labels = c('Out-Sol','Prcp pre','Prcp post',expression(CO[2]),'Sol-Off'))+
+ plotTheme1 +
+ facet_grid(LC_Type~1) +
+ theme(axis.text.x = element_text(angle = 45, hjust=1),
+ strip.text = element_blank(),)
+
+
+ ##############################################################################################################################################
+
+
+ ###############
+ # Monthly plots
+ ###############
+
+
+ #subset the table
+ #################
+
+ Monthly.df.sub = MonthlyAnalysis.df %>%
+ filter(variable == variable.name)
+
+ df.interp.sub = df.interp %>%
+ filter(variable == variable.name)
+
+ df.AUC.sub = df.AUC %>%
+ filter(variable == variable.name)
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ # Plots
+ #######
+
+ #set x and y ranges
+ if(variable.name %in% c('GPP','LAI',"Apm","Azani",'SWrad','GPPstart','LAIstart')){
+ xRange=c(4.1, 8.9) } else {xRange=c(3.2, 8.8) }
+
+ if(variable.name %in% c('LAI')){
+ yRange=c(-0.22,0.22)
+ yRange2=c(-0.25,0.25) } else {
+ yRange=c(-0.2,0.2)
+ yRange2=c(-0.25,0.25)
+ }
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ #All pixels
+ plot.monthly = ggplot() +
+ geom_area(data = df.interp.sub[df.interp.sub$LC_Type=='All',], aes(x = created, y = score, fill=score>0, group=group)) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+ geom_point(data=Monthly.df.sub[Monthly.df.sub$LC_Type=='All',],
+ aes(x=term, y=mean))+
+ geom_errorbar(data=Monthly.df.sub[Monthly.df.sub$LC_Type=='All',],
+ aes(x=term, ymin=lowCI, ymax=hiCI), width=.2,
+ position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ geom_vline(xintercept=6.3, size=2, alpha=0.4)+
+ geom_text(data = df.AUC.sub[df.AUC.sub$LC_Type=='All',], mapping = aes(x = -Inf, y = Inf,
+ hjust = -0.1, vjust = 1.5,
+ label = paste0(percent.neg,'% / ',percent.pos, '%')))+
+ coord_cartesian(xlim=xRange, ylim=yRange) +
+ xlab("")+ylab("Standardized effect")+
+ scale_x_continuous(breaks = seq(1,10,by=1),
+ labels = c('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct'))+
+ plotTheme1
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ #Vegetation-type-specific
+ plot.monthly.LCtype = ggplot() +
+ geom_area(data = df.interp.sub[df.interp.sub$LC_Type!='All',], aes(x = created, y = score, fill=score>0, group=group)) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+ geom_point(data=Monthly.df.sub[Monthly.df.sub$LC_Type!='All',],
+ aes(x=term, y=mean))+
+ geom_errorbar(data=Monthly.df.sub[Monthly.df.sub$LC_Type!='All',],
+ aes(x=term, ymin=lowCI, ymax=hiCI), width=.2,
+ position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ geom_vline(xintercept=6.3, size=2, alpha=0.4)+
+ geom_text(data = df.AUC.sub[df.AUC.sub$LC_Type!='All',],
+ mapping = aes(x = -Inf, y = Inf, hjust = -.1, vjust = 1.5,
+ label = paste0(percent.neg,'% / ',percent.pos, '%')) ) +
+ coord_cartesian(xlim=xRange,ylim=yRange2)+
+ xlab("")+ylab('')+
+ facet_grid(LC_Type~1)+
+ scale_x_continuous(breaks = seq(1,10,by=2),
+ labels = c('Jan','Mar','May','Jul','Sep'))+
+ plotTheme1 +
+ theme(strip.text.x = element_blank())
+
+
+ ##############################################################################################################################################
+
+
+ ###################
+ # Mixed model plots
+ ###################
+
+
+ #Driver plots
+ MixedModel.df.sub = MixedModel.df %>%
+ filter(variable == variable.name)
+
+ coefficients.df.sub = coefficients.df %>%
+ filter(variable == variable.name)
+
+ fitted.df.sub = fitted.df %>%
+ filter(variable == variable.name)
+
+ driver.plot = ggplot() +
+
+ geom_hex(data=fitted.df.sub, aes(y= fitted, x= x), bins=300)+
+
+ scale_fill_gradient2(low="grey95",mid='#E1AF00',"high"='#F21A00', midpoint=45)+
+
+ geom_ribbon(data = MixedModel.df.sub, aes(x = xval, ymin = lower, ymax = upper),
+ alpha = 0.5, fill="black") +
+
+ geom_line(data=MixedModel.df.sub, aes(xval, off), color="black") +
+
+ geom_text(data=coefficients.df.sub, aes(label=paste0(round(Coefficient,2)," days per unit\nR2 = ", round(summary(lm(fitted~x, data=fitted.df.sub))$r.squared,2)),
+ x=Inf, y=Inf, hjust = 1.1, vjust = 1.5))+
+
+ coord_cartesian(ylim = c(170,250), xlim = c(min(fitted.df.sub$x)+max(fitted.df.sub$x)/20,
+ max(fitted.df.sub$x)-max(fitted.df.sub$x)/20))+
+
+ labs(x = variable.name, y = expression(EOS[10]~(DOY)))+
+
+ plotTheme1
+
+
+ # Year plots
+ MixedModel.df.sub = MixedModel.df %>%
+ filter(variable == "Year",
+ class %in% c("Univariate",variable.name)) %>%
+ distinct()
+
+ coefficients.df.sub = coefficients.df %>%
+ filter(variable == "Year",
+ class %in% c("Univariate",variable.name))%>%
+ distinct()
+
+ year.plot = ggplot() +
+ geom_hline(yintercept = 0, linetype="dashed")+
+ geom_ribbon(data = MixedModel.df.sub, aes(x = xval+YearMean, ymin = anomaly.lower, ymax = anomaly.upper, fill=class),
+ alpha = 0.3) +
+ geom_line(data=MixedModel.df.sub, aes(xval+YearMean, anomaly, color=class)) +
+ theme_classic() +
+
+ geom_text(data=coefficients.df.sub[coefficients.df.sub$class==variable.name,],
+ aes(label=paste0("EOS10 ~ Year + ", variable.name, " (", round(Coefficient*10,1)," days per decade)"),
+ x=Inf, y=Inf,hjust = 1.2, vjust = 2),color='black')+
+
+ geom_text(data=coefficients.df.sub[coefficients.df.sub$class=="Univariate",],
+ aes(label=paste0("EOS10 ~ Year (", round(Coefficient*10,1)," days per decade)"),
+ x=Inf, y=-Inf,hjust = 1.2, vjust = -2),color='#F21A00')+
+
+ scale_color_manual(values = c('black','#F21A00'))+
+ scale_fill_manual(values = c('black','#F21A00'))+
+
+ coord_cartesian(ylim = c(-1.3,1.3), xlim=c(2002.5,2017.5))+
+
+ labs(x = "Year", y = expression(EOS[10]~anomaly))+
+ plotTheme1
+
+
+ ##############################################################################################################################################
+
+
+ ##########################
+ # Arrange and safe plots #
+ ##########################
+
+
+ # 1. Monthly plots
+ ##################
+
+ #define plot layout
+ layout <- "ABC"
+
+ #Merge plots
+ Fig_Plot = plot.monthly + plotFull + plotSolstice +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A') &
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plots as .pdf
+ ggsave(Fig_Plot, file=paste('Fig2_',variable.name, ".pdf", sep=''),
+ path=output_path,
+ width=11, height=3.5)
+
+ print(Fig_Plot)
+
+
+ # 2. Map plots
+ ##############
+
+ #define plot layout
+ layout <- "
+AAAAAB
+CCDDEE"
+
+ #Merge plots
+ Fig_Plot = MapPre + LatPlot +
+ HistoPlot + driver.plot + year.plot +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A') &
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plots as .pdf
+ ggsave(Fig_Plot, file=paste('Fig3_',variable.name, ".pdf", sep=''),
+ path=output_path,
+ width=12, height=6)
+
+ print(Fig_Plot)
+
+
+ # 3. Vegetation-type-specific plots
+ ###################################
+
+ #define plot layout
+ layout <- "AB"
+
+ #Merge plots
+ Fig_Plot = plotFullLC + plot.monthly.LCtype +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A') &
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plots as .pdf
+ ggsave(Fig_Plot, file=paste('FigS11_LCtype_',variable.name, ".pdf", sep=''),
+ path=output_path,
+ width=6, height=12)
+
+ print(Fig_Plot)
+
+
+ ##############################################################################################################################################
+
+ #count
+ print(variable.name)
+}
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## datetime
+Sys.time()
+
+
+## session info
+sessionInfo()
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+```
+
\ No newline at end of file
diff --git a/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.2_Model_comparison.Rmd b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.2_Model_comparison.Rmd
new file mode 100644
index 0000000..e542a67
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.2_Model_comparison.Rmd
@@ -0,0 +1,388 @@
+---
+title: Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice
+author: Constantin Zohner
+date: "last updated March 31, 2023"
+
+subtitle: Model comparison (Figure S13)
+output:
+ html_document:
+ highlight: haddock
+ toc: false
+ use_bookdown: true
+ df_print: paged
+---
+
+
+
+
+
+### Figure descriptions
+- Fig. S13: In- and out-of-sample comparison of autumn senescence models, including only pre-solstice (pre-solstice model), only post-solstice (post-solstice model) or both pre- and post-solstice variables (full model)
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(
+ class.source = "numberLines lineAnchors"
+ )
+```
+
+
+
+```{r, message=FALSE, warning=FALSE, attr.source='.numberLines'}
+###################
+# Required packages
+###################
+
+
+
+require(tidyverse)
+require(data.table)
+require(ggplot2)
+require(wesanderson)
+require(patchwork)
+require(broom)
+require(gmodels)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2")
+
+
+# Paths
+#######
+
+#input
+MODIS.EOS10_path = "Remote_sensing/Analysis/Analysis_output_startSen/Data"
+MODIS.EOS50_path = "Remote_sensing/Analysis/Analysis_output_EOS50/Data"
+PEP_path = "PEP_analysis/Analysis/Analysis_output/Autumn/Data"
+
+#output
+output_path = "Remote_sensing/Analysis/Analysis_output_startSen/ModelComparison"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Timeseries-level univariate linear models (MODIS EOS10 data)
+#############################################################
+
+MODIS.EOS10.df = fread(paste(MODIS.EOS10_path, "Model_R2_data.csv", sep="/")) %>%
+ filter(model %in% c("pre","post")) %>%
+ mutate(variable = plyr::revalue(variable, c(
+ "GPPstart" = "GPP",
+ "SWrad" = "SW radiation",
+ "Moist" = "Moisture",
+ "Greenup_DOY" = "Leafout")),
+ variable = factor(variable, levels=c("GPP","Tday","Leafout","SW radiation","Moisture"), ordered=T))
+
+#LC_Type: Land cover type
+#geometry: pixel identifier
+#r.squared: normal R2
+
+
+#Timeseries-level multivariate linear models (MODIS EOS10 data - LOOCV)
+#######################################################################
+
+MODIS.EOS10.CV.df = fread(paste(MODIS.EOS10_path, "Model_R2_CV_data.csv", sep="/")) %>%
+ mutate(model = factor(model, levels=c("pre","full","post"), ordered=T),
+ adj.r.squared = ifelse(adj.r.squared<0, 0, adj.r.squared))
+
+
+#--------------------------------------------------------------------------------------------
+
+
+#Timeseries-level univariate linear models (MODIS EOS50 data)
+#############################################################
+
+MODIS.EOS50.df = fread(paste(MODIS.EOS50_path, "Model_R2_data.csv", sep="/")) %>%
+ filter(model %in% c("pre","post")) %>%
+ mutate(variable = plyr::revalue(variable, c(
+ "GPPstart" = "GPP",
+ "SWrad" = "SW radiation",
+ "Moist" = "Moisture",
+ "Greenup_DOY" = "Leafout")),
+ variable = factor(variable, levels=c("GPP","Tday","Leafout","SW radiation","Moisture"), ordered=T))
+
+#LC_Type: Land cover type
+#geometry: pixel identifier
+#r.squared: normal R2
+
+
+#Timeseries-level multivariate linear models (MODIS EOS50 data - LOOCV)
+#######################################################################
+
+MODIS.EOS50.CV.df = fread(paste(MODIS.EOS50_path, "Model_R2_CV_data.csv", sep="/")) %>%
+ mutate(model = factor(model, levels=c("pre","full","post"), ordered=T),
+ adj.r.squared = ifelse(adj.r.squared<0, 0, adj.r.squared))
+
+
+#--------------------------------------------------------------------------------------------
+
+
+#Timeseries-level univariate linear models (PEP725 EOS50 data)
+##############################################################
+
+PEP.df = fread(paste(PEP_path, "Model_R2_data.csv", sep="/")) %>%
+ mutate(species = gsub("^.*?\\_","", timeseries),#delete before _
+ variable = plyr::revalue(variable, c("Azani" = "Anetday (LPJ)",
+ "SWrad" = "SW radiation",
+ "Moist" = "Moisture",
+ "leaf_out" = "Leafout")),
+ variable = factor(variable, levels=c('Anetday (LPJ)',"Tday", "Leafout","SW radiation","Moisture"), ordered=T))
+
+
+#Timeseries-level multivariate linear models (PEP725 EOS50 data - LOOCV)
+########################################################################
+
+PEP.CV.df = fread(paste(PEP_path, "Model_R2_CV_data.csv", sep="/")) %>%
+ mutate(model = factor(model, levels=c("pre","full","post"), ordered=T),
+ adj.r.squared = ifelse(adj.r.squared<0, 0, adj.r.squared))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+################
+## Plot theme ##
+################
+
+plotTheme1 = theme(
+ legend.position = "none",
+ legend.background = element_blank(),
+ legend.text = element_text(color="black"),
+ legend.key = element_blank(),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ plot.title = element_text(face="bold",hjust = 0.5))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#############
+## Summary ##
+#############
+
+
+
+# Summarize MODIS EOS10 table by groups
+#######################################
+
+data.frame(MODIS.EOS10.df %>%
+ group_by(model,variable) %>%
+ summarise(mean = mean(r.squared)*100,
+ mean_round = round(mean),
+ lowCI = ceiling((ci(r.squared)[2]*100)),
+ hiCI = ceiling((ci(r.squared)[3]*100)),
+ meanAIC = mean(AIC)))
+
+# Summarize MODIS CV table by groups
+####################################
+
+# Which proportion of pixels has an R2 >0.15?
+round(table(MODIS.EOS10.CV.df[MODIS.EOS10.CV.df$CV.R2>=0.15,]$model)/table(MODIS.EOS10.CV.df$model)[1],2)
+round(table(MODIS.EOS10.CV.df[MODIS.EOS10.CV.df$adj.r.squared>=0.15,]$model)/table(MODIS.EOS10.CV.df$model)[1],2)
+
+
+#--------------------------------------------------------------------------------------------
+
+
+# Summarize MODIS EOS50 table by groups
+#######################################
+
+data.frame(MODIS.EOS50.df %>%
+ group_by(model,variable) %>%
+ summarise(mean = mean(r.squared)*100,
+ mean_round = round(mean),
+ lowCI = ceiling((ci(r.squared)[2]*100)),
+ hiCI = ceiling((ci(r.squared)[3]*100)),
+ meanAIC = mean(AIC)))
+
+# Summarize MODIS CV table by groups
+####################################
+
+# Which proportion of pixels has an R2 >0.15?
+round(table(MODIS.EOS50.CV.df[MODIS.EOS50.CV.df$CV.R2>=0.15,]$model)/table(MODIS.EOS50.CV.df$model)[1],2)
+round(table(MODIS.EOS50.CV.df[MODIS.EOS50.CV.df$adj.r.squared>=0.15,]$model)/table(MODIS.EOS50.CV.df$model)[1],2)
+
+
+#--------------------------------------------------------------------------------------------
+
+
+#summarize PEP725 table by groups
+#######################################
+
+data.frame(PEP.df %>%
+ group_by(model,variable) %>%
+ summarise(mean = mean(r.squared)*100,
+ mean_round = round(mean),
+ lowCI = ceiling((ci(r.squared)[2]*100)),
+ hiCI = ceiling((ci(r.squared)[3]*100))) )
+
+
+# Summarize PEP725 CV table by groups
+#####################################
+
+# Which proportion of pixels has an R2 >0.15?
+round(table(PEP.CV.df[PEP.CV.df$CV.R2>=0.15,]$model)/table(PEP.CV.df$model)[1],2)
+round(table(PEP.CV.df[PEP.CV.df$adj.r.squared>=0.15,]$model)/table(PEP.CV.df$model)[1],2)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+###########
+## Plots ##
+###########
+
+
+
+# CV Plot EOS10
+EOS10.CV.plot = ggplot(MODIS.EOS10.CV.df , aes(CV.R2, color=model) ) +
+ geom_vline(xintercept = 0.15, linetype = "dashed")+
+ geom_line(aes(y = 1 - ..y..), stat='ecdf', size=1.3, alpha=0.9) +
+ scale_color_manual(values = rev(wes_palette(3, name = "Zissou1", type = "continuous")))+
+ coord_cartesian(ylim=c(0,0.7), xlim=c(0.023,0.5))+
+ labs(y="Frequency of pixels", x=expression(R^2~"(Leave-one-out cross-validation)")) +
+ plotTheme1
+
+# R2 Plot EOS10
+EOS10.R2.plot =
+ ggplot(MODIS.EOS10.CV.df , aes(adj.r.squared, color=model) ) +
+ geom_vline(xintercept = 0.15, linetype = "dashed")+
+ geom_line(aes(y = 1 - ..y..), stat='ecdf', size=1.3, alpha=0.9) +
+ scale_color_manual(values = rev(wes_palette(3, name = "Zissou1", type = "continuous")))+
+ coord_cartesian(ylim=c(0,.8), xlim=c(0.0355,.75))+
+ labs(y="Frequency of pixels", x=expression(R^2~"(adjusted)")) +
+ ggtitle(expression(EOS[10]~(Satellite))) +
+ plotTheme1
+
+#-----------------------------------------------------------------------------------------
+
+# CV Plot EOS50
+EOS50.CV.plot = ggplot(MODIS.EOS50.CV.df , aes(CV.R2, color=model) ) +
+ geom_vline(xintercept = 0.15, linetype = "dashed")+
+ geom_line(aes(y = 1 - ..y..), stat='ecdf', size=1.3, alpha=0.9) +
+ scale_color_manual(values = rev(wes_palette(3, name = "Zissou1", type = "continuous")))+
+ coord_cartesian(ylim=c(0,0.7), xlim=c(0.023,0.5))+
+ labs(y="", x=expression(R^2~"(Leave-one-out cross-validation)")) +
+ plotTheme1
+
+# R2 Plot EOS50
+EOS50.R2.plot = ggplot(MODIS.EOS50.CV.df , aes(adj.r.squared, color=model) ) +
+ geom_vline(xintercept = 0.15, linetype = "dashed")+
+ geom_line(aes(y = 1 - ..y..), stat='ecdf', size=1.3, alpha=0.9) +
+ scale_color_manual(values = rev(wes_palette(3, name = "Zissou1", type = "continuous")))+
+ coord_cartesian(ylim=c(0,0.8), xlim=c(0.0355,0.75))+
+ labs(y="", x=expression(R^2~"(adjusted)")) +
+ ggtitle(expression(EOS[50]~(Satellite))) +
+ plotTheme1
+
+#-----------------------------------------------------------------------------------------
+
+# CV Plot EOS50 PEP725
+PEP.CV.plot = ggplot(PEP.CV.df , aes(CV.R2, color=model) ) +
+ geom_vline(xintercept = 0.15, linetype = "dashed")+
+ geom_line(aes(y = 1 - ..y..), stat='ecdf', size=1.3, alpha=0.9) +
+ scale_color_manual(values = rev(wes_palette(3, name = "Zissou1", type = "continuous")))+
+ coord_cartesian(ylim=c(0,0.7), xlim=c(0.023,0.5))+
+ labs(y="", x=expression(R^2~"(Leave-one-out cross-validation)")) +
+ plotTheme1 +
+ theme(legend.position = "right")
+
+# R2 Plot EOS50
+PEP.R2.plot = ggplot(PEP.CV.df , aes(adj.r.squared, color=model) ) +
+ geom_vline(xintercept = 0.15, linetype = "dashed")+
+ geom_line(aes(y = 1 - ..y..), stat='ecdf', size=1.3, alpha=0.9) +
+ scale_color_manual(values = rev(wes_palette(3, name = "Zissou1", type = "continuous")))+
+ coord_cartesian(ylim=c(0,0.8), xlim=c(0.0355,0.75))+
+ labs(y="", x=expression(R^2~"(adjusted)")) +
+ ggtitle(expression(EOS[50]~(PEP725~data))) +
+ plotTheme1
+
+#-----------------------------------------------------------------------------------------
+
+#define plot layout
+layout <- "
+ABC
+DEF"
+
+#Merge plots
+R2_plot =
+ EOS10.R2.plot + EOS50.R2.plot + PEP.R2.plot +
+ EOS10.CV.plot + EOS50.CV.plot + PEP.CV.plot +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'a')&
+ theme(plot.tag = element_text(face = 'bold'))
+
+#save plot as pdf
+ggsave(R2_plot, file="FigS13_ModelComparison_CV.pdf", path=output_path,
+ width=10.5, height=7.5)
+
+R2_plot
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## datetime
+Sys.time()
+
+
+## session info
+sessionInfo()
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+```
+
\ No newline at end of file
diff --git a/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.3.1_Driver_comparison.Rmd b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.3.1_Driver_comparison.Rmd
new file mode 100644
index 0000000..044038d
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.3.1_Driver_comparison.Rmd
@@ -0,0 +1,419 @@
+---
+title: Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice
+author: Constantin Zohner
+date: "last updated March 31, 2023"
+
+subtitle: Driver comparison (Figures 5 and S21)
+output:
+ html_document:
+ highlight: haddock
+ toc: false
+ use_bookdown: true
+ df_print: paged
+---
+
+
+
+
+
+### Figure descriptions
+- Fig. 5: The effects of temperature, radiation, spring leaf-out dates and precipitation on inter-annual variation in the timing of EOS10 (A) and EOS50 (B, C)
+- Fig. S21: The effects of pre- and post-solstice temperature, radiation, precipitation and spring leaf-out dates on inter-annual variation in the timing of EOS10 (A) and EOS50 (B, C) for each forest type (A,B) and tree species (C).
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(
+ class.source = "numberLines lineAnchors"
+ )
+```
+
+
+
+```{r, message=FALSE, warning=FALSE, attr.source='.numberLines'}
+###################
+# Required packages
+###################
+
+
+
+require(tidyverse)
+require(data.table)
+require(broom.mixed)
+require(gmodels)
+require(lme4)
+require(car)
+require(sjmisc)
+require(wesanderson)
+require(patchwork)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2")
+
+# paths
+startSen_path = "Remote_sensing/Analysis/Analysis_input/Drivers_final_EOS10/Merged_file"
+MidGreendown_path = "Remote_sensing/Analysis/Analysis_input/Drivers_final_EOS50/Merged_file"
+PEP_path = "PEP_analysis/Analysis/Analysis_input/PEP_drivers_final/Merged_file"
+output_path = "Remote_sensing/Analysis/Analysis_output_startSen/DriverComparison"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#PEP dataframe
+##############
+
+PEP.df <- fread(paste(PEP_path, "pep_drivers_data_preseason.csv", sep="/")) %>%
+ mutate(SWrad.LO.SO = rowSums(.[,363:365]))
+
+
+
+#MODIS Senescence dataframe
+###########################
+
+startSen.df <- fread(paste(startSen_path, "Remote_sensing_drivers_data_startSen_preseason.csv", sep="/")) %>%
+ #data transformation
+ mutate(Prcp.SO.SE = log(Prcp.SO.SE+1),
+ Prcp.LO.SO = log(Prcp.LO.SO+1))%>%
+ #delete pixels with no photosynthesis before solstice
+ group_by(geometry) %>%
+ filter(!(mean(GPPstart.LO.SO)<.1)) %>%
+ ungroup()
+
+
+
+#MODIS MidGreendown dataframe
+#############################
+
+MidGreendown.df <- fread(paste(MidGreendown_path, "Remote_sensing_drivers_data_preseason.csv", sep="/")) %>%
+ #data transformation
+ mutate(Prcp.SO.SE = log(Prcp.SO.SE+1),
+ Prcp.LO.SO = log(Prcp.LO.SO+1))%>%
+ #delete pixels with no photosynthesis before solstice
+ group_by(geometry) %>%
+ filter(!(mean(GPPstart.LO.SO)<.1)) %>%
+ ungroup()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+plotTheme1 = theme(
+ legend.position = "none",
+ legend.background = element_blank(),
+ legend.text = element_text(color="black"),
+ legend.title = element_blank(),
+ legend.key = element_blank(),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text.y = element_text(colour = 'black'),
+ axis.text.x = element_text(angle = 45, hjust=1, colour = 'black'),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold", size=11, hjust = 0.5))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################################################
+## MODIS: Pixel-level linear senescence models ##
+#################################################
+
+
+
+RSModel.df = startSen.df %>%
+ group_by(LC_Type, geometry) %>%
+ do({
+
+ #run model
+ ##########
+
+ model1 = lm(scale(Senesc_DOY)~
+ scale(SWrad.LO.SO)+scale(Prcp.LO.SO)+scale(Greenup_DOY)+
+ scale(Tday.SO.SE)+scale(SWrad.SO.SE)+scale(Prcp.SO.SE)+scale(Tday.LO.SO),
+ data=.)
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(tidy(model1) )
+
+ }) %>%
+ mutate(term = gsub("scale","",term)) %>%
+ mutate(term = str_replace_all(term,"\\(|\\)", "") ) %>%
+ #delete intercept
+ filter(!term %in% c("Intercept")) %>%
+ ungroup() %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN")),
+ LC_Type = plyr::revalue(LC_Type, c("Mixed" = "Mixed",
+ "DecB" = "Deciduous broadleaf",
+ "EvgN" = "Evergreen needleleaf",
+ "DecN" = "Deciduous needleleaf")),
+ term = factor(term,
+ levels=c('Tday.LO.SO','Tday.SO.SE','SWrad.LO.SO', 'SWrad.SO.SE',"Greenup_DOY", "Prcp.LO.SO", 'Prcp.SO.SE'), ordered=T) )
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+###################################################
+## MODIS: Pixel-level linear MidGreendown models ##
+###################################################
+
+
+
+MidGreendownModel.df = MidGreendown.df %>%
+ group_by(LC_Type, geometry) %>%
+ do({
+
+ #run model
+ ##########
+
+ model1 = lm(scale(MidGreendown_DOY)~
+ scale(Tday.LO.SO)+scale(SWrad.LO.SO)+scale(Prcp.LO.SO)+scale(Greenup_DOY)+
+ scale(Tday.SO.SE)+scale(SWrad.SO.SE)+scale(Prcp.SO.SE),
+ data=.)
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(tidy(model1) )
+
+ }) %>%
+ mutate(term = gsub("scale","",term)) %>%
+ mutate(term = str_replace_all(term,"\\(|\\)", "") ) %>%
+ #delete intercept
+ filter(!term %in% c("Intercept")) %>%
+ ungroup %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN")),
+ LC_Type = plyr::revalue(LC_Type, c("Mixed" = "Mixed",
+ "DecB" = "Deciduous broadleaf",
+ "EvgN" = "Evergreen needleleaf",
+ "DecN" = "Deciduous needleleaf")),
+ term = factor(term,
+ levels=c('Tday.LO.SO','Tday.SO.SE','SWrad.LO.SO', 'SWrad.SO.SE',"Greenup_DOY", "Prcp.LO.SO", 'Prcp.SO.SE'), ordered=T) )
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+############################################
+## PEP725: Individual-level linear models ##
+############################################
+
+
+
+PEPmodel.df = PEP.df %>%
+ group_by(species, pep_id) %>%
+ do({
+
+ #run model
+ ##########
+
+ model1 = lm(scale(leaf_off)~
+ scale(Tday.LO.SO) +scale(SWrad.LO.SO)+scale(Prcp.LO.SO)+scale(leaf_out)+
+ scale(Tnight.SO.SE)+scale(SWrad.SO.SE)+scale(Prcp.SO.SE),
+ data=.)
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(rbind(tidy(model1)))
+
+ }) %>%
+ mutate(term = gsub("scale","",term)) %>%
+ mutate(term = str_replace_all(term,"\\(|\\)", "") ) %>%
+ #delete intercept
+ filter(!term %in% c("Intercept")) %>%
+ ungroup() %>%
+ mutate(term = factor(term,
+ levels=c('Tday.LO.SO','Tnight.SO.SE','SWrad.LO.SO', 'SWrad.SO.SE',"leaf_out", "Prcp.LO.SO", 'Prcp.SO.SE'), ordered=T) )
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##################################
+# Land-cover type-specific plots #
+##################################
+
+
+
+A = ggplot(data = RSModel.df, aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch=T) +
+ geom_hline(yintercept = 0)+
+ xlab("") + ylab("Standardized effect") +
+ facet_grid(LC_Type~.)+
+ coord_cartesian(ylim=c(-.9,.9))+
+ scale_fill_manual(values = rev(wes_palette(7, name = "Zissou1", type = "continuous")))+
+ ggtitle(expression(EOS[10]~(Satellite))) +
+ plotTheme1
+
+B = ggplot(data = MidGreendownModel.df, aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch=T) +
+ geom_hline(yintercept = 0)+
+ xlab("") + ylab("") +
+ facet_grid(LC_Type~.)+
+ coord_cartesian(ylim=c(-.9,.9))+
+ scale_fill_manual(values = rev(wes_palette(7, name = "Zissou1", type = "continuous")))+
+ ggtitle(expression(EOS[50]~(Satellite))) +
+ plotTheme1+
+ theme(axis.text.y=element_blank())
+
+C = ggplot(data = PEPmodel.df, aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch=T) +
+ geom_hline(yintercept = 0)+
+ xlab("") + ylab("") +
+ facet_grid(species~.)+
+ coord_cartesian(ylim=c(-.9,.9))+
+ scale_fill_manual(values = rev(wes_palette(7, name = "Zissou1", type = "continuous")))+
+ ggtitle(expression(EOS[50]~(PEP725~data))) +
+ plotTheme1 +
+ theme(axis.text.y=element_blank(),
+ strip.text = element_text(colour = 'black', face="italic"))
+
+#define plot layout
+layout <- "
+ABC"
+
+#Merge plots
+DriverPlot = A + B + C +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A')&
+ theme(plot.tag = element_text(face = 'bold'))
+
+#save plots as .pdf
+ggsave(DriverPlot, file="FigS21_DriverPlot_LCtype.pdf", path=output_path,
+ width=8, height=8)
+
+DriverPlot
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##################
+# Combined plots #
+##################
+
+
+
+A = ggplot(data = RSModel.df, aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch = T) +
+ geom_hline(yintercept = 0)+
+ xlab("") + ylab("Standardized effect") +
+ coord_cartesian(ylim=c(-.9,.9))+
+ scale_fill_manual(values = rev(wes_palette(7, name = "Zissou1", type = "continuous")))+
+ ggtitle(expression(EOS[10]~(Satellite))) +
+ plotTheme1 +
+ theme(axis.text.x=element_blank())
+
+B = ggplot(data = MidGreendownModel.df, aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch = T) +
+ geom_hline(yintercept = 0)+
+ xlab("") + ylab("Standardized effect") +
+ coord_cartesian(ylim=c(-.9,.9))+
+ scale_fill_manual(values = rev(wes_palette(7, name = "Zissou1", type = "continuous")))+
+ ggtitle(expression(EOS[50]~(Satellite))) +
+ plotTheme1+
+ theme(axis.text.x=element_blank())
+
+C = ggplot(data = PEPmodel.df, aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch = T) +
+ geom_hline(yintercept = 0)+
+ xlab("") + ylab("Standardized effect") +
+ coord_cartesian(ylim=c(-.9,.9))+
+ scale_fill_manual(values = rev(wes_palette(7, name = "Zissou1", type = "continuous")))+
+ ggtitle(expression(EOS[50]~(PEP725~data))) +
+ plotTheme1
+
+#define plot layout
+layout <- "
+A
+B
+C"
+
+#Merge plots
+DriverPlot = A + B + C +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A')&
+ theme(plot.tag = element_text(face = 'bold'))
+
+#save plots as .pdf
+ggsave(DriverPlot, file="Fig5_DriverPlot_All.pdf", path=output_path,
+ width=3, height=8)
+
+DriverPlot
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## datetime
+Sys.time()
+
+
+## session info
+sessionInfo()
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+```
+
\ No newline at end of file
diff --git a/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.3.2_Driver_comparison_soilMoisture.Rmd b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.3.2_Driver_comparison_soilMoisture.Rmd
new file mode 100644
index 0000000..a73b8ec
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.3.2_Driver_comparison_soilMoisture.Rmd
@@ -0,0 +1,412 @@
+---
+title: Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice
+author: Constantin Zohner
+date: "last updated March 31, 2023"
+
+subtitle: Driver comparison soil moisture (Figure S22)
+output:
+ html_document:
+ highlight: haddock
+ toc: false
+ use_bookdown: true
+ df_print: paged
+---
+
+
+
+
+
+### Figure descriptions
+- Fig. S22: The effects of pre- and post-solstice temperature, radiation, water availability and spring leaf-out dates on inter-annual variation in the timing of EOS10 (A) and EOS50 (B, C) [same as Fig. 5 but using soil moisture instead of precipitation to represent water availability]
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(
+ class.source = "numberLines lineAnchors"
+ )
+```
+
+
+
+```{r, message=FALSE, warning=FALSE, attr.source='.numberLines'}
+###################
+# Required packages
+###################
+
+
+
+require(tidyverse)
+require(data.table)
+require(broom.mixed)
+require(gmodels)
+require(lme4)
+require(car)
+require(sjmisc)
+require(wesanderson)
+require(patchwork)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2")
+
+# paths
+startSen_path = "Remote_sensing/Analysis/Analysis_input/Drivers_final_EOS10/Merged_file"
+MidGreendown_path = "Remote_sensing/Analysis/Analysis_input/Drivers_final_EOS50/Merged_file"
+PEP_path = "PEP_analysis/Analysis/Analysis_input/PEP_drivers_final/Merged_file"
+output_path = "Remote_sensing/Analysis/Analysis_output_startSen/DriverComparison"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#PEP dataframe
+##############
+
+PEP.df <- fread(paste(PEP_path, "pep_drivers_data_preseason.csv", sep="/")) %>%
+ mutate(SWrad.LO.SO = rowSums(.[,363:365]))
+
+
+
+#MODIS Senescence dataframe
+###########################
+
+startSen.df <- fread(paste(startSen_path, "Remote_sensing_drivers_data_startSen_preseason.csv", sep="/")) %>%
+ #delete pixels with no photosynthesis before solstice
+ group_by(geometry) %>%
+ filter(!(mean(GPPstart.LO.SO)<.1)) %>%
+ ungroup()
+
+
+
+#MODIS MidGreendown dataframe
+#############################
+
+MidGreendown.df <- fread(paste(MidGreendown_path, "Remote_sensing_drivers_data_preseason.csv", sep="/")) %>%
+ #delete pixels with no photosynthesis before solstice
+ group_by(geometry) %>%
+ filter(!(mean(GPPstart.LO.SO)<.1)) %>%
+ ungroup()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+plotTheme1 = theme(
+ legend.position = "none",
+ legend.background = element_blank(),
+ legend.text = element_text(color="black"),
+ legend.title = element_blank(),
+ legend.key = element_blank(),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text.y = element_text(colour = 'black'),
+ axis.text.x = element_text(angle = 45, hjust=1, colour = 'black'),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold", size=11, hjust = 0.5))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################################################
+## MODIS: Pixel-level linear senescence models ##
+#################################################
+
+
+
+RSModel.df = startSen.df %>%
+ group_by(LC_Type, geometry) %>%
+ do({
+
+ #run model
+ ##########
+
+ model1 = lm(scale(Senesc_DOY)~
+ scale(Tday.LO.SO)+scale(SWrad.LO.SO)+scale(Moist.LO.SO)+scale(Greenup_DOY)+
+ scale(Tday.SO.SE)+scale(SWrad.SO.SE)+scale(Moist.SO.SE),
+ data=.)
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(tidy(model1) )
+
+ }) %>%
+ mutate(term = gsub("scale","",term)) %>%
+ mutate(term = str_replace_all(term,"\\(|\\)", "") ) %>%
+ #delete intercept
+ filter(!term %in% c("Intercept")) %>%
+ ungroup() %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN")),
+ LC_Type = plyr::revalue(LC_Type, c("Mixed" = "Mixed",
+ "DecB" = "Deciduous broadleaf",
+ "EvgN" = "Evergreen needleleaf",
+ "DecN" = "Deciduous needleleaf")),
+ term = factor(term,
+ levels=c('Tday.LO.SO','Tday.SO.SE','SWrad.LO.SO', 'SWrad.SO.SE',"Greenup_DOY", "Moist.LO.SO", 'Moist.SO.SE'), ordered=T) )
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+###################################################
+## MODIS: Pixel-level linear MidGreendown models ##
+###################################################
+
+
+
+MidGreendownModel.df = MidGreendown.df %>%
+ group_by(LC_Type, geometry) %>%
+ do({
+
+ #run model
+ ##########
+
+ model1 = lm(scale(MidGreendown_DOY)~
+ scale(Tday.LO.SO)+scale(SWrad.LO.SO)+scale(Moist.LO.SO)+scale(Greenup_DOY)+
+ scale(Tday.SO.SE)+scale(SWrad.SO.SE)+scale(Moist.SO.SE),
+ data=.)
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(tidy(model1) )
+
+ }) %>%
+ mutate(term = gsub("scale","",term)) %>%
+ mutate(term = str_replace_all(term,"\\(|\\)", "") ) %>%
+ #delete intercept
+ filter(!term %in% c("Intercept")) %>%
+ ungroup() %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN")),
+ LC_Type = plyr::revalue(LC_Type, c("Mixed" = "Mixed",
+ "DecB" = "Deciduous broadleaf",
+ "EvgN" = "Evergreen needleleaf",
+ "DecN" = "Deciduous needleleaf")),
+ term = factor(term,
+ levels=c('Tday.LO.SO','Tday.SO.SE','SWrad.LO.SO', 'SWrad.SO.SE',"Greenup_DOY", "Moist.LO.SO", 'Moist.SO.SE'), ordered=T) )
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+############################################
+## PEP725: Individual-level linear models ##
+############################################
+
+
+
+PEPmodel.df = PEP.df %>%
+ group_by(species, pep_id) %>%
+ do({
+
+ #run model
+ ##########
+
+ model1 = lm(scale(leaf_off)~
+ scale(Tday.LO.SO) +scale(SWrad.LO.SO)+scale(Moist.LO.SO)+scale(leaf_out)+
+ scale(Tnight.SO.SE)+scale(SWrad.SO.SE)+scale(Moist.SO.SE),
+ data=.)
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(rbind(tidy(model1)))
+
+ }) %>%
+ mutate(term = gsub("scale","",term)) %>%
+ mutate(term = str_replace_all(term,"\\(|\\)", "") ) %>%
+ #delete intercept
+ filter(!term %in% c("Intercept")) %>%
+ ungroup() %>%
+ mutate(term = factor(term,
+ levels=c('Tday.LO.SO','Tnight.SO.SE','SWrad.LO.SO', 'SWrad.SO.SE',"leaf_out", "Moist.LO.SO", 'Moist.SO.SE'), ordered=T) )
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##################################
+# Land-cover type-specific plots #
+##################################
+
+
+
+A = ggplot(data = RSModel.df, aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch = T) +
+ geom_hline(yintercept = 0)+
+ xlab("") + ylab("Standardized effect") +
+ facet_grid(LC_Type~.)+
+ coord_cartesian(ylim=c(-.9,.9))+
+ scale_fill_manual(values = rev(wes_palette(7, name = "Zissou1", type = "continuous")))+
+ ggtitle(expression(EOS[10]~(Satellite))) +
+ plotTheme1
+
+B = ggplot(data = MidGreendownModel.df, aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch = T) +
+ geom_hline(yintercept = 0)+
+ xlab("") + ylab("") +
+ facet_grid(LC_Type~.)+
+ coord_cartesian(ylim=c(-.9,.9))+
+ scale_fill_manual(values = rev(wes_palette(7, name = "Zissou1", type = "continuous")))+
+ ggtitle(expression(EOS[50]~(Satellite))) +
+ plotTheme1+
+ theme(axis.text.y=element_blank())
+
+C = ggplot(data = PEPmodel.df, aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch = T) +
+ geom_hline(yintercept = 0)+
+ xlab("") + ylab("") +
+ facet_grid(species~.)+
+ coord_cartesian(ylim=c(-.9,.9))+
+ scale_fill_manual(values = rev(wes_palette(7, name = "Zissou1", type = "continuous")))+
+ ggtitle(expression(EOS[50]~(PEP725~data))) +
+ plotTheme1 +
+ theme(axis.text.y=element_blank(),
+ strip.text = element_text(colour = 'black', face="italic"))
+
+#define plot layout
+layout <- "
+ABC"
+
+#Merge plots
+DriverPlot = A + B + C +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'a')&
+ theme(plot.tag = element_text(face = 'bold'))
+
+#save plots as .pdf
+ggsave(DriverPlot, file="DriverPlot_LCtype_moisture.pdf", path=output_path,
+ width=8, height=8)
+
+DriverPlot
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##################
+# Combined plots #
+##################
+
+
+
+A = ggplot(data = RSModel.df, aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch = T) +
+ geom_hline(yintercept = 0)+
+ xlab("") + ylab("Standardized effect") +
+ coord_cartesian(ylim=c(-.9,.9))+
+ scale_fill_manual(values = rev(wes_palette(7, name = "Zissou1", type = "continuous")))+
+ ggtitle(expression(EOS[10]~(Satellite))) +
+ plotTheme1 +
+ theme(axis.text.x=element_blank())
+
+B = ggplot(data = MidGreendownModel.df, aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch = T) +
+ geom_hline(yintercept = 0)+
+ xlab("") + ylab("Standardized effect") +
+ coord_cartesian(ylim=c(-.9,.9))+
+ scale_fill_manual(values = rev(wes_palette(7, name = "Zissou1", type = "continuous")))+
+ ggtitle(expression(EOS[50]~(Satellite))) +
+ plotTheme1+
+ theme(axis.text.x=element_blank())
+
+C = ggplot(data = PEPmodel.df, aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch = T) +
+ geom_hline(yintercept = 0)+
+ xlab("") + ylab("Standardized effect") +
+ coord_cartesian(ylim=c(-.9,.9))+
+ scale_fill_manual(values = rev(wes_palette(7, name = "Zissou1", type = "continuous")))+
+ ggtitle(expression(EOS[50]~(PEP725~data))) +
+ plotTheme1
+
+#define plot layout
+layout <- "
+A
+B
+C"
+
+#Merge plots
+DriverPlot = A + B + C +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'a')&
+ theme(plot.tag = element_text(face = 'bold'))
+
+#save plots as .pdf
+ggsave(DriverPlot, file="FigS22_DriverPlot_All_moisture.pdf", path=output_path,
+ width=3, height=8)
+
+DriverPlot
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## datetime
+Sys.time()
+
+
+## session info
+sessionInfo()
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+```
+
\ No newline at end of file
diff --git a/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.4_Preseason_sensitivity.Rmd b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.4_Preseason_sensitivity.Rmd
new file mode 100644
index 0000000..9b1d9ff
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.4_Preseason_sensitivity.Rmd
@@ -0,0 +1,511 @@
+---
+title: Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice
+author: Constantin Zohner
+date: "last updated March 31, 2023"
+
+subtitle: Autumn temperature sensitivity (Figure S18)
+output:
+ html_document:
+ highlight: haddock
+ toc: false
+ use_bookdown: true
+ df_print: paged
+---
+
+
+
+
+
+### Figure descriptions
+- Fig. S18: The effect of autumn temperature on EOS10 (A), EOSstart (B), and EOS50 dates (C,D)
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(
+ class.source = "numberLines lineAnchors"
+ )
+```
+
+
+
+```{r, message=FALSE, warning=FALSE, attr.source='.numberLines'}
+###################
+# Required packages
+###################
+
+
+
+require(tidyverse)
+require(data.table)
+require(broom)
+require(gmodels)
+require(patchwork)
+require(MASS)
+
+
+#define plot themes
+plotTheme1 = theme(legend.position = "none",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################################
+## Set directories and get own PEP data ##
+##########################################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2")
+
+# paths
+Drivers_path_PEP = "PEP_analysis/Analysis/Analysis_input/PEP_drivers_final/Merged_file"
+Drivers_path_EOS10 = "Remote_sensing/Analysis/Analysis_input/Drivers_final_EOS10/Merged_file"
+Drivers_path_EOSstart = "Remote_sensing/Analysis/Analysis_input/Drivers_final_onset_VNP/Merged_file"
+Drivers_path_EOS50 = "Remote_sensing/Analysis/Analysis_input/Drivers_final_EOS50/Merged_file"
+
+Land_cover_path = "Remote_sensing/Analysis/Analysis_input/Drivers"
+output_path = "Remote_sensing/Analysis/Analysis_output_startSen/Preseason_temperatures"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Land cover info
+################
+
+LandCover.df <- fread(paste(Land_cover_path, "Land_Cover_Type_025.csv", sep="/")) %>%
+ mutate(geometry = gsub("POINT ","", geometry),
+ geometry = gsub("\\(|\\)","", geometry)) %>%
+ separate(geometry, into = c("Lon","Lat"), sep=" ") %>%
+ mutate(Lat = round(as.numeric(Lat),3),
+ Lon = round(as.numeric(Lon),3) )
+
+
+#Local PEP725 data
+##################
+
+PEP.df <- fread(paste(Drivers_path_PEP, "pep_drivers_data.csv", sep="/"))%>%
+ dplyr::select(-V1)
+
+
+#MODIS EOS50 data
+#################
+
+MODIS.EOS50.df <- fread(paste(Drivers_path_EOS50, "Remote_sensing_drivers_data.csv", sep="/"))%>%
+ dplyr::select(-V1) %>%
+ #Add land cover type info
+ mutate(Year = as.numeric(Year)) %>%
+ inner_join(LandCover.df, by=c("Lat","Lon")) %>%
+ #delete evergreen broadleaf pixels
+ filter(!LC_Type == "EvgB")
+
+
+#MODIS EOS10 data
+#################
+
+MODIS.EOS10.df <- fread(paste(Drivers_path_EOS10, "Remote_sensing_drivers_data_startSen.csv", sep="/"))%>%
+ dplyr::select(-V1) %>%
+ filter(
+ #delete senescence dates before DOY 140 and after DOY 290
+ Senesc_DOY>140,Senesc_DOY<290,
+ #delete observation if senescence date occurs before MidGreenup date
+ Senesc_DOY>MidGreenup_DOY)%>%
+ group_by(geometry) %>%
+ #delete pixels with fewer than 15 years
+ filter(n() >= 15) %>%
+ ungroup() %>%
+ #Add land cover type info
+ mutate(Year = as.numeric(Year)) %>%
+ inner_join(LandCover.df, by=c("Lat","Lon")) %>%
+ #delete evergreen broadleaf pixels
+ filter(!LC_Type == "EvgB")
+
+
+#MODIS EOS10 data
+#################
+
+MODIS.EOSstart.df <- fread(paste(Drivers_path_EOSstart, "Remote_sensing_drivers_data_onset_VNP.csv", sep="/"))%>%
+ dplyr::select(-V1) %>%
+ group_by(geometry) %>%
+ #delete pixels with fewer than 9 years
+ filter(n() >= 9) %>%
+ ungroup() %>%
+ #Add land cover type info
+ mutate(Year = as.numeric(Year)) %>%
+ inner_join(LandCover.df, by=c("Lat","Lon")) %>%
+ #delete evergreen broadleaf pixels
+ filter(!LC_Type == "EvgB")
+
+
+rm(LandCover.df)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## PEP725 data ##
+#################
+
+
+
+#reshape table to long format
+#############################
+
+preseason.df = PEP.df %>%
+ #select columns
+ dplyr::select(timeseries,year,species,pep_id,leaf_off,
+ Tday.PS.10,Tday.PS.20,Tday.PS.30,
+ Tday.PS.40,Tday.PS.50,Tday.PS.60,
+ Tday.PS.70,Tday.PS.80,Tday.PS.90,
+ Tday.PS.100,Tday.PS.110,Tday.PS.120,
+ Tnight.PS.10,Tnight.PS.20,Tnight.PS.30,
+ Tnight.PS.40,Tnight.PS.50,Tnight.PS.60,
+ Tnight.PS.70,Tnight.PS.80,Tnight.PS.90,
+ Tnight.PS.100,Tnight.PS.110,Tnight.PS.120)%>%
+ #long format
+ pivot_longer(.,cols=starts_with(c("Td","Tn")), names_to = "preseason", values_to = "temp") %>%
+ #create preseason length and temperature class columns
+ mutate(preseason_length = readr::parse_number(gsub("[.]", "", preseason)), #keep only numbers in string
+ temp_class = gsub("\\..*","", preseason)) %>%
+ dplyr::select(-preseason)
+
+
+#Run linear models
+##################
+
+results.PEP = preseason.df %>%
+ group_by(timeseries, species, pep_id, temp_class, preseason_length) %>%
+ do({model = lm(scale(leaf_off) ~ scale(temp), data=.) # linear model
+ data.frame(tidy(model), # coefficient info
+ glance(model))}) %>% # model info
+ filter(!term %in% c("(Intercept)")) %>%
+ dplyr::select(timeseries,species,pep_id,temp_class,preseason_length,estimate,r.squared)%>%
+ ungroup()
+
+
+#Plot correlation coefficients
+##############################
+
+plot.PEP = results.PEP %>%
+ ggplot()+
+ aes(x=preseason_length, y=estimate,
+ colour=temp_class, group=temp_class) +
+
+ geom_hline(yintercept=0)+
+
+ stat_summary(fun = mean, geom="line", size = .7) +
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.5, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = .7) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+ xlab("Preseason length (days)") +
+ ylab("") +
+ coord_cartesian(ylim = c(-.36, 0.36))+
+ facet_wrap(~species, ncol=1, strip.position = "right") +
+ plotTheme1+
+ theme(strip.text.y = element_text(face="italic"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+######################
+## MODIS EOS50 data ##
+######################
+
+
+
+#reshape table to long format
+#############################
+
+preseason.df = MODIS.EOS50.df %>%
+ #select columns
+ dplyr::select(geometry,Year,LC_Type,MidGreendown_DOY,
+ Tday.PS.10,Tday.PS.20,Tday.PS.30,
+ Tday.PS.40,Tday.PS.50,Tday.PS.60,
+ Tday.PS.70,Tday.PS.80,Tday.PS.90,
+ Tday.PS.100,Tday.PS.110,Tday.PS.120,
+ Tnight.PS.10,Tnight.PS.20,Tnight.PS.30,
+ Tnight.PS.40,Tnight.PS.50,Tnight.PS.60,
+ Tnight.PS.70,Tnight.PS.80,Tnight.PS.90,
+ Tnight.PS.100,Tnight.PS.110,Tnight.PS.120)%>%
+ #long format
+ pivot_longer(.,cols=starts_with(c("Td","Tn")), names_to = "preseason", values_to = "temp") %>%
+ #create preseason length and temperature class columns
+ mutate(preseason_length = readr::parse_number(gsub("[.]", "", preseason)), #keep only numbers in string
+ temp_class = gsub("\\..*","", preseason)) %>%
+ dplyr::select(-preseason)
+
+
+#Run linear models
+##################
+
+results.MODIS.EOS50 = preseason.df %>%
+ group_by(geometry, LC_Type, temp_class, preseason_length) %>%
+ do({model = lm(scale(MidGreendown_DOY) ~ scale(temp), data=.) # linear model
+ data.frame(tidy(model), # coefficient info
+ glance(model))}) %>% # model info
+ filter(!term %in% c("(Intercept)")) %>%
+ dplyr::select(geometry,LC_Type,temp_class,preseason_length,estimate,r.squared)%>%
+ ungroup()
+
+
+#Plot correlation coefficients
+##############################
+
+plot.MODIS.EOS50 = results.MODIS.EOS50 %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN"), ordered=T)) %>%
+ ggplot()+
+ aes(x=preseason_length, y=estimate,
+ colour=temp_class) +
+
+ geom_hline(yintercept=0)+
+
+ stat_summary(fun = mean, geom="line", size = .7) +
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.5, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = .7) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+
+ xlab("Preseason length (days)") +
+ ylab("") +
+ coord_cartesian(ylim = c(-.36, 0.36))+
+ facet_wrap(~LC_Type, ncol=1, strip.position = "right") +
+ plotTheme1
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+######################
+## MODIS EOS10 data ##
+######################
+
+
+
+#reshape table to long format
+#############################
+
+preseason.df = MODIS.EOS10.df %>%
+ #select columns
+ dplyr::select(geometry,Year,LC_Type,Senesc_DOY,
+ Tday.PS.10,Tday.PS.20,Tday.PS.30,
+ Tday.PS.40,Tday.PS.50,Tday.PS.60,
+ Tday.PS.70,Tday.PS.80,Tday.PS.90,
+ Tday.PS.100,Tday.PS.110,Tday.PS.120,
+ Tnight.PS.10,Tnight.PS.20,Tnight.PS.30,
+ Tnight.PS.40,Tnight.PS.50,Tnight.PS.60,
+ Tnight.PS.70,Tnight.PS.80,Tnight.PS.90,
+ Tnight.PS.100,Tnight.PS.110,Tnight.PS.120)%>%
+ #long format
+ pivot_longer(.,cols=starts_with(c("Td","Tn")), names_to = "preseason", values_to = "temp") %>%
+ #create preseason length and temperature class columns
+ mutate(preseason_length = readr::parse_number(gsub("[.]", "", preseason)), #keep only numbers in string
+ temp_class = gsub("\\..*","", preseason)) %>%
+ dplyr::select(-preseason)
+
+
+#Run linear models
+##################
+
+results.MODIS.EOS10 = preseason.df %>%
+ group_by(geometry, LC_Type, temp_class, preseason_length) %>%
+ do({model = lm(scale(Senesc_DOY) ~ scale(temp), data=.) # linear model
+ data.frame(tidy(model), # coefficient info
+ glance(model))}) %>% # model info
+ filter(!term %in% c("(Intercept)")) %>%
+ dplyr::select(geometry,LC_Type,temp_class,preseason_length,estimate,r.squared)%>%
+ ungroup()
+
+
+#Plot correlation coefficients
+##############################
+
+plot.MODIS.EOS10 = results.MODIS.EOS10 %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN"), ordered=T)) %>%
+ ggplot()+
+ aes(x=preseason_length, y=estimate,
+ colour=temp_class) +
+
+ geom_hline(yintercept=0)+
+
+ stat_summary(fun = mean, geom="line", size = .7) +
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.5, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = .7) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+
+ xlab("Preseason length (days)") +
+ ylab("Standardized coefficient") +
+ coord_cartesian(ylim = c(-.36, 0.36))+
+ facet_wrap(~LC_Type, ncol=1, strip.position = "right") +
+ plotTheme1
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#########################
+## MODIS EOSstart data ##
+#########################
+
+
+
+#reshape table to long format
+#############################
+
+preseason.df = MODIS.EOSstart.df %>%
+ #select columns
+ dplyr::select(geometry,Year,LC_Type,Onset_Greenness_Decrease,
+ Tday.PS.10,Tday.PS.20,Tday.PS.30,
+ Tday.PS.40,Tday.PS.50,Tday.PS.60,
+ Tday.PS.70,Tday.PS.80,Tday.PS.90,
+ Tday.PS.100,Tday.PS.110,Tday.PS.120,
+ Tnight.PS.10,Tnight.PS.20,Tnight.PS.30,
+ Tnight.PS.40,Tnight.PS.50,Tnight.PS.60,
+ Tnight.PS.70,Tnight.PS.80,Tnight.PS.90,
+ Tnight.PS.100,Tnight.PS.110,Tnight.PS.120)%>%
+ #long format
+ pivot_longer(.,cols=starts_with(c("Td","Tn")), names_to = "preseason", values_to = "temp") %>%
+ #create preseason length and temperature class columns
+ mutate(preseason_length = readr::parse_number(gsub("[.]", "", preseason)), #keep only numbers in string
+ temp_class = gsub("\\..*","", preseason)) %>%
+ dplyr::select(-preseason)
+
+
+#Run linear models
+##################
+
+results.MODIS.EOSstart = preseason.df %>%
+ group_by(geometry, LC_Type, temp_class, preseason_length) %>%
+ do({model = lm(scale(Onset_Greenness_Decrease) ~ scale(temp), data=.) # linear model
+ data.frame(tidy(model), # coefficient info
+ glance(model))}) %>% # model info
+ filter(!term %in% c("(Intercept)")) %>%
+ dplyr::select(geometry,LC_Type,temp_class,preseason_length,estimate,r.squared)%>%
+ ungroup()
+
+
+#Plot correlation coefficients
+##############################
+
+plot.MODIS.EOSstart = results.MODIS.EOSstart %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN"), ordered=T)) %>%
+ ggplot()+
+ aes(x=preseason_length, y=estimate,
+ colour=temp_class) +
+
+ geom_hline(yintercept=0)+
+
+ stat_summary(fun = mean, geom="line", size = .7) +
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.5, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = .7) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+
+ xlab("Preseason length (days)") +
+ ylab("") +
+ coord_cartesian(ylim = c(-.36, 0.36))+
+ facet_wrap(~LC_Type, ncol=1, strip.position = "right") +
+ plotTheme1
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################
+# Arrange and safe plots #
+##########################
+
+
+
+#define plot layout
+layout <- "ABCD"
+
+#Merge plots
+PreseasonPlot = plot.MODIS.EOS10 + plot.MODIS.EOSstart + plot.MODIS.EOS50 + plot.PEP +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A')&
+ theme(plot.tag = element_text(face = 'bold'))
+
+#Safe plot
+pdf(paste(output_path,"FigS18_Preseason_sensitivity_all.pdf",sep="/"), width=9, height=7, useDingbats=FALSE)
+PreseasonPlot
+dev.off()
+
+PreseasonPlot
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## datetime
+Sys.time()
+
+
+## session info
+sessionInfo()
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+```
+
\ No newline at end of file
diff --git a/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.5_TemporalTrendsMaps.Rmd b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.5_TemporalTrendsMaps.Rmd
new file mode 100644
index 0000000..1adcf85
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.5_TemporalTrendsMaps.Rmd
@@ -0,0 +1,571 @@
+---
+title: Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice
+author: Constantin Zohner
+date: "last updated March 31, 2023"
+
+subtitle: Maps of temporal trends (Figure S14)
+output:
+ html_document:
+ highlight: haddock
+ toc: false
+ use_bookdown: true
+ df_print: paged
+---
+
+
+
+
+
+### Figure descriptions
+- Fig. S14: Temporal trends in (A) pre-solstice gross primary productivity [GPP], (C) senescence onset (EOS10) dates, (E) mid-senescence (EOS50) dates, (G) senescence duration (EOS10-to-EOS50) and (I) autumn temperature at 0.25° resolution for the 2001—2018 period
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(
+ class.source = "numberLines lineAnchors"
+ )
+```
+
+
+
+```{r, message=FALSE, warning=FALSE, attr.source='.numberLines'}
+###################
+# Required packages
+###################
+
+
+
+require(tidyverse)
+require(data.table)
+require(gmodels)
+require(lme4)
+require(car)
+require(sjmisc)
+require(wesanderson)
+require(patchwork)
+require(broom)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2")
+
+# paths
+Drivers_path = "Remote_sensing/Analysis/Analysis_input/Drivers_final_EOS10/Merged_file"
+EOS50_path = "Remote_sensing/Analysis/Analysis_input/Drivers_final_EOS50/Merged_file"
+output_path = "Remote_sensing/Analysis/Analysis_output_startSen/TemporalTrendsMaps"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#EOS10 data
+Pheno.df <- fread(paste(Drivers_path, "Remote_sensing_drivers_data_startSen_preseason.csv", sep="/")) %>%
+ mutate(GPPstart.LO.SO = GPPstart.LO.SO*0.1,
+ AutumnTday = rowMeans(dplyr::select(.,`Tday9`,`Tday10`)))
+
+#EOS50 data
+EOS50.df <- fread(paste(EOS50_path, "Remote_sensing_drivers_data_preseason.csv", sep="/"))%>%
+ dplyr::select(c(geometry, Year, MidGreendown_DOY, Tday))
+
+#Merge
+Pheno.df = merge(Pheno.df, EOS50.df, by=c("geometry", "Year")) %>%
+ mutate(EOS50_EOS10 = MidGreendown_DOY-Senesc_DOY)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+plotTheme1 = theme(
+ legend.position = "none",
+ legend.background = element_blank(),
+ legend.text = element_text(color="black"),
+ legend.title = element_blank(),
+ legend.key = element_blank(),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(color="black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(hjust=0.5))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+###################################
+## Run pixel-level linear models ##
+###################################
+
+
+
+Model.df = Pheno.df %>%
+ group_by(geometry, Lat, Lon) %>%
+ do({
+
+ #run model
+ ##########
+
+ model1 = lm(GPPstart.LO.SO ~ Year, data=.)
+ model2 = lm(Greenup_DOY ~ Year, data=.)
+ model3 = lm(Tday.y ~ Year, data=.)
+ model4 = lm(Senesc_DOY ~ Year, data=.)
+ model5 = lm(MidGreendown_DOY ~ Year, data=.)
+ model6 = lm(EOS50_EOS10 ~ Year, data=.)
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(rbind(
+ tidy(model1) %>% mutate(model = "GPP"),
+ tidy(model2) %>% mutate(model = "Greenup"),
+ tidy(model3) %>% mutate(model = "AutumnTday"),
+ tidy(model4) %>% mutate(model = "EOS10"),
+ tidy(model5) %>% mutate(model = "EOS50"),
+ tidy(model6) %>% mutate(model = "EOSduration")
+ ))
+ }) %>%
+ #delete intercept
+ filter(!term %in% c("(Intercept)"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Create maps ##
+#################
+
+
+
+#Get world map
+mp <- NULL
+mapWorld <- borders("world", colour="gray40", fill="gray40") # create a layer of borders
+
+#---------------------------------------------------------------------------------------
+
+#Add GPP info
+#############
+
+mapGPP =
+ Model.df %>%
+ filter(model == "GPP") %>%
+ mutate(estimate = ifelse(estimate > 10, 10,
+ ifelse(estimate < -10, -10, estimate))) %>%
+ ggplot() + mapWorld + plotTheme1 +
+ geom_tile(show.legend=T,
+ aes(x = Lon, y = Lat, fill=estimate)) +
+ scale_fill_gradient2(midpoint=0,
+ low='#3B9AB2',
+ mid="white",
+ high='#F21A00',
+ space ="Lab" ) +
+ coord_cartesian(ylim = c(27, 75), xlim = c(-160, 175)) +
+ xlab("") + ylab('Latitude') +
+ ggtitle("Pre-solstice GPP")+
+ theme(legend.position = c(0.08,0.33),
+ panel.background = element_rect(fill = "grey1", colour = NA),
+ legend.text=element_text(color="white"))
+
+#---------------------------------------------------------------------------------------
+
+#Add Greenup info
+#################
+
+mapGreenup = Model.df %>%
+ filter(model == "Greenup") %>%
+ mutate(estimate = ifelse(estimate > 1.5, 1.5,
+ ifelse(estimate < -1.5, -1.5, estimate))) %>%
+ ggplot() + mapWorld + plotTheme1 +
+ geom_tile(show.legend=T, aes(x = Lon, y = Lat, fill=estimate)) +
+ scale_fill_gradient2(midpoint=0,
+ low='#3B9AB2',
+ mid="white",
+ high='#F21A00',
+ space ="Lab" ) +
+ coord_cartesian(ylim = c(27, 75), xlim = c(-160, 175)) +
+ xlab("") + ylab('Latitude') +
+ ggtitle("Spring leaf-out")+
+ theme(legend.position = c(0.08,0.33),
+ panel.background = element_rect(fill = "grey1", colour = NA),
+ legend.text=element_text(color="white"))
+
+#---------------------------------------------------------------------------------------
+
+#Add autumn temperature info
+############################
+
+mapAutumn = Model.df %>%
+ filter(model == "AutumnTday") %>%
+ mutate(estimate = ifelse(estimate > .2, .2,
+ ifelse(estimate < -.2, -.2, estimate))) %>%
+ ggplot() + mapWorld + plotTheme1 +
+ geom_tile(show.legend=T, aes(x = Lon, y = Lat, fill=estimate)) +
+ scale_fill_gradient2(midpoint=0,
+ low='#3B9AB2',
+ mid="white",
+ high='#F21A00',
+ space ="Lab" ) +
+ coord_cartesian(ylim = c(27, 75), xlim = c(-160, 175)) +
+ xlab("") + ylab('Latitude') +
+ ggtitle("Autumn temperature")+
+ theme(legend.position = c(0.08,0.33),
+ panel.background = element_rect(fill = "grey1", colour = NA),
+ legend.text=element_text(color="white"))
+
+#---------------------------------------------------------------------------------------
+
+#Add EOS10 info
+###############
+
+mapEOS10 = Model.df %>%
+ filter(model == "EOS10") %>%
+ mutate(estimate = ifelse(estimate > .8, .8,
+ ifelse(estimate < -.8, -.8, estimate))) %>%
+ ggplot() + mapWorld + plotTheme1 +
+ geom_tile(show.legend=T, aes(x = Lon, y = Lat, fill=estimate)) +
+ scale_fill_gradient2(midpoint=0,
+ low='#3B9AB2',
+ mid="white",
+ high='#F21A00',
+ space ="Lab" ) +
+ coord_cartesian(ylim = c(27, 75), xlim = c(-160, 175)) +
+ xlab("") + ylab('Latitude') +
+ ggtitle(expression(Senescence~onset~(EOS[10])))+
+ theme(legend.position = c(0.08,0.33),
+ panel.background = element_rect(fill = "grey1", colour = NA),
+ legend.text=element_text(color="white"))
+
+#---------------------------------------------------------------------------------------
+
+#Add EOS50 info
+###############
+
+mapEOS50 = Model.df %>%
+ filter(model == "EOS50") %>%
+ mutate(estimate = ifelse(estimate > .8, .8,
+ ifelse(estimate < -.8, -.8, estimate))) %>%
+ ggplot() + mapWorld + plotTheme1 +
+ geom_tile(show.legend=T, aes(x = Lon, y = Lat, fill=estimate)) +
+ scale_fill_gradient2(midpoint=0,
+ low='#3B9AB2',
+ mid="white",
+ high='#F21A00',
+ space ="Lab" ) +
+ coord_cartesian(ylim = c(27, 75), xlim = c(-160, 175)) +
+ xlab("") + ylab('Latitude') +
+ ggtitle(expression("Mid-senescence"~(EOS[50])))+
+ theme(legend.position = c(0.08,0.33),
+ panel.background = element_rect(fill = "grey1", colour = NA),
+ legend.text=element_text(color="white"))
+
+#---------------------------------------------------------------------------------------
+
+#Add EOS duration info
+######################
+
+mapEOSduration = Model.df %>%
+ filter(model == "EOSduration") %>%
+ mutate(estimate = ifelse(estimate > 1.2, 1.2,
+ ifelse(estimate < -1.2, -1.2, estimate))) %>%
+ ggplot() + mapWorld + plotTheme1 +
+ geom_tile(show.legend=T, aes(x = Lon, y = Lat, fill=estimate)) +
+ scale_fill_gradient2(midpoint=0,
+ low='#3B9AB2',
+ mid="white",
+ high='#F21A00',
+ space ="Lab" ) +
+ coord_cartesian(ylim = c(27, 75), xlim = c(-160, 175)) +
+ xlab("") + ylab('Latitude') +
+ ggtitle(expression(Senescence~duration~(EOS[50]-EOS[10])))+
+ theme(legend.position = c(0.08,0.33),
+ panel.background = element_rect(fill = "grey1", colour = NA),
+ legend.text=element_text(color="white"))
+
+
+
+#############################################################################
+
+
+
+###################
+# Latitudinal plots
+###################
+
+
+
+LatPlotGPP = Model.df %>%
+ filter(model == "GPP") %>%
+ mutate(LatRound = round(Lat)) %>%
+ group_by(term, LatRound) %>%
+ summarise(mean = mean(estimate),
+ lowCI = ci(estimate)[2],
+ highCI = ci(estimate)[3]) %>%
+ ggplot(aes(x = LatRound, y = mean, group=term, color=term, group=term)) +
+ geom_ribbon(aes(ymin=lowCI, ymax=highCI, fill=term), color=NA, alpha=0.4)+
+ geom_line()+
+ geom_hline(yintercept=0)+
+ scale_color_manual(values = c('#F21A00'))+
+ scale_fill_manual(values = c('#F21A00'))+
+ ylab(expression(gC~m^2~year^-1)) +
+ coord_flip(ylim = c(-10, 10),xlim=c(27,75))+
+ plotTheme1 +
+ theme(axis.text.y = element_blank(),
+ axis.title.y = element_blank())
+
+#---------------------------------------------------------------------------------------
+
+LatPlotGreenup = Model.df %>%
+ filter(model == "Greenup") %>%
+ mutate(LatRound = round(Lat)) %>%
+ group_by(term, LatRound) %>%
+ summarise(mean = mean(estimate),
+ lowCI = ci(estimate)[2],
+ highCI = ci(estimate)[3]) %>%
+ ggplot(aes(x = LatRound, y = mean, group=term, color=term, group=term)) +
+ geom_ribbon(aes(ymin=lowCI, ymax=highCI, fill=term), color=NA, alpha=0.4)+
+ geom_line()+
+ geom_hline(yintercept=0)+
+ scale_color_manual(values = c('#3B9AB2'))+
+ scale_fill_manual(values = c('#3B9AB2'))+
+ ylab("days per year") +
+ coord_flip(ylim = c(-1, 1),xlim=c(27,75))+
+ plotTheme1 +
+ theme(axis.text.y = element_blank(),
+ axis.title.y = element_blank())
+
+#---------------------------------------------------------------------------------------
+
+LatPlotAutumn = Model.df %>%
+ filter(model == "AutumnTday") %>%
+ mutate(LatRound = round(Lat)) %>%
+ group_by(term, LatRound) %>%
+ summarise(mean = mean(estimate),
+ lowCI = ci(estimate)[2],
+ highCI = ci(estimate)[3]) %>%
+ ggplot(aes(x = LatRound, y = mean, group=term, color=term, group=term)) +
+ geom_ribbon(aes(ymin=lowCI, ymax=highCI, fill=term), color=NA, alpha=0.4)+
+ geom_line()+
+ geom_hline(yintercept=0)+
+ scale_color_manual(values = c('#F21A00'))+
+ scale_fill_manual(values = c('#F21A00'))+
+ ylab("??C per year") +
+ coord_flip(ylim = c(-.12, .12),xlim=c(27,75))+
+ plotTheme1 +
+ theme(axis.text.y = element_blank(),
+ axis.title.y = element_blank())
+
+#---------------------------------------------------------------------------------------
+
+LatPlotEOS10 = Model.df %>%
+ filter(model == "EOS10") %>%
+ mutate(LatRound = round(Lat)) %>%
+ group_by(term, LatRound) %>%
+ summarise(mean = mean(estimate),
+ lowCI = ci(estimate)[2],
+ highCI = ci(estimate)[3]) %>%
+ ggplot(aes(x = LatRound, y = mean, group=term, color=term, group=term)) +
+ geom_ribbon(aes(ymin=lowCI, ymax=highCI, fill=term), color=NA, alpha=0.4)+
+ geom_line()+
+ geom_hline(yintercept=0)+
+ scale_color_manual(values = c('#3B9AB2'))+
+ scale_fill_manual(values = c('#3B9AB2'))+
+ ylab("days per year") +
+ coord_flip(ylim = c(-.3, .3),xlim=c(27,75))+
+ plotTheme1 +
+ theme(axis.text.y = element_blank(),
+ axis.title.y = element_blank())
+
+#---------------------------------------------------------------------------------------
+
+LatPlotEOS50 = Model.df %>%
+ filter(model == "EOS50") %>%
+ mutate(LatRound = round(Lat)) %>%
+ group_by(term, LatRound) %>%
+ summarise(mean = mean(estimate),
+ lowCI = ci(estimate)[2],
+ highCI = ci(estimate)[3]) %>%
+ ggplot(aes(x = LatRound, y = mean, group=term, color=term, group=term)) +
+ geom_ribbon(aes(ymin=lowCI, ymax=highCI, fill=term), color=NA, alpha=0.4)+
+ geom_line()+
+ geom_hline(yintercept=0)+
+ scale_color_manual(values = c('#F21A00'))+
+ scale_fill_manual(values = c('#F21A00'))+
+ ylab("days per year") +
+ coord_flip(ylim = c(-.3, .3),xlim=c(27,75))+
+ plotTheme1 +
+ theme(axis.text.y = element_blank(),
+ axis.title.y = element_blank())
+
+#---------------------------------------------------------------------------------------
+
+LatPlotEOSduration = Model.df %>%
+ filter(model == "EOSduration") %>%
+ mutate(LatRound = round(Lat)) %>%
+ group_by(term, LatRound) %>%
+ summarise(mean = mean(estimate),
+ lowCI = ci(estimate)[2],
+ highCI = ci(estimate)[3]) %>%
+ ggplot(aes(x = LatRound, y = mean, group=term, color=term, group=term)) +
+ geom_ribbon(aes(ymin=lowCI, ymax=highCI, fill=term), color=NA, alpha=0.4)+
+ geom_line()+
+ geom_hline(yintercept=0)+
+ scale_color_manual(values = c('#F21A00'))+
+ scale_fill_manual(values = c('#F21A00'))+
+ ylab("days per year") +
+ coord_flip(ylim = c(-.5, .5),xlim=c(27,75))+
+ plotTheme1 +
+ theme(axis.text.y = element_blank(),
+ axis.title.y = element_blank())
+
+
+
+#############################################################################
+
+
+
+################
+# Correlations #
+################
+
+
+
+#filter and long format
+Model.df.wide = Model.df%>%
+ dplyr::select(c(estimate, model)) %>%
+ filter(!Lat>62) %>%
+ pivot_wider(., names_from = model, names_sep = ".", values_from = estimate)
+
+#GPP trend versus EOS10 trend
+GPP_EOS10 = ggplot(Model.df.wide, aes(x=GPP, y=EOS10)) +
+ geom_hline(yintercept = 0, linetype="dashed") +
+ geom_smooth(method=lm, color='#3B9AB2')+
+ coord_cartesian(xlim = c(quantile(Model.df.wide$GPP,probs=0.01), quantile(Model.df.wide$GPP,probs=0.99)),
+ ylim = c(-0.4,0.4)) +
+ xlab(expression("Pre-solstice GPP trend"~(gC~m^-2~yr^-1))) +
+ ylab(expression(EOS[10]~trend~(days~yr^-1))) +
+ plotTheme1
+
+#Autumn Tday trend versus EOS50 trend
+AutumnTemp_EOS50 = ggplot(Model.df.wide, aes(x=AutumnTday, y=EOS50)) +
+ geom_hline(yintercept = 0, linetype="dashed") +
+ geom_smooth(method=lm, color='#F21A00') +
+ coord_cartesian(xlim = c(quantile(Model.df.wide$AutumnTday,probs=0.01), quantile(Model.df.wide$AutumnTday,probs=0.99)),
+ ylim = c(-0.4,0.4)) +
+ xlab(expression(Autumn~temperature~trend~(degree*C~yr^-1))) +
+ ylab(expression(EOS[50]~trend~(days~yr^-1))) +
+ plotTheme1
+
+#Autumn Tday trend versus EOS duration trend
+AutumnTemp_EOSduration = ggplot(Model.df.wide, aes(x=AutumnTday, y=EOSduration)) +
+ geom_hline(yintercept = 0, linetype="dashed") +
+ geom_smooth(method=lm, color='#F21A00') +
+ coord_cartesian(xlim = c(quantile(Model.df.wide$AutumnTday,probs=0.01), quantile(Model.df.wide$AutumnTday,probs=0.99)),
+ ylim = c(-0.4,0.4)) +
+ xlab(expression(Autumn~temperature~trend~(degree*C~yr^-1))) +
+ ylab(expression(Senescence~duration~trend~(days~yr^-1))) +
+ plotTheme1
+
+
+
+#############################################################################
+
+
+
+#############
+# All plots #
+#############
+
+
+#define plot layout
+layout <- "
+AAAAAB
+CCCCCD
+EEEEEF
+GGGGGH
+IIIIIJ
+KKLLMM"
+
+#Merge plots
+All_Plot =
+ mapGPP + LatPlotGPP +
+ mapEOS10 + LatPlotEOS10 +
+ mapEOS50 + LatPlotEOS50 +
+ mapEOSduration + LatPlotEOSduration +
+ mapAutumn + LatPlotAutumn +
+
+ GPP_EOS10 + AutumnTemp_EOS50 + AutumnTemp_EOSduration +
+
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'a') &
+ theme(plot.tag = element_text(face = 'bold'))
+
+#save plots as .pdf
+ggsave(All_Plot, file="FigS14_All_temporal_changes.pdf",
+ path=output_path,
+ width=12, height=3*6.1)
+
+All_Plot
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## datetime
+Sys.time()
+
+
+## session info
+sessionInfo()
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+```
+
\ No newline at end of file
diff --git a/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.6_LatitudePlot_pre_solstice.Rmd b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.6_LatitudePlot_pre_solstice.Rmd
new file mode 100644
index 0000000..67ecc4f
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.6_LatitudePlot_pre_solstice.Rmd
@@ -0,0 +1,294 @@
+---
+title: Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice
+author: Constantin Zohner
+date: "last updated March 31, 2023"
+
+subtitle: Latitude plot (Figure S12)
+output:
+ html_document:
+ highlight: haddock
+ toc: false
+ use_bookdown: true
+ df_print: paged
+---
+
+
+
+
+
+### Figure descriptions
+- Fig. S12: End date (red line) of the early-season growth period exhibiting an advancing effect on the onset of senescence (EOS10)
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(
+ class.source = "numberLines lineAnchors"
+ )
+```
+
+
+
+```{r, message=FALSE, warning=FALSE, attr.source='.numberLines'}
+###################
+# Required packages
+###################
+
+
+
+require(tidyverse)
+require(data.table)
+require(ggplot2)
+require(broom)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+
+# Paths
+
+#input
+Drivers_path = "Analysis_input/Drivers_final_EOS10/Merged_file"
+Analysis_path = "Analysis_output_startSen/Data"
+
+#output
+output_path = "Analysis_output_startSen/LatitudePlot"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+plotTheme1 = theme(
+ legend.position = "none",
+ legend.background = element_blank(),
+ legend.text = element_text(color="black"),
+ legend.title = element_blank(),
+ legend.key = element_blank(),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black',face = "italic"),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology data
+###############
+
+Pheno.df = fread(paste(Drivers_path, "Remote_sensing_drivers_data_startSen_preseason.csv", sep="/"))
+
+
+#Spatial (pixel-level) models
+#############################
+
+Analysis.df = fread(paste(Analysis_path, "Spatial_effect_data.csv", sep="/"))
+
+#geometry: unique pixel identifier
+#Lat: Latitude
+#Lon: Longitude
+#LC_type: All, DecB, DecN, EvgN, Mixed (Landcover type)
+#term: monthly coefficients (1-10) and seasonal coefficients
+#estimate: slopes or standardized coefficients of mixed effects models
+#std.error: std.error of coefficients
+#equation: full model 1/2, monthly/seasonal/solstice
+#variable: climate variable (LAI, GPP, Apm, Azani, Tday, Tnight, SWrad)
+
+
+# get models of climate/growth effects from spring/leaf-out to May 22, June 21, July 21, or August 20
+#####################################################################################################
+
+Model.df = Analysis.df %>%
+ filter(equation == "Seasonal.scaled",
+ variable %in% c("GPPstart"),
+ Lat>29.5, Lat<65.5) %>%
+ mutate(latRound = round(Lat,-.5),
+ period = gsub("^.*?\\.","", term)) %>%
+ filter(!period %in% c("LO.SE","SO.SE","SOm30.SE","SOp30.SE")) %>%
+ #create preseason length and temperature class columns
+ mutate(period_end = ifelse(period == "LO.SOm30", 172-30,
+ ifelse(period == "LO.SO", 172,
+ ifelse(period == "LO.SOp30", 172+30, 172+60))))
+
+
+
+#########################################################################################################################
+#########################################################################################################################
+
+
+
+#keep only models with most negative estimates and summarize by latitude
+########################################################################
+
+Model.df = Model.df %>%
+
+ #keep only model with most negative estimate for each pixel
+ group_by(geometry, latRound) %>%
+ top_n(-1, estimate) %>%
+ ungroup() %>%
+
+ #Summarize by latitude
+ group_by(latRound) %>%
+ summarise(end = mean(period_end),
+ end.lowCI = t.test(period_end)$conf.int[1],
+ end.hiCI = t.test(period_end)$conf.int[2])%>%
+ ungroup() %>%
+
+ #transform to date
+ mutate(end.date = as.Date(end, origin="1970-01-01"),
+ end.date.lowCI = as.Date(end.lowCI, origin="1970-01-01"),
+ end.date.hiCI = as.Date(end.hiCI, origin="1970-01-01"))
+
+
+
+#get leaf-out dates per latitude
+################################
+
+Leafout.df = Pheno.df %>%
+ filter(Lat>29.5, Lat<65.5) %>%
+ mutate(latRound = round(Lat)) %>%
+ group_by(latRound) %>%
+ summarise(start = mean(Greenup_DOY),
+ start.lowCI = t.test(Greenup_DOY)$conf.int[1],
+ start.hiCI = t.test(Greenup_DOY)$conf.int[2])%>%
+ ungroup() %>%
+
+ #transform to date
+ mutate(start.date = as.Date(start, origin="1970-01-01"),
+ start.date.lowCI = as.Date(start.lowCI, origin="1970-01-01"),
+ start.date.hiCI = as.Date(start.hiCI, origin="1970-01-01"))
+
+
+#Run linear models to test effect of latitude
+################################
+
+EndDateLM = summary(lm(end ~ latRound, data=Model.df))
+leafoutLM = summary(lm(start ~ latRound, data=Leafout.df))
+
+
+
+#########################################################################################################################
+#########################################################################################################################
+
+
+
+########
+# Plot #
+########
+
+
+
+LatPlot = ggplot(Model.df, aes(x = latRound, y = end.date)) +
+
+ #Solstice line
+ geom_hline(yintercept = as.Date('1970-06-21'), color="grey",size=3)+
+
+
+ #End of early-season effect data
+ geom_smooth(method='lm', formula = y~x, se = FALSE, linetype="dashed", color="black")+
+
+ geom_ribbon(aes(ymin = end.date.lowCI, ymax = end.date.hiCI),
+ fill = '#F21A00', color=NA, alpha = 0.3) +
+
+ geom_line(size=1, color="#F21A00") +
+
+
+
+ annotate(geom="text", x=-Inf, y = as.Date(Inf, origin="1970-01-01"), vjust=1.5, hjust=-.03, color= '#F21A00',
+ label=paste0("Mean = ", format(as.Date(floor(mean(Model.df$end)), origin="1970-01-01"), "%b %d"),
+ "\n",
+ round(EndDateLM$coefficients[2,1],2),
+ ' days per ??Lat, R2 = ', round(EndDateLM$r.squared,2),ifelse(EndDateLM$coefficients[2,4]>0.05," (n.s.)","check again")))+
+
+
+ #Add leaf-out data
+ geom_smooth(data = Leafout.df, aes(x=latRound, y=start.date),
+ method='lm', formula = y~x, se = FALSE, linetype="dashed", color="black")+
+
+ geom_ribbon(data = Leafout.df, aes(x=latRound, y=start.date, ymin = start.date.lowCI, ymax = start.date.hiCI),
+ fill = "green4", color=NA, alpha = 0.3) +
+
+ geom_line(data = Leafout.df, aes(x=latRound, y=start.date), color="green4", size=1)+
+
+ annotate(geom="text", x=Inf, y = as.Date(-Inf, origin="1970-01-01"), vjust=-.5, hjust=1.05, color= "green4",
+ label=paste0("Mean = ", format(as.Date(floor(mean(Leafout.df$start)), origin="1970-01-01"),"%b %d"),
+ "\n",
+ round(leafoutLM$coefficients[2,1],2),
+ ' days per ??Lat, R2 = ',
+ round(leafoutLM$r.squared,2),
+ ifelse(leafoutLM$coefficients[2,4]<0.001,"***","check again")))+
+
+
+ #Plot settings
+ coord_cartesian(xlim=c(31.47,61.5),ylim=c(as.Date('1970-04-01'),as.Date('1970-08-10')))+
+ xlab("Latitude") + ylab('End date of negative early-season effect')+
+ scale_y_date(date_labels = "%b %d")+
+ plotTheme1
+
+
+#save plots as .pdf
+ggsave(LatPlot, file="FigS12_LatitudePlot.pdf",
+ path=output_path,
+ width=4, height=4)
+
+LatPlot
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## datetime
+Sys.time()
+
+
+## session info
+sessionInfo()
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+```
+
\ No newline at end of file
diff --git a/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.7_Monthly_water_availability.Rmd b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.7_Monthly_water_availability.Rmd
new file mode 100644
index 0000000..3af1591
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.7_Monthly_water_availability.Rmd
@@ -0,0 +1,275 @@
+---
+title: Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice
+author: Constantin Zohner
+date: "last updated March 31, 2023"
+
+subtitle: Compare GPP/temperature effects with monthly water availability (Fig. S10)
+output:
+ html_document:
+ highlight: haddock
+ toc: false
+ use_bookdown: true
+ df_print: paged
+---
+
+
+
+
+
+### Figure descriptions
+- Fig. S10: The effects of pre-solstice GPP (upper panels) or temperature (lower panels) and monthly water availability (soil moisture in left panels; precipitation in right panels) on inter-annual variation in the timing of EOS10 from satellite observations.
+
+
+
+### Variable names
+- Prcp...Precipitation
+- Tday...Day-time temperature
+- GPP...Gross primary productivity
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(
+ class.source = "numberLines lineAnchors"
+ )
+```
+
+
+
+```{r, message=FALSE, warning=FALSE, attr.source='.numberLines'}
+###################
+# Required packages
+###################
+
+
+
+require(tidyverse)
+require(ggplot2)
+require(data.table)
+require(broom.mixed)
+require(sjmisc)
+require(lme4)
+
+
+
+#define plot themes
+plotTheme1 = theme(legend.position = "none",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+# paths
+Drivers_path = "Analysis_input/Drivers_final_EOS10/Merged_file"
+output_path = "Analysis_output_startSen/Monthly_water_availability"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+Pheno.df <- fread(paste(Drivers_path, "Remote_sensing_drivers_data_startSen_preseason.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##################################################################################################
+## Test correlation between monthly (June-September) precipitation and pre-solstice temperature ##
+##################################################################################################
+
+
+
+ModelResults.df = Pheno.df %>%
+
+ group_by(geometry) %>%
+ do({
+
+ #run model
+ ##########
+
+ model1 = lm(Prcp6~Tday.LO.SO, data=.)
+ model2 = lm(Prcp7~Tday.LO.SO, data=.)
+ model3 = lm(Prcp8~Tday.LO.SO, data=.)
+ model4 = lm(Prcp9~Tday.LO.SO, data=.)
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(rbind(
+
+ glance(model1) %>%
+ mutate(var = 'June'),
+ glance(model2) %>%
+ mutate(var = 'July'),
+ glance(model3) %>%
+ mutate(var = 'August'),
+ glance(model4) %>%
+ mutate(var = 'September')
+ ) )
+
+ })
+
+ModelResults.df %>%
+ group_by(var) %>%
+ summarize(mean = round(mean(r.squared), 2))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##################
+## Mixed models ##
+##################
+
+
+
+ModelResults.df = Pheno.df %>%
+ do({
+
+ #run model
+ ##########
+
+ model1 = lmer(scale(Senesc_DOY)~scale(Tday.LO.SO)+scale(Prcp6)+scale(Prcp7)+scale(Prcp8)+scale(Prcp9)+(1|geometry),
+ data=., control = lmerControl(optimizer ="Nelder_Mead"))
+ model2 = lmer(scale(Senesc_DOY)~scale(Tday.LO.SO)+scale(Moist6)+scale(Moist7)+scale(Moist8)+scale(Moist9)+(1|geometry),
+ data=., control = lmerControl(optimizer ="Nelder_Mead"))
+ model3 = lmer(scale(Senesc_DOY)~scale(GPP.LO.SO)+scale(Prcp6)+scale(Prcp7)+scale(Prcp8)+scale(Prcp9)+(1|geometry),
+ data=., control = lmerControl(optimizer ="Nelder_Mead"))
+ model4 = lmer(scale(Senesc_DOY)~scale(GPP.LO.SO)+scale(Moist6)+scale(Moist7)+scale(Moist8)+scale(Moist9)+(1|geometry),
+ data=., control = lmerControl(optimizer ="Nelder_Mead"))
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(rbind(
+
+ tidy(model1, effects="fixed") %>%
+ mutate(var1 = 'Precipitation',
+ var2 = 'Temperature'),
+ tidy(model2, effects="fixed") %>%
+ mutate(var1 = 'Moisture',
+ var2 = 'Temperature'),
+ tidy(model3, effects="fixed") %>%
+ mutate(var1 = 'Precipitation',
+ var2 = 'GPP'),
+ tidy(model4, effects="fixed") %>%
+ mutate(var1 = 'Moisture',
+ var2 = 'GPP')
+ ) )
+
+ }) %>%
+
+ #delete intercept
+ filter(!term %in% c("(Intercept)")) %>%
+ mutate(term = gsub("scale","",term),
+ term = gsub("\\(|\\)","",term),
+ term = plyr::revalue(term, c("Moist6"="June",
+ "Moist7"='July',
+ 'Moist8'='August',
+ 'Moist9'='September',
+ "Prcp6"="June",
+ "Prcp7"='July',
+ 'Prcp8'='August',
+ 'Prcp9'='September',
+ 'GPP.LO.SO'='Pre-solstice',
+ 'Tday.LO.SO'='Pre-solstice')),
+ term = factor(term, levels = c("Pre-solstice","June","July",'August',"September")))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########
+## Plot ##
+##########
+
+
+MonthlyWater.plot = ggplot(data = ModelResults.df, aes(x = term, y = estimate, fill=term)) +
+ geom_bar(stat = "identity")+
+ geom_errorbar(aes(ymin = estimate - 2*std.error, ymax = estimate + 2*std.error), width=.2,
+ position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ xlab("") + ylab("Standardized effect") +
+ coord_cartesian(ylim = c(-0.42,0.42)) +
+ scale_fill_manual(values = c('#F21A00',rep('#3B9AB2',4)))+
+ plotTheme1 +
+ theme(axis.text.x = element_text(angle = 45, hjust=1)) +
+ facet_grid(var2~var1)
+
+
+#save plots as .pdf
+ggsave(MonthlyWater.plot , file="FigS10_Monthly_water.pdf", path=output_path,
+ width=4.5, height=4.5)
+
+MonthlyWater.plot
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## date time
+Sys.time()
+
+## session info
+sessionInfo()
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+```
+
diff --git a/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.8_Full_model_noCO2.R b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.8_Full_model_noCO2.R
new file mode 100644
index 0000000..c9aa688
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS10_SenescenceStart/3.4_Figures/3.4.8_Full_model_noCO2.R
@@ -0,0 +1,269 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Full models excluding CO2 for the satellite data (EOS10) ##################################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(ggplot2)
+require(data.table)
+require(broom)
+require(sjmisc)
+
+
+
+#define plot themes
+plotTheme1 = theme(legend.position = "right",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+# paths
+Drivers_path = "Analysis_input/Drivers_final_EOS10/Merged_file"
+output_path = "Analysis_output_startSen/Reviewer5"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology data frame
+#####################
+
+Pheno.df <- fread(paste(Drivers_path, "Remote_sensing_drivers_data_startSen_preseason.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Full models ##
+#################
+
+
+
+#Define variables
+variables = c('GPPstart', 'Tday')
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+##############################################################################################################################################
+
+
+#Loop through variables
+#######################
+
+for (i in 1:length(variables)){
+
+ #delete pixels with no photosynthesis before solstice
+ if (variables[i] %in% c('GPPstart'))
+ Pheno.df2 = Pheno.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(paste0(variables[i],".LO.SO"))) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.df
+
+
+ #set equations
+ ##############
+
+ #define variable names
+ covariates = paste0(variables[i], c('.LO.SO','.SO.SE'))
+
+
+ #full models
+ equation.scaled1 = as.formula(paste("scale(Senesc_DOY) ~ ", paste0('scale(',covariates[1], ') + scale(', covariates[2], ')',
+ collapse="+"),
+ '+ scale(Prcp.LO.SO) + scale(Prcp.SO.SE)', collapse=""))
+
+ equation.2 = as.formula(paste("Senesc_DOY ~ ", paste0(covariates[1], '+', covariates[2],
+ collapse="+"),
+ '+ Prcp.LO.SO + Prcp.SO.SE', collapse=""))
+
+
+ ##############################################################################################################################################
+
+
+ ##############
+ #linear models
+ ##############
+
+
+ ModelResults.df = Pheno.df2 %>%
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+ do({
+
+ #run model
+ ##########
+
+ model1 = lm(equation.scaled1, data=.)
+ model2 = lm(equation.2, data=.)
+
+ #create combined data frame
+ ###########################
+
+ data.frame(rbind(
+
+ #Equation 1
+ tidy(model1) %>% mutate(equation = 'full model 1'),
+ tidy(model2) %>% mutate(equation = 'full model 2'))
+
+ )
+ }) %>%
+
+ #add variable name and delete "scale()" from term column
+ mutate(variable = variables[i],
+ term = gsub("scale","",term),
+ term = gsub("\\(|\\)","",term) ) %>%
+ #delete intercept
+ filter(!term %in% c("Intercept")) %>%
+ ungroup()
+
+
+ ##############################################################################################################################################
+
+
+ #store data frame in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+FullAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+###########
+## Plots ##
+###########
+
+
+
+variable.name="Tday"
+plotTday = FullAnalysis.df %>%
+ filter(variable == variable.name,
+ equation=="full model 1") %>%
+ mutate(term = factor(term,
+ levels=c(paste0(variable.name, ".LO.SO"),
+ "Prcp.LO.SO", 'Prcp.SO.SE',
+ paste0(variable.name, ".SO.SE")), ordered=T) ) %>%
+ ggplot(aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch=T)+
+ geom_hline(yintercept=0)+
+ xlab("") + ylab("Standardized effect") +
+ coord_cartesian(ylim = c(-.9,.9)) +
+ scale_fill_manual(values = c('#F21A00','grey60','grey35','#3B9AB2'))+
+ scale_x_discrete(labels = c(paste0(variable.name, " pre"),
+ 'Prcp pre','Prcp post',
+ paste0(variable.name, " post")))+
+ plotTheme1 +
+ theme(axis.text.x = element_text(angle = 45, hjust=1),
+ legend.position = "none")
+
+variable.name="GPPstart"
+plotGPP = FullAnalysis.df %>%
+ filter(variable == variable.name,
+ equation=="full model 1") %>%
+ mutate(term = factor(term,
+ levels=c(paste0(variable.name, ".LO.SO"),
+ "Prcp.LO.SO", 'Prcp.SO.SE',
+ paste0(variable.name, ".SO.SE")), ordered=T) ) %>%
+ ggplot(aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch=T)+
+ geom_hline(yintercept=0)+
+ xlab("") + ylab("") +
+ coord_cartesian(ylim = c(-.9,.9)) +
+ scale_fill_manual(values = c('#F21A00','grey60','grey35','#3B9AB2'))+
+ scale_x_discrete(labels = c(paste0(variable.name, " pre"),
+ 'Prcp pre','Prcp post',
+ paste0(variable.name, " post")))+
+ plotTheme1 +
+ theme(axis.text.x = element_text(angle = 45, hjust=1),
+ legend.position = "none")
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+################
+## Safe plots ##
+################
+
+
+
+layout <- "AB"
+
+#Merge plots
+Fig_Plot = plotTday + plotGPP +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A') &
+ theme(plot.tag = element_text(face = 'bold'))
+
+#save plots as .pdf
+ggsave(Fig_Plot, file='Fig2B_noCo2.pdf',
+ path=output_path,
+ width=6, height=3.5)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.1_Sample_sizes_RS.Rmd b/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.1_Sample_sizes_RS.Rmd
new file mode 100644
index 0000000..c5a1b69
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.1_Sample_sizes_RS.Rmd
@@ -0,0 +1,126 @@
+---
+title: "Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice"
+subtitle: "Satellite data (EOS50): sample size check"
+---
+
+
+
+## 1. Load packages and data
+
+get packages
+```{r}
+require(data.table)
+require(ggplot2)
+require(tidyverse)
+require(raster)
+require(viridis)
+
+
+#plot theme
+plotTheme1 = theme(
+ legend.position = "top",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.grid.major = element_line(colour = "lightgrey"),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+```
+
+
+get data
+```{r}
+## set working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+# paths
+Drivers_path = "Analysis_input/Drivers_final_EOS50/Merged_file"
+Land_cover_path = "Analysis_input/Drivers"
+
+## Import data
+Pheno.df <- fread(paste(Drivers_path, "Remote_sensing_drivers_data.csv", sep="/"))
+
+LandCover.df <- fread(paste(Land_cover_path, "Land_Cover_Type_025.csv", sep="/")) %>%
+ mutate(geometry = gsub("POINT ","", geometry),
+ geometry = gsub("\\(|\\)","", geometry)) %>%
+ separate(geometry, into = c("Lon","Lat"), sep=" ") %>%
+ mutate(Lat = as.numeric(Lat),
+ Lon = as.numeric(Lon))
+```
+
+
+
+
+## 2. Data cleaning
+show code
+```{r}
+Pheno.df = Pheno.df %>%
+ mutate(Year = as.numeric(Year)) %>%
+ dplyr::select(-c(V1)) %>%
+ left_join(LandCover.df, by=c("Lat","Lon")) %>%
+ #delete evergreen broadleaf pixels
+ filter(!LC_Type == "EvgB")
+```
+
+
+
+
+## 3. Check sample sizes
+show code
+```{r}
+#total observations
+nrow(Pheno.df)
+
+#how many sites in total?
+length(unique(Pheno.df$geometry))
+
+#time span
+range(Pheno.df$Year)
+hist(Pheno.df$Year, xlab="Year", main="Temporal distribution of data", col='lightblue', breaks=40)
+
+#latitudinal gradient
+range(Pheno.df$Lat)
+hist(Pheno.df$Lat, xlab="Latitude", main="Latitudinal gradient", col='lightblue')
+
+#Land cover types
+Pheno.df.unique = Pheno.df %>% distinct(geometry, .keep_all = T)
+barplot(table(Pheno.df.unique$LC_Type))
+table(Pheno.df.unique$LC_Type)
+
+#leaf-out data
+mean(Pheno.df$Greenup_DOY)
+sd(Pheno.df$Greenup_DOY)
+range(Pheno.df$Greenup_DOY)
+hist(Pheno.df$Greenup_DOY, xlab="Leaf-out date", main="Leaf-out gradient", col='lightblue')
+
+#leaf-off data
+mean(Pheno.df$MidGreendown_DOY)
+sd(Pheno.df$MidGreendown_DOY)
+range(Pheno.df$MidGreendown_DOY)
+hist(Pheno.df$MidGreendown_DOY, xlab="Senescence date", main="Senescence gradient", col='lightblue')
+
+#Create summary dataframe by time series
+n.years = Pheno.df %>%
+ group_by(geometry) %>%
+ summarise(count = n())
+mean(n.years$count)
+max(n.years$count)
+min(n.years$count)
+
+#Map the observations
+mp <- NULL
+mapWorld <- borders("world", colour="gray60", fill="gray60") # create a layer of borders
+mp <- ggplot() + mapWorld + plotTheme1
+
+#Now Layer the stations on top
+mp <- mp + geom_tile(data = Pheno.df,
+ aes(x = Lon, y = Lat, fill=LC_Type)) +
+ scale_fill_viridis_d(option = "D") +
+ coord_cartesian(ylim = c(20, 70)) +
+ xlab("") + ylab('')
+mp
+```
+
\ No newline at end of file
diff --git a/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.2_Add_preseasons_RS_MidGreendown.R b/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.2_Add_preseasons_RS_MidGreendown.R
new file mode 100644
index 0000000..52f0808
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.2_Add_preseasons_RS_MidGreendown.R
@@ -0,0 +1,397 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Run autumn temperature (preseason) models for the satellite data (EOS50) ##################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(data.table)
+require(broom)
+require(gmodels)
+require(patchwork)
+require(MASS)
+
+
+#define plot themes
+plotTheme1 = theme(legend.position = "none",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################################
+## Set directories and get own PEP data ##
+##########################################
+
+
+
+# set the working dirctory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+# paths
+Drivers_path = "Analysis_input/Drivers_final_EOS50/Merged_file"
+Land_cover_path = "Analysis_input/Drivers"
+output_path = "Analysis_output/Preseason_temperatures"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology data
+Pheno.df <- fread(paste(Drivers_path, "Remote_sensing_drivers_data.csv", sep="/"))%>%
+ dplyr::select(-V1)
+
+#Land cover info
+LandCover.df <- fread(paste(Land_cover_path, "Land_Cover_Type_025.csv", sep="/")) %>%
+ mutate(geometry = gsub("POINT ","", geometry),
+ geometry = gsub("\\(|\\)","", geometry)) %>%
+ separate(geometry, into = c("Lon","Lat"), sep=" ") %>%
+ mutate(Lat = round(as.numeric(Lat),3),
+ Lon = round(as.numeric(Lon),3) )
+
+#Merge tables
+Pheno.df = Pheno.df %>%
+ mutate(Year = as.numeric(Year)) %>%
+ inner_join(LandCover.df, by=c("Lat","Lon")) %>%
+ #delete evergreen broadleaf pixels
+ filter(!LC_Type == "EvgB")
+
+rm(LandCover.df)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+## Get best preseason ##
+########################
+
+
+
+#reshape table to long format
+#############################
+
+preseason.df = Pheno.df %>%
+ #select columns
+ dplyr::select(geometry,Year,LC_Type,MidGreendown_DOY,
+ Tday.PS.10,Tday.PS.20,Tday.PS.30,
+ Tday.PS.40,Tday.PS.50,Tday.PS.60,
+ Tday.PS.70,Tday.PS.80,Tday.PS.90,
+ Tday.PS.100,Tday.PS.110,Tday.PS.120,
+ Tnight.PS.10,Tnight.PS.20,Tnight.PS.30,
+ Tnight.PS.40,Tnight.PS.50,Tnight.PS.60,
+ Tnight.PS.70,Tnight.PS.80,Tnight.PS.90,
+ Tnight.PS.100,Tnight.PS.110,Tnight.PS.120)%>%
+ #long format
+ pivot_longer(.,cols=starts_with(c("Td","Tn")), names_to = "preseason", values_to = "temp") %>%
+ #create preseason length and temperature class columns
+ mutate(preseason_length = readr::parse_number(gsub("[.]", "", preseason)), #keep only numbers in string
+ temp_class = gsub("\\..*","", preseason)) %>%
+ dplyr::select(-preseason)
+
+
+#Run linear models
+##################
+
+resultsLM = preseason.df %>%
+ group_by(geometry, LC_Type, temp_class, preseason_length) %>%
+ do({model = lm(scale(MidGreendown_DOY) ~ scale(temp), data=.) # linear model
+ data.frame(tidy(model), # coefficient info
+ glance(model))}) %>% # model info
+ filter(!term %in% c("(Intercept)")) %>%
+ dplyr::select(geometry,LC_Type,temp_class,preseason_length,estimate,r.squared)%>%
+ ungroup()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+############################################
+## Plot preseason-senescence correlations ##
+############################################
+
+
+
+#R2
+###
+
+resultsLM = resultsLM %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN"), ordered=T))
+
+plot.R2 = resultsLM %>%
+ ggplot()+
+ aes(x=preseason_length, y=r.squared,
+ colour=temp_class) +
+
+ stat_summary(fun=mean, geom="line", size = .7) +
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.5, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = 1) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+
+ xlab("Preseason length (days)") +
+ ylab("Coefficient of determination (R2)") +
+ coord_cartesian(ylim = c(0.01, 0.15))+
+ facet_wrap(~LC_Type, ncol=1) +
+ plotTheme1 +
+ theme(strip.text.x = element_blank())
+
+
+#Correlation coefficient
+########################
+
+plot.estimate = resultsLM %>%
+ ggplot()+
+ aes(x=preseason_length, y=estimate,
+ colour=temp_class) +
+
+ stat_summary(fun = mean, geom="line", size = .7) +
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.5, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = 1) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+
+ xlab("Preseason length (days)") +
+ ylab("Standardized coefficient") +
+ coord_cartesian(ylim = c(0.01, 0.28))+
+ facet_wrap(~LC_Type, ncol=1) +
+ plotTheme1+
+ theme(strip.text.x = element_blank())
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################################################
+## Plot best preseason length for each temperature ##
+#####################################################
+
+
+
+#keep only models with best predictions
+resultsLM2 = resultsLM %>%
+ group_by(geometry,temp_class) %>%
+ top_n(1, r.squared) %>%
+ ungroup()
+
+#plot
+plot.length = resultsLM2 %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN"), ordered=T)) %>%
+ dplyr::select(LC_Type,temp_class,preseason_length)%>%
+
+ ggplot() + aes(x=temp_class, y=preseason_length) +
+
+ stat_summary(fun = mean,
+ fun.min = function(x) mean(x) - sd(x),
+ fun.max = function(x) mean(x) + sd(x),
+ geom = "pointrange",
+ size=0.5,
+ aes(colour = temp_class)) +
+
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+
+ coord_cartesian(ylim = c(5, 95))+
+ xlab("Daily temperature") +
+ ylab("Best preseason length (days)") +
+ facet_wrap(~LC_Type, ncol=1) +
+ plotTheme1+
+ theme(strip.text.x = element_blank(),
+ axis.text.x = element_text(angle = 45, hjust=1))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################################
+#Add best preseason temps to PEP data
+#####################################
+
+
+
+Pheno.df = Pheno.df %>%
+ inner_join(., preseason.df %>%
+ #filter by model data
+ semi_join(resultsLM2, by=c('geometry','temp_class','preseason_length')) %>%
+ dplyr::select(c(geometry,Year,temp_class,temp))%>%
+ pivot_wider(.,names_from = temp_class, values_from = temp),
+ by = c("Year", "geometry"))%>%
+ dplyr::select(-(cols=starts_with(c("Tday.PS","Tnight.PS"))))
+
+#Safe table
+write.csv(Pheno.df, paste(Drivers_path, "Remote_sensing_drivers_data_preseason.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##################################
+#Run linear ridge regression model
+##################################
+
+
+
+resultsLM3 = Pheno.df %>%
+ group_by(geometry,LC_Type) %>%
+ do({model = lm.ridge(scale(MidGreendown_DOY) ~ scale(Tday)+scale(Tnight), data=.) # linear model
+ data.frame(tidy(model), # coefficient info
+ glance(model))}) %>% # model info
+ ungroup() %>%
+ #rename temperature class
+ mutate(term=dplyr::recode(term, `scale(Tday)`="Tday", `scale(Tnight)`="Tnight"))
+
+#plot preseason-senescence correlations
+plot.ridge = resultsLM3 %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN"), ordered=T) ) %>%
+
+ ggplot()+
+ aes(x=term, y=estimate,
+ colour=term, fill = term) +
+ scale_colour_manual(values = c('#F21A00','#3B9AB2')) +
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.9, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = 1) +
+
+ geom_hline(yintercept = 0)+
+ xlab("Daily temperature") +
+ ylab("Standardized coefficient (ridge regression)") +
+ coord_cartesian(ylim = c(-0.3, 0.3))+
+ facet_wrap(~LC_Type, ncol=1,strip.position = "right") +
+ plotTheme1+
+ theme(axis.text.x = element_text(angle = 45, hjust=1))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################
+# Arrange and safe plots #
+##########################
+
+
+
+#define plot layout
+layout <- "AABBCD"
+
+#Merge plots
+PreseasonPlot = plot.R2 + plot.estimate + plot.length + plot.ridge +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'a')&
+ theme(plot.tag = element_text(face = 'bold'))
+
+#Safe plot
+pdf(paste(output_path,"Preseason_sensitivity_RS.pdf",sep="/"), width=8, height=7, useDingbats=FALSE)
+PreseasonPlot
+dev.off()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+## datetime
+Sys.time()
+#"2021-07-13 10:00:16 CEST"
+
+
+## sessioninfo
+sessionInfo()
+#R version 4.1.0 (2021-05-18)
+#Platform: x86_64-apple-darwin17.0 (64-bit)
+#Running under: macOS Big Sur 11.2.3
+
+#Matrix products: default
+#LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+#locale:
+# [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+#attached base packages:
+# [1] stats graphics grDevices utils datasets methods base
+
+#other attached packages:
+# [1] MASS_7.3-54 patchwork_1.1.1 gmodels_2.18.1 broom_0.7.8 data.table_1.14.0 forcats_0.5.1
+#[7] stringr_1.4.0 dplyr_1.0.7 purrr_0.3.4 readr_1.4.0 tidyr_1.1.3 tibble_3.1.2
+#[13] ggplot2_3.3.4 tidyverse_1.3.1
+
+#loaded via a namespace (and not attached):
+# [1] httr_1.4.2 jsonlite_1.7.2 splines_4.1.0 modelr_0.1.8 gtools_3.9.2
+#[6] Formula_1.2-4 assertthat_0.2.1 latticeExtra_0.6-29 cellranger_1.1.0 pillar_1.6.1
+#[11] backports_1.2.1 lattice_0.20-44 glue_1.4.2 digest_0.6.27 RColorBrewer_1.1-2
+#[16] checkmate_2.0.0 rvest_1.0.0 colorspace_2.0-1 htmltools_0.5.1.1 Matrix_1.3-3
+#[21] pkgconfig_2.0.3 haven_2.4.1 scales_1.1.1 gdata_2.18.0 jpeg_0.1-8.1
+#[26] htmlTable_2.2.1 generics_0.1.0 farver_2.1.0 ellipsis_0.3.2 withr_2.4.2
+#[31] nnet_7.3-16 cli_2.5.0 survival_3.2-11 magrittr_2.0.1 crayon_1.4.1
+#[36] readxl_1.3.1 fs_1.5.0 fansi_0.5.0 xml2_1.3.2 foreign_0.8-81
+#[41] tools_4.1.0 hms_1.1.0 lifecycle_1.0.0 munsell_0.5.0 reprex_2.0.0
+#[46] cluster_2.1.2 compiler_4.1.0 rlang_0.4.11 grid_4.1.0 rstudioapi_0.13
+#[51] htmlwidgets_1.5.3 base64enc_0.1-3 labeling_0.4.2 gtable_0.3.0 DBI_1.1.1
+#[56] R6_2.5.0 gridExtra_2.3 lubridate_1.7.10 knitr_1.33 utf8_1.2.1
+#[61] Hmisc_4.5-0 stringi_1.6.2 Rcpp_1.0.6 vctrs_0.3.8 rpart_4.1-15
+#[66] png_0.1-7 dbplyr_2.1.1 tidyselect_1.1.1 xfun_0.24
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.3_Modeling/3.3.1_Spatial_models_EOS50.R b/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.3_Modeling/3.3.1_Spatial_models_EOS50.R
new file mode 100644
index 0000000..6fdf5c6
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.3_Modeling/3.3.1_Spatial_models_EOS50.R
@@ -0,0 +1,599 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Linear models for the satellite data (EOS50) ##############################################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(data.table)
+require(broom)
+require(sjmisc)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+# paths
+Drivers_path = "Analysis_input/Drivers_final_EOS50/Merged_file"
+output_path = "Analysis_output/Data"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology data frame
+#####################
+
+Pheno.df <- fread(paste(Drivers_path, "Remote_sensing_drivers_data_preseason.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+## VARIABLE EXPLANATION:
+########################
+
+#General
+########
+
+#geometry...site identifier
+#Year...observation year
+#Lat...site latitude (decimal degrees)
+#Lon...site longitude (decomal degrees)
+#alt...site altitude (m a.s.l.)
+
+#---------------------------------------------------
+
+#Phenology
+##########
+
+#MidGreendown_DOY...senescence date (DOY)
+#MidGreendownMean...mean timeseries senescence date (DOY)
+
+#---------------------------------------------------
+
+#Day-of-year maximum temperature and radiation
+##############################################
+
+#HottestDOY...DOY with maximum annual temperature
+#MaxRadDOY...DOY with maximum irradiance
+
+#---------------------------------------------------
+
+#Seasonal drivers
+#################
+
+#SUMS (flexible start = leaf-out):
+#---------------------------------
+#Apm...Daily net photosynthesis p-model
+#Azani...Daily net photosynthesis Zani model
+#GSI...photoperiod-influenced growing-season index
+#GSIrad...radiation-influenced growing-season index
+#GDDday...daytime degree days
+#GDDnight...nighttime degree days
+#SWrad...Radiation sum
+
+#MEANS (fixed start = March equinox):
+#------------------------------------
+#Tday...mean daytime temperature
+#Tnight...mean nighttime temperature
+#Moist...mean soil moisture (10-40cm)
+#Prcp...precipitation sum
+
+#-----------------
+
+#PERIODS
+
+#seasonal
+#--------
+#LO.SOm30...leaf-out to 30 days before summer solstice
+#LO.SO...leaf-out to summer solstice
+#LO.SOp30...leaf-out to 30 days after solstice
+#LO.SOp60...leaf-out to 60 days after solstice
+#LO.SE...leaf-out to mean senescence
+#SOm30.SE...30 days before solstice to mean senescence
+#SO.SE...solstice to mean senescence
+#SOp30.SE...30 days after solstice to mean senescence
+#SOp60.SE...60 days after solstice to mean senescence
+
+#around summer solstice
+#----------------------
+#solstice1...40 to 10 days before solstice
+#solstice2...30 days before solstice
+#solstice3...20 days before until 10 days after solstice
+#solstice4...10 days before until 20 days after solstice
+#solstice5...30 days after solstice
+#solstice6...10 to 40 days after solstice
+
+#---------------------------------------------------
+
+#Monthly drivers
+################
+
+#Tnight1-12...mean of nighttime temperatures in January (1) to December (12)
+#Tday1-12...mean of daytime temperatures in January (1) to December (12)
+#GDDnight1-12...sum of nighttime degree-days in January (1) to December (12)
+#GDDday1-12...sum of daytime degree-days in January (1) to December (12)
+#SWrad1-12...mean of daily short-wave radiation in January (1) to December (12)
+#Moist1-12...mean of daily soil moisture (10-40cm) in January (1) to December (12)
+#Prcp1-12...sum of daily precipitation in January (1) to December (12)
+#Apm1-12...sum of daily gross photosynthesis in January (1) to December (12)
+#Azani1-12...sum of daily net photosynthesis in January (1) to December (12)
+#GSI...day length-influenced growing-season index
+#GSIrad...radiation-influenced growing-season index
+
+#---------------------------------------------------
+
+#Preseason temperatures
+#######################
+
+#Tmin.PS15-90...mean daily minimum temperature 15 to 90 days prior to mean timeseries senescence date
+#tmean.PS15-90...mean daily mean temperature 15 to 90 days prior to mean timeseries senescence date
+#tmax.PS15-90...mean daily maximum temperature 15 to 90 days prior to mean timeseries senescence date
+
+#Tday...time series-specific best preseason (R2-based) for daytime temperatures
+#tnight...time series-specific best preseason (R2-based) for nighttime temperatures
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Full models ##
+#################
+
+
+
+#Define variables
+variables = c('GPPstart', 'LAIstart',
+ 'Apm', 'Azani',
+ 'Tnight', 'Tday',
+ 'SWrad')
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+##############################################################################################################################################
+
+
+#Loop through variables
+#######################
+
+for (i in 1:length(variables)){
+
+ #delete pixels with no photosynthesis before solstice
+ if (variables[i] %in% c("GPPstart","Azani","Apm"))
+ Pheno.df2 = Pheno.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(paste0(variables[i],".LO.SO"))) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.df
+
+
+ #set equations
+ ##############
+
+ #define variable names
+ covariates = paste0(variables[i], c('.LO.SO','.SO.SE'))
+
+
+ #full models
+ equation1 = as.formula(paste("scale(MidGreendown_DOY) ~ ",
+ paste0('scale(',covariates[1], ') + scale(', covariates[2], ')',
+ collapse="+"),
+ '+ scale(Prcp.LO.SO) + scale(Prcp.SO.SE) + scale(CO2) + scale(Tday)', collapse=""))
+
+ equation2 = as.formula(paste("scale(MidGreendown_DOY) ~ ",
+ paste0('scale(',covariates[1], ') + scale(', covariates[2], ')')))
+
+ equation3 = as.formula(paste("scale(MidGreendown_DOY) ~ ",
+ paste0('scale(',covariates[1], ') + scale(Tday)')))
+
+ ##############################################################################################################################################
+
+
+ ##############
+ #linear models
+ ##############
+
+
+ ModelResults.df = Pheno.df2 %>%
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+ do({
+
+ #run models
+ ###########
+
+ model1 = lm(equation1, data=.)
+ model2 = lm(equation2, data=.)
+ model3 = lm(equation3, data=.)
+
+ #create combined data frame
+ ###########################
+
+ data.frame(rbind(
+
+ #Equations 1-3
+ tidy(model1) %>% mutate(equation = 'full model1'),
+ tidy(model2) %>% mutate(equation = 'full model2'),
+ tidy(model3) %>% mutate(equation = 'full model3') )
+
+
+ )}) %>%
+
+ #add variable name and delete "scale()" from term column
+ mutate(variable = variables[i],
+ term = gsub("scale","",term),
+ term = gsub("\\(|\\)","",term) ) %>%
+ #delete intercept
+ filter(!term %in% c("Intercept")) %>%
+ ungroup()
+
+
+ ##############################################################################################################################################
+
+
+ #store data frame in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+FullAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################
+## Monthly correlations ##
+##########################
+
+
+
+#Get sums for January to April photosynthesis parameters
+Pheno.monthly.df = Pheno.df %>%
+ mutate(LAIstart4 = rowSums(dplyr::select(.,c("LAIstart1","LAIstart2","LAIstart3","LAIstart4"))),
+ GPPstart4 = rowSums(dplyr::select(.,c("GPPstart1","GPPstart2","GPPstart3","GPPstart4"))),
+ Apm4 = rowSums(dplyr::select(.,c("Apm1","Apm2","Apm3","Apm4"))),
+ Azani4 = rowSums(dplyr::select(.,c("Azani1","Azani2","Azani3","Azani4")))
+ )
+
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+##############################################################################################################################################
+
+
+#Loop through covariate groups
+##############################
+
+
+for (i in 1:length(variables)){
+
+ #delete pixels with no photosynthesis before solstice
+ #####################################################
+
+ if (variables[i] %in% c("GPPstart","LAIstart","Azani","Apm"))
+ Pheno.df2 = Pheno.monthly.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(paste0(variables[i],"4"))) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.monthly.df
+
+ #create explanatory variables
+ #############################
+
+ covariates.monthly = paste0(variables[i], c(1:10))
+
+ #---------------------------------------------------------
+
+ #set equations
+ ##############
+
+ if(variables[i] %in% c('GPPstart', 'LAIstart', 'SWrad', 'Apm', 'Azani')) {
+ equation = as.formula(paste("scale(MidGreendown_DOY) ~ ", paste('scale(', covariates.monthly[4:10], ')', collapse="+")))
+ } else {
+ equation = as.formula(paste("scale(MidGreendown_DOY) ~ ", paste('scale(', covariates.monthly, ')', collapse="+")))
+ }
+
+ #---------------------------------------------------------
+
+ ###############
+ # Linear models
+ ###############
+
+ ModelResults.df = Pheno.df2 %>%
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+ do({
+
+ #run models
+ ###########
+
+ model = lm(equation, data=.)
+
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(tidy(model) %>% mutate(equation = 'monthly'))
+ }) %>%
+
+ ungroup() %>%
+ #delete intercept
+ filter(!term %in% c("(Intercept)")) %>%
+ #add variable name and keep only numbers in month column
+ mutate(variable = variables[i],
+ term = readr::parse_number(term))
+
+
+ #---------------------------------------------------------
+
+ #store dataframe in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+MonthlyAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+######################
+## Seasonal drivers ##
+######################
+
+
+#Covariates
+###########
+
+#Variable length (leaf-out influenced):
+#--------------------------------------
+#Apm...Daily net photosynthesis (p-model)
+#Azani...Daily net photosynthesis (Zani model)
+#GSI...photoperiod-influenced growing-season index
+#GSIrad...radiation-influenced growing-season index
+#GDDday...daytime degree days
+#GDDnight...nighttime degree days
+#SWrad...Radiation sum
+
+#Fixed length:
+#-------------
+#Tday...mean daytime temperature
+#Tnight...mean daytime temperature
+
+
+#-------------------------------------------------------------
+
+
+## Define covariate groups
+seasons = c('LO.SOm30', 'LO.SO', 'LO.SOp30', 'LO.SOp60', 'LO.SE', 'SOm30.SE', 'SO.SE', 'SOp30.SE')
+solstice = c('solstice1', 'solstice2', 'solstice3', 'solstice4', 'solstice5', 'solstice6')
+
+covariates1 = paste(rep(variables, each=length(seasons)), seasons, sep = '.')
+covariates2 = paste(rep(variables, each=length(solstice)), solstice, sep = '.')
+covariates = c(covariates1,covariates2)
+
+#Check if all variables are in dataframe
+table(names(Pheno.df) %in% covariates)[2]/length(covariates)==1
+
+#-------------------------------------------------------------
+
+## Create List object to store results
+DataList = replicate(length(covariates), data.frame())
+names(DataList) = covariates
+i=1
+
+
+##############################################################################################################################################
+
+
+#Loop through covariates
+########################
+
+for (covariate in covariates){
+
+ #get variable name
+ variable = gsub("\\..*","", covariate)
+
+ #delete pixels with no photosynthesis for the respective period
+ if (variable %in% c("GPPstart","Azani","Apm"))
+ Pheno.df2 = Pheno.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(covariates[i])) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.df
+
+ #---------------------------------------------------------
+
+ #set equations
+ ##############
+
+ if(grepl("solstice",covariate) & variable %in% c("GPPstart","Azani","Apm","LAIstart","SWrad")) {
+ #autumn-temperature controlled scaled
+ equation = as.formula(paste("scale(MidGreendown_DOY) ~ ", paste('scale(', covariate, ')', collapse="+"),
+ '+ scale(Tday)', collapse=""))
+ } else {
+ #univariate scaled
+ equation = as.formula(paste("scale(MidGreendown_DOY) ~ ", paste('scale(', covariate, ')', collapse="+"), collapse=""))
+ }
+
+
+ ##############################################################################################################################################
+
+
+ ##################
+ #Run linear models
+ ##################
+
+
+
+ ModelResults.df = Pheno.df2 %>%
+
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+
+ do({
+
+ #run models
+ ###########
+
+ model = lm(equation, data=.)
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(
+
+ #Equation 1
+ tidy(model) %>%
+ add_column(equation = paste0(ifelse(str_contains(covariate, c("solstice"), logic="or"),"Solstice","Seasonal"),
+ '.scaled') ) %>%
+ filter(term %in% paste0('scale(',covariate,')')) )#delete intercept
+
+ }) %>%
+
+ #add variable name
+ mutate(term = covariate,
+ variable = sub("\\..*", "", covariate))
+
+
+ ##############################################################################################################################################
+
+
+ #store dataframe in variable list
+ DataList[[i]] = ModelResults.df
+
+ print(paste0('..... ',i, ' out of ', length(covariates), ' done'))
+ i=i+1
+}
+
+#bind tables
+SeasonalAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########
+## Safe ##
+##########
+
+
+
+#bind full model, monthly and seasonal analyses
+Analysis.df = rbind(FullAnalysis.df, MonthlyAnalysis.df, SeasonalAnalysis.df)
+
+#Safe tables
+write.csv(Analysis.df, paste(output_path, "Spatial_effect_data.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## datetime
+Sys.time()
+#"2021-12-08 14:21:44 CET"
+
+
+## session info
+sessionInfo()
+#R version 4.1.0 (2021-05-18)
+#Platform: x86_64-apple-darwin17.0 (64-bit)
+#Running under: macOS Big Sur 11.2.3
+
+#Matrix products: default
+#LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+#locale:
+# [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+#attached base packages:
+# [1] stats graphics grDevices utils datasets methods base
+
+#other attached packages:
+# [1] sjmisc_2.8.7 broom_0.7.8 data.table_1.14.0 forcats_0.5.1 stringr_1.4.0 dplyr_1.0.7
+#[7] purrr_0.3.4 readr_1.4.0 tidyr_1.1.3 tibble_3.1.2 ggplot2_3.3.4 tidyverse_1.3.1
+
+#loaded via a namespace (and not attached):
+# [1] xfun_0.24 tidyselect_1.1.1 sjlabelled_1.1.8 haven_2.4.1 colorspace_2.0-1 vctrs_0.3.8
+#[7] generics_0.1.0 htmltools_0.5.1.1 yaml_2.2.1 utf8_1.2.1 rlang_0.4.11 pillar_1.6.1
+#[13] glue_1.4.2 withr_2.4.2 DBI_1.1.1 dbplyr_2.1.1 modelr_0.1.8 readxl_1.3.1
+#[19] plyr_1.8.6 lifecycle_1.0.0 munsell_0.5.0 gtable_0.3.0 cellranger_1.1.0 rvest_1.0.0
+#[25] evaluate_0.14 knitr_1.33 fansi_0.5.0 Rcpp_1.0.6 scales_1.1.1 backports_1.2.1
+#[31] jsonlite_1.7.2 fs_1.5.0 hms_1.1.0 digest_0.6.27 stringi_1.6.2 insight_0.14.2
+#[37] grid_4.1.0 cli_2.5.0 tools_4.1.0 magrittr_2.0.1 crayon_1.4.1 pkgconfig_2.0.3
+#[43] ellipsis_0.3.2 xml2_1.3.2 reprex_2.0.0 lubridate_1.7.10 assertthat_0.2.1 rmarkdown_2.9
+#[49] httr_1.4.2 rstudioapi_0.13 R6_2.5.0 compiler_4.1.0
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.3_Modeling/3.3.1_Spatial_models_EOS50_no_scaling.R b/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.3_Modeling/3.3.1_Spatial_models_EOS50_no_scaling.R
new file mode 100644
index 0000000..4b7bd8a
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.3_Modeling/3.3.1_Spatial_models_EOS50_no_scaling.R
@@ -0,0 +1,465 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Linear models for the satellite data (EOS50) ##############################################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(data.table)
+require(broom)
+require(sjmisc)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+# paths
+Drivers_path = "Analysis_input/Drivers_final_EOS50/Merged_file"
+output_path = "Analysis_output_EOS50/Data"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology data frame
+#####################
+
+Pheno.df <- fread(paste(Drivers_path, "Remote_sensing_drivers_data_preseason.csv", sep="/")) %>%
+ #transform GPP to gCm-2
+ mutate_at(c("GPPstart.LO.SO",
+ "GPPstart.SO.SE",
+ "GPPstart1",
+ "GPPstart2",
+ "GPPstart3",
+ "GPPstart4",
+ "GPPstart5",
+ "GPPstart6",
+ "GPPstart7",
+ "GPPstart8",
+ "GPPstart9",
+ "GPPstart10"),
+ function(x)(x*0.1))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+## VARIABLE EXPLANATION:
+########################
+
+#General
+########
+
+#geometry...site identifier
+#Year...observation year
+#Lat...site latitude (decimal degrees)
+#Lon...site longitude (decomal degrees)
+#alt...site altitude (m a.s.l.)
+
+#---------------------------------------------------
+
+#Phenology
+##########
+
+#MidGreendown_DOY...senescence date (DOY)
+#MidGreendownMean...mean timeseries senescence date (DOY)
+
+#---------------------------------------------------
+
+#Day-of-year maximum temperature and radiation
+##############################################
+
+#HottestDOY...DOY with maximum annual temperature
+#MaxRadDOY...DOY with maximum irradiance
+
+#---------------------------------------------------
+
+#Seasonal drivers
+#################
+
+#SUMS (flexible start = leaf-out):
+#---------------------------------
+#Apm...Daily net photosynthesis p-model
+#Azani...Daily net photosynthesis Zani model
+#GSI...photoperiod-influenced growing-season index
+#GSIrad...radiation-influenced growing-season index
+#GDDday...daytime degree days
+#GDDnight...nighttime degree days
+#SWrad...Radiation sum
+
+#MEANS (fixed start = March equinox):
+#------------------------------------
+#Tday...mean daytime temperature
+#Tnight...mean nighttime temperature
+#Moist...mean soil moisture (10-40cm)
+#Prcp...precipitation sum
+
+#-----------------
+
+#PERIODS
+
+#seasonal
+#--------
+#LO.SOm30...leaf-out to 30 days before summer solstice
+#LO.SO...leaf-out to summer solstice
+#LO.SOp30...leaf-out to 30 days after solstice
+#LO.SOp60...leaf-out to 60 days after solstice
+#LO.SE...leaf-out to mean senescence
+#SOm30.SE...30 days before solstice to mean senescence
+#SO.SE...solstice to mean senescence
+#SOp30.SE...30 days after solstice to mean senescence
+#SOp60.SE...60 days after solstice to mean senescence
+
+#around summer solstice
+#----------------------
+#solstice1...40 to 10 days before solstice
+#solstice2...30 days before solstice
+#solstice3...20 days before until 10 days after solstice
+#solstice4...10 days before until 20 days after solstice
+#solstice5...30 days after solstice
+#solstice6...10 to 40 days after solstice
+
+#---------------------------------------------------
+
+#Monthly drivers
+################
+
+#Tnight1-12...mean of nighttime temperatures in January (1) to December (12)
+#Tday1-12...mean of daytime temperatures in January (1) to December (12)
+#GDDnight1-12...sum of nighttime degree-days in January (1) to December (12)
+#GDDday1-12...sum of daytime degree-days in January (1) to December (12)
+#SWrad1-12...mean of daily short-wave radiation in January (1) to December (12)
+#Moist1-12...mean of daily soil moisture (10-40cm) in January (1) to December (12)
+#Prcp1-12...sum of daily precipitation in January (1) to December (12)
+#Apm1-12...sum of daily gross photosynthesis in January (1) to December (12)
+#Azani1-12...sum of daily net photosynthesis in January (1) to December (12)
+#GSI...day length-influenced growing-season index
+#GSIrad...radiation-influenced growing-season index
+
+#---------------------------------------------------
+
+#Preseason temperatures
+#######################
+
+#Tmin.PS15-90...mean daily minimum temperature 15 to 90 days prior to mean timeseries senescence date
+#tmean.PS15-90...mean daily mean temperature 15 to 90 days prior to mean timeseries senescence date
+#tmax.PS15-90...mean daily maximum temperature 15 to 90 days prior to mean timeseries senescence date
+
+#Tday...time series-specific best preseason (R2-based) for daytime temperatures
+#tnight...time series-specific best preseason (R2-based) for nighttime temperatures
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Full models ##
+#################
+
+
+
+#Define variables
+variables = c('GPPstart', 'Tday')
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+##############################################################################################################################################
+
+
+#Loop through variables
+#######################
+
+for (i in 1:length(variables)){
+
+ #delete pixels with no photosynthesis before solstice
+ if (variables[i] %in% c("GPPstart"))
+ Pheno.df2 = Pheno.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(paste0(variables[i],".LO.SO"))) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.df
+
+
+ #set equations
+ ##############
+
+ #define variable names
+ covariates = paste0(variables[i], c('.LO.SO','.SO.SE'))
+
+
+ #full models
+ equation1 = as.formula(paste("MidGreendown_DOY ~ ",
+ paste(covariates[1], covariates[2],
+ 'Prcp.LO.SO', 'Prcp.SO.SE', 'CO2', 'Tday', sep="+")))
+
+ equation2 = as.formula(paste("MidGreendown_DOY ~ ",
+ paste(covariates[1], covariates[2], sep = "+")))
+
+ equation3 = as.formula(paste("MidGreendown_DOY ~ ",
+ paste(covariates[1], 'Tday', sep = '+')))
+
+ ##############################################################################################################################################
+
+
+ ##############
+ #linear models
+ ##############
+
+
+ ModelResults.df = Pheno.df2 %>%
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+ do({
+
+ #run models
+ ###########
+
+ model1 = lm(equation1, data=.)
+ model2 = lm(equation2, data=.)
+ model3 = lm(equation3, data=.)
+
+ #create combined data frame
+ ###########################
+
+ data.frame(rbind(
+
+ #Equations 1-3
+ tidy(model1) %>% mutate(equation = 'full model1'),
+ tidy(model2) %>% mutate(equation = 'full model2'),
+ tidy(model3) %>% mutate(equation = 'full model3') )
+
+
+ )}) %>%
+
+ #add variable name
+ mutate(variable = variables[i]) %>%
+ #delete intercept
+ filter(!term %in% c("(Intercept)")) %>%
+ ungroup()
+
+
+ ##############################################################################################################################################
+
+
+ #store data frame in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+FullAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################
+## Monthly correlations ##
+##########################
+
+
+
+#Get sums for January to April photosynthesis parameters
+Pheno.monthly.df = Pheno.df %>%
+ mutate(GPPstart4 = rowSums(dplyr::select(.,c("GPPstart1","GPPstart2","GPPstart3","GPPstart4"))))
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+##############################################################################################################################################
+
+
+#Loop through covariate groups
+##############################
+
+
+for (i in 1:length(variables)){
+
+ #delete pixels with no photosynthesis before solstice
+ #####################################################
+
+ if (variables[i] %in% c("GPPstart"))
+ Pheno.df2 = Pheno.monthly.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(paste0(variables[i],"4"))) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.monthly.df
+
+ #create explanatory variables
+ #############################
+
+ covariates.monthly = paste0(variables[i], c(1:10))
+
+ #---------------------------------------------------------
+
+ #set equations
+ ##############
+
+ if(variables[i] %in% c('GPPstart')) {
+ equation = as.formula(paste("MidGreendown_DOY ~ ", paste(covariates.monthly[4:10], collapse="+")))
+ } else {
+ equation = as.formula(paste("MidGreendown_DOY ~ ", paste(covariates.monthly[3:10], collapse="+")))
+ }
+
+ #---------------------------------------------------------
+
+ ###############
+ # Linear models
+ ###############
+
+ ModelResults.df = Pheno.df2 %>%
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+ do({
+
+ #run models
+ ###########
+
+ model = lm(equation, data=.)
+
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(tidy(model) %>% mutate(equation = 'monthly'))
+ }) %>%
+
+ ungroup() %>%
+ #delete intercept
+ filter(!term %in% c("(Intercept)")) %>%
+ #add variable name and keep only numbers in month column
+ mutate(variable = variables[i],
+ term = readr::parse_number(term))
+
+
+ #---------------------------------------------------------
+
+ #store dataframe in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+MonthlyAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########
+## Safe ##
+##########
+
+
+
+#bind full model, monthly and seasonal analyses
+Analysis.df = rbind(FullAnalysis.df, MonthlyAnalysis.df)
+
+#Safe tables
+write.csv(Analysis.df, paste(output_path, "Spatial_effect_data_no_scaling.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## datetime
+Sys.time()
+#"2021-12-08 14:21:44 CET"
+
+
+## session info
+sessionInfo()
+#R version 4.1.0 (2021-05-18)
+#Platform: x86_64-apple-darwin17.0 (64-bit)
+#Running under: macOS Big Sur 11.2.3
+
+#Matrix products: default
+#LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+#locale:
+# [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+#attached base packages:
+# [1] stats graphics grDevices utils datasets methods base
+
+#other attached packages:
+# [1] sjmisc_2.8.7 broom_0.7.8 data.table_1.14.0 forcats_0.5.1 stringr_1.4.0 dplyr_1.0.7
+#[7] purrr_0.3.4 readr_1.4.0 tidyr_1.1.3 tibble_3.1.2 ggplot2_3.3.4 tidyverse_1.3.1
+
+#loaded via a namespace (and not attached):
+# [1] xfun_0.24 tidyselect_1.1.1 sjlabelled_1.1.8 haven_2.4.1 colorspace_2.0-1 vctrs_0.3.8
+#[7] generics_0.1.0 htmltools_0.5.1.1 yaml_2.2.1 utf8_1.2.1 rlang_0.4.11 pillar_1.6.1
+#[13] glue_1.4.2 withr_2.4.2 DBI_1.1.1 dbplyr_2.1.1 modelr_0.1.8 readxl_1.3.1
+#[19] plyr_1.8.6 lifecycle_1.0.0 munsell_0.5.0 gtable_0.3.0 cellranger_1.1.0 rvest_1.0.0
+#[25] evaluate_0.14 knitr_1.33 fansi_0.5.0 Rcpp_1.0.6 scales_1.1.1 backports_1.2.1
+#[31] jsonlite_1.7.2 fs_1.5.0 hms_1.1.0 digest_0.6.27 stringi_1.6.2 insight_0.14.2
+#[37] grid_4.1.0 cli_2.5.0 tools_4.1.0 magrittr_2.0.1 crayon_1.4.1 pkgconfig_2.0.3
+#[43] ellipsis_0.3.2 xml2_1.3.2 reprex_2.0.0 lubridate_1.7.10 assertthat_0.2.1 rmarkdown_2.9
+#[49] httr_1.4.2 rstudioapi_0.13 R6_2.5.0 compiler_4.1.0
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.3_Modeling/3.3.2_Model_comparison_CV_EOS50.R b/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.3_Modeling/3.3.2_Model_comparison_CV_EOS50.R
new file mode 100644
index 0000000..2074261
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.3_Modeling/3.3.2_Model_comparison_CV_EOS50.R
@@ -0,0 +1,214 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Multivariate pre-/post-solstice models (EOS50) - Leave-one-out cross validation ###########################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(data.table)
+require(broom)
+require(caret)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+# paths
+drivers_path = "Analysis_input/Drivers_final_EOS50/Merged_file"
+output_path = "Analysis_output/Data"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology dataframe
+####################
+
+Pheno.df <- fread(paste(drivers_path, "Remote_sensing_drivers_data_preseason.csv", sep="/")) %>%
+ #delete pixels with no photosynthesis before solstice
+ group_by(geometry) %>%
+ filter(!(mean(GPPstart.LO.SO)<.1)) %>%
+ ungroup()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#######################################
+## Timeseries-level model assessment ##
+#######################################
+
+
+
+#set equations
+##############
+
+equation.full = as.formula("MidGreendown_DOY ~ GPPstart.LO.SO + Tday.LO.SO + SWrad.LO.SO + Moist.LO.SO + Greenup_DOY +
+ GPPstart.SO.SE + Tday + SWrad.SO.SE + Moist.SO.SE")
+equation.pre = as.formula("MidGreendown_DOY ~ GPPstart.LO.SO + Tday.LO.SO + SWrad.LO.SO + Moist.LO.SO + Greenup_DOY")
+equation.post = as.formula("MidGreendown_DOY ~ GPPstart.SO.SE + Tday + SWrad.SO.SE + Moist.SO.SE")
+
+#---------------------------------------------------------
+
+###############
+#Get model info
+###############
+
+ModelResults.df = Pheno.df %>%
+ group_by(LC_Type, geometry)%>%
+ do({
+
+ #run models
+ ###########
+
+ modelFull = lm(equation.full, data=.)
+ modelPre = lm(equation.pre, data=.)
+ modelPost = lm(equation.post, data=.)
+
+ CVmodelFull <- train(
+ equation.full, ., method = "lm",
+ trControl = trainControl(method = "LOOCV") )
+
+ CVmodelPre <- train(
+ equation.pre, ., method = "lm",
+ trControl = trainControl(method = "LOOCV") )
+
+ CVmodelPost <- train(
+ equation.post, ., method = "lm",
+ trControl = trainControl(method = "LOOCV") )
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(rbind(
+
+ #Equation full
+ glance(modelFull) %>%
+ mutate(model = 'full',
+ CV.R2 = as.numeric(CVmodelFull[4]$results[3])),
+
+ #Equation pre-solstice
+ glance(modelPre) %>%
+ mutate(model = 'pre',
+ CV.R2 = as.numeric(CVmodelPre[4]$results[3])),
+
+ #Equation post-solstice
+ glance(modelPost) %>%
+ mutate(model ='post',
+ CV.R2 = as.numeric(CVmodelPost[4]$results[3]))
+ ) )
+ })%>%
+ mutate(CV.R2 = ifelse(CV.R2 > r.squared, r.squared, CV.R2)) %>%
+ ungroup()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########
+## Safe ##
+##########
+
+
+
+write.csv(ModelResults.df, paste(output_path, "Model_R2_CV_data.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+## datetime
+Sys.time()
+#"2022-06-22 15:05:11 CEST"
+
+## session info
+sessionInfo()
+#R version 4.1.0 (2021-05-18)
+#Platform: x86_64-apple-darwin17.0 (64-bit)
+#Running under: macOS Big Sur 11.6.2
+
+#Matrix products: default
+#LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+#locale:
+# [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+#attached base packages:
+# [1] stats graphics grDevices utils datasets methods base
+
+#other attached packages:
+# [1] caret_6.0-92 lattice_0.20-44 broom_0.7.8 data.table_1.14.0 forcats_0.5.1 stringr_1.4.0
+#[7] dplyr_1.0.8 purrr_0.3.4 readr_1.4.0 tidyr_1.2.0 tibble_3.1.7 ggplot2_3.3.4
+#[13] tidyverse_1.3.1
+
+#loaded via a namespace (and not attached):
+# [1] httr_1.4.2 jsonlite_1.7.3 splines_4.1.0 foreach_1.5.2 prodlim_2019.11.13
+#[6] modelr_0.1.8 assertthat_0.2.1 stats4_4.1.0 cellranger_1.1.0 yaml_2.2.2
+#[11] globals_0.15.0 ipred_0.9-13 pillar_1.7.0 backports_1.2.1 glue_1.6.2
+#[16] pROC_1.18.0 digest_0.6.29 rvest_1.0.2 hardhat_1.1.0 colorspace_2.0-2
+#[21] recipes_0.2.0 htmltools_0.5.2 Matrix_1.3-3 plyr_1.8.6 timeDate_3043.102
+#[26] pkgconfig_2.0.3 listenv_0.8.0 haven_2.4.1 scales_1.1.1 gower_1.0.0
+#[31] lava_1.6.10 generics_0.1.2 ellipsis_0.3.2 withr_2.4.3 nnet_7.3-16
+#[36] cli_3.2.0 survival_3.2-11 magrittr_2.0.2 crayon_1.5.0 readxl_1.3.1
+#[41] evaluate_0.14 parallelly_1.32.0 fs_1.5.2 fansi_1.0.2 future_1.26.1
+#[46] nlme_3.1-152 MASS_7.3-54 xml2_1.3.3 class_7.3-19 tools_4.1.0
+#[51] hms_1.1.0 lifecycle_1.0.1 munsell_0.5.0 reprex_2.0.0 compiler_4.1.0
+#[56] rlang_1.0.2 grid_4.1.0 iterators_1.0.14 rstudioapi_0.13 rmarkdown_2.9
+#[61] ModelMetrics_1.2.2.2 gtable_0.3.0 codetools_0.2-18 DBI_1.1.2 reshape2_1.4.4
+#[66] R6_2.5.1 lubridate_1.7.10 knitr_1.33 fastmap_1.1.0 future.apply_1.9.0
+#[71] utf8_1.2.2 stringi_1.7.6 parallel_4.1.0 Rcpp_1.0.8 vctrs_0.4.1
+#[76] rpart_4.1-15 dbplyr_2.1.1 tidyselect_1.1.1 xfun_0.24
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.3_Modeling/3.3.2_Model_comparison_EOS50.R b/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.3_Modeling/3.3.2_Model_comparison_EOS50.R
new file mode 100644
index 0000000..5e7c203
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.3_Modeling/3.3.2_Model_comparison_EOS50.R
@@ -0,0 +1,212 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Univariate pre-/post-solstice models (EOS50) ##############################################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(data.table)
+require(broom)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+# paths
+drivers_path = "Analysis_input/Drivers_final_EOS50/Merged_file"
+output_path = "Analysis_output/Data"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology dataframe
+####################
+
+Pheno.df <- fread(paste(drivers_path, "Remote_sensing_drivers_data_preseason.csv", sep="/")) %>%
+ #delete pixels with no photosynthesis before solstice
+ group_by(geometry) %>%
+ filter(!(mean(GPPstart.LO.SO)<.1)) %>%
+ ungroup()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#######################################
+## Timeseries-level model assessment ##
+#######################################
+
+
+
+#variable vector
+variables=c("GPPstart","Tday","SWrad","Moist","Greenup_DOY")
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+#Loop through variables
+#######################
+
+for (i in 1:length(variables)){
+
+ #define variable names
+ if (variables[i] == "Greenup_DOY") {
+ covariates = c('Greenup_DOY','CO2')
+ } else {covariates = paste0(variables[i], c('.LO.SO','.SO.SE')) }
+
+
+ #set equations
+ ##############
+
+ equation.pre = as.formula(paste("MidGreendown_DOY ~ ", paste0(covariates[1])))
+ equation.post = as.formula(paste("MidGreendown_DOY ~ ", paste0(covariates[2])))
+
+ #---------------------------------------------------------
+
+ ###############
+ #Get model info
+ ###############
+
+ ModelResults.df = Pheno.df %>%
+ group_by(LC_Type, geometry)%>%
+ do({
+
+ #run models
+ ###########
+
+ modelPre = lm(equation.pre, data=.)
+ modelPost = lm(equation.post, data=.)
+
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(rbind(
+
+ #Equation pre-solstice
+ glance(modelPre) %>%
+ mutate(model='pre'),
+
+ #Equation post-solstice
+ glance(modelPost) %>%
+ mutate(model='post') ) )
+ })%>%
+ mutate(variable = variables[i]) %>%
+ ungroup()
+
+ #---------------------------------------------------------
+
+ #store dataframe in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+Analysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########
+## Safe ##
+##########
+
+
+
+write.csv(Analysis.df, paste(output_path, "Model_R2_data.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+## datetime
+Sys.time()
+#"2021-12-05 20:06:47 CET"
+
+## session info
+sessionInfo()
+#R version 4.1.0 (2021-05-18)
+#Platform: x86_64-apple-darwin17.0 (64-bit)
+#Running under: macOS Big Sur 11.2.3
+
+#Matrix products: default
+#LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+#locale:
+# [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+#attached base packages:
+# [1] stats graphics grDevices utils datasets methods base
+
+#other attached packages:
+# [1] broom_0.7.8 data.table_1.14.0 forcats_0.5.1 stringr_1.4.0 dplyr_1.0.7 purrr_0.3.4
+#[7] readr_1.4.0 tidyr_1.1.3 tibble_3.1.2 ggplot2_3.3.4 tidyverse_1.3.1
+
+#loaded via a namespace (and not attached):
+# [1] Rcpp_1.0.6 cellranger_1.1.0 pillar_1.6.1 compiler_4.1.0 dbplyr_2.1.1 tools_4.1.0 jsonlite_1.7.2
+#[8] lubridate_1.7.10 lifecycle_1.0.0 gtable_0.3.0 pkgconfig_2.0.3 rlang_0.4.11 reprex_2.0.0 cli_2.5.0
+#[15] rstudioapi_0.13 DBI_1.1.1 haven_2.4.1 xml2_1.3.2 withr_2.4.2 httr_1.4.2 gtools_3.9.2
+#[22] fs_1.5.0 generics_0.1.0 vctrs_0.3.8 hms_1.1.0 grid_4.1.0 tidyselect_1.1.1 glue_1.4.2
+#[29] R6_2.5.0 fansi_0.5.0 readxl_1.3.1 gdata_2.18.0 modelr_0.1.8 magrittr_2.0.1 MASS_7.3-54
+#[36] gmodels_2.18.1 backports_1.2.1 scales_1.1.1 ellipsis_0.3.2 rvest_1.0.0 assertthat_0.2.1 colorspace_2.0-1
+#[43] utf8_1.2.1 stringi_1.6.2 munsell_0.5.0 crayon_1.4.1
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.4_Figures/3.4.1_Mapping_EOS50.Rmd b/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.4_Figures/3.4.1_Mapping_EOS50.Rmd
new file mode 100644
index 0000000..e0a5d81
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS50_MidGreendown/3.4_Figures/3.4.1_Mapping_EOS50.Rmd
@@ -0,0 +1,968 @@
+---
+title: Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice
+author: Constantin Zohner
+date: "last updated March 31, 2023"
+
+subtitle: Satellite-derived EOS50 data (Figs. S2 and S3)
+output:
+ html_document:
+ highlight: haddock
+ toc: false
+ use_bookdown: true
+ df_print: paged
+---
+
+
+
+
+
+### Figure descriptions
+- Fig. S2: The seasonal effects of Tday on inter-annual variation in mid-senescence (EOS50 dates)
+- Fig. S3: The seasonal relationships between gross primary productivity (GPP) and inter-annual variation in mid-senescence (EOS50 dates)
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(
+ class.source = "numberLines lineAnchors"
+ )
+```
+
+
+
+```{r, message=FALSE, warning=FALSE, attr.source='.numberLines'}
+###################
+# Required packages
+###################
+
+
+
+require(tidyverse)
+require(data.table)
+require(ggplot2)
+require(patchwork)
+require(gmodels)
+require(wesanderson)
+require(pracma)
+require(lme4)
+require(effects) #plot effects
+require(remef)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+
+# Paths
+
+#input
+Drivers_path = "Analysis_input/Drivers_final_EOS50/Merged_file"
+Analysis_path = "Analysis_output_EOS50/Data"
+photo_path = "Analysis_input/Drivers" #Photoperiod file
+
+#output
+output_path = "Analysis_output_EOS50/Maps"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Spatial (pixel-level) models
+#############################
+
+#scaled
+Analysis.df = fread(paste(Analysis_path, "Spatial_effect_data.csv", sep="/")) %>%
+ filter(!is.na(estimate))
+
+#unscaled
+AnalysisNoScaling.df = fread(paste(Analysis_path, "Spatial_effect_data_no_scaling.csv", sep="/")) %>%
+ filter(!is.na(estimate))
+
+#geometry: unique pixel identifier
+#Lat: Latitude
+#Lon: Longitude
+#LC_type: All, DecB, DecN, EvgN, Mixed (Landcover type)
+#term: monthly coefficients (1-10) and seasonal coefficients
+#estimate: slopes or standardized coefficients of mixed effects models
+#std.error: std.error of coefficients
+#statistic:
+#equation: full model 1/2, monthly/seasonal/solstice, scaled/unscaled, tempCon (Tday controlled)
+#variable: climate variable (LAI, GPP, Apm, Azani, Tday, Tnight, SWrad)
+
+
+# get full model correlations
+#############################
+
+FullModel.df = Analysis.df %>%
+ filter(equation == "full model1")
+
+ReducedModel.df = AnalysisNoScaling.df %>%
+ filter(equation == "full model2")
+
+
+#-------------------------------------------------------------------------------------------------------
+
+
+# get monthly correlations
+##########################
+
+#Summarize all pixels
+MonthlyAnalysisAll.df = Analysis.df %>%
+ filter(equation == "monthly") %>%
+ group_by(term, variable) %>%
+ summarise(mean = mean(estimate),
+ lowCI = t.test(estimate)$conf.int[1],
+ hiCI = t.test(estimate)$conf.int[2]) %>%
+ mutate(LC_Type = "All") %>%
+ ungroup()
+
+#Summarize by vegetation type
+MonthlyAnalysisLCtype.df = Analysis.df %>%
+ filter(equation == "monthly") %>%
+ group_by(term, variable, LC_Type) %>%
+ summarise(mean = mean(estimate),
+ lowCI = t.test(estimate)$conf.int[1],
+ hiCI = t.test(estimate)$conf.int[2]) %>%
+ ungroup()
+
+#Rbind
+MonthlyAnalysis.df = rbind(MonthlyAnalysisAll.df, MonthlyAnalysisLCtype.df) %>%
+ #Add variable x equation identifier
+ mutate(variable.type = paste(variable, LC_Type, sep='.'),
+ term = as.numeric(term),
+ LC_Type = factor(LC_Type, levels = c("All","Mixed", "DecB", "EvgN","DecN")))
+
+
+#-------------------------------------------------------------------------------------------------------
+
+
+# get seasonal correlations
+###########################
+
+SeasonalModel.df = Analysis.df %>%
+ filter(equation == "Solstice.scaled") %>%
+ #Add variable class identifier
+ mutate(variable.class = gsub("^.*?\\.","", term) )
+
+
+##############################################################################################################################################
+
+
+#Phenology data
+###############
+
+Pheno.df = fread(paste(Drivers_path, "Remote_sensing_drivers_data_preseason.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+################
+## Plot theme ##
+################
+
+
+#Color.palette: col=c('#F21A00','#E1AF00','#EBCC2A','#78B7C5','#3B9AB2')
+
+plotTheme1 = theme(
+ legend.position = "none",
+ legend.background = element_blank(),
+ legend.text = element_text(color="black"),
+ legend.title = element_blank(),
+ legend.key = element_blank(),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(hjust = 0.5))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+######################
+# Photoperiod figure #
+######################
+
+
+#get mean leaf-out and senescence dates
+leaf_out = as.Date(mean(Pheno.df$Greenup_DOY), origin = "2016-12-31")
+leaf_off = as.Date(mean(Pheno.df$MidGreendown_DOY), origin = "2016-12-31")
+
+# dataframe of photoperiods
+photo.df = fread(paste(photo_path, "Photoperiod.csv", sep="/"))
+phot.sub = photo.df[475,3:367]
+phot.sub = rbind(as.data.frame(t(phot.sub)), as.data.frame(t(phot.sub)))
+phot.sub$X = as.Date(1:nrow(phot.sub), origin = "2016-12-31")
+
+
+# Plot of periods around solstice
+#################################
+
+#dataframe of periods
+solstice.data = rbind(
+ data.frame(X=as.Date(c("2017-05-14","2017-06-12")), Y=10, season = "A"),
+ data.frame(X=as.Date(c("2017-05-24","2017-06-22")), Y=11, season = "B"),
+ data.frame(X=as.Date(c("2017-06-02","2017-07-01")), Y=12, season = "C"),
+ data.frame(X=as.Date(c("2017-06-12","2017-07-11")), Y=13, season = "D"),
+ data.frame(X=as.Date(c("2017-06-22","2017-07-21")), Y=14, season = "E"),
+ data.frame(X=as.Date(c("2017-07-03","2017-08-01")), Y=15, season = "F") )
+
+#Plot
+PhotoSolstice = ggplot() +
+ #day length line
+ geom_line(data=phot.sub, aes(x=X, y=V1, group=1),col="black") +
+ #solstice
+ geom_vline(xintercept = as.Date("2017-06-22"), size=1, alpha=0.4)+
+ #periods
+ geom_line(data=solstice.data, aes(x=X, y=Y, color=season), size=2.75)+
+ scale_color_manual(values = rev(wes_palette(6, name = "Zissou1", type = "continuous")))+
+ #plot settings
+ coord_cartesian(xlim=c(as.Date(c('2017-03-01','2017-10-31'))), ylim=c(10,16))+
+ ylab("Day length")+xlab("")+
+ scale_x_date(position = "top") +
+ plotTheme1+
+ theme(plot.background = element_rect(fill = "transparent", color = NA),
+ panel.background = element_rect(fill = "white"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################################
+## Interpolation of monthly estimates ##
+########################################
+
+
+
+#Interpolation function
+lin_interp = function(x, y, length.out=100) {
+ approx(x, y, xout=seq(min(x), max(x), length.out=length.out))$y
+}
+
+#create identifier
+variable.type = unique(MonthlyAnalysis.df$variable.type)
+
+#create interpolation dataframe
+df.interp = data.frame()
+df.AUC = data.frame()
+
+#loop over variable x equation x vegetation type vector
+for (variable.name in variable.type){
+
+ #subset table
+ df.sub = MonthlyAnalysis.df %>%
+ filter(variable.type == variable.name)
+
+ # Interpolate data
+ created.interp = lin_interp(df.sub$term, df.sub$term)
+ score.interp = lin_interp(df.sub$term, df.sub$mean)
+ df.interp.sub = data.frame(created=created.interp, score=score.interp)
+ # Make a grouping variable for each pos/neg segment
+ cat.rle = rle(df.interp.sub$score < 0)
+ df.interp.sub = df.interp.sub %>%
+ mutate(group = rep.int(1:length(cat.rle$lengths), times=cat.rle$lengths),
+ LC_Type = unique(df.sub$LC_Type),
+ variable = unique(df.sub$variable) )
+ #rbind sub dataframes
+ df.interp = rbind(df.interp, df.interp.sub)
+
+ #get Area under curve (%)
+ df.AUC.sub = df.interp.sub %>%
+ mutate(positive = ifelse(score<0, 0, score),
+ negative = ifelse(score>0, 0, score))%>%
+ summarise(sum.pos = trapz(created, positive),
+ sum.neg = abs(trapz(created, negative)))%>%
+ mutate(percent.neg = round(sum.neg/(sum.pos+sum.neg)*100),
+ percent.pos = round(sum.pos/(sum.pos+sum.neg)*100),
+ LC_Type = unique(df.sub$LC_Type),
+ variable = unique(df.sub$variable) )
+ #rbind sub dataframes
+ df.AUC = rbind(df.AUC, df.AUC.sub)
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+# Mixed effects models #
+########################
+
+
+
+#Prepare data
+#############
+
+PhenoMixed.df <- Pheno.df %>%
+ #delete outlier values
+ filter(GPPstart.LO.SO < quantile(.$GPP.LO.SO, 0.999),
+ GPPstart.LO.SO > quantile(.$GPP.LO.SO, 0.01))
+
+#get year mean
+YearMean = mean(PhenoMixed.df$Year)
+
+#transform units and center year variable
+PhenoMixed.df <- PhenoMixed.df %>%
+ mutate(GPPstart.LO.SO = GPPstart.LO.SO*0.1,
+ Year = Year - mean(Year)) %>%
+ #delete pixels with less than 15 years
+ group_by(geometry) %>%
+ filter(n() >= 15) %>%
+ ungroup()
+
+
+# Effect of post-solstice temperature
+#####################################
+
+summary(lmer(MidGreendown_DOY ~ Tday.SO.SE + (1|geometry), data=PhenoMixed.df))
+
+
+##############################################################################################################################################
+
+
+# Models
+########
+
+#list variables to loop through
+variables = unique(AnalysisNoScaling.df$variable)
+
+#create List object to store results
+DataList1 = replicate(length(variables), data.frame())
+DataList2 = replicate(length(variables), data.frame())
+DataList3 = replicate(length(variables), data.frame())
+names(DataList1) = variables
+names(DataList2) = variables
+names(DataList3) = variables
+
+##############################################################################################################################################
+
+
+#Loop through variables
+#######################
+
+for (i in 1:length(variables)){
+
+ #extract variables
+ Year = as.numeric(PhenoMixed.df$Year)
+ Pre.solstice = as.numeric(PhenoMixed.df %>% pull(paste0(variables[i],".LO.SO")))
+ Post.solstice = as.numeric(PhenoMixed.df %>% pull(paste0(variables[i],".SO.SE")))
+ MidGreendown_DOY = as.numeric(PhenoMixed.df$MidGreendown_DOY)
+ geometry = PhenoMixed.df$geometry
+
+
+ #Multivariate
+ fit_multi = lmer(MidGreendown_DOY ~ Pre.solstice + Year + (1 | geometry),
+ na.action = "na.exclude", control = lmerControl(optimizer ="Nelder_Mead"))
+
+ fit_multi2 = lmer(MidGreendown_DOY ~ Pre.solstice + Post.solstice + Year + (1 | geometry),
+ na.action = "na.exclude", control = lmerControl(optimizer ="Nelder_Mead"))
+
+ #year-only
+ fit_year = lmer(MidGreendown_DOY ~ Year + (1 | geometry),
+ na.action = "na.exclude", control = lmerControl(optimizer ="Nelder_Mead"))
+
+ # Extract information for plotting
+ plotMulti = allEffects(fit_multi)
+ plotYear = allEffects(fit_year)
+
+ # Extract coefficients
+ df.coefficients = tibble(Coefficient = coef(summary(fit_multi))[ , "Estimate"][2:3],
+ std.error = coef(summary(fit_multi))[ , "Std. Error"][2:3],
+ variable = c(paste0(variables[i]),"Year"),
+ class = paste0(variables[i])) %>%
+ bind_rows(tibble(Coefficient = coef(summary(fit_year))[ , "Estimate"][2],
+ std.error = coef(summary(fit_multi))[ , "Std. Error"][2],
+ variable = c("Year"),
+ class = "Univariate"))
+
+ # Final table
+ df <- tibble(upper = plotYear$Year$upper[,1],
+ lower = plotYear$Year$lower[,1],
+ off = plotYear$Year$fit[,1],
+ xval = plotYear$Year$x[,1],
+ class = "Univariate",
+ variable = "Year") %>%
+ #Multi
+ bind_rows(
+ tibble(upper = plotMulti$Year$upper[,1],
+ lower = plotMulti$Year$lower[,1],
+ off = plotMulti$Year$fit[,1],
+ xval = plotMulti$Year$x[,1],
+ class = paste0(variables[i]),
+ variable = "Year")
+ )%>%
+ bind_rows(
+ tibble(upper = plotMulti$Pre.solstice$upper[,1],
+ lower = plotMulti$Pre.solstice$lower[,1],
+ off = plotMulti$Pre.solstice$fit[,1],
+ xval = plotMulti$Pre.solstice$x[,1],
+ class = paste0(variables[i]),
+ variable = paste0(variables[i]))
+ )
+
+
+ # get phenology anomalies
+ df = df %>%
+ group_by(class, variable) %>%
+ mutate(anomaly = off - mean(off),
+ anomaly.upper = upper - mean(off),
+ anomaly.lower = lower - mean(off)) %>%
+ ungroup()
+
+ ##############################################################################################################################################
+
+ # get partial Senescence dates, removing effect of year (fixed) and site (random)
+ y_partial = remef(fit_multi2, fix=c("Year","Post.solstice"), ran="all", keep.intercept = T)
+
+ # Create table
+ df.fitted = tibble(fitted = y_partial,
+ x = Pre.solstice,
+ variable = variables[i])
+
+ ##############################################################################################################################################
+
+ #store data frame in variable list
+ DataList1[[i]] = df
+ DataList2[[i]] = df.coefficients
+ DataList3[[i]] = df.fitted
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+MixedModel.df = bind_rows(DataList1)
+coefficients.df = bind_rows(DataList2)
+fitted.df = bind_rows(DataList3)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##############
+# Map figure #
+##############
+
+
+
+#start loop
+for(variable.name in variables) {
+
+ #subset and reshape data
+ Analysis.df.sub2 = ReducedModel.df %>%
+ filter(variable == variable.name) %>%
+ mutate(term = factor(term, levels=c(paste0(variable.name,".SO.SE"),
+ paste0(variable.name,".LO.SO") ), ordered=T),
+ positive = ifelse(estimate>0,1,0),
+ negative = ifelse(estimate<0,1,0),
+ positive.sign = ifelse(estimate>0 & p.value<0.05,1,0),
+ negative.sign = ifelse(estimate<0 & p.value<0.05,1,0))
+
+
+ ##############################################################################################################################################
+
+
+ ###########
+ # Histogram
+ ###########
+
+ #create summary info
+ VariablesVector = c("estimate","p.value","positive","negative","positive.sign","negative.sign")
+ data1 = Analysis.df.sub2 %>%
+ group_by(term) %>%
+ summarize_at(VariablesVector, mean, na.rm = TRUE)
+
+ if(variable.name %in% c('GPPstart')){
+ xRange=c(-0.12,0.12)
+ yRange=c(-.05,.05)
+ binw = 0.0013} else {
+ xRange=c(-5,5)
+ yRange=c(-3.5,3.5)
+ binw = .05}
+
+ #Plot
+ HistoPlot = ggplot(Analysis.df.sub2, aes(x=estimate, fill=term, alpha=term)) +
+ geom_histogram(binwidth=binw, position="identity") +
+ geom_vline(xintercept=0, colour="black") +
+ scale_fill_manual(values = c('#3B9AB2','#F21A00'))+
+ scale_alpha_discrete(range = c(0.8, 0.8))+
+ #add pre-solstice text
+ geom_text(data = data1[data1$term==paste0(variable.name,".LO.SO"),],
+ mapping = aes(x = -Inf, y = Inf, hjust = -0.1, vjust = 1.5,
+ label = paste(variable.name, " pre\nMean = ",round(estimate,2), "\n",
+ round(negative*100), "% (", round(negative.sign*100), '%)', sep="")),
+ size=3.5, color='#F21A00')+
+ #add post-solstice text
+ geom_text(data = data1[data1$term==paste0(variable.name,".SO.SE"),],
+ mapping = aes(x = Inf, y = Inf, hjust = 1.1, vjust = 1.5,
+ label = paste(variable.name, " post\nMean = ",round(estimate,2), "\n",
+ round(positive*100), "% (", round(positive.sign*100), '%)', sep="")),
+ size=3.5, color='#3B9AB2')+
+ xlab(paste("Days per", variable.name, sep=" ")) +
+ ylab("Count (number of pixels)") +
+ coord_cartesian(xlim = xRange, ylim = c(12, 250))+
+ plotTheme1
+
+
+ ##############################################################################################################################################
+
+
+ ###################
+ # Latitudinal plots
+ ###################
+
+ #Pre-solstice
+ LatPlotPre = Analysis.df.sub2[Analysis.df.sub2$term==paste0(variable.name,".LO.SO"),] %>%
+ mutate(LatRound = round(Lat)) %>%
+ group_by(term, LatRound) %>%
+ summarise(mean = mean(estimate),
+ lowCI = ci(estimate)[2],
+ highCI = ci(estimate)[3]) %>%
+ ggplot(aes(x = LatRound, y= mean, group=term, color=term)) +
+ geom_ribbon(aes(ymin=lowCI, ymax=highCI, fill=term), alpha=0.4, color=NA)+
+ geom_line()+
+ geom_hline(yintercept=0)+
+ scale_color_manual(values = c('#F21A00'))+
+ scale_fill_manual(values = c('#F21A00'))+
+ ylab("") +
+ coord_flip(ylim = yRange, xlim=c(27,75))+
+ plotTheme1 +
+ theme(axis.text.y = element_blank(),
+ axis.title.y = element_blank())
+
+ #Post-solstice
+ LatPlotPost = Analysis.df.sub2[Analysis.df.sub2$term==paste0(variable.name,".SO.SE"),] %>%
+ mutate(LatRound = round(Lat)) %>%
+ group_by(term, LatRound) %>%
+ summarise(mean = mean(estimate),
+ lowCI = ci(estimate)[2],
+ highCI = ci(estimate)[3]) %>%
+ ggplot(aes(x = LatRound, y= mean, group=term, color=term)) +
+ geom_ribbon(aes(ymin=lowCI, ymax=highCI, fill=term), alpha=0.4, color=NA)+
+ geom_line()+
+ geom_hline(yintercept=0)+
+ scale_color_manual(values = c('#3B9AB2'))+
+ scale_fill_manual(values = c('#3B9AB2'))+
+ ylab("Days per unit") +
+ coord_flip(ylim = yRange, xlim=c(27,75))+
+ plotTheme1 +
+ theme(axis.text.y = element_blank(),
+ axis.title.y = element_blank())
+
+
+ ##############################################################################################################################################
+
+
+ #########
+ # Mapping
+ #########
+
+ #subset and reshape data
+ Analysis.df.sub3 = ReducedModel.df %>%
+ filter(variable == variable.name,
+ term %in% c(paste0(variable.name,'.SO.SE'),paste0(variable.name,'.LO.SO'))) %>%
+ mutate(estimate = if(variable.name == "GPPstart"){ifelse(estimate>.06, .06, ifelse(estimate < -.06, -.06, estimate))} else {
+ ifelse(estimate>3, 3, ifelse(estimate < -3, -3, estimate))} ) %>%
+ dplyr::select(c(Lat, Lon, geometry, variable, term, estimate)) %>%
+ pivot_wider(., names_from = term, values_from = estimate) %>%
+ dplyr::rename('Post' = as.name(paste0(variable.name,'.SO.SE')),
+ 'Pre' = as.name(paste0(variable.name,'.LO.SO')))
+
+ #Get world map
+ mp <- NULL
+ mapWorld <- borders("world", colour="gray40", fill="gray40") # create a layer of borders
+ mp <- ggplot() + mapWorld + plotTheme1
+
+ #Add pre-solstice information
+ MapPre <- mp + geom_tile(data = Analysis.df.sub3,
+ show.legend=T,
+ aes(x = Lon, y = Lat, fill=Pre)) +
+ scale_fill_gradient2(midpoint=0, low='#F21A00', mid="white",
+ high='#3B9AB2', space ="Lab" ) +
+ coord_cartesian(ylim = c(27, 75), xlim = c(-160, 175)) +
+ xlab("") + ylab('Latitude') +
+ theme(legend.position = c(0.08,0.33))
+
+ #Add post-solstice information
+ MapPost <- mp + geom_tile(data = Analysis.df.sub3,
+ show.legend=T,
+ aes(x = Lon, y = Lat, fill=Post)) +
+ scale_fill_gradient2(midpoint=0, low='#F21A00', mid="white",
+ high='#3B9AB2', space ="Lab" ) +
+ coord_cartesian(ylim = c(27, 75), xlim = c(-160, 175)) +
+ xlab("") + ylab('Latitude')
+
+
+ ##############################################################################################################################################
+
+
+ ################
+ # Solstice plots
+ ################
+
+ #subset the data
+ SolsticeModel.df.sub = SeasonalModel.df %>%
+ filter(variable == variable.name)
+
+ # Plot
+ plotSolstice = ggplot(data = SolsticeModel.df.sub, aes(x = variable.class, y = estimate, fill=variable.class)) +
+ geom_boxplot(outlier.shape = NA, notch=T)+
+ geom_hline(yintercept=0)+
+ xlab("") + ylab("") +
+ coord_cartesian(ylim = c(-.8,.8)) +
+ scale_fill_manual(values = rev(wes_palette(6, name = "Zissou1", type = "continuous")))+
+ scale_x_discrete(labels=c("solstice1" = "May 13\nJun 11", "solstice2" = "May 23\nJun 21",
+ "solstice3" = "Jun 2\nJul 1", "solstice4"="Jun 12\nJul 11",
+ "solstice5"="Jun 22\nJul 21", "solstice6"="Jul 2\nJul 31"))+
+ plotTheme1 #+
+ #annotation_custom(ggplotGrob(PhotoSolstice), xmin = 0.6, xmax = 3.6,
+ # ymin = 0.2, ymax = 1.05)
+
+
+ ##############################################################################################################################################
+
+
+ #######################################
+ # Full model plots (Linear model means)
+ #######################################
+
+
+ #All pixels
+ ###########
+
+ plotFull = FullModel.df %>%
+ filter(variable == variable.name) %>%
+ mutate(term = factor(term,
+ levels=c(paste0(variable.name, ".LO.SO"),
+ "Prcp.LO.SO", 'Prcp.SO.SE', "CO2",
+ paste0(variable.name, ".SO.SE"), "Tday"), ordered=T) ) %>%
+ ggplot(aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch=T)+
+ geom_hline(yintercept=0)+
+ xlab("") + ylab("") +
+ coord_cartesian(ylim = c(-.9,.9)) +
+ scale_fill_manual(values = c('#F21A00','grey60','grey35','black','#3B9AB2','#78B7C5'))+
+ scale_x_discrete(labels = c('Out-Sol','Prcp pre','Prcp post','CO2','Sol-Off','Autumn Tday'))+
+ plotTheme1 +
+ theme(axis.text.x = element_text(angle = 45, hjust=1))
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ #Vegetation-type-specific
+ #########################
+
+ plotFullLC = FullModel.df %>%
+ filter(variable == variable.name) %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN")),
+ term = factor(term,
+ levels=c(paste0(variable.name, ".LO.SO"),
+ "Prcp.LO.SO", 'Prcp.SO.SE', "CO2",
+ paste0(variable.name, ".SO.SE"),'Tday'), ordered=T) ) %>%
+ ggplot(aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch=T)+
+ geom_hline(yintercept=0)+
+ xlab("") + ylab("Standardized effect") +
+ coord_cartesian(ylim = c(-.9,.9)) +
+ scale_fill_manual(values = c('#F21A00','grey60','grey35','black','#3B9AB2','#78B7C5'))+
+ scale_x_discrete(labels = c('Out-Sol','Prcp pre','Prcp post','CO2','Sol-Off','Autumn Tday'))+
+ plotTheme1 +
+ facet_grid(LC_Type~1) +
+ theme(axis.text.x = element_text(angle = 45, hjust=1),
+ strip.text = element_blank())
+
+
+ ##############################################################################################################################################
+
+
+ ###############
+ # Monthly plots
+ ###############
+
+
+ #subset the table
+ #################
+
+ Monthly.df.sub = MonthlyAnalysis.df %>%
+ filter(variable == variable.name)
+
+ df.interp.sub = df.interp %>%
+ filter(variable == variable.name)
+
+ df.AUC.sub = df.AUC %>%
+ filter(variable == variable.name)
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ # Plots
+ #######
+
+ #set x and y ranges
+ if(variable.name %in% c('GPPstart')){
+ xRange=c(4.1, 8.9) } else {xRange=c(3.2, 8.8) }
+
+ yRange=c(-0.2,0.2)
+ yRange2=c(-0.25,0.25)
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ #All pixels
+ plot.monthly = ggplot() +
+ geom_area(data = df.interp.sub[df.interp.sub$LC_Type=='All',], aes(x = created, y = score, fill=score>0, group=group)) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+ geom_point(data=Monthly.df.sub[Monthly.df.sub$LC_Type=='All',],
+ aes(x=term, y=mean))+
+ geom_errorbar(data=Monthly.df.sub[Monthly.df.sub$LC_Type=='All',],
+ aes(x=term, ymin=lowCI, ymax=hiCI), width=.2,
+ position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ geom_vline(xintercept=6.3, size=2, alpha=0.4)+
+ geom_text(data = df.AUC.sub[df.AUC.sub$LC_Type=='All',], mapping = aes(x = -Inf, y = Inf,
+ hjust = -0.1, vjust = 1.5,
+ label = paste0(percent.neg,'% / ',percent.pos, '%')))+
+ coord_cartesian(xlim=xRange, ylim=yRange)+
+ xlab("")+ylab("Standardized effect")+
+ scale_x_continuous(breaks = seq(1,10,by=1),
+ labels = c('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct'))+
+ plotTheme1
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ #Vegetation-type-specific
+ plot.monthly.LCtype = ggplot() +
+ geom_area(data = df.interp.sub[df.interp.sub$LC_Type!='All',], aes(x = created, y = score, fill=score>0, group=group)) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+ geom_point(data=Monthly.df.sub[Monthly.df.sub$LC_Type!='All',],
+ aes(x=term, y=mean))+
+ geom_errorbar(data=Monthly.df.sub[Monthly.df.sub$LC_Type!='All',],
+ aes(x=term, ymin=lowCI, ymax=hiCI), width=.2,
+ position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ geom_vline(xintercept=6.3, size=2, alpha=0.4)+
+ geom_text(data = df.AUC.sub[df.AUC.sub$LC_Type!='All',],
+ mapping = aes(x = -Inf, y = Inf, hjust = -.1, vjust = 1.5,
+ label = paste0(percent.neg,'% / ',percent.pos, '%')) ) +
+ coord_cartesian(xlim=xRange,ylim=yRange2)+
+ xlab("")+ylab('')+
+ facet_grid(LC_Type~1)+
+ scale_x_continuous(breaks = seq(1,10,by=2),
+ labels = c('Jan','Mar','May','Jul','Sep'))+
+ plotTheme1 +
+ theme(strip.text.x = element_blank())
+
+
+ ##############################################################################################################################################
+
+
+ ###################
+ # Mixed model plots
+ ###################
+
+
+ #Driver plots
+ fitted.df.sub = fitted.df %>%
+ filter(variable == variable.name)
+
+ driver.plot = ggplot(fitted.df.sub, aes(y= fitted, x= x)) +
+
+ geom_hex(bins=300)+
+
+ scale_fill_gradient2(low="grey95",mid='#E1AF00',"high"='#F21A00', midpoint=65)+
+
+ geom_smooth(method = "lm", color="black", se=T) +
+
+ geom_text(data=fitted.df.sub[1,], aes(label=paste0(round(summary(lm(fitted~x, data=fitted.df.sub))$coefficients[2,1],2),
+ " days per unit\nR2 = ",
+ round(summary(lm(fitted~x, data=fitted.df.sub))$r.squared,2)),
+ x=Inf, y=Inf, hjust = 1.1, vjust = 1.5))+
+
+ coord_cartesian(ylim = c(200,290), xlim = c(min(fitted.df.sub$x)+max(fitted.df.sub$x)/20,
+ max(fitted.df.sub$x)-max(fitted.df.sub$x)/20))+
+
+ labs(x = variable.name, y = expression(EOS[50]~(DOY)))+
+
+ plotTheme1
+
+
+ # Year plots
+ MixedModel.df.sub = MixedModel.df %>%
+ filter(variable == "Year",
+ class %in% c("Univariate", variable.name)) %>%
+ distinct()
+
+ coefficients.df.sub = coefficients.df %>%
+ filter(variable == "Year",
+ class %in% c("Univariate", variable.name))%>%
+ distinct()
+
+ year.plot = ggplot() +
+ geom_hline(yintercept = 0, linetype="dashed")+
+ geom_ribbon(data = MixedModel.df.sub, aes(x = xval+YearMean, ymin = anomaly.lower, ymax = anomaly.upper, fill=class),
+ alpha = 0.3) +
+ geom_line(data=MixedModel.df.sub, aes(xval+YearMean, anomaly, color=class)) +
+ theme_classic() +
+
+ geom_text(data=coefficients.df.sub[coefficients.df.sub$class==variable.name,],
+ aes(label=paste0("EOS50 ~ Year + ", variable.name, "\n(", round(Coefficient*10,1)," days per decade)"),
+ x=Inf, y=Inf,hjust = 1.2, vjust = 2),color='black')+
+
+ geom_text(data=coefficients.df.sub[coefficients.df.sub$class=="Univariate",][1,],
+ aes(label=paste0("EOS50 ~ Year\n(", round(Coefficient*10,1)," days per decade)"),
+ x=Inf, y=-Inf,hjust = 1.2, vjust = -2),color='#F21A00')+
+
+ scale_color_manual(values = c('black','#F21A00'))+
+ scale_fill_manual(values = c('black','#F21A00'))+
+
+ coord_cartesian(ylim = c(-1.5,1.5), xlim=c(2002.5,2017.5))+
+
+ labs(x = "Year", y = expression(EOS[50]~anomaly))+
+ plotTheme1
+
+
+ ##############################################################################################################################################
+
+
+ ##########################
+ # Arrange and safe plots #
+ ##########################
+
+
+ # 1. Monthly plots
+ ##############
+
+ #define plot layout
+ layout <- "ABC"
+
+ #Merge plots
+ Fig_Plot = plot.monthly + plotFull + plotSolstice +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A') &
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plots as .pdf
+ ggsave(Fig_Plot, file=paste('Fig2_',variable.name, ".pdf", sep=''),
+ path=output_path,
+ width=11, height=3.5)
+
+ print(Fig_Plot)
+
+
+ # 2. Map plots
+ ##############
+
+ #define plot layout
+ layout <- "
+AAAAAB
+CCCCCD
+EEFFGG"
+
+ #Merge plots
+ Fig_Plot = MapPre + LatPlotPre +
+ MapPost + LatPlotPost +
+ HistoPlot + driver.plot + year.plot +
+ plotFull + plotSolstice + plot.monthly +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A') &
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plots as .pdf
+ ggsave(Fig_Plot, file=paste(ifelse(variable.name=="Tday","FigS2","FigS3"),'_Map_',variable.name, ".pdf", sep=''),
+ path=output_path,
+ width=12, height=8.5)
+
+ print(Fig_Plot)
+
+
+ # 3. Vegetation-type-specific plots
+ ###################################
+
+ #define plot layout
+ layout <- "AB"
+
+ #Merge plots
+ Fig_Plot = plotFullLC + plot.monthly.LCtype +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'a') &
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plots as .pdf
+ ggsave(Fig_Plot, file=paste('LCtype_',variable.name, ".pdf", sep=''),
+ path=output_path,
+ width=8, height=10)
+
+ print(Fig_Plot)
+
+
+ ##############################################################################################################################################
+
+ #count
+ print(variable.name)
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## datetime
+Sys.time()
+
+
+## session info
+sessionInfo()
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+```
+
\ No newline at end of file
diff --git a/R code/Remote_sensing/3_Analysis/EOS85_Dormancy/3.1_Sample_sizes_RS_EOS85.Rmd b/R code/Remote_sensing/3_Analysis/EOS85_Dormancy/3.1_Sample_sizes_RS_EOS85.Rmd
new file mode 100644
index 0000000..3672f33
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS85_Dormancy/3.1_Sample_sizes_RS_EOS85.Rmd
@@ -0,0 +1,126 @@
+---
+title: "Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice"
+subtitle: "Satellite data (EOS85): sample size check"
+---
+
+
+
+## 1. Load packages and data
+
+get packages
+```{r}
+require(data.table)
+require(ggplot2)
+require(tidyverse)
+require(raster)
+require(viridis)
+
+
+#plot theme
+plotTheme1 = theme(
+ legend.position = "top",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.grid.major = element_line(colour = "lightgrey"),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+```
+
+
+get data
+```{r}
+## set working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+# paths
+Drivers_path = "Analysis_input/Drivers_final_EOS85/Merged_file"
+Land_cover_path = "Analysis_input/Drivers"
+
+## Import data
+Pheno.df <- fread(paste(Drivers_path, "Remote_sensing_drivers_data_EOS85.csv", sep="/"))
+
+LandCover.df <- fread(paste(Land_cover_path, "Land_Cover_Type_025.csv", sep="/")) %>%
+ mutate(geometry = gsub("POINT ","", geometry),
+ geometry = gsub("\\(|\\)","", geometry)) %>%
+ separate(geometry, into = c("Lon","Lat"), sep=" ") %>%
+ mutate(Lat = as.numeric(Lat),
+ Lon = as.numeric(Lon))
+```
+
+
+
+
+## 2. Data cleaning
+show code
+```{r}
+Pheno.df = Pheno.df %>%
+ mutate(Year = as.numeric(Year)) %>%
+ dplyr::select(-c(V1)) %>%
+ left_join(LandCover.df, by=c("Lat","Lon")) %>%
+ #delete evergreen broadleaf pixels
+ filter(!LC_Type == "EvgB")
+```
+
+
+
+
+## 3. Check sample sizes
+show code
+```{r}
+#total observations
+nrow(Pheno.df)
+
+#how many sites in total?
+length(unique(Pheno.df$geometry))
+
+#time span
+range(Pheno.df$Year)
+hist(Pheno.df$Year, xlab="Year", main="Temporal distribution of data", col='lightblue', breaks=40)
+
+#latitudinal gradient
+range(Pheno.df$Lat)
+hist(Pheno.df$Lat, xlab="Latitude", main="Latitudinal gradient", col='lightblue')
+
+#Land cover types
+Pheno.df.unique = Pheno.df %>% distinct(geometry, .keep_all = T)
+barplot(table(Pheno.df.unique$LC_Type))
+table(Pheno.df.unique$LC_Type)
+
+#leaf-out data
+mean(Pheno.df$Greenup_DOY)
+sd(Pheno.df$Greenup_DOY)
+range(Pheno.df$Greenup_DOY)
+hist(Pheno.df$Greenup_DOY, xlab="Leaf-out date", main="Leaf-out gradient", col='lightblue')
+
+#leaf-off data
+mean(Pheno.df$Dormancy_DOY)
+sd(Pheno.df$Dormancy_DOY)
+range(Pheno.df$Dormancy_DOY)
+hist(Pheno.df$Dormancy_DOY, xlab="EOS85 date", main="EOS85 gradient", col='lightblue')
+
+#Create summary dataframe by time series
+n.years = Pheno.df %>%
+ group_by(geometry) %>%
+ summarise(count = n())
+mean(n.years$count)
+max(n.years$count)
+min(n.years$count)
+
+#Map the observations
+mp <- NULL
+mapWorld <- borders("world", colour="gray60", fill="gray60") # create a layer of borders
+mp <- ggplot() + mapWorld + plotTheme1
+
+#Now Layer the stations on top
+mp <- mp + geom_tile(data = Pheno.df,
+ aes(x = Lon, y = Lat, fill=LC_Type)) +
+ scale_fill_viridis_d(option = "D") +
+ coord_cartesian(ylim = c(20, 70)) +
+ xlab("") + ylab('')
+mp
+```
+
\ No newline at end of file
diff --git a/R code/Remote_sensing/3_Analysis/EOS85_Dormancy/3.2_Add_preseasons_RS_dormancy.R b/R code/Remote_sensing/3_Analysis/EOS85_Dormancy/3.2_Add_preseasons_RS_dormancy.R
new file mode 100644
index 0000000..1a7b311
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS85_Dormancy/3.2_Add_preseasons_RS_dormancy.R
@@ -0,0 +1,403 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Run autumn temperature (preseason) models for the satellite data (EOS10) ##################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(data.table)
+require(broom)
+require(gmodels)
+require(patchwork)
+require(MASS)
+
+
+#define plot themes
+plotTheme1 = theme(legend.position = "none",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################################
+## Set directories and get own PEP data ##
+##########################################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+# paths
+Drivers_path = "Analysis_input/Drivers_final_EOS85/Merged_file"
+Land_cover_path = "Analysis_input/Drivers"
+output_path = "Analysis_output_EOS85/Preseason_temperatures"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology data
+Pheno.df <- fread(paste(Drivers_path, "Remote_sensing_drivers_data_EOS85.csv", sep="/"))%>%
+ dplyr::select(-V1)
+
+#Land cover info
+LandCover.df <- fread(paste(Land_cover_path, "Land_Cover_Type_025.csv", sep="/")) %>%
+ mutate(geometry = gsub("POINT ","", geometry),
+ geometry = gsub("\\(|\\)","", geometry)) %>%
+ separate(geometry, into = c("Lon","Lat"), sep=" ") %>%
+ mutate(Lat = round(as.numeric(Lat),3),
+ Lon = round(as.numeric(Lon),3) )
+
+#Merge tables
+Pheno.df = Pheno.df %>%
+ mutate(Year = as.numeric(Year)) %>%
+ inner_join(LandCover.df, by=c("Lat","Lon")) %>%
+ #delete evergreen broadleaf pixels
+ filter(!LC_Type == "EvgB")
+
+rm(LandCover.df)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+## Get best preseason ##
+########################
+
+
+
+#reshape table to long format
+#############################
+
+preseason.df = Pheno.df %>%
+ #select columns
+ dplyr::select(geometry,Year,LC_Type,Dormancy_DOY,
+ Tday.PS.10,Tday.PS.20,Tday.PS.30,
+ Tday.PS.40,Tday.PS.50,Tday.PS.60,
+ Tday.PS.70,Tday.PS.80,Tday.PS.90,
+ Tday.PS.100,Tday.PS.110,Tday.PS.120,
+ Tnight.PS.10,Tnight.PS.20,Tnight.PS.30,
+ Tnight.PS.40,Tnight.PS.50,Tnight.PS.60,
+ Tnight.PS.70,Tnight.PS.80,Tnight.PS.90,
+ Tnight.PS.100,Tnight.PS.110,Tnight.PS.120)%>%
+ #long format
+ pivot_longer(.,cols=starts_with(c("Td","Tn")), names_to = "preseason", values_to = "temp") %>%
+ #create preseason length and temperature class columns
+ mutate(preseason_length = readr::parse_number(gsub("[.]", "", preseason)), #keep only numbers in string
+ temp_class = gsub("\\..*","", preseason)) %>%
+ dplyr::select(-preseason)
+
+
+#Run linear models
+##################
+
+resultsLM = preseason.df %>%
+ group_by(geometry, LC_Type, temp_class, preseason_length) %>%
+ do({
+
+ model = lm(scale(Dormancy_DOY) ~ scale(temp), data=.) # linear model
+ data.frame(tidy(model), glance(model) )}) %>% # model info
+
+ filter(!term %in% c("(Intercept)")) %>%
+ dplyr::select(geometry,LC_Type,temp_class,preseason_length,estimate,r.squared)%>%
+ ungroup()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+############################################
+## Plot preseason-senescence correlations ##
+############################################
+
+
+
+#R2
+###
+
+resultsLM = resultsLM %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN"), ordered=T))
+
+plot.R2 = resultsLM %>%
+
+ ggplot()+
+ aes(x=preseason_length, y=r.squared,
+ colour=temp_class) +
+
+ stat_summary(fun=mean, geom="line", size = .7) +
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.5, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = 1) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+
+ xlab("Preseason length (days)") +
+ ylab("Coefficient of determination (R2)") +
+ coord_cartesian(ylim = c(0.01, 0.15))+
+ facet_wrap(~LC_Type, ncol=1) +
+ plotTheme1 +
+ theme(strip.text.x = element_blank())
+
+
+#Correlation coefficient
+########################
+
+plot.estimate = resultsLM %>%
+
+ ggplot()+
+ aes(x=preseason_length, y=estimate,
+ colour=temp_class) +
+
+ geom_hline(yintercept = 0)+
+ stat_summary(fun = mean, geom="line", size = .7) +
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.5, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = 1) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+
+ xlab("Preseason length (days)") +
+ ylab("Standardized coefficient") +
+ #coord_cartesian(ylim = c(0.01, 0.28))+
+ facet_wrap(~LC_Type, ncol=1) +
+ plotTheme1+
+ theme(strip.text.x = element_blank())
+
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################################################
+## Plot best preseason length for each temperature ##
+#####################################################
+
+
+
+#keep only models with best predictions
+resultsLM2 = resultsLM %>%
+ group_by(geometry,temp_class) %>%
+ top_n(1, r.squared) %>%
+ ungroup()
+
+#plot
+plot.length = resultsLM2 %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN"), ordered=T)) %>%
+ dplyr::select(LC_Type,temp_class,preseason_length)%>%
+
+ ggplot() + aes(x=temp_class, y=preseason_length) +
+
+ stat_summary(fun = mean,
+ fun.min = function(x) mean(x) - sd(x),
+ fun.max = function(x) mean(x) + sd(x),
+ geom = "pointrange",
+ size=0.5,
+ aes(colour = temp_class)) +
+
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+
+ coord_cartesian(ylim = c(5, 120))+
+ xlab("Daily temperature") +
+ ylab("Best preseason length (days)") +
+ facet_wrap(~LC_Type, ncol=1) +
+ plotTheme1+
+ theme(strip.text.x = element_blank(),
+ axis.text.x = element_text(angle = 45, hjust=1))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################################
+#Add best preseason temps to PEP data
+#####################################
+
+
+
+Pheno.df = Pheno.df %>%
+ inner_join(., preseason.df %>%
+ #filter by model data
+ semi_join(resultsLM2, by=c('geometry','temp_class','preseason_length')) %>%
+ dplyr::select(c(geometry,Year,temp_class,temp))%>%
+ pivot_wider(.,names_from = temp_class, values_from = temp),
+ by = c("Year", "geometry"))
+
+#Safe table
+write.csv(Pheno.df, paste(Drivers_path, "Remote_sensing_drivers_data_EOS85_preseason.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##################################
+#Run linear ridge regression model
+##################################
+
+
+
+resultsLM3 = Pheno.df %>%
+ group_by(geometry,LC_Type) %>%
+ do({model = lm.ridge(scale(Senesc_DOY) ~ scale(Tday)+scale(Tnight), data=.) # linear model
+ data.frame(tidy(model), # coefficient info
+ glance(model))}) %>% # model info
+ ungroup() %>%
+ #rename temperature class
+ mutate(term=dplyr::recode(term, `scale(Tday)`="Tday", `scale(Tnight)`="Tnight"))
+
+#plot preseason-senescence correlations
+plot.ridge = resultsLM3 %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN"), ordered=T) ) %>%
+
+ ggplot()+
+ aes(x=term, y=estimate,
+ colour=term, fill = term) +
+ scale_colour_manual(values = c('#F21A00','#3B9AB2')) +
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.9, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = 1) +
+
+ geom_hline(yintercept = 0)+
+ xlab("Daily temperature") +
+ ylab("Standardized coefficient (ridge regression)") +
+ coord_cartesian(ylim = c(-0.3, 0.3))+
+ facet_wrap(~LC_Type, ncol=1,strip.position = "right") +
+ plotTheme1+
+ theme(axis.text.x = element_text(angle = 45, hjust=1))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################
+# Arrange and safe plots #
+##########################
+
+
+
+#define plot layout
+layout <- "AABBCD"
+
+#Merge plots
+PreseasonPlot = plot.R2 + plot.estimate + plot.length + plot.ridge +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'a')&
+ theme(plot.tag = element_text(face = 'bold'))
+
+#Safe plot
+pdf(paste(output_path,"Preseason_sensitivity_RS_EOS85.pdf",sep="/"), width=8, height=7, useDingbats=FALSE)
+PreseasonPlot
+dev.off()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+## datetime
+Sys.time()
+#"2023-02-03 11:04:59 CET"
+
+
+## session info
+sessionInfo()
+#R version 4.1.0 (2021-05-18)
+#Platform: x86_64-apple-darwin17.0 (64-bit)
+#Running under: macOS 12.5.1
+
+#Matrix products: default
+#LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+#locale:
+# [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+#attached base packages:
+# [1] stats graphics grDevices utils datasets methods base
+
+#other attached packages:
+# [1] MASS_7.3-54 patchwork_1.1.1 gmodels_2.18.1 broom_0.7.8 data.table_1.14.0 forcats_0.5.1
+#[7] stringr_1.4.0 dplyr_1.0.10 purrr_0.3.4 readr_1.4.0 tidyr_1.2.0 tibble_3.1.8
+#[13] ggplot2_3.3.6 tidyverse_1.3.1
+
+#loaded via a namespace (and not attached):
+# [1] httr_1.4.2 jsonlite_1.8.0 splines_4.1.0 modelr_0.1.8 gtools_3.9.2
+#[6] Formula_1.2-4 assertthat_0.2.1 latticeExtra_0.6-29 cellranger_1.1.0 yaml_2.2.2
+#[11] pillar_1.8.0 backports_1.2.1 lattice_0.20-44 glue_1.6.2 digest_0.6.29
+#[16] checkmate_2.0.0 RColorBrewer_1.1-3 rvest_1.0.2 colorspace_2.0-3 htmltools_0.5.2
+#[21] Matrix_1.3-3 plyr_1.8.6 pkgconfig_2.0.3 haven_2.4.1 scales_1.2.0
+#[26] gdata_2.18.0 jpeg_0.1-8.1 htmlTable_2.2.1 farver_2.1.1 generics_0.1.3
+#[31] ellipsis_0.3.2 withr_2.5.0 nnet_7.3-16 cli_3.3.0 survival_3.2-11
+#[36] magrittr_2.0.3 crayon_1.5.1 readxl_1.3.1 evaluate_0.15 fs_1.5.2
+#[41] fansi_1.0.3 xml2_1.3.3 foreign_0.8-81 tools_4.1.0 hms_1.1.0
+#[46] lifecycle_1.0.1 munsell_0.5.0 reprex_2.0.0 cluster_2.1.2 compiler_4.1.0
+#[51] rlang_1.0.4 grid_4.1.0 rstudioapi_0.13 htmlwidgets_1.5.3 labeling_0.4.2
+#[56] base64enc_0.1-3 rmarkdown_2.9 gtable_0.3.0 DBI_1.1.2 R6_2.5.1
+#[61] gridExtra_2.3 lubridate_1.7.10 knitr_1.33 fastmap_1.1.0 utf8_1.2.2
+#[66] Hmisc_4.5-0 stringi_1.7.6 Rcpp_1.0.9 rpart_4.1-15 vctrs_0.4.1
+#[71] png_0.1-7 dbplyr_2.1.1 tidyselect_1.1.2 xfun_0.24
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/3_Analysis/EOS85_Dormancy/3.3_Spatial_models_RS.R b/R code/Remote_sensing/3_Analysis/EOS85_Dormancy/3.3_Spatial_models_RS.R
new file mode 100644
index 0000000..c77db9a
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS85_Dormancy/3.3_Spatial_models_RS.R
@@ -0,0 +1,643 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Linear models for the satellite data (EOS85) ##############################################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(ggplot2)
+require(data.table)
+require(broom)
+require(sjmisc)
+
+
+
+#define plot themes
+plotTheme1 = theme(legend.position = "right",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+# paths
+Drivers_path = "Analysis_input/Drivers_final_EOS85/Merged_file"
+output_path = "Analysis_output_EOS85/Data"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology data frame
+#####################
+
+Pheno.df <- fread(paste(Drivers_path, "Remote_sensing_drivers_data_EOS85_preseason.csv", sep="/")) %>%
+ filter(Dormancy_DOY>MidGreendown_DOY,
+ Dormancy_DOY>Senesc_DOY,
+ MidGreendown_DOY>Senesc_DOY) %>%
+ mutate(Duration_EOS10_50 = MidGreendown_DOY - Senesc_DOY,
+ Duration_EOS10_85 = Dormancy_DOY - Senesc_DOY,
+ Duration_EOS50_85 = Dormancy_DOY - MidGreendown_DOY) %>%
+ filter(Duration_EOS10_50 < 150,
+ Duration_EOS10_85 < 175,
+ Duration_EOS50_85 < 125) %>%
+ group_by(geometry, Lat, Lon) %>%
+ filter(n() >= 15) %>%
+ ungroup()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+## VARIABLE EXPLANATION:
+########################
+
+#General
+########
+
+#geometry...site identifier
+#Year...observation year
+#Lat...site latitude (decimal degrees)
+#Lon...site longitude (decomal degrees)
+#alt...site altitude (m a.s.l.)
+
+#---------------------------------------------------
+
+#Phenology
+##########
+
+#Dormancy_DOY...senescence date (DOY)
+
+#---------------------------------------------------
+
+#Day-of-year maximum temperature and radiation
+##############################################
+
+#HottestDOY...DOY with maximum annual temperature
+#MaxRadDOY...DOY with maximum irradiance
+
+#---------------------------------------------------
+
+#Seasonal drivers
+#################
+
+#SUMS (flexible start = leaf-out):
+#---------------------------------
+#GPP...Daily net photosynthesis
+#LAI...Daily LAI
+
+#MEANS (fixed start = March equinox):
+#------------------------------------
+#Tday...mean daytime temperature
+#Tnight...mean nighttime temperature
+#Moist...mean soil moisture (10-40cm)
+#Prcp...precipitation sum
+
+#-----------------
+
+#PERIODS
+
+#seasonal
+#--------
+#LO.SOm30...leaf-out to 30 days before summer solstice
+#LO.SO...leaf-out to summer solstice
+#LO.SOp30...leaf-out to 30 days after solstice
+#LO.SOp60...leaf-out to 60 days after solstice
+#LO.SE...leaf-out to mean senescence
+#SOm30.SE...30 days before solstice to mean senescence
+#SO.SE...solstice to mean senescence
+#SOp30.SE...30 days after solstice to mean senescence
+#SOp60.SE...60 days after solstice to mean senescence
+
+#around summer solstice
+#----------------------
+#solstice1...40 to 10 days before solstice
+#solstice2...30 days before solstice
+#solstice3...20 days before until 10 days after solstice
+#solstice4...10 days before until 20 days after solstice
+#solstice5...30 days after solstice
+#solstice6...10 to 40 days after solstice
+
+#---------------------------------------------------
+
+#Monthly drivers
+################
+
+#Tnight1-12...mean of nighttime temperatures in January (1) to December (12)
+#Tday1-12...mean of daytime temperatures in January (1) to December (12)
+#GDDnight1-12...sum of nighttime degree-days in January (1) to December (12)
+#GDDday1-12...sum of daytime degree-days in January (1) to December (12)
+#SWrad1-12...mean of daily short-wave radiation in January (1) to December (12)
+#Moist1-12...mean of daily soil moisture (10-40cm) in January (1) to December (12)
+#Prcp1-12...sum of daily precipitation in January (1) to December (12)
+#Apm1-12...sum of daily gross photosynthesis in January (1) to December (12)
+#Azani1-12...sum of daily net photosynthesis in January (1) to December (12)
+#GSI...day length-influenced growing-season index
+#GSIrad...radiation-influenced growing-season index
+
+#---------------------------------------------------
+
+#Preseason temperatures
+#######################
+
+#Tday...time series-specific best preseason (R2-based) for daytime temperatures
+#tnight...time series-specific best preseason (R2-based) for nighttime temperatures
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+################################
+## Senescence duration models ##
+################################
+
+
+
+#Define variables
+predictors = c('Tday.EOS10.PS.60', 'Tday.EOS10.PS.90', "Tday.EOS50.PS.60",
+ 'Tday.EOS10mean_50', 'Tday.EOS10mean_85', "Tday.EOS50mean_85")
+
+responses = rep(c('Duration_EOS10_50', 'Duration_EOS10_85', "Duration_EOS50_85"),2)
+
+#create List object to store results
+DataList = replicate(length(predictors), data.frame())
+names(DataList) = predictors
+
+
+##############################################################################################################################################
+
+
+#Loop through variables
+#######################
+
+for (i in 1:length(predictors)){
+
+ #set equation
+ #############
+
+ equation = as.formula(paste(responses[i], " ~ ", predictors[i]))
+
+
+ ##############################################################################################################################################
+
+
+ ##############
+ #linear models
+ ##############
+
+
+ ModelResults.df = Pheno.df %>%
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+ do({
+
+ #run model
+ ##########
+
+ model = lm(equation, data=.)
+
+
+ #create combined data frame
+ ###########################
+
+ data.frame(tidy(model))}) %>%
+
+ #add variable name
+ mutate(response = responses[i],
+ predictor = predictors[i]) %>%
+ #delete intercept
+ filter(!term %in% c("(Intercept)")) %>%
+ ungroup()
+
+
+ ##############################################################################################################################################
+
+
+ #store data frame in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(predictors), ' (',predictors[i],') done'))
+}
+
+#bind rows
+DurationAnalysis.df = bind_rows(DataList)
+
+#Safe table
+write.csv(DurationAnalysis.df, paste(output_path, "Duration_data.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Full models ##
+#################
+
+
+
+#Define variables
+variables = c('GPPstart', 'LAIstart',
+ 'Tnight', 'Tday',
+ 'SWrad')
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+##############################################################################################################################################
+
+
+#Loop through variables
+#######################
+
+for (i in 1:length(variables)){
+
+ #delete pixels with no photosynthesis before solstice
+ if (variables[i] %in% c('GPPstart'))
+ Pheno.df2 = Pheno.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(paste0(variables[i],".LO.SO"))) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.df
+
+
+ #set equations
+ ##############
+
+ #define variable names
+ covariates = paste0(variables[i], c('.LO.SO','.SO.SE'))
+
+
+ #full models
+ equation.scaled1 = as.formula(paste("scale(Dormancy_DOY) ~ ", paste0('scale(',covariates[1], ') + scale(', covariates[2], ')',
+ collapse="+"),
+ '+ scale(Prcp.LO.SO) + scale(Prcp.SO.SE) + scale(CO2)', collapse=""))
+
+ equation.scaled2 = as.formula(paste("scale(Dormancy_DOY) ~ ", paste0('scale(',covariates[1], ') + scale(', covariates[2], ')',
+ collapse="+")))
+
+
+ ##############################################################################################################################################
+
+
+ ##############
+ #linear models
+ ##############
+
+
+ ModelResults.df = Pheno.df2 %>%
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+ do({
+
+ #run model
+ ##########
+
+ model1 = lm(equation.scaled1, data=.)
+ model2 = lm(equation.scaled2, data=.)
+
+ #create combined data frame
+ ###########################
+
+ data.frame(rbind(
+
+ #Equation 1
+ tidy(model1) %>% mutate(equation = 'full model 1'), #add model name
+
+ #Equation 2
+ tidy(model2) %>% mutate(equation = 'full model 2')
+
+ ))
+ }) %>%
+
+ #add variable name and delete "scale()" from term column
+ mutate(variable = variables[i],
+ term = gsub("scale","",term),
+ term = gsub("\\(|\\)","",term) ) %>%
+ #delete intercept
+ filter(!term %in% c("Intercept")) %>%
+ ungroup()
+
+
+ ##############################################################################################################################################
+
+
+ #store data frame in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+FullAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################
+## Monthly correlations ##
+##########################
+
+
+
+#Get sums for January to April photosynthesis parameters
+Pheno.monthly.df = Pheno.df %>%
+ mutate(LAIstart4 = rowSums(dplyr::select(.,c("LAIstart1","LAIstart2","LAIstart3","LAIstart4"))),
+ GPPstart4 = rowSums(dplyr::select(.,c("GPPstart1","GPPstart2","GPPstart3","GPPstart4")))
+ )
+
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+##############################################################################################################################################
+
+
+#Loop through covariate groups
+##############################
+
+
+for (i in 1:length(variables)){
+
+ #delete pixels with no photosynthesis before solstice
+ #####################################################
+
+ if (variables[i] %in% c("GPPstart","LAIstart"))
+ Pheno.df2 = Pheno.monthly.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(paste0(variables[i],"4"))) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.monthly.df
+
+ #create explanatory variables
+ #############################
+
+ covariates.monthly = paste0(variables[i], c(1:9))
+
+ #---------------------------------------------------------
+
+ #set equations
+ ##############
+
+ if(variables[i] %in% c('GPPstart', 'LAIstart', 'SWrad')) {
+ equation = as.formula(paste("scale(Dormancy_DOY) ~ ", paste('scale(', covariates.monthly[4:9], ')', collapse="+"),
+ collapse=""))
+ } else {
+ equation = as.formula(paste("scale(Dormancy_DOY) ~ ", paste('scale(', covariates.monthly, ')', collapse="+"),
+ collapse=""))
+ }
+
+ #---------------------------------------------------------
+
+ ###############
+ # Linear models
+ ###############
+
+ ModelResults.df = Pheno.df2 %>%
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+ do({
+
+ #run models
+ ###########
+
+ model = lm(equation, data=.)
+
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(tidy(model) %>% mutate(equation = 'monthly') )
+ }) %>%
+
+ ungroup() %>%
+ #delete intercept
+ filter(!term %in% c("(Intercept)")) %>%
+ #add variable name and keep only numbers in month column
+ mutate(variable = variables[i],
+ term = readr::parse_number(term))
+
+
+ #---------------------------------------------------------
+
+ #store dataframe in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+MonthlyAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+######################
+## Seasonal drivers ##
+######################
+
+
+#Covariates
+###########
+
+#Variable length (leaf-out influenced):
+#--------------------------------------
+#Apm...Daily net photosynthesis (p-model)
+#Azani...Daily net photosynthesis (Zani model)
+#GSI...photoperiod-influenced growing-season index
+#GSIrad...radiation-influenced growing-season index
+#GDDday...daytime degree days
+#GDDnight...nighttime degree days
+#SWrad...Radiation sum
+
+#Fixed length:
+#-------------
+#Tday...mean daytime temperature
+#Tnight...mean daytime temperature
+
+
+#-------------------------------------------------------------
+
+
+## Define covariate groups
+seasons = c('LO.SOm30', 'LO.SO', 'LO.SOp30', 'LO.SOp60', 'LO.SE', 'SOm30.SE', 'SO.SE', 'SOp30.SE')
+solstice = c('solstice1', 'solstice2', 'solstice3', 'solstice4', 'solstice5', 'solstice6')
+
+covariates1 = paste(rep(variables, each=length(seasons)), seasons, sep = '.')
+covariates2 = paste(rep(variables, each=length(solstice)), solstice, sep = '.')
+covariates = c(covariates1,covariates2)
+
+#Check if all variables are in dataframe
+table(names(Pheno.df) %in% covariates)[2]/length(covariates)==1
+
+#-------------------------------------------------------------
+
+## Create List object to store results
+DataList = replicate(length(covariates), data.frame())
+names(DataList) = covariates
+i=1
+
+
+##############################################################################################################################################
+
+
+#Loop through covariates
+########################
+
+for (covariate in covariates){
+
+ #get variable name
+ variable = gsub("\\..*","", covariate)
+
+ #delete pixels with no photosynthesis for the respective period
+ if (variable %in% c("GPPstart"))
+ Pheno.df2 = Pheno.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(covariates[i])) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.df
+
+ #---------------------------------------------------------
+
+ #set equations
+ ##############
+
+
+ #univariate scaled
+ equation = as.formula(paste("scale(Dormancy_DOY) ~ ", paste('scale(', covariate, ')', collapse="+"), collapse=""))
+
+
+ ##############################################################################################################################################
+
+
+ ##################
+ #Run linear models
+ ##################
+
+
+
+ ModelResults.df = Pheno.df2 %>%
+
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+
+ do({
+
+ #run models
+ ###########
+
+ model = lm(equation, data=.)
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(tidy(model) %>%
+ add_column(equation = paste0(ifelse(str_contains(covariate, c("solstice"), logic="or"),"Solstice","Seasonal"),
+ '.scaled') ) %>%
+ filter(term %in% paste0('scale(',covariate,')')) )#delete intercept
+
+ }) %>%
+
+ #add variable name
+ mutate(term = covariate,
+ variable = sub("\\..*", "", covariate))
+
+
+ ##############################################################################################################################################
+
+
+ #store dataframe in variable list
+ DataList[[i]] = ModelResults.df
+
+ print(paste0('..... ',i, ' out of ', length(covariates), ' done'))
+ i=i+1
+}
+
+#bind tables
+SeasonalAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########
+## Safe ##
+##########
+
+
+
+#bind full model, monthly and seasonal analyses
+Analysis.df = rbind(FullAnalysis.df, MonthlyAnalysis.df, SeasonalAnalysis.df)
+
+#Safe tables
+write.csv(Analysis.df, paste(output_path, "Spatial_effect_data.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/3_Analysis/EOS85_Dormancy/3.4_Mapping_EOS85.Rmd b/R code/Remote_sensing/3_Analysis/EOS85_Dormancy/3.4_Mapping_EOS85.Rmd
new file mode 100644
index 0000000..c106823
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOS85_Dormancy/3.4_Mapping_EOS85.Rmd
@@ -0,0 +1,1182 @@
+---
+title: Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice
+author: Constantin Zohner
+date: "last updated March 31, 2023"
+
+subtitle: Satellite-derived EOS85 data (Figure S9)
+output:
+ html_document:
+ highlight: haddock
+ toc: false
+ use_bookdown: true
+ df_print: paged
+---
+
+
+
+
+
+### Figure descriptions
+- Fig. S9: Effect of autumn temperature on the duration of senescence at 0.25° resolution for the 2001—2018 period
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(
+ class.source = "numberLines lineAnchors"
+ )
+```
+
+
+
+```{r, message=FALSE, warning=FALSE, attr.source='.numberLines'}
+###################
+# Required packages
+###################
+
+
+
+require(tidyverse)
+require(data.table)
+require(ggplot2)
+require(patchwork)
+require(gmodels)
+require(wesanderson)
+require(pracma)
+require(lme4)
+require(effects) #plot effects
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+
+# Paths
+
+#input
+Drivers_path = "Analysis_input/Drivers_final_EOS85/Merged_file"
+Analysis_path = "Analysis_output_EOS85/Data"
+photo_path = "Analysis_input/Drivers" #Photoperiod file
+
+#output
+output_path = "Analysis_output_EOS85/Maps"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Spatial (pixel-level) models
+#############################
+
+Analysis.df = fread(paste(Analysis_path, "Spatial_effect_data.csv", sep="/"))
+
+#geometry: unique pixel identifier
+#Lat: Latitude
+#Lon: Longitude
+#LC_type: All, DecB, DecN, EvgN, Mixed (Landcover type)
+#term: monthly coefficients (1-10) and seasonal coefficients
+#estimate: slopes or standardized coefficients of mixed effects models
+#std.error: std.error of coefficients
+#statistic:
+#equation: full model 1/2, monthly/seasonal/solstice, scaled/unscaled, tempCon (Tday controlled)
+#variable: climate variable (LAI, GPP, Tday, Tnight, SWrad)
+
+
+# Duration model correlations
+#############################
+
+DurationModel.df = fread(paste(Analysis_path, "Duration_data.csv", sep="/")) %>%
+ mutate(equation = ifelse(grepl("mean",predictor), "Mean", "Flexible"))
+
+
+#-------------------------------------------------------------------------------------------------------
+
+
+# get full model correlations
+#############################
+
+FullModel.df = Analysis.df %>%
+ filter(equation == "full model 1")
+
+ReducedModel.df = Analysis.df %>%
+ filter(equation == "full model 2")
+
+
+#-------------------------------------------------------------------------------------------------------
+
+
+# get monthly correlations
+##########################
+
+#Summarize all pixels
+MonthlyAnalysisAll.df = Analysis.df %>%
+ filter(equation == "monthly") %>%
+ group_by(term, variable) %>%
+ summarise(mean = gmodels::ci(estimate)[1],
+ lowCI = gmodels::ci(estimate)[2],
+ hiCI = gmodels::ci(estimate)[3],
+ lowSD = mean-sd(estimate),
+ hiSD = mean+sd(estimate)) %>%
+ mutate(LC_Type = "All") %>%
+ ungroup()
+
+#Summarize by vegetation type
+MonthlyAnalysisLCtype.df = Analysis.df %>%
+ filter(equation == "monthly") %>%
+ group_by(term, variable, LC_Type) %>%
+ summarise(mean = gmodels::ci(estimate)[1],
+ lowCI = gmodels::ci(estimate)[2],
+ hiCI = gmodels::ci(estimate)[3],
+ lowSD = mean-sd(estimate),
+ hiSD = mean+sd(estimate)) %>%
+ ungroup()
+
+#Rbind
+MonthlyAnalysis.df = rbind(MonthlyAnalysisAll.df, MonthlyAnalysisLCtype.df) %>%
+ #Add variable x equation identifier
+ mutate(variable.type = paste(variable, LC_Type, sep='.'),
+ term = as.numeric(term),
+ LC_Type = factor(LC_Type, levels = c("All","Mixed", "DecB", "EvgN","DecN")))
+
+
+#-------------------------------------------------------------------------------------------------------
+
+
+# get seasonal correlations
+###########################
+
+SeasonalModel.df = Analysis.df %>%
+ filter(equation == "Solstice.scaled") %>%
+ #Add variable class identifier
+ mutate(variable.class = gsub("^.*?\\.","", term) )
+
+
+##############################################################################################################################################
+
+
+#Phenology data
+###############
+
+Pheno.df = fread(paste(Drivers_path, "Remote_sensing_drivers_data_EOS85_preseason.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+################
+## Plot theme ##
+################
+
+
+#Color.palette: col=c('#F21A00','#E1AF00','#EBCC2A','#78B7C5','#3B9AB2')
+
+plotTheme1 = theme(
+ legend.position = "none",
+ legend.background = element_blank(),
+ legend.text = element_text(color="black"),
+ legend.title = element_blank(),
+ legend.key = element_blank(),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(hjust = 0.5))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+###################
+# Duration figure #
+###################
+
+
+
+#list variables to loop through
+variables = unique(DurationModel.df$equation)
+
+
+#start loop
+for(variable.name in variables) {
+
+ #subset and reshape data
+ Analysis.df.sub = DurationModel.df %>%
+ filter(equation == variable.name) %>%
+ mutate(positive = ifelse(estimate>0,1,0),
+ negative = ifelse(estimate<0,1,0),
+ positive.sign = ifelse(estimate>0 & p.value<0.05,1,0),
+ negative.sign = ifelse(estimate<0 & p.value<0.05,1,0))
+
+
+ ##########################################################################################################################################
+
+ require(plotrix)
+ #create summary info
+ VariablesVector = c("estimate","p.value","positive","negative","positive.sign","negative.sign")
+ data1 = Analysis.df.sub %>%
+ group_by(response) %>%
+ summarize_at(VariablesVector, c(mean, std.error), na.rm = TRUE)
+
+
+
+ ###################
+ # Latitudinal plots
+ ###################
+
+
+ LatPlot_EOS50_85 = Analysis.df.sub %>%
+ filter(response == "Duration_EOS50_85") %>%
+ mutate(LatRound = round(Lat)) %>%
+ group_by(LatRound, equation) %>%
+ summarise(mean = ci(estimate)[1],
+ lowCI = ci(estimate)[2],
+ highCI = ci(estimate)[3]) %>%
+ ungroup() %>%
+ ggplot(aes(x = LatRound, y= mean, color=equation)) +
+ geom_ribbon(aes(ymin=lowCI, ymax=highCI, fill=equation), color=NA, alpha=0.5)+
+ geom_line()+
+ geom_hline(yintercept=0)+
+ scale_color_manual(values = c('#3B9AB2'))+
+ scale_fill_manual(values = c('#3B9AB2'))+
+ scale_alpha_discrete(range = c(0.5, 0.5, 0.5))+
+ ylab("Days per °C") +
+ coord_flip(ylim = c(-4, 4),xlim=c(27,75))+
+ plotTheme1 +
+ theme(axis.text.y = element_blank(),
+ axis.title.y = element_blank())
+
+ LatPlot_EOS10_85 =Analysis.df.sub %>%
+ filter(response == "Duration_EOS10_85") %>%
+ mutate(LatRound = round(Lat)) %>%
+ group_by(LatRound, equation) %>%
+ summarise(mean = ci(estimate)[1],
+ lowCI = ci(estimate)[2],
+ highCI = ci(estimate)[3]) %>%
+ ungroup() %>%
+ ggplot(aes(x = LatRound, y= mean, color=equation)) +
+ geom_ribbon(aes(ymin=lowCI, ymax=highCI, fill=equation), color=NA, alpha=0.5)+
+ geom_line()+
+ geom_hline(yintercept=0)+
+ scale_color_manual(values = c('#3B9AB2'))+
+ scale_fill_manual(values = c('#3B9AB2'))+
+ scale_alpha_discrete(range = c(0.5, 0.5, 0.5))+
+ ylab("Days per °C") +
+ coord_flip(ylim = c(-7, 7),xlim=c(27,75))+
+ plotTheme1 +
+ theme(axis.text.y = element_blank(),
+ axis.title.y = element_blank())
+
+ LatPlot_EOS10_50 =Analysis.df.sub %>%
+ filter(response == "Duration_EOS10_50") %>%
+ mutate(LatRound = round(Lat)) %>%
+ group_by(LatRound, equation) %>%
+ summarise(mean = ci(estimate)[1],
+ lowCI = ci(estimate)[2],
+ highCI = ci(estimate)[3]) %>%
+ ungroup() %>%
+ ggplot(aes(x = LatRound, y= mean, color=equation)) +
+ geom_ribbon(aes(ymin=lowCI, ymax=highCI, fill=equation), color=NA, alpha=0.5)+
+ geom_line()+
+ geom_hline(yintercept=0)+
+ scale_color_manual(values = c('#3B9AB2','#F21A00','green'))+
+ scale_fill_manual(values = c('#3B9AB2','#F21A00','green'))+
+ scale_alpha_discrete(range = c(0.5, 0.5, 0.5))+
+ ylab("Days per °C") +
+ coord_flip(ylim = c(-7, 7),xlim=c(27,75))+
+ plotTheme1 +
+ theme(axis.text.y = element_blank(),
+ axis.title.y = element_blank())
+
+ ##############################################################################################################################################
+
+
+
+ #########
+ # Mapping
+ #########
+
+
+ #Get world map
+ mp <- NULL
+ mapWorld <- borders("world", colour="gray40", fill="gray40") # create a layer of borders
+ mp <- ggplot() + mapWorld + plotTheme1
+
+ #Map EOS50_85
+ #subset and reshape data
+ Analysis.df.sub2 = DurationModel.df %>%
+ filter(equation == variable.name,
+ response == "Duration_EOS50_85") %>%
+ mutate(estimate = ifelse(estimate>3.5, 3.5, ifelse(estimate < -3.5, -3.5, estimate)) )
+ #Plot
+ Map_EOS50_85 = mp + geom_tile(data = Analysis.df.sub2,
+ show.legend=T,
+ aes(x = Lon, y = Lat, fill=estimate)) +
+ scale_fill_gradient2(midpoint=0, low='#F21A00', mid="white",
+ high='#3B9AB2', space ="Lab" ) +
+ #add text
+ ggtitle(paste("EOS50 to EOS85 (mean = ",
+ round(data1[data1$response=="Duration_EOS50_85",]$estimate_fn1,2),
+ " ± ",
+ round(data1[data1$response=="Duration_EOS50_85",]$estimate_fn2,2)*2,
+ " days per °C; ",
+ round(data1[data1$response=="Duration_EOS50_85",]$positive_fn1*100),
+ "% of pixels positive; ",
+ round(data1[data1$response=="Duration_EOS50_85",]$positive.sign_fn1*100),
+ '% significant)', sep=""))+
+ coord_cartesian(ylim = c(27, 75), xlim = c(-160, 175)) +
+ xlab("") + ylab('Latitude') +
+ theme(legend.position = c(0.08,0.33))
+
+ #Map EOS10_85
+ #subset and reshape data
+ Analysis.df.sub2 = DurationModel.df %>%
+ filter(equation == variable.name,
+ response == "Duration_EOS10_85") %>%
+ mutate(estimate = ifelse(estimate>7, 7, ifelse(estimate < -7, -7, estimate)) )
+ #Plot
+ Map_EOS10_85 = mp + geom_tile(data = Analysis.df.sub2,
+ show.legend=T,
+ aes(x = Lon, y = Lat, fill=estimate)) +
+ scale_fill_gradient2(midpoint=0, low='#F21A00', mid="white",
+ high='#3B9AB2', space ="Lab" ) +
+ #add text
+ ggtitle(paste("EOS10 to EOS85 (mean = ",
+ round(data1[data1$response=="Duration_EOS10_85",]$estimate_fn1,2),
+ " ± ",
+ round(data1[data1$response=="Duration_EOS10_85",]$estimate_fn2,2)*2,
+ " days per °C; ",
+ round(data1[data1$response=="Duration_EOS10_85",]$positive_fn1*100),
+ "% of pixels positive; ",
+ round(data1[data1$response=="Duration_EOS10_85",]$positive.sign_fn1*100),
+ '% significant)', sep=""))+
+ coord_cartesian(ylim = c(27, 75), xlim = c(-160, 175)) +
+ xlab("") + ylab('Latitude') +
+ theme(legend.position = c(0.08,0.33))
+
+ #Map EOS10_50
+ #subset and reshape data
+ Analysis.df.sub2 = DurationModel.df %>%
+ filter(equation == variable.name,
+ response == "Duration_EOS10_50") %>%
+ mutate(estimate = ifelse(estimate>6, 6, ifelse(estimate < -6, -6, estimate)) )
+ #Plot
+ Map_EOS10_50 = mp + geom_tile(data = Analysis.df.sub2,
+ show.legend=T,
+ aes(x = Lon, y = Lat, fill=estimate)) +
+ scale_fill_gradient2(midpoint=0, low='#F21A00', mid="white",
+ high='#3B9AB2', space ="Lab" ) +
+ #add text
+ ggtitle(paste("EOS10 to EOS50 (mean = ",
+ round(data1[data1$response=="Duration_EOS10_50",]$estimate_fn1,2),
+ " ± ",
+ round(data1[data1$response=="Duration_EOS10_50",]$estimate_fn2,2)*2,
+ " days per °C; ",
+ round(data1[data1$response=="Duration_EOS10_50",]$positive_fn1*100),
+ "% of pixels positive; ",
+ round(data1[data1$response=="Duration_EOS10_50",]$positive.sign_fn1*100),
+ '% significant)', sep=""))+
+ coord_cartesian(ylim = c(27, 75), xlim = c(-160, 175)) +
+ xlab("") + ylab('Latitude') +
+ theme(legend.position = c(0.08,0.33))
+
+
+ ##############################################################################################################################################
+
+
+ ##########################
+ # Arrange and safe plots #
+ ##########################
+
+
+ # 1. Map plots
+ ##############
+
+ #define plot layout
+ layout <- "
+AAAAAB
+CCCCCD
+EEEEEF
+"
+
+ #Merge plots
+ Fig_Plot = Map_EOS10_85 + LatPlot_EOS10_85 +
+ Map_EOS10_50 + LatPlot_EOS10_50 +
+ Map_EOS50_85 + LatPlot_EOS50_85 +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A') &
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plots as .pdf
+ ggsave(Fig_Plot, file=paste('FigS9_Duration_Map_',variable.name, ".pdf", sep=''),
+ path=output_path,
+ width=13, height=10)
+
+ print(Fig_Plot)
+
+
+ ##############################################################################################################################################
+
+ #count
+ print(variable.name)
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+######################
+# Photoperiod figure #
+######################
+
+
+#get mean leaf-out and senescence dates
+leaf_out = as.Date(mean(Pheno.df$Greenup_DOY), origin = "2016-12-31")
+leaf_off = as.Date(mean(Pheno.df$Dormancy_DOY), origin = "2016-12-31")
+
+# dataframe of photoperiods
+photo.df = fread(paste(photo_path, "Photoperiod.csv", sep="/"))
+phot.sub = photo.df[475,3:367]
+phot.sub = rbind(as.data.frame(t(phot.sub)), as.data.frame(t(phot.sub)))
+phot.sub$X = as.Date(1:nrow(phot.sub), origin = "2016-12-31")
+
+
+# Plot of periods around solstice
+#################################
+
+#dataframe of periods
+solstice.data = rbind(
+ data.frame(X=as.Date(c("2017-05-14","2017-06-12")), Y=10, season = "A"),
+ data.frame(X=as.Date(c("2017-05-24","2017-06-22")), Y=11, season = "B"),
+ data.frame(X=as.Date(c("2017-06-02","2017-07-01")), Y=12, season = "C"),
+ data.frame(X=as.Date(c("2017-06-12","2017-07-11")), Y=13, season = "D"),
+ data.frame(X=as.Date(c("2017-06-22","2017-07-21")), Y=14, season = "E"),
+ data.frame(X=as.Date(c("2017-07-03","2017-08-01")), Y=15, season = "F") )
+
+#Plot
+PhotoSolstice = ggplot() +
+ #day length line
+ geom_line(data=phot.sub, aes(x=X, y=V1, group=1),col="black") +
+ #solstice
+ geom_vline(xintercept = as.Date("2017-06-22"), size=1, alpha=0.4)+
+ #periods
+ geom_line(data=solstice.data, aes(x=X, y=Y, color=season), size=2.75)+
+ scale_color_manual(values = rev(wes_palette(6, name = "Zissou1", type = "continuous")))+
+ #plot settings
+ coord_cartesian(xlim=c(as.Date(c('2017-03-01','2017-10-31'))), ylim=c(10,16))+
+ ylab("Day length")+xlab("")+
+ scale_x_date(position = "top") +
+ plotTheme1+
+ theme(plot.background = element_rect(fill = "transparent", color = NA),
+ panel.background = element_rect(fill = "white"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################################
+## Interpolation of monthly estimates ##
+########################################
+
+
+
+#Interpolation function
+lin_interp = function(x, y, length.out=100) {
+ approx(x, y, xout=seq(min(x), max(x), length.out=length.out))$y
+}
+
+#create identifier
+variable.type = unique(MonthlyAnalysis.df$variable.type)
+
+#create interpolation dataframe
+df.interp = data.frame()
+df.AUC = data.frame()
+
+#loop over variable x equation x vegetation type vector
+for (variable.name in variable.type){
+
+ #subset table
+ df.sub = MonthlyAnalysis.df %>%
+ filter(variable.type == variable.name)
+
+ # Interpolate data
+ created.interp = lin_interp(df.sub$term, df.sub$term)
+ score.interp = lin_interp(df.sub$term, df.sub$mean)
+ df.interp.sub = data.frame(created=created.interp, score=score.interp)
+ # Make a grouping variable for each pos/neg segment
+ cat.rle = rle(df.interp.sub$score < 0)
+ df.interp.sub = df.interp.sub %>%
+ mutate(group = rep.int(1:length(cat.rle$lengths), times=cat.rle$lengths),
+ LC_Type = unique(df.sub$LC_Type),
+ variable = unique(df.sub$variable) )
+ #rbind sub dataframes
+ df.interp = rbind(df.interp, df.interp.sub)
+
+ #get Area under curve (%)
+ df.AUC.sub = df.interp.sub %>%
+ mutate(positive = ifelse(score<0, 0, score),
+ negative = ifelse(score>0, 0, score))%>%
+ summarise(sum.pos = trapz(created, positive),
+ sum.neg = abs(trapz(created, negative)))%>%
+ mutate(percent.neg = round(sum.neg/(sum.pos+sum.neg)*100),
+ percent.pos = round(sum.pos/(sum.pos+sum.neg)*100),
+ LC_Type = unique(df.sub$LC_Type),
+ variable = unique(df.sub$variable) )
+ #rbind sub dataframes
+ df.AUC = rbind(df.AUC, df.AUC.sub)
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+# Mixed effects models #
+########################
+
+
+
+#Prepare data
+#############
+
+#delete outlier values
+PhenoMixed.df <- Pheno.df %>%
+ filter(GPPstart.LO.SO < quantile(.$GPPstart.LO.SO, 0.999),
+ GPPstart.LO.SO > quantile(.$GPPstart.LO.SO, 0.01))
+
+#get year mean
+YearMean = mean(PhenoMixed.df$Year)
+
+#transform units and center year variable
+PhenoMixed.df <- PhenoMixed.df %>%
+ mutate(GPPstart.LO.SO = GPPstart.LO.SO*0.1,
+ Year = Year - mean(Year)) %>%
+ #delete pixels with less than 15 years
+ group_by(geometry) %>%
+ filter(n() >= 15) %>%
+ ungroup()
+
+
+###############################################################
+#get advance in EOS85 per each 10% increase in pre-solstice GPP
+###############################################################
+
+coefficients = coef(summary(lmer(Dormancy_DOY ~ GPPstart.LO.SO + (1 | geometry), data=PhenoMixed.df,
+ na.action = "na.exclude", control = lmerControl(optimizer ="Nelder_Mead"))))[2,1:2]
+
+#relative to overall variation
+coefficients * (max(PhenoMixed.df$GPPstart.LO.SO)-min(PhenoMixed.df$GPPstart.LO.SO))/10
+
+
+##############################################################################################################################################
+
+
+# Models
+########
+
+#list variables to loop through
+variables = c("Tday","GPPstart")
+
+#create List object to store results
+DataList1 = replicate(length(variables), data.frame())
+DataList2 = replicate(length(variables), data.frame())
+DataList3 = replicate(length(variables), data.frame())
+names(DataList1) = variables
+names(DataList2) = variables
+names(DataList3) = variables
+
+##############################################################################################################################################
+
+
+#Loop through variables
+#######################
+
+for (i in 1:length(variables)){
+
+ #extract variables
+ Year = as.numeric(PhenoMixed.df$Year)
+ Pre.solstice = as.numeric(PhenoMixed.df %>% pull(paste0(variables[i],".LO.SO")))
+ Dormancy_DOY = as.numeric(PhenoMixed.df$Dormancy_DOY)
+ geometry = PhenoMixed.df$geometry
+
+
+ #Multivariate
+ fit_multi = lmer(Dormancy_DOY ~ Pre.solstice + Year + (1 | geometry),
+ na.action = "na.exclude", control = lmerControl(optimizer ="Nelder_Mead"))
+
+ #year-only
+ fit_year = lmer(Dormancy_DOY ~ Year + (1 | geometry),
+ na.action = "na.exclude", control = lmerControl(optimizer ="Nelder_Mead"))
+
+ # Extract information for plotting
+ plotMulti = allEffects(fit_multi)
+ plotYear = allEffects(fit_year)
+
+ # Extract coefficients
+ df.coefficients = tibble(Coefficient = coef(summary(fit_multi))[ , "Estimate"][2:3],
+ variable = c(paste0(variables[i]),"Year"),
+ class = paste0(variables[i])) %>%
+ bind_rows(tibble(Coefficient = coef(summary(fit_year))[ , "Estimate"][2],
+ variable = c("Year"),
+ class = "Univariate"))
+
+ # Final table
+ df <- tibble(upper = plotYear$Year$upper[,1],
+ lower = plotYear$Year$lower[,1],
+ off = plotYear$Year$fit[,1],
+ xval = plotYear$Year$x[,1],
+ class = "Univariate",
+ variable = "Year") %>%
+ #Multi
+ bind_rows(
+ tibble(upper = plotMulti$Year$upper[,1],
+ lower = plotMulti$Year$lower[,1],
+ off = plotMulti$Year$fit[,1],
+ xval = plotMulti$Year$x[,1],
+ class = paste0(variables[i]),
+ variable = "Year")
+ )%>%
+ bind_rows(
+ tibble(upper = plotMulti$Pre.solstice$upper[,1],
+ lower = plotMulti$Pre.solstice$lower[,1],
+ off = plotMulti$Pre.solstice$fit[,1],
+ xval = plotMulti$Pre.solstice$x[,1],
+ class = paste0(variables[i]),
+ variable = paste0(variables[i]))
+ )
+
+
+ # get phenology anomalies
+ df = df %>%
+ group_by(class, variable) %>%
+ mutate(anomaly = off - mean(off),
+ anomaly.upper = upper - mean(off),
+ anomaly.lower = lower - mean(off)) %>%
+ ungroup()
+
+ ##############################################################################################################################################
+
+ # get partial Senescence dates, removing effect of year (fixed) and site (random)
+ y_partial = remef::remef(fit_multi, fix="Year", ran="all", keep.intercept = T)
+
+ # Create table
+ df.fitted = tibble(fitted = y_partial,
+ x = Pre.solstice,
+ variable = variables[i])
+
+ ##############################################################################################################################################
+
+ #store data frame in variable list
+ DataList1[[i]] = df
+ DataList2[[i]] = df.coefficients
+ DataList3[[i]] = df.fitted
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+MixedModel.df = bind_rows(DataList1)
+coefficients.df = bind_rows(DataList2)
+fitted.df = bind_rows(DataList3)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##############
+# Map figure #
+##############
+
+
+
+#start loop
+for(variable.name in variables) {
+
+ #subset and reshape data
+ Analysis.df.sub2 = ReducedModel.df %>%
+ filter(variable == variable.name,
+ term %in% c(paste0(variable.name,'.SO.SE'),paste0(variable.name,'.LO.SO'))) %>%
+ mutate(term = factor(term, levels=c(paste0(variable.name,".SO.SE"),
+ paste0(variable.name,".LO.SO") ), ordered=T),
+ positive = ifelse(estimate>0,1,0),
+ negative = ifelse(estimate<0,1,0),
+ positive.sign = ifelse(estimate>0 & p.value<0.05,1,0),
+ negative.sign = ifelse(estimate<0 & p.value<0.05,1,0))
+
+
+ ##############################################################################################################################################
+
+
+ ###########
+ # Histogram
+ ###########
+
+ #create summary info
+ VariablesVector = c("estimate","p.value","positive","negative","positive.sign","negative.sign")
+ data1 = Analysis.df.sub2 %>%
+ group_by(term) %>%
+ summarize_at(VariablesVector, mean, na.rm = TRUE)
+
+ #Plot
+ HistoPlot = ggplot(Analysis.df.sub2, aes(x=estimate, fill=term)) +
+ geom_histogram(binwidth=.01, alpha=.7, position="identity") +
+ geom_vline(xintercept=0, colour="black",alpha=.8) +
+ scale_fill_manual(values = c('#3B9AB2','#F21A00'))+
+ #add pre-solstice text
+ geom_text(data = data1[data1$term==paste0(variable.name,".LO.SO"),],
+ mapping = aes(x = -Inf, y = Inf, hjust = -0.1, vjust = 1.5,
+ label = paste(variable.name, " pre:\nMean = ",round(estimate,2), "\n",
+ round(negative*100), "% (", round(negative.sign*100), '%)', sep="")),
+ size=3.5, color='#F21A00')+
+ #add post-solstice text
+ geom_text(data = data1[data1$term==paste0(variable.name,".SO.SE"),],
+ mapping = aes(x = Inf, y = Inf, hjust = 1.1, vjust = 1.5,
+ label = paste(variable.name, " post:\nMean = ",round(estimate,2), "\n",
+ round(positive*100), "% (", round(positive.sign*100), '%)', sep="")),
+ size=3.5, color='#3B9AB2')+
+ xlab("Standardized effect") +
+ ylab("Count (number of pixels)") +
+ coord_cartesian(xlim = c(-.9, .9), ylim = c(12, 270))+
+ plotTheme1
+
+
+ ##############################################################################################################################################
+
+
+ ###################
+ # Latitudinal plots
+ ###################
+
+
+ LatPlot = Analysis.df.sub2 %>%
+ mutate(LatRound = round(Lat)) %>%
+ group_by(term, LatRound) %>%
+ summarise(mean = ci(estimate)[1],
+ lowCI = ci(estimate)[2],
+ highCI = ci(estimate)[3]) %>%
+ ggplot(aes(x = LatRound, y= mean, group=term, color=term, group=term, alpha=term)) +
+ geom_ribbon(aes(ymin=lowCI, ymax=highCI, fill=term), color=NA)+
+ geom_line()+
+ geom_hline(yintercept=0)+
+ scale_color_manual(values = c('#3B9AB2','#F21A00'))+
+ scale_fill_manual(values = c('#3B9AB2','#F21A00'))+
+ scale_alpha_discrete(range = c(0.2, 0.7))+
+ ylab("Standardized effect") +
+ coord_flip(ylim = c(-0.4, 0.4),xlim=c(27,75))+
+ plotTheme1 +
+ theme(axis.text.y = element_blank(),
+ axis.title.y = element_blank())
+
+
+ ##############################################################################################################################################
+
+
+ #########
+ # Mapping
+ #########
+
+ #subset and reshape data
+ Analysis.df.sub3 = ReducedModel.df %>%
+ filter(variable == variable.name,
+ term %in% c(paste0(variable.name,'.SO.SE'),paste0(variable.name,'.LO.SO'))) %>%
+ mutate(estimate = ifelse(estimate>0.5, 0.5, ifelse(estimate < -0.5, -0.5, estimate)) ) %>%
+ dplyr::select(c(Lat, Lon, geometry, variable, term, estimate)) %>%
+ pivot_wider(., names_from = term, values_from = estimate) %>%
+ dplyr::rename('Post' = as.name(paste0(variable.name,'.SO.SE')),
+ 'Pre' = as.name(paste0(variable.name,'.LO.SO')))
+
+ #Get world map
+ mp <- NULL
+ mapWorld <- borders("world", colour="gray40", fill="gray40") # create a layer of borders
+ mp <- ggplot() + mapWorld + plotTheme1
+
+ #Add pre-solstice information
+ MapPre <- mp + geom_tile(data = Analysis.df.sub3,
+ show.legend=T,
+ aes(x = Lon, y = Lat, fill=Pre)) +
+ scale_fill_gradient2(midpoint=0, low='#F21A00', mid="white",
+ high='#3B9AB2', space ="Lab" ) +
+ coord_cartesian(ylim = c(27, 75), xlim = c(-160, 175)) +
+ xlab("") + ylab('Latitude') +
+ theme(legend.position = c(0.08,0.33))
+
+ #Add post-solstice information
+ MapPost <- mp + geom_tile(data = Analysis.df.sub3,
+ show.legend=T,
+ aes(x = Lon, y = Lat, fill=Post)) +
+ scale_fill_gradient2(midpoint=0, low='#F21A00', mid="white",
+ high='#3B9AB2', space ="Lab" ) +
+ coord_cartesian(ylim = c(27, 75), xlim = c(-160, 175)) +
+ xlab("") + ylab('Latitude')
+
+ ##############################################################################################################################################
+
+
+ ################
+ # Solstice plots
+ ################
+
+ #subset the data
+ SolsticeModel.df.sub = SeasonalModel.df %>%
+ filter(variable == variable.name)
+
+ # Plot
+ plotSolstice = ggplot(data = SolsticeModel.df.sub, aes(x = variable.class, y = estimate, fill=variable.class)) +
+ geom_boxplot(outlier.shape = NA, notch=T)+
+ geom_hline(yintercept=0)+
+ xlab("") + ylab("") +
+ coord_cartesian(ylim = c(-.8,.8)) +
+ scale_fill_manual(values = rev(wes_palette(6, name = "Zissou1", type = "continuous")))+
+ scale_x_discrete(labels=c("solstice1" = "May 13\nJun 11", "solstice2" = "May 23\nJun 21",
+ "solstice3" = "Jun 2\nJul 1", "solstice4"="Jun 12\nJul 11",
+ "solstice5"="Jun 22\nJul 21", "solstice6"="Jul 2\nJul 31"))+
+ plotTheme1
+
+ plotSolstice = plotSolstice + annotation_custom(ggplotGrob(PhotoSolstice),
+ xmin = 0.6, xmax = 3.6,
+ ymin = 0.2, ymax = 1.05)
+
+
+ ##############################################################################################################################################
+
+
+ #######################################
+ # Full model plots (Linear model means)
+ #######################################
+
+
+ #All pixels
+ ###########
+
+ plotFull = FullModel.df %>%
+ filter(variable == variable.name) %>%
+ mutate(term = factor(term,
+ levels=c(paste0(variable.name, ".LO.SO"),
+ "Prcp.LO.SO", 'Prcp.SO.SE', "CO2",
+ paste0(variable.name, ".SO.SE")), ordered=T) ) %>%
+ ggplot(aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch=T)+
+ geom_hline(yintercept=0)+
+ xlab("") + ylab("Standardized effect") +
+ coord_cartesian(ylim = c(-.9,.9)) +
+ scale_fill_manual(values = c('#F21A00','grey60','grey35','black','#3B9AB2'))+
+ scale_x_discrete(labels = c(paste0(variable.name, " pre"),
+ 'Prcp pre','Prcp post',
+ expression(CO[2]),
+ paste0(variable.name, " post")))+
+ plotTheme1 +
+ theme(axis.text.x = element_text(angle = 45, hjust=1))
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ #Vegetation-type-specific
+ #########################
+
+ plotFullLC = FullModel.df %>%
+ filter(variable == variable.name) %>%
+ group_by(LC_Type, term) %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN")),
+ term = factor(term,
+ levels=c(paste0(variable.name, ".LO.SO"),
+ "Prcp.LO.SO", 'Prcp.SO.SE', "CO2",
+ paste0(variable.name, ".SO.SE")), ordered=T) ) %>%
+ ggplot(aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch=T)+
+ geom_hline(yintercept=0)+
+ xlab("") + ylab("Standardized effect") +
+ coord_cartesian(ylim = c(-.9,.9)) +
+ scale_fill_manual(values = c('#F21A00','grey60','grey35','black','#3B9AB2'))+
+ scale_x_discrete(labels = c('Out-Sol','Prcp pre','Prcp post',expression(CO[2]),'Sol-Off'))+
+ plotTheme1 +
+ facet_grid(LC_Type~1) +
+ theme(axis.text.x = element_text(angle = 45, hjust=1),
+ strip.text = element_blank())
+
+
+ ##############################################################################################################################################
+
+
+ ###############
+ # Monthly plots
+ ###############
+
+
+ #subset the table
+ #################
+
+ Monthly.df.sub = MonthlyAnalysis.df %>%
+ filter(variable == variable.name)
+
+ df.interp.sub = df.interp %>%
+ filter(variable == variable.name)
+
+ df.AUC.sub = df.AUC %>%
+ filter(variable == variable.name)
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ # Plots
+ #######
+
+ #set x and y ranges
+ if(variable.name %in% c('GPP','LAI','SWrad','GPPstart','LAIstart')){
+ xRange=c(4.1, 8.9) } else {xRange=c(1.3, 8.7) }
+
+ if(variable.name %in% c('LAI')){
+ yRange=c(-0.22,0.22)
+ yRange2=c(-0.25,0.25) } else {
+ yRange=c(-0.2,0.2)
+ yRange2=c(-0.25,0.25)
+ }
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ #All pixels
+ plot.monthly = ggplot() +
+ geom_area(data = df.interp.sub[df.interp.sub$LC_Type=='All',], aes(x = created, y = score, fill=score>0, group=group)) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+ geom_point(data=Monthly.df.sub[Monthly.df.sub$LC_Type=='All',],
+ aes(x=term, y=mean))+
+ geom_errorbar(data=Monthly.df.sub[Monthly.df.sub$LC_Type=='All',],
+ aes(x=term, ymin=lowCI, ymax=hiCI), width=.2,
+ position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ geom_vline(xintercept=6.3, size=2, alpha=0.4)+
+ geom_text(data = df.AUC.sub[df.AUC.sub$LC_Type=='All',], mapping = aes(x = -Inf, y = Inf,
+ hjust = -0.1, vjust = 1.5,
+ label = paste0(percent.neg,'% / ',percent.pos, '%')))+
+ coord_cartesian(xlim=xRange, ylim=yRange) +
+ xlab("")+ylab("")+
+ scale_x_continuous(breaks = seq(1,10,by=1),
+ labels = c('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct'))+
+ plotTheme1
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ #Vegetation-type-specific
+ plot.monthly.LCtype = ggplot() +
+ geom_area(data = df.interp.sub[df.interp.sub$LC_Type!='All',], aes(x = created, y = score, fill=score>0, group=group)) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+ geom_point(data=Monthly.df.sub[Monthly.df.sub$LC_Type!='All',],
+ aes(x=term, y=mean))+
+ geom_errorbar(data=Monthly.df.sub[Monthly.df.sub$LC_Type!='All',],
+ aes(x=term, ymin=lowCI, ymax=hiCI), width=.2,
+ position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ geom_vline(xintercept=6.3, size=2, alpha=0.4)+
+ geom_text(data = df.AUC.sub[df.AUC.sub$LC_Type!='All',],
+ mapping = aes(x = -Inf, y = Inf, hjust = -.1, vjust = 1.5,
+ label = paste0(percent.neg,'% / ',percent.pos, '%')) ) +
+ coord_cartesian(xlim=xRange,ylim=yRange2)+
+ xlab("")+ylab('')+
+ facet_grid(LC_Type~1)+
+ scale_x_continuous(breaks = seq(1,10,by=2),
+ labels = c('Jan','Mar','May','Jul','Sep'))+
+ plotTheme1 +
+ theme(strip.text.x = element_blank())
+
+
+ ##############################################################################################################################################
+
+
+ ###################
+ # Mixed model plots
+ ###################
+
+
+ #Driver plots
+ MixedModel.df.sub = MixedModel.df %>%
+ filter(variable == variable.name)
+
+ coefficients.df.sub = coefficients.df %>%
+ filter(variable == variable.name)
+
+ fitted.df.sub = fitted.df %>%
+ filter(variable == variable.name)
+
+ driver.plot = ggplot() +
+
+ geom_hex(data=fitted.df.sub, aes(y= fitted, x= x), bins=300)+
+
+ scale_fill_gradient2(low="grey95",mid='#E1AF00',"high"='#F21A00', midpoint=45)+
+
+ geom_ribbon(data = MixedModel.df.sub, aes(x = xval, ymin = lower, ymax = upper),
+ alpha = 0.5, fill="black") +
+
+ geom_line(data=MixedModel.df.sub, aes(xval, off), color="black") +
+
+ geom_text(data=coefficients.df.sub, aes(label=paste0(round(Coefficient,2)," days per unit\nR2 = ", round(summary(lm(fitted~x, data=fitted.df.sub))$r.squared,2)),
+ x=Inf, y=Inf, hjust = 1.1, vjust = 1.5))+
+
+ coord_cartesian(ylim = c(250,340), xlim = c(min(fitted.df.sub$x)+max(fitted.df.sub$x)/20,
+ max(fitted.df.sub$x)-max(fitted.df.sub$x)/20))+
+
+ labs(x = variable.name, y = expression(EOS[10]~(DOY)))+
+
+ plotTheme1
+
+
+ # Year plots
+ MixedModel.df.sub = MixedModel.df %>%
+ filter(variable == "Year",
+ class %in% c("Univariate",variable.name)) %>%
+ distinct()
+
+ coefficients.df.sub = coefficients.df %>%
+ filter(variable == "Year",
+ class %in% c("Univariate",variable.name))%>%
+ distinct()
+
+ year.plot = ggplot() +
+ geom_hline(yintercept = 0, linetype="dashed")+
+ geom_ribbon(data = MixedModel.df.sub, aes(x = xval+YearMean, ymin = anomaly.lower, ymax = anomaly.upper, fill=class),
+ alpha = 0.3) +
+ geom_line(data=MixedModel.df.sub, aes(xval+YearMean, anomaly, color=class)) +
+ theme_classic() +
+
+ geom_text(data=coefficients.df.sub[coefficients.df.sub$class==variable.name,],
+ aes(label=paste0("EOS10 ~ Year + ", variable.name, " (", round(Coefficient*10,1)," days per decade)"),
+ x=Inf, y=Inf,hjust = 1.2, vjust = 2),color='#3B9AB2')+
+
+ geom_text(data=coefficients.df.sub[coefficients.df.sub$class=="Univariate",],
+ aes(label=paste0("EOS10 ~ Year (", round(Coefficient*10,1)," days per decade)"),
+ x=Inf, y=-Inf,hjust = 1.2, vjust = -2),color='#F21A00')+
+
+ scale_color_manual(values = c('#3B9AB2','#F21A00'))+
+ scale_fill_manual(values = c('#3B9AB2','#F21A00'))+
+
+ coord_cartesian(ylim = c(-1.5,1.5), xlim=c(2002.5,2017.5))+
+
+ labs(x = "Year", y = expression(EOS[10]~anomaly))+
+ plotTheme1
+
+
+ ##############################################################################################################################################
+
+
+ ##########################
+ # Arrange and safe plots #
+ ##########################
+
+
+ # 1. Map plots
+ ##############
+
+ #define plot layout
+ layout <- "
+AAAAAB
+CCDDEE
+FFGGHH"
+
+ #Merge plots
+ Fig_Plot = MapPre + LatPlot +
+ HistoPlot + driver.plot + year.plot +
+ plotFull + plotSolstice + plot.monthly +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'a') &
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plots as .pdf
+ ggsave(Fig_Plot, file=paste('Map_',variable.name, ".pdf", sep=''),
+ path=output_path,
+ width=14, height=10)
+
+ print(Fig_Plot)
+
+
+ # 2. Vegetation-type-specific plots
+ ###################################
+
+ #define plot layout
+ layout <- "AB"
+
+ #Merge plots
+ Fig_Plot = plotFullLC + plot.monthly.LCtype +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'a') &
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plots as .pdf
+ ggsave(Fig_Plot, file=paste('LCtype_',variable.name, ".pdf", sep=''),
+ path=output_path,
+ width=8, height=10)
+
+ print(Fig_Plot)
+
+
+ ##############################################################################################################################################
+
+ #count
+ print(variable.name)
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## datetime
+Sys.time()
+
+
+## session info
+sessionInfo()
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+```
+
\ No newline at end of file
diff --git a/R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.1_Sample_sizes_VNP.Rmd b/R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.1_Sample_sizes_VNP.Rmd
new file mode 100644
index 0000000..e2a9451
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.1_Sample_sizes_VNP.Rmd
@@ -0,0 +1,131 @@
+---
+title: "Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice"
+subtitle: "Satellite data (VNP): sample size check"
+---
+
+
+
+## 1. Load packages and data
+
+get packages
+```{r}
+require(data.table)
+require(ggplot2)
+require(tidyverse)
+require(raster)
+require(viridis)
+
+
+#plot theme
+plotTheme1 = theme(
+ legend.position = "top",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.grid.major = element_line(colour = "lightgrey"),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+```
+
+
+get data
+```{r}
+## set working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+# paths
+Drivers_path = "Analysis_input/Drivers_final_onset_VNP/Merged_file"
+Land_cover_path = "Analysis_input/Drivers"
+
+## Import data
+Pheno.df <- fread(paste(Drivers_path, "Remote_sensing_drivers_data_onset_VNP.csv", sep="/"))
+
+LandCover.df <- fread(paste(Land_cover_path, "Land_Cover_Type_025.csv", sep="/")) %>%
+ mutate(geometry = gsub("POINT ","", geometry),
+ geometry = gsub("\\(|\\)","", geometry)) %>%
+ separate(geometry, into = c("Lon","Lat"), sep=" ") %>%
+ mutate(Lat = as.numeric(Lat),
+ Lon = as.numeric(Lon))
+```
+
+
+
+
+## 2. Data cleaning
+show code
+```{r}
+Pheno.df = Pheno.df %>%
+ mutate(Year = as.numeric(Year)) %>%
+ group_by(geometry) %>%
+ #delete pixels with fewer than 9 years
+ filter(n() >= 9) %>%
+ ungroup() %>%
+ dplyr::select(-c(V1)) %>%
+ left_join(LandCover.df, by=c("Lat","Lon")) %>%
+ #delete evergreen broadleaf pixels
+ filter(!LC_Type == "EvgB")
+```
+
+
+
+
+## 3. Check sample sizes
+show code
+```{r}
+#total observations
+nrow(Pheno.df)
+
+#how many sites in total?
+length(unique(Pheno.df$geometry))
+
+#time span
+range(Pheno.df$Year)
+hist(Pheno.df$Year, xlab="Year", main="Temporal distribution of data", col='lightblue', breaks=10)
+
+#latitudinal gradient
+range(Pheno.df$Lat)
+hist(Pheno.df$Lat, xlab="Latitude", main="Latitudinal gradient", col='lightblue')
+
+#Land cover types
+Pheno.df.unique = Pheno.df %>% distinct(geometry, .keep_all = T)
+barplot(table(Pheno.df.unique$LC_Type))
+table(Pheno.df.unique$LC_Type)
+
+#leaf-out data
+mean(Pheno.df$Onset_Greenness_Increase)
+sd(Pheno.df$Onset_Greenness_Increase)
+range(Pheno.df$Onset_Greenness_Increase)
+hist(Pheno.df$Onset_Greenness_Increase, xlab="Leaf-out date", main="Leaf-out gradient", col='lightblue')
+
+#leaf-off data
+mean(Pheno.df$Onset_Greenness_Decrease)
+sd(Pheno.df$Onset_Greenness_Decrease)
+quantile(Pheno.df$Onset_Greenness_Decrease, probs=c(0.05, 0.5, 0.95))
+range(Pheno.df$Onset_Greenness_Decrease)
+hist(Pheno.df$Onset_Greenness_Decrease, xlab="Senescence date", main="Senescence gradient", col='lightblue')
+
+#Create summary dataframe by time series
+n.years = Pheno.df %>%
+ group_by(geometry) %>%
+ summarise(count = n())
+mean(n.years$count)
+max(n.years$count)
+min(n.years$count)
+
+#Map the observations
+mp <- NULL
+mapWorld <- borders("world", colour="gray60", fill="gray60") # create a layer of borders
+mp <- ggplot() + mapWorld + plotTheme1
+
+#Now Layer the stations on top
+mp <- mp + geom_tile(data = Pheno.df,
+ aes(x = Lon, y = Lat, fill=LC_Type)) +
+ scale_fill_viridis_d(option = "D") +
+ coord_cartesian(ylim = c(20, 70)) +
+ xlab("") + ylab('')
+mp
+```
+
\ No newline at end of file
diff --git a/R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.2_Add_preseasons_onset_VNP.R b/R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.2_Add_preseasons_onset_VNP.R
new file mode 100644
index 0000000..9a9e2c4
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.2_Add_preseasons_onset_VNP.R
@@ -0,0 +1,417 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Run autumn temperature (preseason) models for the satellite data (EOSstart) ###############################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(data.table)
+require(broom)
+require(gmodels)
+require(patchwork)
+require(MASS)
+
+
+#define plot themes
+plotTheme1 = theme(legend.position = "none",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################################
+## Set directories and get own PEP data ##
+##########################################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+# paths
+Drivers_path = "Analysis_input/Drivers_final_onset_VNP/Merged_file"
+Land_cover_path = "Analysis_input/Drivers"
+output_path = "Analysis_output_startSen_VNP/Preseason_temperatures"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology data
+Pheno.df <- fread(paste(Drivers_path, "Remote_sensing_drivers_data_onset_VNP.csv", sep="/"))%>%
+ dplyr::select(-V1) %>%
+ group_by(geometry) %>%
+ #delete pixels with less than 9 years
+ filter(n() >= 9) %>%
+ ungroup()
+
+#Land cover info
+LandCover.df <- fread(paste(Land_cover_path, "Land_Cover_Type_025.csv", sep="/")) %>%
+ mutate(geometry = gsub("POINT ","", geometry),
+ geometry = gsub("\\(|\\)","", geometry)) %>%
+ separate(geometry, into = c("Lon","Lat"), sep=" ") %>%
+ mutate(Lat = round(as.numeric(Lat),3),
+ Lon = round(as.numeric(Lon),3) )
+
+#Merge tables
+Pheno.df = Pheno.df %>%
+ mutate(Year = as.numeric(Year)) %>%
+ inner_join(LandCover.df, by=c("Lat","Lon")) %>%
+ #delete evergreen broadleaf pixels
+ filter(!LC_Type == "EvgB")
+
+rm(LandCover.df)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+## Get best preseason ##
+########################
+
+
+
+#reshape table to long format
+#############################
+
+preseason.df = Pheno.df %>%
+ #select columns
+ dplyr::select(geometry,Year,LC_Type,Onset_Greenness_Decrease,
+ Tday.PS.10,Tday.PS.20,Tday.PS.30,
+ Tday.PS.40,Tday.PS.50,Tday.PS.60,
+ Tday.PS.70,Tday.PS.80,Tday.PS.90,
+ Tday.PS.100,Tday.PS.110,Tday.PS.120,
+ Tnight.PS.10,Tnight.PS.20,Tnight.PS.30,
+ Tnight.PS.40,Tnight.PS.50,Tnight.PS.60,
+ Tnight.PS.70,Tnight.PS.80,Tnight.PS.90,
+ Tnight.PS.100,Tnight.PS.110,Tnight.PS.120)%>%
+ #long format
+ pivot_longer(.,cols=starts_with(c("Td","Tn")), names_to = "preseason", values_to = "temp") %>%
+ #create preseason length and temperature class columns
+ mutate(preseason_length = readr::parse_number(gsub("[.]", "", preseason)), #keep only numbers in string
+ temp_class = gsub("\\..*","", preseason)) %>%
+ dplyr::select(-preseason)
+
+
+#Run linear models
+##################
+
+resultsLM = preseason.df %>%
+ group_by(geometry, LC_Type, temp_class, preseason_length) %>%
+ do({
+
+ model = lm(scale(Onset_Greenness_Decrease) ~ scale(temp), data=.) # linear model
+ data.frame(tidy(model), glance(model) )}) %>% # model info
+
+ filter(!term %in% c("(Intercept)")) %>%
+ dplyr::select(geometry,LC_Type,temp_class,preseason_length,estimate,r.squared)%>%
+ ungroup()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+############################################
+## Plot preseason-senescence correlations ##
+############################################
+
+
+
+#R2
+###
+
+resultsLM = resultsLM %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN"), ordered=T))
+
+plot.R2 = resultsLM %>%
+
+ ggplot()+
+ aes(x=preseason_length, y=r.squared,
+ colour=temp_class) +
+
+ stat_summary(fun=mean, geom="line", size = .7) +
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.5, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = 1) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+
+ xlab("Preseason length (days)") +
+ ylab("Coefficient of determination (R2)") +
+ coord_cartesian(ylim = c(0.01, 0.25))+
+ facet_wrap(~LC_Type, ncol=1) +
+ plotTheme1 +
+ theme(strip.text.x = element_blank())
+
+
+#Correlation coefficient
+########################
+
+plot.estimate = resultsLM %>%
+
+ ggplot()+
+ aes(x=preseason_length, y=estimate,
+ colour=temp_class) +
+
+ geom_hline(yintercept = 0)+
+ stat_summary(fun = mean, geom="line", size = .7) +
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.5, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = 1) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+
+ xlab("Preseason length (days)") +
+ ylab("Standardized coefficient") +
+ #coord_cartesian(ylim = c(0.01, 0.28))+
+ facet_wrap(~LC_Type, ncol=1) +
+ plotTheme1 +
+ theme(strip.text.x = element_blank())
+
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################################################
+## Plot best preseason length for each temperature ##
+#####################################################
+
+
+
+#keep only models with best predictions
+resultsLM2 = resultsLM %>%
+ group_by(geometry,temp_class) %>%
+ top_n(1, r.squared) %>%
+ ungroup()
+
+#plot
+plot.length = resultsLM2 %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN"), ordered=T)) %>%
+ dplyr::select(LC_Type,temp_class,preseason_length)%>%
+
+ ggplot() + aes(x=temp_class, y=preseason_length) +
+
+ stat_summary(fun = mean,
+ fun.min = function(x) mean(x) - sd(x),
+ fun.max = function(x) mean(x) + sd(x),
+ geom = "pointrange",
+ size=0.5,
+ aes(colour = temp_class)) +
+
+ scale_colour_manual(values = c('#F21A00', '#3B9AB2')) +
+
+ coord_cartesian(ylim = c(5, 120))+
+ xlab("Daily temperature") +
+ ylab("Best preseason length (days)") +
+ facet_wrap(~LC_Type, ncol=1) +
+ plotTheme1+
+ theme(strip.text.x = element_blank(),
+ axis.text.x = element_text(angle = 45, hjust=1))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################################
+#Add best preseason temps to PEP data
+#####################################
+
+
+
+Pheno.df = Pheno.df %>%
+ inner_join(., preseason.df %>%
+ #filter by model data
+ semi_join(resultsLM2, by=c('geometry','temp_class','preseason_length')) %>%
+ dplyr::select(c(geometry,Year,temp_class,temp))%>%
+ pivot_wider(.,names_from = temp_class, values_from = temp),
+ by = c("Year", "geometry"))%>%
+ dplyr::select(-(cols=starts_with(c("Tday.PS","Tnight.PS"))))
+
+#Safe table
+write.csv(Pheno.df, paste(Drivers_path, "Remote_sensing_drivers_data_onset_VNP_preseason.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##################################
+#Run linear ridge regression model
+##################################
+
+
+
+resultsLM3 = Pheno.df %>%
+ group_by(geometry,LC_Type) %>%
+ do({model = lm.ridge(scale(Onset_Greenness_Decrease) ~ scale(Tday)+scale(Tnight), data=.) # linear model
+ data.frame(tidy(model), # coefficient info
+ glance(model))}) %>% # model info
+ ungroup() %>%
+ #rename temperature class
+ mutate(term=dplyr::recode(term, `scale(Tday)`="Tday", `scale(Tnight)`="Tnight"))
+
+#plot preseason-senescence correlations
+plot.ridge = resultsLM3 %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed","DecB","EvgN","DecN"), ordered=T) ) %>%
+
+ ggplot()+
+ aes(x=term, y=estimate,
+ colour=term, fill = term) +
+ scale_colour_manual(values = c('#F21A00','#3B9AB2')) +
+ stat_summary(fun.data = "mean_cl_normal", geom="errorbar", size = 0.9, width=0) +
+ stat_summary(fun.data = "mean_cl_normal", geom="point", size = 1) +
+
+ geom_hline(yintercept = 0)+
+ xlab("Daily temperature") +
+ ylab("Standardized coefficient (ridge regression)") +
+ coord_cartesian(ylim = c(-0.3, 0.3))+
+ facet_wrap(~LC_Type, ncol=1,strip.position = "right") +
+ plotTheme1+
+ theme(axis.text.x = element_text(angle = 45, hjust=1))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################
+# Arrange and safe plots #
+##########################
+
+
+
+#define plot layout
+layout <- "AABBCD"
+
+#Merge plots
+PreseasonPlot = plot.R2 + plot.estimate + plot.length + plot.ridge +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'a')&
+ theme(plot.tag = element_text(face = 'bold'))
+
+#Safe plot
+pdf(paste(output_path,"Preseason_sensitivity_startSen_VNP.pdf",sep="/"), width=8, height=7, useDingbats=FALSE)
+PreseasonPlot
+dev.off()
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+## datetime
+Sys.time()
+#"2023-01-26 08:50:51 CET"
+
+
+## session info
+sessionInfo()
+#R version 4.1.0 (2021-05-18)
+#Platform: x86_64-apple-darwin17.0 (64-bit)
+#Running under: macOS 12.5.1
+
+#Matrix products: default
+#LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+#locale:
+# [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+#attached base packages:
+# [1] parallel stats graphics grDevices utils datasets methods base
+
+#other attached packages:
+# [1] MASS_7.3-54 patchwork_1.1.1 gmodels_2.18.1 broom_0.7.8 viridis_0.6.1
+#[6] viridisLite_0.4.0 rgdal_1.5-27 weathermetrics_1.2.2 lubridate_1.7.10 chillR_0.72.4
+#[11] zoo_1.8-9 pbmcapply_1.5.0 rpmodel_1.2.0 forcats_0.5.1 stringr_1.4.0
+#[16] dplyr_1.0.10 purrr_0.3.4 readr_1.4.0 tidyr_1.2.0 tibble_3.1.8
+#[21] ggplot2_3.3.6 tidyverse_1.3.1 raster_3.5-15 sp_1.4-6 ncdf4_1.19
+#[26] sf_1.0-6 data.table_1.14.0
+
+#loaded via a namespace (and not attached):
+# [1] minqa_1.2.4 colorspace_2.0-3 ellipsis_0.3.2 class_7.3-19 htmlTable_2.2.1
+#[6] base64enc_0.1-3 pls_2.8-0 fs_1.5.2 rstudioapi_0.13 proxy_0.4-26
+#[11] farver_2.1.1 fansi_1.0.3 xml2_1.3.3 codetools_0.2-18 splines_4.1.0
+#[16] R.methodsS3_1.8.1 knitr_1.33 Formula_1.2-4 spam_2.7-0 jsonlite_1.8.0
+#[21] nloptr_2.0.3 cluster_2.1.2 dbplyr_2.1.1 png_0.1-7 R.oo_1.24.0
+#[26] Kendall_2.2 compiler_4.1.0 httr_1.4.2 backports_1.2.1 assertthat_0.2.1
+#[31] Matrix_1.3-3 fastmap_1.1.0 cli_3.3.0 htmltools_0.5.2 tools_4.1.0
+#[36] dotCall64_1.0-1 gtable_0.3.0 glue_1.6.2 maps_3.3.0 Rcpp_1.0.9
+#[41] cellranger_1.1.0 vctrs_0.4.1 gdata_2.18.0 nlme_3.1-152 xfun_0.24
+#[46] lme4_1.1-30 rvest_1.0.2 lifecycle_1.0.1 gtools_3.9.2 XML_3.99-0.8
+#[51] terra_1.5-17 scales_1.2.0 hms_1.1.0 RColorBrewer_1.1-3 fields_12.5
+#[56] yaml_2.2.2 gridExtra_2.3 rpart_4.1-15 latticeExtra_0.6-29 stringi_1.7.6
+#[61] checkmate_2.0.0 e1071_1.7-9 GenSA_1.1.7 boot_1.3-28 rlang_1.0.4
+#[66] pkgconfig_2.0.3 bitops_1.0-7 pracma_2.3.3 evaluate_0.15 lattice_0.20-44
+#[71] labeling_0.4.2 htmlwidgets_1.5.3 tidyselect_1.1.2 remef_1.0.7 plyr_1.8.6
+#[76] magrittr_2.0.3 R6_2.5.1 Hmisc_4.5-0 generics_0.1.3 DBI_1.1.2
+#[81] foreign_0.8-81 pillar_1.8.0 haven_2.4.1 withr_2.5.0 units_0.8-0
+#[86] nnet_7.3-16 survival_3.2-11 RCurl_1.98-1.5 modelr_0.1.8 crayon_1.5.1
+#[91] KernSmooth_2.23-20 utf8_1.2.2 rmarkdown_2.9 jpeg_0.1-8.1 grid_4.1.0
+#[96] readxl_1.3.1 reprex_2.0.0 digest_0.6.29 classInt_0.4-3 R.utils_2.11.0
+#[101] munsell_0.5.0
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.3_Spatial_models_onset_VNP.R b/R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.3_Spatial_models_onset_VNP.R
new file mode 100644
index 0000000..e15b0a2
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.3_Spatial_models_onset_VNP.R
@@ -0,0 +1,593 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Linear models for the satellite data (EOS10) ##############################################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(ggplot2)
+require(data.table)
+require(broom)
+require(sjmisc)
+
+
+
+#define plot themes
+plotTheme1 = theme(legend.position = "right",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+# paths
+Drivers_path = "Analysis_input/Drivers_final_onset_VNP/Merged_file"
+output_path = "Analysis_output_startSen_VNP/Data"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology data frame
+#####################
+
+Pheno.df <- fread(paste(Drivers_path, "Remote_sensing_drivers_data_onset_VNP_preseason.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+## VARIABLE EXPLANATION:
+########################
+
+#General
+########
+
+#geometry...site identifier
+#Year...observation year
+#Lat...site latitude (decimal degrees)
+#Lon...site longitude (decomal degrees)
+#alt...site altitude (m a.s.l.)
+
+#---------------------------------------------------
+
+#Phenology
+##########
+
+#Onset_Greenness_Decrease...senescence date (DOY)
+
+#---------------------------------------------------
+
+#Day-of-year maximum temperature and radiation
+##############################################
+
+#HottestDOY...DOY with maximum annual temperature
+#MaxRadDOY...DOY with maximum irradiance
+
+#---------------------------------------------------
+
+#Seasonal drivers
+#################
+
+#SUMS (flexible start = leaf-out):
+#---------------------------------
+#Apm...Daily net photosynthesis p-model
+#Azani...Daily net photosynthesis Zani model
+#GSI...photoperiod-influenced growing-season index
+#GSIrad...radiation-influenced growing-season index
+#GDDday...daytime degree days
+#GDDnight...nighttime degree days
+#SWrad...Radiation sum
+
+#MEANS (fixed start = March equinox):
+#------------------------------------
+#Tday...mean daytime temperature
+#Tnight...mean nighttime temperature
+#Moist...mean soil moisture (10-40cm)
+#Prcp...precipitation sum
+
+#-----------------
+
+#PERIODS
+
+#seasonal
+#--------
+#LO.SOm30...leaf-out to 30 days before summer solstice
+#LO.SO...leaf-out to summer solstice
+#LO.SOp30...leaf-out to 30 days after solstice
+#LO.SOp60...leaf-out to 60 days after solstice
+#LO.SE...leaf-out to mean senescence
+#SOm30.SE...30 days before solstice to mean senescence
+#SO.SE...solstice to mean senescence
+#SOp30.SE...30 days after solstice to mean senescence
+#SOp60.SE...60 days after solstice to mean senescence
+
+#around summer solstice
+#----------------------
+#solstice1...40 to 10 days before solstice
+#solstice2...30 days before solstice
+#solstice3...20 days before until 10 days after solstice
+#solstice4...10 days before until 20 days after solstice
+#solstice5...30 days after solstice
+#solstice6...10 to 40 days after solstice
+
+#---------------------------------------------------
+
+#Monthly drivers
+################
+
+#Tnight1-12...mean of nighttime temperatures in January (1) to December (12)
+#Tday1-12...mean of daytime temperatures in January (1) to December (12)
+#GDDnight1-12...sum of nighttime degree-days in January (1) to December (12)
+#GDDday1-12...sum of daytime degree-days in January (1) to December (12)
+#SWrad1-12...mean of daily short-wave radiation in January (1) to December (12)
+#Moist1-12...mean of daily soil moisture (10-40cm) in January (1) to December (12)
+#Prcp1-12...sum of daily precipitation in January (1) to December (12)
+#Apm1-12...sum of daily gross photosynthesis in January (1) to December (12)
+#Azani1-12...sum of daily net photosynthesis in January (1) to December (12)
+#GSI...day length-influenced growing-season index
+#GSIrad...radiation-influenced growing-season index
+
+#---------------------------------------------------
+
+#Preseason temperatures
+#######################
+
+#Tday...time series-specific best preseason (R2-based) for daytime temperatures
+#tnight...time series-specific best preseason (R2-based) for nighttime temperatures
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Full models ##
+#################
+
+
+
+#Define variables
+variables = c('GPPstart','Tnight', 'Tday')
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+##############################################################################################################################################
+
+
+#Loop through variables
+#######################
+
+for (i in 1:length(variables)){
+
+ #delete pixels with no photosynthesis before solstice
+ if (variables[i] %in% c('GPPstart'))
+ Pheno.df2 = Pheno.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(paste0(variables[i],".LO.SO"))) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.df
+
+
+ #set equations
+ ##############
+
+ #define variable names
+ covariates = paste0(variables[i], c('.LO.SO','.SO.SE'))
+
+
+ #full models
+ equation.scaled1 = as.formula(paste("scale(Onset_Greenness_Decrease) ~ ", paste0('scale(',covariates[1], ') + scale(', covariates[2], ')',
+ collapse="+"),
+ '+ scale(Prcp.LO.SO) + scale(Prcp.SO.SE) + scale(CO2)', collapse=""))
+
+ equation.scaled2 = as.formula(paste("scale(Onset_Greenness_Decrease) ~ ", paste0('scale(',covariates[1], ') + scale(', covariates[2], ')',
+ collapse="+")))
+
+
+ ##############################################################################################################################################
+
+
+ ##############
+ #linear models
+ ##############
+
+
+ ModelResults.df = Pheno.df2 %>%
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+ do({
+
+ #run model
+ ##########
+
+ model1 = lm(equation.scaled1, data=.)
+ model2 = lm(equation.scaled2, data=.)
+
+ #create combined data frame
+ ###########################
+
+ data.frame(rbind(
+
+ #Equation 1
+ tidy(model1) %>% mutate(equation = 'full model 1'), #add model name
+
+ #Equation 2
+ tidy(model2) %>% mutate(equation = 'full model 2')
+
+ ))
+ }) %>%
+
+ #add variable name and delete "scale()" from term column
+ mutate(variable = variables[i],
+ term = gsub("scale","",term),
+ term = gsub("\\(|\\)","",term) ) %>%
+ #delete intercept
+ filter(!term %in% c("Intercept")) %>%
+ ungroup()
+
+
+ ##############################################################################################################################################
+
+
+ #store data frame in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+FullAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################
+## Monthly correlations ##
+##########################
+
+
+
+#Get sums for January to April photosynthesis parameters
+Pheno.monthly.df = Pheno.df %>%
+ mutate(GPPstart4 = rowSums(dplyr::select(.,c("GPPstart1","GPPstart2","GPPstart3","GPPstart4"))))
+
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+##############################################################################################################################################
+
+
+#Loop through covariate groups
+##############################
+
+
+for (i in 1:length(variables)){
+
+ #delete pixels with no photosynthesis in April
+ ##############################################
+
+ if (variables[i] %in% c("GPPstart"))
+ Pheno.df2 = Pheno.monthly.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(paste0(variables[i],"4"))) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.monthly.df
+
+ #create explanatory variables
+ #############################
+
+ covariates.monthly = paste0(variables[i], c(1:9))
+
+ #---------------------------------------------------------
+
+ #set equations
+ ##############
+
+ if(variables[i] %in% c('GPPstart')) {
+ equation = as.formula(paste("scale(Onset_Greenness_Decrease) ~ ", paste('scale(', covariates.monthly[4:9], ')', collapse="+"),
+ collapse=""))
+ } else {
+ equation = as.formula(paste("scale(Onset_Greenness_Decrease) ~ ", paste('scale(', covariates.monthly[3:9], ')', collapse="+"),
+ collapse=""))
+ }
+
+ #---------------------------------------------------------
+
+ ###############
+ # Linear models
+ ###############
+
+ ModelResults.df = Pheno.df2 %>%
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+ do({
+
+ #run models
+ ###########
+
+ model = lm(equation, data=.)
+
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(tidy(model) %>% mutate(equation = 'monthly') )
+ }) %>%
+
+ ungroup() %>%
+ #delete intercept
+ filter(!term %in% c("(Intercept)")) %>%
+ #add variable name and keep only numbers in month column
+ mutate(variable = variables[i],
+ term = readr::parse_number(term))
+
+
+ #---------------------------------------------------------
+
+ #store dataframe in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+MonthlyAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+######################
+## Seasonal drivers ##
+######################
+
+
+#Covariates
+###########
+
+#Variable length (leaf-out influenced):
+#--------------------------------------
+#Apm...Daily net photosynthesis (p-model)
+#Azani...Daily net photosynthesis (Zani model)
+#GSI...photoperiod-influenced growing-season index
+#GSIrad...radiation-influenced growing-season index
+#GDDday...daytime degree days
+#GDDnight...nighttime degree days
+#SWrad...Radiation sum
+
+#Fixed length:
+#-------------
+#Tday...mean daytime temperature
+#Tnight...mean daytime temperature
+
+
+#-------------------------------------------------------------
+
+
+## Define covariate groups
+seasons = c('LO.SOm30', 'LO.SO', 'LO.SOp30', 'LO.SOp60', 'LO.SE', 'SOm30.SE', 'SO.SE', 'SOp30.SE')
+solstice = c('solstice1', 'solstice2', 'solstice3', 'solstice4', 'solstice5', 'solstice6')
+
+covariates1 = paste(rep(variables, each=length(seasons)), seasons, sep = '.')
+covariates2 = paste(rep(variables, each=length(solstice)), solstice, sep = '.')
+covariates = c(covariates1,covariates2)
+
+#Check if all variables are in dataframe
+table(names(Pheno.df) %in% covariates)[2]/length(covariates)==1
+
+#-------------------------------------------------------------
+
+## Create List object to store results
+DataList = replicate(length(covariates), data.frame())
+names(DataList) = covariates
+i=1
+
+
+##############################################################################################################################################
+
+
+#Loop through covariates
+########################
+
+for (covariate in covariates){
+
+ #get variable name
+ variable = gsub("\\..*","", covariate)
+
+ #delete pixels with no photosynthesis for the respective period
+ if (variable %in% c("GPPstart"))
+ Pheno.df2 = Pheno.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(covariates[i])) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.df
+
+ #---------------------------------------------------------
+
+ #set equations
+ ##############
+
+
+ #univariate scaled
+ equation = as.formula(paste("scale(Onset_Greenness_Decrease) ~ ", paste('scale(', covariate, ')', collapse="+"), collapse=""))
+
+
+ ##############################################################################################################################################
+
+
+ ##################
+ #Run linear models
+ ##################
+
+
+
+ ModelResults.df = Pheno.df2 %>%
+
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+
+ do({
+
+ #run models
+ ###########
+
+ model = lm(equation, data=.)
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(tidy(model) %>%
+ add_column(equation = paste0(ifelse(str_contains(covariate, c("solstice"), logic="or"),"Solstice","Seasonal"),
+ '.scaled') ) %>%
+ filter(term %in% paste0('scale(',covariate,')')) )#delete intercept
+
+ }) %>%
+
+ #add variable name
+ mutate(term = covariate,
+ variable = sub("\\..*", "", covariate))
+
+
+ ##############################################################################################################################################
+
+
+ #store dataframe in variable list
+ DataList[[i]] = ModelResults.df
+
+ print(paste0('..... ',i, ' out of ', length(covariates), ' done'))
+ i=i+1
+}
+
+#bind tables
+SeasonalAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########
+## Safe ##
+##########
+
+
+
+#bind full model, monthly and seasonal analyses
+Analysis.df = rbind(FullAnalysis.df, MonthlyAnalysis.df, SeasonalAnalysis.df)
+
+#Safe tables
+write.csv(Analysis.df, paste(output_path, "Spatial_effect_data_onset_VNP.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## datetime
+Sys.time()
+#"2021-12-05 19:41:36 CET"
+
+
+## session info
+sessionInfo()
+#R version 4.1.0 (2021-05-18)
+#Platform: x86_64-apple-darwin17.0 (64-bit)
+#Running under: macOS Big Sur 11.2.3
+
+#Matrix products: default
+#LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+#locale:
+# [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+#attached base packages:
+# [1] stats graphics grDevices utils datasets methods base
+
+#other attached packages:
+# [1] sjmisc_2.8.7 broom_0.7.8 data.table_1.14.0 forcats_0.5.1 stringr_1.4.0 dplyr_1.0.7
+#[7] purrr_0.3.4 readr_1.4.0 tidyr_1.1.3 tibble_3.1.2 ggplot2_3.3.4 tidyverse_1.3.1
+
+#loaded via a namespace (and not attached):
+# [1] Rcpp_1.0.6 cellranger_1.1.0 pillar_1.6.1 compiler_4.1.0 dbplyr_2.1.1 tools_4.1.0 jsonlite_1.7.2
+#[8] lubridate_1.7.10 lifecycle_1.0.0 gtable_0.3.0 pkgconfig_2.0.3 rlang_0.4.11 reprex_2.0.0 cli_2.5.0
+#[15] rstudioapi_0.13 DBI_1.1.1 haven_2.4.1 xml2_1.3.2 withr_2.4.2 httr_1.4.2 fs_1.5.0
+#[22] generics_0.1.0 vctrs_0.3.8 hms_1.1.0 sjlabelled_1.1.8 grid_4.1.0 tidyselect_1.1.1 glue_1.4.2
+#[29] R6_2.5.0 fansi_0.5.0 readxl_1.3.1 modelr_0.1.8 magrittr_2.0.1 backports_1.2.1 scales_1.1.1
+#[36] ellipsis_0.3.2 insight_0.14.2 rvest_1.0.0 assertthat_0.2.1 colorspace_2.0-1 utf8_1.2.1 stringi_1.6.2
+#[43] munsell_0.5.0 crayon_1.4.1
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.3_Spatial_models_onset_VNP_no_scaling.R b/R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.3_Spatial_models_onset_VNP_no_scaling.R
new file mode 100644
index 0000000..b101fbe
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.3_Spatial_models_onset_VNP_no_scaling.R
@@ -0,0 +1,476 @@
+
+
+
+#############################################################################################################
+############################################## R script for: ################################################
+#############################################################################################################
+##### Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice ##
+#############################################################################################################
+
+
+#############################################################################################################
+# Linear models for the satellite data (EOSstart) ###########################################################
+#############################################################################################################
+
+
+
+#required packages
+require(tidyverse)
+require(ggplot2)
+require(data.table)
+require(broom)
+require(sjmisc)
+
+
+
+#define plot themes
+plotTheme1 = theme(legend.position = "right",
+ legend.background = element_rect(fill=NA, size=0.5, linetype="solid"),
+ legend.text = element_text(color="black"),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(face="bold"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+# paths
+Drivers_path = "Analysis_input/Drivers_final_onset_VNP/Merged_file"
+output_path = "Analysis_output_startSen_VNP/Data"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Phenology data frame
+#####################
+
+Pheno.df <- fread(paste(Drivers_path, "Remote_sensing_drivers_data_onset_VNP_preseason.csv", sep="/")) %>%
+ #transform GPP to gCm-2
+ mutate_at(c("GPPstart.LO.SO",
+ "GPPstart.SO.SE",
+ "GPPstart1",
+ "GPPstart2",
+ "GPPstart3",
+ "GPPstart4",
+ "GPPstart5",
+ "GPPstart6",
+ "GPPstart7",
+ "GPPstart8",
+ "GPPstart9",
+ "GPPstart10"),
+ function(x)(x*0.1))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+## VARIABLE EXPLANATION:
+########################
+
+#General
+########
+
+#geometry...site identifier
+#Year...observation year
+#Lat...site latitude (decimal degrees)
+#Lon...site longitude (decomal degrees)
+#alt...site altitude (m a.s.l.)
+
+#---------------------------------------------------
+
+#Phenology
+##########
+
+#Onset_Greenness_Decrease...senescence date (DOY)
+
+#---------------------------------------------------
+
+#Day-of-year maximum temperature and radiation
+##############################################
+
+#HottestDOY...DOY with maximum annual temperature
+#MaxRadDOY...DOY with maximum irradiance
+
+#---------------------------------------------------
+
+#Seasonal drivers
+#################
+
+#SUMS (flexible start = leaf-out):
+#---------------------------------
+#Apm...Daily net photosynthesis p-model
+#Azani...Daily net photosynthesis Zani model
+#GSI...photoperiod-influenced growing-season index
+#GSIrad...radiation-influenced growing-season index
+#GDDday...daytime degree days
+#GDDnight...nighttime degree days
+#SWrad...Radiation sum
+
+#MEANS (fixed start = March equinox):
+#------------------------------------
+#Tday...mean daytime temperature
+#Tnight...mean nighttime temperature
+#Moist...mean soil moisture (10-40cm)
+#Prcp...precipitation sum
+
+#-----------------
+
+#PERIODS
+
+#seasonal
+#--------
+#LO.SOm30...leaf-out to 30 days before summer solstice
+#LO.SO...leaf-out to summer solstice
+#LO.SOp30...leaf-out to 30 days after solstice
+#LO.SOp60...leaf-out to 60 days after solstice
+#LO.SE...leaf-out to mean senescence
+#SOm30.SE...30 days before solstice to mean senescence
+#SO.SE...solstice to mean senescence
+#SOp30.SE...30 days after solstice to mean senescence
+#SOp60.SE...60 days after solstice to mean senescence
+
+#around summer solstice
+#----------------------
+#solstice1...40 to 10 days before solstice
+#solstice2...30 days before solstice
+#solstice3...20 days before until 10 days after solstice
+#solstice4...10 days before until 20 days after solstice
+#solstice5...30 days after solstice
+#solstice6...10 to 40 days after solstice
+
+#---------------------------------------------------
+
+#Monthly drivers
+################
+
+#Tnight1-12...mean of nighttime temperatures in January (1) to December (12)
+#Tday1-12...mean of daytime temperatures in January (1) to December (12)
+#GDDnight1-12...sum of nighttime degree-days in January (1) to December (12)
+#GDDday1-12...sum of daytime degree-days in January (1) to December (12)
+#SWrad1-12...mean of daily short-wave radiation in January (1) to December (12)
+#Moist1-12...mean of daily soil moisture (10-40cm) in January (1) to December (12)
+#Prcp1-12...sum of daily precipitation in January (1) to December (12)
+#Apm1-12...sum of daily gross photosynthesis in January (1) to December (12)
+#Azani1-12...sum of daily net photosynthesis in January (1) to December (12)
+#GSI...day length-influenced growing-season index
+#GSIrad...radiation-influenced growing-season index
+
+#---------------------------------------------------
+
+#Preseason temperatures
+#######################
+
+#Tday...time series-specific best preseason (R2-based) for daytime temperatures
+#tnight...time series-specific best preseason (R2-based) for nighttime temperatures
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Full models ##
+#################
+
+
+
+#Define variables
+variables = c('GPPstart','Tday')
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+##############################################################################################################################################
+
+
+#Loop through variables
+#######################
+
+for (i in 1:length(variables)){
+
+ #delete pixels with no photosynthesis before solstice
+ if (variables[i] %in% c('GPPstart'))
+ Pheno.df2 = Pheno.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(paste0(variables[i],".LO.SO"))) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.df
+
+
+ #set equations
+ ##############
+
+ #define variable names
+ covariates = paste0(variables[i], c('.LO.SO','.SO.SE'))
+
+
+ #full models
+ equation.scaled1 = as.formula(paste("Onset_Greenness_Decrease ~ ", paste0(covariates[1], '+', covariates[2],
+ collapse="+"),
+ '+ Prcp.LO.SO + Prcp.SO.SE + CO2', collapse=""))
+
+ equation.scaled2 = as.formula(paste("Onset_Greenness_Decrease ~ ", paste0(covariates[1], '+', covariates[2],
+ collapse="+")))
+
+
+ ##############################################################################################################################################
+
+
+ ##############
+ #linear models
+ ##############
+
+
+ ModelResults.df = Pheno.df2 %>%
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+ do({
+
+ #run model
+ ##########
+
+ model1 = lm(equation.scaled1, data=.)
+ model2 = lm(equation.scaled2, data=.)
+
+ #create combined data frame
+ ###########################
+
+ data.frame(rbind(
+
+ #Equation 1
+ tidy(model1) %>% mutate(equation = 'full model 1'), #add model name
+
+ #Equation 2
+ tidy(model2) %>% mutate(equation = 'full model 2')
+
+ ))
+ }) %>%
+
+ #add variable name and delete "scale()" from term column
+ mutate(variable = variables[i]) %>%
+ #delete intercept
+ filter(!term %in% c("(Intercept)")) %>%
+ ungroup()
+
+
+ ##############################################################################################################################################
+
+
+ #store data frame in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+FullAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########################
+## Monthly correlations ##
+##########################
+
+
+
+#Get sums for January to April photosynthesis parameters
+Pheno.monthly.df = Pheno.df %>%
+ mutate(GPPstart4 = rowSums(dplyr::select(.,c("GPPstart1","GPPstart2","GPPstart3","GPPstart4"))))
+
+
+#create List object to store results
+DataList = replicate(length(variables), data.frame())
+names(DataList) = variables
+
+
+##############################################################################################################################################
+
+
+#Loop through covariate groups
+##############################
+
+
+for (i in 1:length(variables)){
+
+ #delete pixels with no photosynthesis in April
+ ##############################################
+
+ if (variables[i] %in% c("GPPstart"))
+ Pheno.df2 = Pheno.monthly.df %>%
+ group_by(geometry) %>%
+ filter(!mean(!!as.name(paste0(variables[i],"4"))) < .1) %>%
+ ungroup() else Pheno.df2 = Pheno.monthly.df
+
+ #create explanatory variables
+ #############################
+
+ covariates.monthly = paste0(variables[i], c(1:9))
+
+ #---------------------------------------------------------
+
+ #set equations
+ ##############
+
+ if(variables[i] %in% c('GPPstart')) {
+ equation = as.formula(paste("Onset_Greenness_Decrease ~ ", paste(covariates.monthly[4:9], collapse="+"),
+ collapse=""))
+ } else {
+ equation = as.formula(paste("Onset_Greenness_Decrease ~ ", paste(covariates.monthly[3:9], collapse="+"),
+ collapse=""))
+ }
+
+ #---------------------------------------------------------
+
+ ###############
+ # Linear models
+ ###############
+
+ ModelResults.df = Pheno.df2 %>%
+ group_by(geometry, Lat, Lon, LC_Type) %>%
+ do({
+
+ #run models
+ ###########
+
+ model = lm(equation, data=.)
+
+
+ #create combined dataframe
+ ##########################
+
+ data.frame(tidy(model) %>% mutate(equation = 'monthly') )
+ }) %>%
+
+ ungroup() %>%
+ #delete intercept
+ filter(!term %in% c("(Intercept)")) %>%
+ #add variable name and keep only numbers in month column
+ mutate(variable = variables[i],
+ term = readr::parse_number(term))
+
+
+ #---------------------------------------------------------
+
+ #store dataframe in variable list
+ DataList[[i]] = ModelResults.df
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+MonthlyAnalysis.df = bind_rows(DataList)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##########
+## Safe ##
+##########
+
+
+
+#bind full model, monthly and seasonal analyses
+Analysis.df = rbind(FullAnalysis.df, MonthlyAnalysis.df)
+
+#Safe tables
+write.csv(Analysis.df, paste(output_path, "Spatial_effect_data_onset_VNP_no_scaling.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## datetime
+Sys.time()
+#"2021-12-05 19:41:36 CET"
+
+
+## session info
+sessionInfo()
+#R version 4.1.0 (2021-05-18)
+#Platform: x86_64-apple-darwin17.0 (64-bit)
+#Running under: macOS Big Sur 11.2.3
+
+#Matrix products: default
+#LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+#locale:
+# [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+#attached base packages:
+# [1] stats graphics grDevices utils datasets methods base
+
+#other attached packages:
+# [1] sjmisc_2.8.7 broom_0.7.8 data.table_1.14.0 forcats_0.5.1 stringr_1.4.0 dplyr_1.0.7
+#[7] purrr_0.3.4 readr_1.4.0 tidyr_1.1.3 tibble_3.1.2 ggplot2_3.3.4 tidyverse_1.3.1
+
+#loaded via a namespace (and not attached):
+# [1] Rcpp_1.0.6 cellranger_1.1.0 pillar_1.6.1 compiler_4.1.0 dbplyr_2.1.1 tools_4.1.0 jsonlite_1.7.2
+#[8] lubridate_1.7.10 lifecycle_1.0.0 gtable_0.3.0 pkgconfig_2.0.3 rlang_0.4.11 reprex_2.0.0 cli_2.5.0
+#[15] rstudioapi_0.13 DBI_1.1.1 haven_2.4.1 xml2_1.3.2 withr_2.4.2 httr_1.4.2 fs_1.5.0
+#[22] generics_0.1.0 vctrs_0.3.8 hms_1.1.0 sjlabelled_1.1.8 grid_4.1.0 tidyselect_1.1.1 glue_1.4.2
+#[29] R6_2.5.0 fansi_0.5.0 readxl_1.3.1 modelr_0.1.8 magrittr_2.0.1 backports_1.2.1 scales_1.1.1
+#[36] ellipsis_0.3.2 insight_0.14.2 rvest_1.0.0 assertthat_0.2.1 colorspace_2.0-1 utf8_1.2.1 stringi_1.6.2
+#[43] munsell_0.5.0 crayon_1.4.1
+
+
+
+##############################################################################################################################################
+#############################################################THE END##########################################################################
+##############################################################################################################################################
+
+
diff --git a/R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.4_Mapping_onset_VNP.Rmd b/R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.4_Mapping_onset_VNP.Rmd
new file mode 100644
index 0000000..83109a2
--- /dev/null
+++ b/R code/Remote_sensing/3_Analysis/EOSstart_VNP/3.4_Mapping_onset_VNP.Rmd
@@ -0,0 +1,965 @@
+---
+title: Effect of climate warming on the timing of autumn leaf senescence reverses after the summer solstice
+author: Constantin Zohner
+date: "last updated March 30, 2023"
+
+subtitle: Satellite-derived EOSstart data (Figure S8)
+output:
+ html_document:
+ highlight: haddock
+ toc: false
+ use_bookdown: true
+ df_print: paged
+---
+
+
+
+
+
+### Figure descriptions
+- Fig. S8: Effect of temperature on the timing of senescence onset in northern forests reverses after the summer solstice (same as Fig. 2A but using EOSstart instead of EOS10 as phenological metric)
+
+```{r setup, include=FALSE}
+knitr::opts_chunk$set(
+ class.source = "numberLines lineAnchors"
+ )
+```
+
+
+
+```{r, message=FALSE, warning=FALSE, attr.source='.numberLines'}
+###################
+# Required packages
+###################
+
+
+
+require(tidyverse)
+require(data.table)
+require(ggplot2)
+require(patchwork)
+require(gmodels)
+require(wesanderson)
+require(pracma)
+require(lme4)
+require(effects) #plot effects
+require(remef)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Set directories ##
+#####################
+
+
+
+# set the working directory
+setwd("/Users/consti/Desktop/PhD/Publication_material/17_Autumn_phenology_tier2/Remote_sensing/Analysis")
+
+
+# Paths
+
+#input
+Drivers_path = "Analysis_input/Drivers_final_onset_VNP/Merged_file"
+Analysis_path = "Analysis_output_startSen_VNP/Data"
+photo_path = "Analysis_input/Drivers" #Photoperiod file
+
+#output
+output_path = "Analysis_output_startSen_VNP/Maps"
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#################
+## Import data ##
+#################
+
+
+
+#Spatial (pixel-level) models
+#############################
+
+#scaled
+Analysis.df = fread(paste(Analysis_path, "Spatial_effect_data_onset_VNP.csv", sep="/")) %>%
+ mutate(continent = ifelse(Lon < -30, "North America", "Eurasia"),
+ LC_Type = paste(LC_Type, continent, sep="_"))
+
+#unscaled
+AnalysisNoScaling.df = fread(paste(Analysis_path, "Spatial_effect_data_onset_VNP_no_scaling.csv", sep="/")) %>%
+ mutate(continent = ifelse(Lon < -30, "North America", "Eurasia"),
+ LC_Type = paste(LC_Type, continent, sep="_"))
+#geometry: unique pixel identifier
+#Lat: Latitude
+#Lon: Longitude
+#LC_type: All, DecB, DecN, EvgN, Mixed (Landcover type)
+#term: monthly coefficients (1-10) and seasonal coefficients
+#estimate: slopes or standardized coefficients of mixed effects models
+#std.error: std.error of coefficients
+#statistic:
+#equation: full model 1/2, monthly/seasonal/solstice, scaled/unscaled, tempCon (Tday controlled)
+#variable: climate variable (LAI, GPP, Apm, Azani, Tday, Tnight, SWrad)
+
+
+# get full model correlations
+#############################
+
+FullModel.df = Analysis.df %>%
+ filter(equation == "full model 1")
+
+ReducedModel.df = AnalysisNoScaling.df %>%
+ filter(equation == "full model 2")
+
+
+#-------------------------------------------------------------------------------------------------------
+
+
+# get monthly correlations
+##########################
+
+#Summarize all pixels
+MonthlyAnalysisAll.df = Analysis.df %>%
+ filter(equation == "monthly") %>%
+ group_by(term, variable) %>%
+ summarise(mean = gmodels::ci(estimate)[1],
+ lowCI = gmodels::ci(estimate)[2],
+ hiCI = gmodels::ci(estimate)[3],
+ lowSD = mean-sd(estimate),
+ hiSD = mean+sd(estimate)) %>%
+ mutate(LC_Type = "All") %>%
+ ungroup()
+
+#Summarize by vegetation type
+MonthlyAnalysisLCtype.df = Analysis.df %>%
+ filter(equation == "monthly") %>%
+ group_by(term, variable, LC_Type) %>%
+ summarise(mean = gmodels::ci(estimate)[1],
+ lowCI = gmodels::ci(estimate)[2],
+ hiCI = gmodels::ci(estimate)[3],
+ lowSD = mean-sd(estimate),
+ hiSD = mean+sd(estimate)) %>%
+ ungroup()
+
+#Rbind
+MonthlyAnalysis.df = rbind(MonthlyAnalysisAll.df, MonthlyAnalysisLCtype.df) %>%
+ #Add variable x equation identifier
+ mutate(variable.type = paste(variable, LC_Type, sep='.'),
+ term = as.numeric(term),
+ LC_Type = factor(LC_Type, levels = c("All",
+ "Mixed_North America", "Mixed_Eurasia",
+ "DecB_North America", "DecB_Eurasia",
+ "EvgN_North America", "EvgN_Eurasia",
+ "DecN_Eurasia"))
+ )
+
+
+#-------------------------------------------------------------------------------------------------------
+
+
+# get seasonal correlations
+###########################
+
+SeasonalModel.df = Analysis.df %>%
+ filter(equation == "Solstice.scaled") %>%
+ #Add variable class identifier
+ mutate(variable.class = gsub("^.*?\\.","", term) )
+
+
+##############################################################################################################################################
+
+
+#Phenology data
+###############
+
+Pheno.df = fread(paste(Drivers_path, "Remote_sensing_drivers_data_onset_VNP_preseason.csv", sep="/"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+################
+## Plot theme ##
+################
+
+
+#Color.palette: col=c('#F21A00','#E1AF00','#EBCC2A','#78B7C5','#3B9AB2')
+
+plotTheme1 = theme(
+ legend.position = "none",
+ legend.background = element_blank(),
+ legend.text = element_text(color="black"),
+ legend.title = element_blank(),
+ legend.key = element_blank(),
+ panel.grid.major = element_blank(),
+ panel.grid.minor = element_blank(),
+ panel.background = element_blank(),
+ panel.border = element_rect(colour = "black", fill=NA),
+ axis.line = element_line(color = "black"),
+ axis.text = element_text(colour = "black"),
+ strip.background = element_rect(fill=NA),
+ strip.text = element_text(colour = 'black'),
+ plot.title = element_text(hjust = 0.5))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+######################
+# Photoperiod figure #
+######################
+
+
+#get mean leaf-out and senescence dates
+leaf_out = as.Date(mean(Pheno.df$Onset_Greenness_Decrease), origin = "2016-12-31")
+leaf_off = as.Date(mean(Pheno.df$Onset_Greenness_Decrease), origin = "2016-12-31")
+
+# dataframe of photoperiods
+photo.df = fread(paste(photo_path, "Photoperiod.csv", sep="/"))
+phot.sub = photo.df[475,3:367]
+phot.sub = rbind(as.data.frame(t(phot.sub)), as.data.frame(t(phot.sub)))
+phot.sub$X = as.Date(1:nrow(phot.sub), origin = "2016-12-31")
+
+
+# Plot of periods around solstice
+#################################
+
+#dataframe of periods
+solstice.data = rbind(
+ data.frame(X=as.Date(c("2017-05-14","2017-06-12")), Y=10, season = "A"),
+ data.frame(X=as.Date(c("2017-05-24","2017-06-22")), Y=11, season = "B"),
+ data.frame(X=as.Date(c("2017-06-02","2017-07-01")), Y=12, season = "C"),
+ data.frame(X=as.Date(c("2017-06-12","2017-07-11")), Y=13, season = "D"),
+ data.frame(X=as.Date(c("2017-06-22","2017-07-21")), Y=14, season = "E"),
+ data.frame(X=as.Date(c("2017-07-03","2017-08-01")), Y=15, season = "F") )
+
+#Plot
+PhotoSolstice = ggplot() +
+ #day length line
+ geom_line(data=phot.sub, aes(x=X, y=V1, group=1),col="black") +
+ #solstice
+ geom_vline(xintercept = as.Date("2017-06-22"), size=1, alpha=0.4)+
+ #periods
+ geom_line(data=solstice.data, aes(x=X, y=Y, color=season), size=2.75)+
+ scale_color_manual(values = rev(wes_palette(6, name = "Zissou1", type = "continuous")))+
+ #plot settings
+ coord_cartesian(xlim=c(as.Date(c('2017-03-01','2017-10-31'))), ylim=c(10,16))+
+ ylab("Day length")+xlab("")+
+ scale_x_date(position = "top") +
+ plotTheme1+
+ theme(plot.background = element_rect(fill = "transparent", color = NA),
+ panel.background = element_rect(fill = "white"))
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################################
+## Interpolation of monthly estimates ##
+########################################
+
+
+
+#Interpolation function
+lin_interp = function(x, y, length.out=100) {
+ approx(x, y, xout=seq(min(x), max(x), length.out=length.out))$y
+}
+
+#create identifier
+variable.type = unique(MonthlyAnalysis.df$variable.type)
+
+#create interpolation dataframe
+df.interp = data.frame()
+df.AUC = data.frame()
+
+#loop over variable x equation x vegetation type vector
+for (variable.name in variable.type){
+
+ #subset table
+ df.sub = MonthlyAnalysis.df %>%
+ filter(variable.type == variable.name)
+
+ # Interpolate data
+ created.interp = lin_interp(df.sub$term, df.sub$term)
+ score.interp = lin_interp(df.sub$term, df.sub$mean)
+ df.interp.sub = data.frame(created=created.interp, score=score.interp)
+ # Make a grouping variable for each pos/neg segment
+ cat.rle = rle(df.interp.sub$score < 0)
+ df.interp.sub = df.interp.sub %>%
+ mutate(group = rep.int(1:length(cat.rle$lengths), times=cat.rle$lengths),
+ LC_Type = unique(df.sub$LC_Type),
+ variable = unique(df.sub$variable) )
+ #rbind sub dataframes
+ df.interp = rbind(df.interp, df.interp.sub)
+
+ #get Area under curve (%)
+ df.AUC.sub = df.interp.sub %>%
+ mutate(positive = ifelse(score<0, 0, score),
+ negative = ifelse(score>0, 0, score))%>%
+ summarise(sum.pos = trapz(created, positive),
+ sum.neg = abs(trapz(created, negative)))%>%
+ mutate(percent.neg = round(sum.neg/(sum.pos+sum.neg)*100),
+ percent.pos = round(sum.pos/(sum.pos+sum.neg)*100),
+ LC_Type = unique(df.sub$LC_Type),
+ variable = unique(df.sub$variable) )
+ #rbind sub dataframes
+ df.AUC = rbind(df.AUC, df.AUC.sub)
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+########################
+# Mixed effects models #
+########################
+
+
+
+#Prepare data
+#############
+
+#delete outlier values
+PhenoMixed.df <- Pheno.df %>%
+ filter(GPPstart.LO.SO < quantile(.$GPPstart.LO.SO, 0.999),
+ GPPstart.LO.SO > quantile(.$GPPstart.LO.SO, 0.01))
+
+#get year mean
+YearMean = mean(PhenoMixed.df$Year)
+
+#transform units and center year variable
+PhenoMixed.df <- PhenoMixed.df %>%
+ mutate(GPPstart.LO.SO = GPPstart.LO.SO*0.1,
+ Year = Year - mean(Year)) %>%
+ #delete pixels with less than 15 years
+ group_by(geometry) %>%
+ filter(n() >= 9) %>%
+ ungroup()
+
+
+##################################################################
+#get advance in EOSonset per each 10% increase in pre-solstice GPP
+##################################################################
+
+coefficients = coef(summary(lmer(Onset_Greenness_Decrease ~ GPPstart.LO.SO + (1 | geometry), data=PhenoMixed.df,
+ na.action = "na.exclude", control = lmerControl(optimizer ="Nelder_Mead"))))[2,1:2]
+
+#relative to overall variation
+coefficients * (max(PhenoMixed.df$GPPstart.LO.SO)-min(PhenoMixed.df$GPPstart.LO.SO))/10
+#Estimate Std. Error
+#-2.14698871 0.01622658
+
+
+##############################################################################################################################################
+
+
+# Models
+########
+
+#list variables to loop through
+#variables = unique(Analysis.df$variable)
+variables = c("Tday","GPPstart")
+
+#create List object to store results
+DataList1 = replicate(length(variables), data.frame())
+DataList2 = replicate(length(variables), data.frame())
+DataList3 = replicate(length(variables), data.frame())
+names(DataList1) = variables
+names(DataList2) = variables
+names(DataList3) = variables
+
+##############################################################################################################################################
+
+
+#Loop through variables
+#######################
+
+for (i in 1:length(variables)){
+
+ #extract variables
+ Year = as.numeric(PhenoMixed.df$Year)
+ Pre.solstice = as.numeric(PhenoMixed.df %>% pull(paste0(variables[i],".LO.SO")))
+ Senesc_DOY = as.numeric(PhenoMixed.df$Onset_Greenness_Decrease)
+ geometry = PhenoMixed.df$geometry
+
+
+ #Multivariate
+ fit_multi = lmer(Senesc_DOY ~ Pre.solstice + Year + (1 | geometry),
+ na.action = "na.exclude", control = lmerControl(optimizer ="Nelder_Mead"))
+
+ #year-only
+ fit_year = lmer(Senesc_DOY ~ Year + (1 | geometry),
+ na.action = "na.exclude", control = lmerControl(optimizer ="Nelder_Mead"))
+
+ # Extract information for plotting
+ plotMulti = allEffects(fit_multi)
+ plotYear = allEffects(fit_year)
+
+ # Extract coefficients
+ df.coefficients = tibble(Coefficient = coef(summary(fit_multi))[ , "Estimate"][2:3],
+ variable = c(paste0(variables[i]),"Year"),
+ class = paste0(variables[i])) %>%
+ bind_rows(tibble(Coefficient = coef(summary(fit_year))[ , "Estimate"][2],
+ variable = c("Year"),
+ class = "Univariate"))
+
+ # Final table
+ df <- tibble(upper = plotYear$Year$upper[,1],
+ lower = plotYear$Year$lower[,1],
+ off = plotYear$Year$fit[,1],
+ xval = plotYear$Year$x[,1],
+ class = "Univariate",
+ variable = "Year") %>%
+ #Multi
+ bind_rows(
+ tibble(upper = plotMulti$Year$upper[,1],
+ lower = plotMulti$Year$lower[,1],
+ off = plotMulti$Year$fit[,1],
+ xval = plotMulti$Year$x[,1],
+ class = paste0(variables[i]),
+ variable = "Year")
+ )%>%
+ bind_rows(
+ tibble(upper = plotMulti$Pre.solstice$upper[,1],
+ lower = plotMulti$Pre.solstice$lower[,1],
+ off = plotMulti$Pre.solstice$fit[,1],
+ xval = plotMulti$Pre.solstice$x[,1],
+ class = paste0(variables[i]),
+ variable = paste0(variables[i]))
+ )
+
+
+ # get phenology anomalies
+ df = df %>%
+ group_by(class, variable) %>%
+ mutate(anomaly = off - mean(off),
+ anomaly.upper = upper - mean(off),
+ anomaly.lower = lower - mean(off)) %>%
+ ungroup()
+
+ ##############################################################################################################################################
+
+ # get partial Senescence dates, removing effect of year (fixed) and site (random)
+ y_partial = remef(fit_multi, fix="Year", ran="all", keep.intercept = T)
+
+ # Create table
+ df.fitted = tibble(fitted = y_partial,
+ x = Pre.solstice,
+ variable = variables[i])
+
+ ##############################################################################################################################################
+
+ #store data frame in variable list
+ DataList1[[i]] = df
+ DataList2[[i]] = df.coefficients
+ DataList3[[i]] = df.fitted
+
+ #count
+ print(paste0('...',i,' out of ',length(variables), ' (',variables[i],') done'))
+}
+
+#bind rows
+MixedModel.df = bind_rows(DataList1)
+coefficients.df = bind_rows(DataList2)
+fitted.df = bind_rows(DataList3)
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+##############
+# Map figure #
+##############
+
+
+
+#start loop
+for(variable.name in variables) {
+
+ #subset and reshape data
+ Analysis.df.sub2 = ReducedModel.df %>%
+ filter(variable == variable.name,
+ term %in% c(paste0(variable.name,'.SO.SE'),paste0(variable.name,'.LO.SO'))) %>%
+ mutate(term = factor(term, levels=c(paste0(variable.name,".SO.SE"),
+ paste0(variable.name,".LO.SO") ), ordered=T),
+ positive = ifelse(estimate>0,1,0),
+ negative = ifelse(estimate<0,1,0),
+ positive.sign = ifelse(estimate>0 & p.value<0.05,1,0),
+ negative.sign = ifelse(estimate<0 & p.value<0.05,1,0))
+
+
+ ##############################################################################################################################################
+
+
+ ###########
+ # Histogram
+ ###########
+
+ #create summary info
+ VariablesVector = c("estimate","p.value","positive","negative","positive.sign","negative.sign")
+ data1 = Analysis.df.sub2 %>%
+ group_by(term) %>%
+ summarize_at(VariablesVector, mean, na.rm = TRUE)
+
+ if(variable.name %in% c('GPPstart')){
+ xRange=c(-0.15,0.15)
+ yRange=c(-.08,.08)
+ binw = 0.0018} else {
+ xRange=c(-6,6)
+ yRange=c(-3.5,3.5)
+ binw = .035}
+
+ #Plot
+ HistoPlot = ggplot(Analysis.df.sub2, aes(x=estimate, fill=term, alpha=term)) +
+ geom_histogram(binwidth=binw, position="identity") +
+ geom_vline(xintercept=0, colour="black") +
+ scale_fill_manual(values = c('black','#F21A00'))+
+ scale_alpha_discrete(range = c(0.5, 0.8))+
+ #add pre-solstice text
+ geom_text(data = data1[data1$term==paste0(variable.name,".LO.SO"),],
+ mapping = aes(x = -Inf, y = Inf, hjust = -0.1, vjust = 1.5,
+ label = paste(variable.name, " pre:\nMean = ",round(estimate,2), "\n",
+ round(negative*100), "% (", round(negative.sign*100), '%)', sep="")),
+ size=3.5, color='#F21A00')+
+ #add post-solstice text
+ geom_text(data = data1[data1$term==paste0(variable.name,".SO.SE"),],
+ mapping = aes(x = Inf, y = Inf, hjust = 1.1, vjust = 1.5,
+ label = paste(variable.name, " post:\nMean = ",round(estimate,2), "\n",
+ round(positive*100), "% (", round(positive.sign*100), '%)', sep="")),
+ size=3.5, color='black')+
+ xlab("days per unit") +
+ ylab("Count (number of pixels)") +
+ coord_cartesian(xlim = xRange, ylim = c(12, 270))+
+ plotTheme1
+
+
+ ##############################################################################################################################################
+
+
+ ###################
+ # Latitudinal plots
+ ###################
+
+
+ LatPlot = Analysis.df.sub2 %>%
+ mutate(LatRound = round(Lat)) %>%
+ group_by(term, LatRound) %>%
+ summarise(mean = ci(estimate)[1],
+ lowCI = ci(estimate)[2],
+ highCI = ci(estimate)[3]) %>%
+ ggplot(aes(x = LatRound, y= mean, group=term, color=term, group=term, alpha=term)) +
+ geom_ribbon(aes(ymin=lowCI, ymax=highCI, fill=term), color=NA)+
+ geom_line()+
+ geom_hline(yintercept=0)+
+ scale_color_manual(values = c('black','#F21A00'))+
+ scale_fill_manual(values = c('black','#F21A00'))+
+ scale_alpha_discrete(range = c(0.3, 0.8))+
+ ylab("days per unit") +
+ coord_flip(ylim = yRange, xlim=c(27,75))+
+ plotTheme1 +
+ theme(axis.text.y = element_blank(),
+ axis.title.y = element_blank())
+
+
+ ##############################################################################################################################################
+
+
+ #########
+ # Mapping
+ #########
+
+ #subset and reshape data
+ Analysis.df.sub3 = ReducedModel.df %>%
+ filter(variable == variable.name,
+ term %in% c(paste0(variable.name,'.SO.SE'),paste0(variable.name,'.LO.SO'))) %>%
+ mutate(estimate = if(variable.name == "GPPstart"){ifelse(estimate>.07, .07, ifelse(estimate < -.07, -.07, estimate))} else {
+ ifelse(estimate>3, 3, ifelse(estimate < -3, -3, estimate))} ) %>%
+ dplyr::select(c(Lat, Lon, geometry, variable, term, estimate)) %>%
+ pivot_wider(., names_from = term, values_from = estimate) %>%
+ dplyr::rename('Post' = as.name(paste0(variable.name,'.SO.SE')),
+ 'Pre' = as.name(paste0(variable.name,'.LO.SO')))
+
+ #Get world map
+ mp <- NULL
+ mapWorld <- borders("world", colour="gray40", fill="gray40") # create a layer of borders
+ mp <- ggplot() + mapWorld + plotTheme1
+
+ #Add pre-solstice information
+ MapPre <- mp + geom_tile(data = Analysis.df.sub3,
+ show.legend=T,
+ aes(x = Lon, y = Lat, fill=Pre)) +
+ scale_fill_gradient2(midpoint=0, low='#F21A00', mid="white",
+ high='#3B9AB2', space ="Lab" ) +
+ coord_cartesian(ylim = c(27, 75), xlim = c(-160, 175)) +
+ xlab("") + ylab('Latitude') +
+ theme(legend.position = c(0.08,0.33))
+
+ #Add post-solstice information
+ MapPost <- mp + geom_tile(data = Analysis.df.sub3,
+ show.legend=T,
+ aes(x = Lon, y = Lat, fill=Post)) +
+ scale_fill_gradient2(midpoint=0, low='#F21A00', mid="white",
+ high='#3B9AB2', space ="Lab" ) +
+ coord_cartesian(ylim = c(27, 75), xlim = c(-160, 175)) +
+ xlab("") + ylab('Latitude')
+
+ ##############################################################################################################################################
+
+
+ ################
+ # Solstice plots
+ ################
+
+ #subset the data
+ SolsticeModel.df.sub = SeasonalModel.df %>%
+ filter(variable == variable.name)
+
+ # Plot
+ plotSolstice = ggplot(data = SolsticeModel.df.sub, aes(x = variable.class, y = estimate, fill=variable.class)) +
+ geom_boxplot(outlier.shape = NA, notch=T)+
+ geom_hline(yintercept=0)+
+ xlab("") + ylab("") +
+ coord_cartesian(ylim = c(-.8,.8)) +
+ scale_fill_manual(values = rev(wes_palette(6, name = "Zissou1", type = "continuous")))+
+ scale_x_discrete(labels=c("solstice1" = "May 13\nJun 11", "solstice2" = "May 23\nJun 21",
+ "solstice3" = "Jun 2\nJul 1", "solstice4"="Jun 12\nJul 11",
+ "solstice5"="Jun 22\nJul 21", "solstice6"="Jul 2\nJul 31"))+
+ plotTheme1
+
+ plotSolstice = plotSolstice + annotation_custom(ggplotGrob(PhotoSolstice),
+ xmin = 0.6, xmax = 3.6,
+ ymin = 0.2, ymax = 1.05)
+
+
+ ##############################################################################################################################################
+
+
+ #######################################
+ # Full model plots (Linear model means)
+ #######################################
+
+
+ #All pixels
+ ###########
+
+ plotFull = FullModel.df %>%
+ filter(variable == variable.name) %>%
+ mutate(term = factor(term,
+ levels=c(paste0(variable.name, ".LO.SO"),
+ "Prcp.LO.SO", 'Prcp.SO.SE', "CO2",
+ paste0(variable.name, ".SO.SE")), ordered=T) ) %>%
+ ggplot(aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch=T)+
+ geom_hline(yintercept=0)+
+ xlab("") + ylab("") +
+ coord_cartesian(ylim = c(-.9,.9)) +
+ scale_fill_manual(values = c('#F21A00','grey60','grey35','black','#3B9AB2'))+
+ scale_x_discrete(labels = c(paste0(variable.name, " pre"),
+ 'Prcp pre','Prcp post',
+ expression(CO[2]),
+ paste0(variable.name, " post")))+
+ plotTheme1 +
+ theme(axis.text.x = element_text(angle = 45, hjust=1))
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ #Vegetation-type-specific
+ #########################
+
+ plotFullLC = FullModel.df %>%
+ filter(variable == variable.name) %>%
+ group_by(LC_Type, term) %>%
+ mutate(LC_Type = factor(LC_Type, levels=c("Mixed_North America", "Mixed_Eurasia",
+ "DecB_North America", "DecB_Eurasia",
+ "EvgN_North America", "EvgN_Eurasia",
+ "DecN_Eurasia")),
+ term = factor(term,
+ levels=c(paste0(variable.name, ".LO.SO"),
+ "Prcp.LO.SO", 'Prcp.SO.SE', "CO2",
+ paste0(variable.name, ".SO.SE")), ordered=T) ) %>%
+ ggplot(aes(x = term, y = estimate, fill=term)) +
+ geom_boxplot(outlier.shape = NA, notch=T)+
+ geom_hline(yintercept=0)+
+ xlab("") + ylab("Standardized effect") +
+ coord_cartesian(ylim = c(-.9,.9)) +
+ scale_fill_manual(values = c('#F21A00','grey60','grey35','black','#3B9AB2'))+
+ scale_x_discrete(labels = c('Out-Sol','Prcp pre','Prcp post',expression(CO[2]),'Sol-Off'))+
+ plotTheme1 +
+ facet_grid(LC_Type~1) +
+ theme(axis.text.x = element_text(angle = 45, hjust=1),
+ strip.text = element_blank(),)
+
+
+ ##############################################################################################################################################
+
+
+ ###############
+ # Monthly plots
+ ###############
+
+
+ #subset the table
+ #################
+
+ Monthly.df.sub = MonthlyAnalysis.df %>%
+ filter(variable == variable.name)
+
+ df.interp.sub = df.interp %>%
+ filter(variable == variable.name)
+
+ df.AUC.sub = df.AUC %>%
+ filter(variable == variable.name)
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ # Plots
+ #######
+
+ #set x and y ranges
+ if(variable.name %in% c('GPP','LAI',"Apm","Azani",'SWrad','GPPstart','LAIstart')){
+ xRange=c(4.1, 8.9) } else {xRange=c(3.2, 8.8) }
+
+ yRange=c(-0.38,0.38)
+ yRange2=c(-0.55,0.55)
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ #All pixels
+ plot.monthly = ggplot() +
+ geom_area(data = df.interp.sub[df.interp.sub$LC_Type=='All',], aes(x = created, y = score, fill=score>0, group=group)) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+ geom_point(data=Monthly.df.sub[Monthly.df.sub$LC_Type=='All',],
+ aes(x=term, y=mean))+
+ geom_errorbar(data=Monthly.df.sub[Monthly.df.sub$LC_Type=='All',],
+ aes(x=term, ymin=lowCI, ymax=hiCI), width=.2,
+ position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ geom_vline(xintercept=6.3, size=2, alpha=0.4)+
+ geom_text(data = df.AUC.sub[df.AUC.sub$LC_Type=='All',], mapping = aes(x = -Inf, y = Inf,
+ hjust = -0.1, vjust = 1.5,
+ label = paste0(percent.neg,'% / ',percent.pos, '%')))+
+ coord_cartesian(xlim=xRange, ylim=yRange) +
+ xlab("")+ylab("Standardized effect")+
+ scale_x_continuous(breaks = seq(1,10,by=1),
+ labels = c('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct'))+
+ plotTheme1
+
+ #-----------------------------------------------------------------------------------------------------------------------
+
+ #Vegetation-type-specific
+ plot.monthly.LCtype = ggplot() +
+ geom_area(data = df.interp.sub[df.interp.sub$LC_Type!='All',], aes(x = created, y = score, fill=score>0, group=group)) +
+ scale_fill_manual(values = c('#F21A00', '#3B9AB2'))+
+ geom_point(data=Monthly.df.sub[Monthly.df.sub$LC_Type!='All',],
+ aes(x=term, y=mean))+
+ geom_errorbar(data=Monthly.df.sub[Monthly.df.sub$LC_Type!='All',],
+ aes(x=term, ymin=lowCI, ymax=hiCI), width=.2,
+ position=position_dodge(.9)) +
+ geom_hline(yintercept=0)+
+ geom_vline(xintercept=6.3, size=2, alpha=0.4)+
+ geom_text(data = df.AUC.sub[df.AUC.sub$LC_Type!='All',],
+ mapping = aes(x = -Inf, y = Inf, hjust = -.1, vjust = 1.5,
+ label = paste0(percent.neg,'% / ',percent.pos, '%')) ) +
+ coord_cartesian(xlim=xRange,ylim=yRange2)+
+ xlab("")+ylab('')+
+ facet_grid(LC_Type~1)+
+ scale_x_continuous(breaks = seq(1,10,by=2),
+ labels = c('Jan','Mar','May','Jul','Sep'))+
+ plotTheme1 +
+ theme(strip.text.x = element_blank())
+
+
+ ##############################################################################################################################################
+
+
+ ###################
+ # Mixed model plots
+ ###################
+
+
+ #Driver plots
+ MixedModel.df.sub = MixedModel.df %>%
+ filter(variable == variable.name)
+
+ coefficients.df.sub = coefficients.df %>%
+ filter(variable == variable.name)
+
+ fitted.df.sub = fitted.df %>%
+ filter(variable == variable.name)
+
+ driver.plot = ggplot() +
+
+ geom_hex(data=fitted.df.sub, aes(y= fitted, x= x), bins=300)+
+
+ scale_fill_gradient2(low="grey95",mid='#E1AF00',"high"='#F21A00', midpoint=45)+
+
+ geom_ribbon(data = MixedModel.df.sub, aes(x = xval, ymin = lower, ymax = upper),
+ alpha = 0.5, fill="black") +
+
+ geom_line(data=MixedModel.df.sub, aes(xval, off), color="black") +
+
+ geom_text(data=coefficients.df.sub, aes(label=paste0(round(Coefficient,2)," days per unit\nR2 = ", round(summary(lm(fitted~x, data=fitted.df.sub))$r.squared,2)),
+ x=Inf, y=Inf, hjust = 1.1, vjust = 1.5))+
+
+ coord_cartesian(ylim = c(190,250), xlim = c(min(fitted.df.sub$x)+max(fitted.df.sub$x)/20,
+ max(fitted.df.sub$x)-max(fitted.df.sub$x)/20))+
+
+ labs(x = variable.name, y = expression(EOS[start]~(DOY)))+
+
+ plotTheme1
+
+
+ # Year plots
+ MixedModel.df.sub = MixedModel.df %>%
+ filter(variable == "Year",
+ class %in% c("Univariate",variable.name)) %>%
+ distinct()
+
+ coefficients.df.sub = coefficients.df %>%
+ filter(variable == "Year",
+ class %in% c("Univariate",variable.name))%>%
+ distinct()
+
+ year.plot = ggplot() +
+ geom_hline(yintercept = 0, linetype="dashed")+
+ geom_ribbon(data = MixedModel.df.sub, aes(x = xval+YearMean, ymin = anomaly.lower, ymax = anomaly.upper, fill=class),
+ alpha = 0.3) +
+ geom_line(data=MixedModel.df.sub, aes(xval+YearMean, anomaly, color=class)) +
+ theme_classic() +
+
+ geom_text(data=coefficients.df.sub[coefficients.df.sub$class==variable.name,],
+ aes(label=paste0("EOS10 ~ Year + ", variable.name, " (", round(Coefficient*10,1)," days per decade)"),
+ x=Inf, y=Inf,hjust = 1.2, vjust = 2),color='#3B9AB2')+
+
+ geom_text(data=coefficients.df.sub[coefficients.df.sub$class=="Univariate",],
+ aes(label=paste0("EOS10 ~ Year (", round(Coefficient*10,1)," days per decade)"),
+ x=Inf, y=-Inf,hjust = 1.2, vjust = -2),color='#F21A00')+
+
+ scale_color_manual(values = c('#3B9AB2','#F21A00'))+
+ scale_fill_manual(values = c('#3B9AB2','#F21A00'))+
+
+ coord_cartesian(ylim = c(-1.5,1.5), xlim=c(2013.5,2020.5))+
+
+ labs(x = "Year", y = expression(EOS[start]~anomaly))+
+ plotTheme1
+
+
+ ##############################################################################################################################################
+
+
+ ##########################
+ # Arrange and safe plots #
+ ##########################
+
+
+ # 1. Monthly plots
+ ##################
+
+ #define plot layout
+ layout <- "ABC"
+
+ #Merge plots
+ Fig_Plot = plot.monthly + plotFull + plotSolstice +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A') &
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plots as .pdf
+ ggsave(Fig_Plot, file=paste('FigS8_',variable.name, ".pdf", sep=''),
+ path=output_path,
+ width=11, height=3.5)
+
+ print(Fig_Plot)
+
+ # 2. Map plots
+ ##############
+
+ #define plot layout
+ layout <- "
+AAAAAB
+CCDDEE"
+
+ #Merge plots
+ Fig_Plot = MapPre + LatPlot +
+ HistoPlot + driver.plot + year.plot +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A') &
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plots as .pdf
+ ggsave(Fig_Plot, file=paste(variable.name, ".pdf", sep=''),
+ path=output_path,
+ width=12, height=6)
+
+ print(Fig_Plot)
+
+
+ # 3. Vegetation-type-specific plots
+ ###################################
+
+ #define plot layout
+ layout <- "AB"
+
+ #Merge plots
+ Fig_Plot = plotFullLC + plot.monthly.LCtype +
+ plot_layout(design = layout) + plot_annotation(tag_levels = 'A') &
+ theme(plot.tag = element_text(face = 'bold'))
+
+ #save plots as .pdf
+ ggsave(Fig_Plot, file=paste('LCtype_',variable.name, ".pdf", sep=''),
+ path=output_path,
+ width=6, height=12)
+
+ print(Fig_Plot)
+
+ ##############################################################################################################################################
+
+ #count
+ print(variable.name)
+}
+
+
+
+##############################################################################################################################################
+##############################################################################################################################################
+
+
+
+#####################
+## Reproducibility ##
+#####################
+
+
+
+## date time
+Sys.time()
+
+
+## session info
+sessionInfo()
+```
\ No newline at end of file