### Latitudinal change temp_full6$Lat_change=0 temp_full6$Lat_change=sqrt(temp_full6$FC1_source_lat^2)-sqrt(temp_full6$LATITUDE^2) # create simplified ecoregions # temp_full7<-temp_full6 temp_full7$simple_gez<-NA unique(levels(temp_full7$gez_name)) levels(temp_full7$simple_gez)<-c("Boreal","Temperate","Subtropical","Tropical") temp_full7[temp_full7$gez_name%in%c("Boreal coniferous forest","Boreal mountain system"),"simple_gez"]<-"Boreal" temp_full7[temp_full7$gez_name%in%c("Subtropical desert","Subtropical dry forest","Subtropical humid forest","Subtropical mountain system","Subtropical steppe"),"simple_gez"]<-"Subtropical" temp_full7[temp_full7$gez_name%in%c("Temperate continental forest","Temperate desert","Temperate mountain system", "Temperate oceanic forest","Temperate steppe"),"simple_gez"]<-"Temperate" temp_full7[temp_full7$gez_name%in%c("Tropical desert","Tropical dry forest","Tropical moist forest","Tropical mountain system", "Tropical rainforest","Tropical shrubland"),"simple_gez"]<-"Tropical" boxplot(temp_full7$Lat_change~temp_full7$simple_gez) temp_full7$LATITUDE_sq<-sqrt(temp_full7$LATITUDE^2) plot(temp_full7$LATITUDE_sq, temp_full7$Lat_change) abline(h=0,col="red") sub=temp_full7[,c("LATITUDE","LATITUDE_sq","Lat_change","simple_gez")] p<-ggplot(sub, aes(x=LATITUDE_sq, y=Lat_change)) + geom_point(aes(colour=factor(simple_gez)))+ scale_colour_manual(breaks = c("Tropical", "Subtropical", "Temperate","Boreal"),values=c( "steelblue", "coral", "forestgreen","red"))+ theme(panel.background = element_rect(fill = "white",colour = "white",size = 0.5, linetype = "solid"), axis.line = element_line(colour = "grey"))+ xlab("Distance to equator")+ylab("Change in latitude")+ geom_smooth(method="lm",color="black")+coord_fixed()+ geom_hline(yintercept=c(0), linetype="dotted") ggsave("change_lat_vs_lat.pdf", plot = p, device = NULL, path = getwd(),width = 7, height = 7,dpi = 300, limitsize = FALSE) # # ?tapply # # table(temp_full7$out_hull_4axes,temp_full7$simple_gez) # tapply(temp_full7$out_hull_4axes,temp_full7$simple_gez,function(x)mean(x,na.rm=TRUE)) # 64% in the tropics # # # tapply(temp_full7$Annual_Mean_Temperature-temp_full7$future_Annual_Mean_Temperature,temp_full7$simple_gez,function(x)mean(x,na.rm=TRUE)) # 64% in the tropics # tapply(temp_full7$Min_Temperature_of_Coldest_Month-temp_full7$future_Min_Temperature_of_Coldest_Month,temp_full7$simple_gez,function(x)mean(x,na.rm=TRUE)) # 64% in the tropics # tapply(temp_full7$Max_Temperature_of_Warmest_Month-temp_full7$future_Max_Temperature_of_Warmest_Month,temp_full7$simple_gez,function(x)mean(x,na.rm=TRUE)) # 64% in the tropics # # tapply(temp_full7$Annual_Precipitation-temp_full7$future_Annual_Precipitation,temp_full7$simple_gez,function(x)mean(x,na.rm=TRUE)) # 64% in the tropics # a=tapply(temp_full7$Precipitation_of_Wettest_Month-temp_full7$future_Precipitation_of_Wettest_Month,temp_full7$simple_gez,function(x)mean(x,na.rm=TRUE)) # 64% in the tropics # aa=tapply(temp_full7$Precipitation_of_Wettest_Month,temp_full7$simple_gez,function(x)mean(x,na.rm=TRUE)) # 64% in the tropics # a/aa # # b=tapply(temp_full7$Precipitation_of_Driest_Month-temp_full7$future_Precipitation_of_Driest_Month,temp_full7$simple_gez,function(x)mean(x,na.rm=TRUE)) # 64% in the tropics # bb=tapply(temp_full7$Precipitation_of_Driest_Month,temp_full7$simple_gez,function(x)mean(x,na.rm=TRUE)) # 64% in the tropics # b/bb # # # # c=tapply(temp_full7$Annual_Precipitation-temp_full7$future_Annual_Precipitation,temp_full7$simple_gez,function(x)mean(x,na.rm=TRUE)) # 64% in the tropics # cc=tapply(temp_full7$Annual_Precipitation,temp_full7$simple_gez,function(x)mean(x,na.rm=TRUE)) # 64% in the tropics # c/cc # table(temp_full6$current_biome_ref) # future=rowSums(table(temp_full6$current_biome_ref,temp_full6$future_biome_ref)) # present=colSums(table(temp_full6$current_biome_ref,temp_full6$future_biome_ref)) # (future-present)/(future+present/2) # # table(temp_full6$gez_name) # future=rowSums(table(temp_full6$gez_name,temp_full6$future_gez)) # present=colSums(table(temp_full6$gez_name,temp_full6$future_gez)) # (future-present)/(future+present/2) # # temp_full6$future_continent # temp_full6$future_gez # 22.1+(0.66*40) # # ### Test graph # temp_full6$Lat_change=sqrt((temp_full6$FC1_source_lat)^2)-sqrt((temp_full6$LATITUDE)^2) # sub=temp_full6[temp_full6$CONTINENT=="Europe",] # bp<-boxplot(sub$Lat_change) # pdf("bp_europe4.pdf",height=6,width=3) # boxplot(sub$Lat_change, yaxt="n", ylim=c(-20,20)) # axis(2,las=1) # dev.off() # # sub=temp_full6[temp_full6$CONTINENT=="North America",] # bp<-boxplot(sub$Lat_change) # pdf("bp_Nam2.pdf",height=6,width=3) # boxplot(sub$Lat_change, yaxt="n", ylim=c(-20,20)) # axis(2,las=1) # dev.off() # MAKE A GRAPH/COLOR FOR EACH CONTINENT/BIOME ################################### ### CONTROL OF SPATIAL DISTRIBUTION ################################### # # I need to calculate the distance # mat_current=as.matrix(temp_full2[,c("LONGITUDE","LATITUDE")]) # mat_future=as.matrix(temp_full2[,c("future_LONGITUDE","future_LATITUDE")]) # # # Distance between current and future, to check if distance is related to dissimilarity # library(raster) # temp_full2$dist_future_current=pointDistance(mat_current, mat_future, lonlat=FALSE) # plot(temp_full2$dist_future_current,temp_full2$future_city_dist) # abline(lm(temp_full2$future_city_dist~temp_full2$dist_future_current)) # summary(lm(temp_full2$future_city_dist~temp_full2$dist_future_current)) # # # RESULT : geographic distance between current and future city do not explain the difference # # # # Distance to the closest point, to check if isolation is related to dissimilarity # library(sp) # library(rgeos) # sp.mydata <- data.frame(mat_current) # colnames(sp.mydata)<-c("long","lat") # rownames(sp.mydata)<-temp_full2$NAMEASCII # temp_full2$NAMEASCII[duplicated(temp_full2$NAMEASCII)] # coordinates(sp.mydata) <- ~long+lat # # # d <- gDistance(sp.mydata, byid=T) # # Find second shortest distance (closest distance is of point to itself, therefore use second shortest) # # # min.d <- apply(d, 1, function(x) order(x, decreasing=F)[2]) # temp_full2$min_distance<-d[min.d] # # # temp_full2=temp_full2[complete.cases(temp_full2),] # plot(temp_full2$min_distance,temp_full2$future_city_dist) # abline(lm(temp_full2$future_city_dist~temp_full2$min_distance)) # summary(lm(temp_full2$future_city_dist~temp_full2$min_distance)) # db_fin<-temp_full2 # # Slight effect of isolated cities # # Isolation explain 1.9 % of dissimilarity between current and future # # #### NEED TO INCLUDE THE 0 of the former town being the closest to the new towns !!!!! # # # Figure 1 - plot PCA axis1/2 current - future with boxplot # # a - level of cities # p<-ggplot() + geom_point(data = PCA_current$li, aes(x = Axis1, y = Axis2),colour = "blue", fill="blue", alpha=0.3, pch = 21) # p<-p + geom_point(data = PCA_future, aes(x = Axis1, y = Axis2),colour = "red", fill="red", alpha=0.3, pch = 21) # db_bp <- data.frame(matrix(NA, ncol=5,nrow=length(db_fin$current_axis1))) # db_bp[,1]<-"current" # db_bp[,c(2:5)]<-db_fin[,c("current_axis1","current_axis2","current_axis3","current_axis4")] # db_bp_f <- data.frame(matrix(NA, ncol=5,nrow=length(db_fin$current_axis1))) # db_bp_f[,1]<-"future" # db_bp_f[,c(2:5)]<-db_fin[,c("future_axis1","future_axis2","future_axis3","future_axis4")] # db_bp<-rbind(db_bp,db_bp_f) # colnames(db_bp)<-c("period","axis1","axis2","axis3","axis4") # m_db=melt(db_bp, value=c("axis1","axis2","axis3","axis4")) # p1<-ggplot(data=m_db[m_db$variable=="axis1",],aes(x=period,y=value, fill=period))+geom_boxplot()+scale_fill_manual(values=c("blue","red"))+ scale_x_discrete(labels=c("future" = "F", "current" = "C"))+ coord_flip() # p2<-ggplot(data=m_db[m_db$variable=="axis2",],aes(x=period,y=value, fill=period))+geom_boxplot()+scale_fill_manual(values=c("blue","red"))+ scale_x_discrete(labels=c("future" = "F", "current" = "C")) # p1<-p1+theme(legend.position="none") # p2<-p2+theme(legend.position="none") # m1<-marrangeGrob(list(p,p2,p1),widths=c(2,1),heights=c(2,1),top=NULL,ncol = 2, nrow=2) # # b - levels of continent # db_bp <- data.frame(matrix(NA, ncol=5,nrow=length(db_fin$current_axis1))) # db_bp[,c(1:5)]<-db_fin[,c("CONTINENT","current_axis1","current_axis2","current_axis3","current_axis4")] # colnames(db_bp)<-c("CONTINENT","axis1","axis2","axis3","axis4") # agg=aggregate(.~CONTINENT,db_bp,mean,na.rm=TRUE) # m_agg=melt(agg) # m_agg2=cbind("current",m_agg) # colnames(m_agg2)<-c("period",colnames(m_agg)) # # db_bp_f <- data.frame(matrix(NA, ncol=5,nrow=length(db_fin$current_axis1))) # db_bp_f[,c(1:5)]<-db_fin[,c("CONTINENT","future_axis1","future_axis2","future_axis3","future_axis4")] # colnames(db_bp_f)<-c("CONTINENT","axis1","axis2","axis3","axis4") # agg_f=aggregate(.~CONTINENT,db_bp_f,mean,na.rm=TRUE) # m_agg_f=melt(agg_f) # m_agg2_f=cbind("future",m_agg_f) # colnames(m_agg2_f)<-c("period",colnames(m_agg_f)) # # agg=cbind("current",agg) # agg_f=cbind("future",agg_f) # colnames(agg)<-c("period","CONTINENT","axis1","axis2","axis3","axis4") # colnames(agg_f)<-c("period","CONTINENT","axis1","axis2","axis3","axis4") # # # # Axis 1 and 2 # p_cont<-ggplot() + geom_point(data=agg, aes(x = axis1, y = axis2),colour = "blue", fill="blue", pch = 21, size=3)+geom_text(data=agg, aes(x = axis1, y = axis2,label=factor(CONTINENT)),hjust = 0, nudge_x = 0.05) # p_cont<-p_cont + geom_point(data = agg_f, aes(x = axis1, y = axis2),colour = "red", fill="red", pch = 21,size=3)+geom_text(data=agg_f, aes(x = axis1, y = axis2,label=factor(CONTINENT)),hjust = 0, nudge_x = 0.05) # diff_agg=agg_f[,c(3:6)]-agg[,c(3:6)] # diff_agg=cbind(agg[,c(1:2)],diff_agg) # diff_agg_axis1=diff_agg[,c(1:3)] # diff_agg_axis1$colour <- ifelse(diff_agg_axis1$axis1 < 0, "negative","positive") # barplot_cont_a1<-ggplot(diff_agg_axis1[-1,],aes(reorder(CONTINENT, -axis1),axis1,label=""))+ # geom_bar(stat="identity",position="identity",aes(fill = colour))+ # scale_fill_manual(values=c(positive="grey",negative="black"))+ # theme(axis.text.x = element_text(angle = 30, hjust = 1))+ # xlab("Continent")+ylim(-1,1)+theme(legend.position="none")+coord_flip() # diff_agg_axis2=diff_agg[,c(1:2,4)] # diff_agg_axis2$colour <- ifelse(diff_agg_axis2$axis2 < 0, "negative","positive") # barplot_cont_a2<-ggplot(diff_agg_axis2[-1,],aes(reorder(CONTINENT, axis2),axis2,label=""))+ # geom_bar(stat="identity",position="identity",aes(fill = colour))+ # scale_fill_manual(values=c(positive="grey",negative="black"))+ # theme(axis.text.x = element_text(angle = 30, hjust = 1))+ # xlab("Continent")+ylim(-1,1)+theme(legend.position="none") # plot_a1a2_continent<-marrangeGrob(list(p_cont,barplot_cont_a2,barplot_cont_a1),widths=c(1,1),heights=c(1,1),top=NULL,ncol = 2, nrow=2) # # # Axis 3 and 4 # p_cont_b<-ggplot() + geom_point(data=agg, aes(x = axis3, y = axis4),colour = "blue", fill="blue", pch = 21, size=3)+geom_text(data=agg, aes(x = axis3, y = axis4,label=factor(CONTINENT)),hjust = 0, nudge_x = 0.05) # p_cont_b<-p_cont_b + geom_point(data = agg_f, aes(x = axis3, y = axis4),colour = "red", fill="red", pch = 21,size=3)+geom_text(data=agg_f, aes(x = axis3, y = axis4,label=factor(CONTINENT)),hjust = 0, nudge_x = 0.05) # diff_agg_axis3=diff_agg[,c(1:2,5)] # diff_agg_axis3$colour <- ifelse(diff_agg_axis3$axis3 < 0, "negative","positive") # barplot_cont_a3<-ggplot(diff_agg_axis3[-1,],aes(reorder(CONTINENT, -axis3),axis3,label=""))+ # geom_bar(stat="identity",position="identity",aes(fill = colour))+ # scale_fill_manual(values=c(positive="grey",negative="black"))+ # theme(axis.text.x = element_text(angle = 30, hjust = 1))+ # xlab("Continent")+ylim(-1,1)+theme(legend.position="none")+coord_flip() # diff_agg_axis4=diff_agg[,c(1:2,6)] # diff_agg_axis4$colour <- ifelse(diff_agg_axis4$axis4 < 0, "negative","positive") # barplot_cont_a4<-ggplot(diff_agg_axis4[-1,],aes(reorder(CONTINENT, -axis4),axis4,label=""))+ # geom_bar(stat="identity",position="identity",aes(fill = colour))+ # scale_fill_manual(values=c(positive="grey",negative="black"))+ # theme(axis.text.x = element_text(angle = 30, hjust = 1))+ # xlab("Continent")+ylim(-1,1)+theme(legend.position="none") # # plot_a3a4_continent<-marrangeGrob(list(p_cont_b,barplot_cont_a4,barplot_cont_a3),widths=c(1,1),heights=c(1,1),top=NULL,ncol = 2, nrow=2) # # Cities of Europe will undergo a lot of change # # General move towards decrease in seasonality, and higher average temperature, cooler coldedst month and warmer driest month (axis 1) - Led by 1-Europe, 2-Asia, 3-NA # # General move towards less precipitation during the driest month, higher temperature of the warmest month, more variation in diurnal range of temperature, and more variation in precipitation seasonality (axis 2) - Led by 1-Europe 2-SA 3-Australia # # Axis 3 : nothing # # General Axis 4 : increase of max temp of the warmest month. precipitation of the driest month, mean diurnal range - led by Europe/North America/ Australia # # # ggplot()+geom_barplot # colnames(temp_full6) # # # m1<-marrangeGrob(list(p,p2,p1),widths=c(2,1),heights=c(2,1),top=NULL,ncol = 2, nrow=2) # # # c - levels of ecoZ # db_bp <- data.frame(matrix(NA, ncol=5,nrow=length(db_fin$current_axis1))) # db_bp[,c(1:5)]<-db_fin[,c("gez_name","current_axis1","current_axis2","current_axis3","current_axis4")] # colnames(db_bp)<-c("gez_name","axis1","axis2","axis3","axis4") # agg=aggregate(.~gez_name,db_bp,mean,na.rm=TRUE) # m_agg=melt(agg) # m_agg2=cbind("current",m_agg) # colnames(m_agg2)<-c("period",colnames(m_agg)) # # db_bp_f <- data.frame(matrix(NA, ncol=5,nrow=length(db_fin$current_axis1))) # table(db_bp$gez_name) # # table(db_bp_f$X1) # db_bp_f[,c(1:5)]<-db_fin[,c("future_gez","future_axis1","future_axis2","future_axis3","future_axis4")] # colnames(db_bp_f)<-c("gez_name","axis1","axis2","axis3","axis4") # agg_f=aggregate(.~gez_name,db_bp_f,mean,na.rm=TRUE) # m_agg_f=melt(agg_f) # m_agg2_f=cbind("future",m_agg_f) # colnames(m_agg2_f)<-c("period",colnames(m_agg_f)) # # agg=cbind("current",agg) # agg_f=cbind("future",agg_f) # colnames(agg)<-c("period","gez_name","axis1","axis2","axis3","axis4") # colnames(agg_f)<-c("period","gez_name","axis1","axis2","axis3","axis4") # # p_gez<-ggplot() + geom_point(data=agg, aes(x = axis1, y = axis2),colour = "blue", fill="blue", pch = 21, size=3)+geom_text(data=agg, aes(x = axis1, y = axis2,label=factor(gez_name)),hjust = 0, nudge_x = 0.05)+xlim(-6,6)+ylim(-3,3) # p_gez<-p_gez + geom_point(data = agg_f, aes(x = axis1, y = axis2),colour = "red", fill="red", pch = 21,size=3)+geom_text(data=agg_f, aes(x = axis1, y = axis2,label=factor(gez_name)),hjust = 0, nudge_x = 0.05) # # diff_agg=0 # diff_agg=agg_f[,c(3:6)]-agg[agg$gez_name%in%agg_f$gez_name,c(3:6)] # diff_agg=cbind(agg[agg$gez_name%in%agg_f$gez_name,c(1:2)],diff_agg) # diff_agg_axis1=diff_agg[,c(1:3)] # diff_agg_axis1$colour <- ifelse(diff_agg_axis1$axis1 < 0, "negative","positive") # barplot_gez_a1<-ggplot(diff_agg_axis1[-1,],aes(reorder(gez_name, -axis1),axis1,label=""))+ # geom_bar(stat="identity",position="identity",aes(fill = colour))+ # scale_fill_manual(values=c(positive="grey",negative="black"))+ # theme(axis.text.x = element_text(angle = 30, hjust = 1))+ # xlab("Global ecological zones")+ylim(-1,1)+theme(legend.position="none")+coord_flip() # diff_agg_axis2=diff_agg[,c(1:2,4)] # diff_agg_axis2$colour <- ifelse(diff_agg_axis2$axis2 < 0, "negative","positive") # barplot_gez_a2<-ggplot(diff_agg_axis2[-1,],aes(reorder(gez_name, axis2),axis2,label=""))+ # geom_bar(stat="identity",position="identity",aes(fill = colour))+ # scale_fill_manual(values=c(positive="grey",negative="black"))+ # theme(axis.text.x = element_text(angle = 30, hjust = 1))+ # xlab("Global ecological zones")+ylim(-1,1)+theme(legend.position="none") # plot_a1a2_gez<-marrangeGrob(list(p_gez,barplot_gez_a2,barplot_gez_a1),widths=c(1,1),heights=c(1,1),top=NULL,ncol = 2, nrow=2) # # p_gez_b<-ggplot() + geom_point(data=agg, aes(x = axis3, y = axis4),colour = "blue", fill="blue", pch = 21, size=3)+geom_text(data=agg, aes(x = axis3, y = axis4,label=factor(gez_name)),hjust = 0, nudge_x = 0.05)+xlim(-3,3)+ylim(-2,2) # p_gez_b<-p_gez_b + geom_point(data = agg_f, aes(x = axis3, y = axis4),colour = "red", fill="red", pch = 21,size=3)+geom_text(data=agg_f, aes(x = axis3, y = axis4,label=factor(gez_name)),hjust = 0, nudge_x = 0.05) # # diff_agg_axis3=diff_agg[,c(1:2,5)] # diff_agg_axis3$colour <- ifelse(diff_agg_axis3$axis3 < 0, "negative","positive") # barplot_gez_a3<-ggplot(diff_agg_axis3[-1,],aes(reorder(gez_name, -axis3),axis3,label=""))+ # geom_bar(stat="identity",position="identity",aes(fill = colour))+ # scale_fill_manual(values=c(positive="grey",negative="black"))+ # theme(axis.text.x = element_text(angle = 30, hjust = 1))+ # xlab("Global ecological zones")+ylim(-1,1)+theme(legend.position="none")+coord_flip() # diff_agg_axis4=diff_agg[,c(1:2,6)] # diff_agg_axis4$colour <- ifelse(diff_agg_axis4$axis4 < 0, "negative","positive") # barplot_gez_a4<-ggplot(diff_agg_axis4[-1,],aes(reorder(gez_name, axis4),axis4,label=""))+ # geom_bar(stat="identity",position="identity",aes(fill = colour))+ # scale_fill_manual(values=c(positive="grey",negative="black"))+ # theme(axis.text.x = element_text(angle = 30, hjust = 1))+ # xlab("Global ecological zones")+ylim(-1,1)+theme(legend.position="none") # plot_a3a4_gez<-marrangeGrob(list(p_gez_b,barplot_gez_a4,barplot_gez_a3),widths=c(1,1),heights=c(1,1),top=NULL,ncol = 2, nrow=2) # # Cities of Europe will undergo a lot of change # # General move towards decrease in seasonality, and higher average temperature, cooler coldedst month and warmer driest month (axis 1) - Led by temperate gez (steppe, continental forest, mountain and then oceanic forest / followed by subtropical and tropical) # # Temperate desert might get colder # # # General move towards less precipitation during the driest month, higher temperature of the warmest month, more variation in diurnal range of temperature, and more variation in precipitation seasonality (axis 2) # # Led by Temperate steppe, tropical mountain, temperated continental forest # # High precipitation in dry months, lower temperature warmest month and less diurnal variations in subtropical steppe and temperate mountain systems # # # Axis 3 : temp of driest quarter increases in temperate mountain / decreases in temperate desert where precip warmest quarter increase # # General Axis 4 : increase of max temp of the warmest month. precipitation of the driest month, mean diurnal range # # ### BIOME # # db_fin<-temp_full4 # db_bp <- data.frame(matrix(NA, ncol=5,nrow=length(db_fin$current_axis1))) # db_bp[,c(1:5)]<-db_fin[,c("current_biome_ref","current_axis1","current_axis2","current_axis3","current_axis4")] # colnames(db_bp)<-c("biome_name","axis1","axis2","axis3","axis4") # agg=aggregate(.~biome_name,db_bp,mean,na.rm=TRUE) # m_agg=melt(agg) # m_agg2=cbind("current",m_agg) # colnames(m_agg2)<-c("period",colnames(m_agg)) # # db_bp_f <- data.frame(matrix(NA, ncol=5,nrow=length(db_fin$current_axis1))) # db_bp_f[,c(1:5)]<-db_fin[,c("future_biome_ref","future_axis1","future_axis2","future_axis3","future_axis4")] # colnames(db_bp_f)<-c("biome_name","axis1","axis2","axis3","axis4") # agg_f=aggregate(.~biome_name,db_bp_f,mean,na.rm=TRUE) # m_agg_f=melt(agg_f) # m_agg2_f=cbind("future",m_agg_f) # colnames(m_agg2_f)<-c("period",colnames(m_agg_f)) # # agg=cbind("current",agg) # agg_f=cbind("future",agg_f) # colnames(agg)<-c("period","biome_name","axis1","axis2","axis3","axis4") # colnames(agg_f)<-c("period","biome_name","axis1","axis2","axis3","axis4") # # head(agg) # p_biome<-ggplot() + geom_point(data=agg, aes(x = axis1, y = axis2),colour = "blue", fill="blue", pch = 21, size=3)+geom_text(data=agg, aes(x = axis1, y = axis2,label=factor(biome_name)),hjust = 0, nudge_x = 0.05)+xlim(-6,6)+ylim(-3,3) # p_biome<-p_biome + geom_point(data = agg_f, aes(x = axis1, y = axis2),colour = "red", fill="red", pch = 21,size=3)+geom_text(data=agg_f, aes(x = axis1, y = axis2,label=factor(biome_name)),hjust = 0, nudge_x = 0.05) # # diff_agg=0 # diff_agg=agg_f[,c(3:6)]-agg[agg$biome_name%in%agg_f$biome_name,c(3:6)] # diff_agg=cbind(agg[agg$biome_name%in%agg_f$biome_name,c(1:2)],diff_agg) # diff_agg_axis1=diff_agg[,c(1:3)] # diff_agg_axis1$colour <- ifelse(diff_agg_axis1$axis1 < 0, "negative","positive") # barplot_biome_a1<-ggplot(diff_agg_axis1[-1,],aes(reorder(biome_name, -axis1),axis1,label=""))+ # geom_bar(stat="identity",position="identity",aes(fill = colour))+ # scale_fill_manual(values=c(positive="grey",negative="black"))+ # theme(axis.text.x = element_text(angle = 30, hjust = 1))+ # xlab("Global ecological zones")+ylim(-1,1)+theme(legend.position="none")+coord_flip() # diff_agg_axis2=diff_agg[,c(1:2,4)] # diff_agg_axis2$colour <- ifelse(diff_agg_axis2$axis2 < 0, "negative","positive") # barplot_biome_a2<-ggplot(diff_agg_axis2[-1,],aes(reorder(biome_name, axis2),axis2,label=""))+ # geom_bar(stat="identity",position="identity",aes(fill = colour))+ # scale_fill_manual(values=c(positive="grey",negative="black"))+ # theme(axis.text.x = element_text(angle = 30, hjust = 1))+ # xlab("Global ecological zones")+ylim(-1,1)+theme(legend.position="none") # plot_a1a2_biome<-marrangeGrob(list(p_biome,barplot_biome_a2,barplot_biome_a1),widths=c(1,1),heights=c(1,1),top=NULL,ncol = 2, nrow=2) # # p_biome_b<-ggplot() + geom_point(data=agg, aes(x = axis3, y = axis4),colour = "blue", fill="blue", pch = 21, size=3)+geom_text(data=agg, aes(x = axis3, y = axis4,label=factor(biome_name)),hjust = 0, nudge_x = 0.05)+xlim(-3,3)+ylim(-2,2) # p_biome_b<-p_biome_b + geom_point(data = agg_f, aes(x = axis3, y = axis4),colour = "red", fill="red", pch = 21,size=3)+geom_text(data=agg_f, aes(x = axis3, y = axis4,label=factor(biome_name)),hjust = 0, nudge_x = 0.05) # # diff_agg_axis3=diff_agg[,c(1:2,5)] # diff_agg_axis3$colour <- ifelse(diff_agg_axis3$axis3 < 0, "negative","positive") # barplot_biome_a3<-ggplot(diff_agg_axis3[-1,],aes(reorder(biome_name, -axis3),axis3,label=""))+ # geom_bar(stat="identity",position="identity",aes(fill = colour))+ # scale_fill_manual(values=c(positive="grey",negative="black"))+ # theme(axis.text.x = element_text(angle = 30, hjust = 1))+ # xlab("Global ecological zones")+ylim(-1,1)+theme(legend.position="none")+coord_flip() # diff_agg_axis4=diff_agg[,c(1:2,6)] # diff_agg_axis4$colour <- ifelse(diff_agg_axis4$axis4 < 0, "negative","positive") # barplot_biome_a4<-ggplot(diff_agg_axis4[-1,],aes(reorder(biome_name, axis4),axis4,label=""))+ # geom_bar(stat="identity",position="identity",aes(fill = colour))+ # scale_fill_manual(values=c(positive="grey",negative="black"))+ # theme(axis.text.x = element_text(angle = 30, hjust = 1))+ # xlab("Global ecological zones")+ylim(-1,1)+theme(legend.position="none") # plot_a3a4_biome<-marrangeGrob(list(p_biome_b,barplot_biome_a4,barplot_biome_a3),widths=c(1,1),heights=c(1,1),top=NULL,ncol = 2, nrow=2) # # # ### Correlogram Change vs Change # # clim_change=db_comp_current_rcp85_2050_future-db_comp_current_rcp85_2050_current # # df_change=db_fin[db_fin$NAMEASCII%in%rownames(clim_change),c("NAMEASCII","change_axis1","change_axis2","change_axis3","change_axis4")] # df_change=merge(df_change,clim_change,by.x="NAMEASCII",by.y="row.names",all.x=TRUE) # corr=cor(df_change[,-1]) # ggcorrplot(corr, method = "circle") # # # Figure 3 - barplot of what becoming what # # a - continent # # b - ecoZ # # c - biomes # # df_barplot=cbind(table(db_fin$current_biome_ref),table(db_fin$future_biome_ref)) # df_barplot=data.frame(as.matrix(df_barplot)) # colnames(df_barplot)<-c("current","future") # # df_barplot$diff<-df_barplot$future-df_barplot$current # # # # df_barplot$id<-rownames(df_barplot) # # m_df_barplot=melt(df_barplot[,c(3,4)]) # # m_df_barplot=m_df_barplot[complete.cases(m_df_barplot),] # # ggplot(m_df_barplot[-1,], aes(x=reorder(id, value), y = value)) + # # geom_bar(stat="identity", position="identity")+ # # scale_fill_manual(values=c(positive="grey",negative="black"))+ # # theme(axis.text.x = element_text(angle = 45, hjust = 1))+ # # xlab("Global ecological zones")+theme(legend.position="none") # # df_barplot$rel<-df_barplot$diff/df_barplot$current # # m_df_barplot=melt(df_barplot[,c(4,5)]) # # m_df_barplot=m_df_barplot[complete.cases(m_df_barplot),] # # m_df_barplot=m_df_barplot[!m_df_barplot$id=="Water",] # # ggplot(m_df_barplot[-1,], aes(x=reorder(id, value), y = value)) + # # geom_bar(stat="identity", position="identity")+ # # scale_fill_manual(values=c(positive="grey",negative="black"))+ # # theme(axis.text.x = element_text(angle = 45, hjust = 1))+ # # xlab("Global ecological zones")+theme(legend.position="none") # # # df_barplot$id<-rownames(df_barplot) # m_df_barplot=melt(df_barplot) # m_df_barplot=m_df_barplot[complete.cases(m_df_barplot),] # m_df_barplot=m_df_barplot[!m_df_barplot$id=="Water",] # # ggplot(m_df_barplot[-1,], aes(x=variable, y = value,fill = id)) + # geom_bar(stat="identity") # # ## CONT # df_barplot=cbind(table(db_fin$CONTINENT),table(db_fin$future_continent)) # df_barplot=data.frame(as.matrix(df_barplot)) # colnames(df_barplot)<-c("current","future") # df_barplot$id<-rownames(df_barplot) # m_df_barplot=melt(df_barplot) # m_df_barplot=m_df_barplot[complete.cases(m_df_barplot),] # m_df_barplot=m_df_barplot[!m_df_barplot$id=="Water",] # # ggplot(m_df_barplot[-1,], aes(x=variable, y = value,fill = id)) + # geom_bar(stat="identity") # # par(mar=c(2,2,1,1)) # par(mfrow=c(2,2)) # plot(sqrt(temp_full4$future_LATITUDE^2)-sqrt(temp_full4$LATITUDE^2),temp_full4$change_axis1) # plot(sqrt(temp_full4$future_LATITUDE^2)-sqrt(temp_full4$LATITUDE^2),temp_full4$change_axis2) # plot(sqrt(temp_full4$future_LATITUDE^2)-sqrt(temp_full4$LATITUDE^2),temp_full4$change_axis3) # plot(sqrt(temp_full4$future_LATITUDE^2)-sqrt(temp_full4$LATITUDE^2),temp_full4$change_axis4) # # abline(h=0,col="red") # # plot(temp_full4$future_LONGITUDE,temp_full4$LONGITUDE) # # plot(temp_full4$future_LATITUDE-temp_full4$LATITUDE,temp_full4$change_axis1) # plot(temp_full4$future_LATITUDE-temp_full4$LATITUDE,temp_full4$change_axis2) # plot(temp_full4$future_LATITUDE-temp_full4$LATITUDE,temp_full4$change_axis3) # plot(temp_full4$future_LATITUDE-temp_full4$LATITUDE,temp_full4$change_axis4) # # # Figure 4 - New position of capital cities of europe # # # List the champions of change # # # # par(mfrow=c(2,2)) # par(mar=c(2,2,2,2)) # boxplot(temp_full$change_axis1~temp_full$CONTINENT) # boxplot(temp_full$change_axis2~temp_full$CONTINENT) # boxplot(temp_full$change_axis3~temp_full$CONTINENT) # boxplot(temp_full$change_axis4~temp_full$CONTINENT) # # par(mfrow=c(2,2)) # par(mar=c(2,2,2,2)) # boxplot(temp_full$change_axis1~temp_full$gez_name) # boxplot(temp_full$change_axis2~temp_full$gez_name) # boxplot(temp_full$change_axis3~temp_full$gez_name) # boxplot(temp_full$change_axis4~temp_full$gez_name) # # # # par(mfrow=c(3,1)) # par(mar=c(2,2,2,2)) # plot(temp_full$LATITUDE,temp_full$change_axis1) # abline(lm(temp_full$change_axis1~temp_full$LATITUDE),col="red") # plot(temp_full$LATITUDE,temp_full$change_axis2) # abline(lm(temp_full$change_axis2~temp_full$LATITUDE),col="red") # plot(temp_full$LATITUDE,temp_full$change_axis4) # abline(lm(temp_full$change_axis4~temp_full$LATITUDE),col="red") # # head(temp) # # db_current$LATITUDE # temp$LATITUDE # plot(temp$LATITUDE,temp$y) # plot(temp$Temperature_Seasonality,temp$y) # # db<-read.csv("cities_rcp85_2050.csv",sep=";") # db[1,] # #