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 + + + + + + + + + + + + + + + + + + + + + + +
+
+

GLDAS database extraction on Google Earth Engine

——Python API code

+
+
+
+ +
+ +
+
+ +
+ +
+
+ +
+ +
+
+ +
+ +
+ + + + +
+ +
+
+ +
+ +
+ + + + +
+ +
+
+ +
+ +
+
+
+

Below is the key part of the code

+
+
+
+ +
+ +
+
+
+

Bash downloading Google Cloud Storage data

+
+
+
+ +
+ +
+ + + + + + + + + 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