# Figure 5 for cloud forest paper
library(raster)
INPUT <-"C:/bio/Bio_Backup/TIN R Skripte/GIT/cloudforests/data/"
namematching<-read.csv("Z:/karger/revision1/cf_namematching.csv")

insertLayer <- function(P, after=0, ...) {
  #  P     : Plot object
  # after  : Position where to insert new layers, relative to existing layers
  #  ...   : additional layers, separated by commas (,) instead of plus sign (+)
  
  if (after < 0)
    after <- after + length(P$layers)
  
  if (!length(P$layers))
    P$layers <- list(...)
  else 
    P$layers <- append(P$layers, list(...), after)
  
  return(P)
}

df<-read.csv("C:/bio/Bio_Backup/TIN R Skripte/GIT/cloudforests/output/figure5.csv",sep=";")
df2<-shapefile("C:/bio/Bio_Backup/TIN R Skripte/GIT/cloudforests/data/cf_regions_countries_R2.shp")
dfxx<-df2[!is.na(df2$tcf_ensembl)&!is.na(df2$tcf_ensembl.2),]
write.table(dfxx,"C:/bio/Bio_Backup/TIN R Skripte/GIT/cloudforests/output/Table_S3.csv",sep=",")

df2<-as.data.frame(df2)
df2<-df2[,-1]
colnames(df2)[length(df2[1,])]<-"ID"

#df3[,3:6]<-df3[,3:6]/10000
tc <- read.csv (paste0("C:/bio/Bio_Backup/TIN R Skripte/GIT/cloudforests/data/cf_statistics_newid.txt"),
                   header=T,sep="\t")
tc <- tc[,1:2]

full <- read.csv (paste0(INPUT,"vertsferns_by_cfID_speclist_101518_newid.csv"),sep=";")

# do some data quentching on the input files
{
  CFRegCount_per_spec <- ddply(full, .(taxogroup,scientificname,cf_ass,cf_end), 
                               summarise, cfIDCount = length(na.omit(cf_id)))
  CFRegCountIsOne <- subset(CFRegCount_per_spec, cfIDCount ==1)
  
  CFSingleRegEndemicsInfo <- merge(CFRegCountIsOne, subset(full,select = c("scientificname","cf_id",
                                   "CFRegionName","CFRegionContinent")),
                                   by = "scientificname", all.x= TRUE, all.y = FALSE)
  
  agg.cfEndemics <- ddply(CFSingleRegEndemicsInfo, .(cf_id, CFRegionName, CFRegionContinent, taxogroup), summarise,
                          EndSR.cf.assoc = sum(cf_ass),
                          EndSR.cf.restr = sum(cf_end))
  
  agg.cfEndemics <- agg.cfEndemics[order(-agg.cfEndemics$EndSR.cf.restr),]
  
  biodiv     <- ddply(full, .(cf_id, CFRegionName, CFRegionContinent, taxogroup), summarise,
                      cf_ass = sum(cf_ass),
                      cf_end = sum(cf_end))
  
  ends<-CFSingleRegEndemicsInfo
  
  full  <-full[,-8]
  #Rends <- aggregate(full$cf_id~full$scientificname,FUN=function(x){length(x)})
  #Rends <- Rends[Rends$`full$cf_id`==1,]
  #ends <- full[full$scientificname %in% Rends$`full$scientificname`,]
  
  cff<-full[,1:3]
  cff<-cff[duplicated(cff)==FALSE,]
  
  cord<-as.data.frame(pp$ID)
  cord$x<-coordinates(pp)[,1]
  cord$y<-coordinates(pp)[,2]
  colnames(cord)<-c("cf_id","x","y")
  biodiv<-merge(biodiv,cord,by.x="cf_id",by.y="cf_id")
}

cf_end<-ends[ends$cf_end==1&ends$cfIDCount==1,]
cf_end<-aggregate(x=cf_end[,4],by=list(cf_end$cf_id,cf_end$CFRegionName),FUN=function(x){sum(na.omit(x))})
cf_end$Group.1<-gsub(" ","_",cf_end$Group.1)
#cf_end<-merge(cf_end,tc,by.x="Group.1","Name")
colnames(cf_end)<-c("ID_org","Name","cf_sr_end")
cf_end<-merge(cf_end,namematching,by.x="ID_org",by.y="ID_org")

df2 <- merge(df2,cf_end,by.x="ID","ID_new",all.x=TRUE)
df3 <- aggregate(x=df2[,c(14:17)],by=list(df2$ISO3,df2$ID,df2$cf_sr_end,df2$ID_org),FUN=function(x){sum(na.omit(x))})
colnames(df3) <- c("ISO3","ID","cf_sr_end","ID_org","tcf_2001_pr","tcf_2018_pr","tcf_2001_mn","tcf_2018_mn")

df4 <- aggregate(x=df2[,c(20)],by=list(df2$ISO3,df2$ID,df2$cf_sr_end,df2$ID_org),FUN=function(x){unique(na.omit(x))})
df3$cf_rs_end <- df4$x

df5 <- aggregate(x=df2[,c(14:17)],by=list(df2$ID),FUN=function(x){sum(na.omit(x))})
df3 <- merge(df3,df5,by.x="ID",by.y="Group.1",all.x=T)


colnames(df3)<-c("ID","ISO3","cf_sr_end","ID_org","tcf_2001_pr","tcf_2018_pr","tcf_2001_mn","tcf_2018_mn","cf_rs_end2",
                 "tcf_region2001_pr","tcf_region2018_pr","tcf_region2001_mn","tcf_region2018_mn")

df3$cf_change_perc_sum_unpr_2001_16<-(100-(100*df3$tcf_2018_mn/df3$tcf_2001_mn))*(-1)
df3$CntryStew_All_cf_sr_end<-df3$cf_sr_end*df3$tcf_2001_mn/df3$tcf_region2001_mn

d1 <- aggregate(x=df3[,c(15)],by=list(df3$ISO3),FUN=function(x){sum(na.omit(x))})
d2 <- aggregate(x=df3[,c(7)],by=list(df3$ISO3),FUN=function(x){sum(na.omit(x))})
d3 <- aggregate(x=df3[,c(14)],by=list(df3$ISO3),FUN=function(x){mean(na.omit(x))})

d4 <- d1
d4$tcf_2001_mn <- d2[,2]
d4$cf_change_perc_sum_unpr_2001_16 <- d3[,2]

colnames(d4) <- c("ISO3","CntryStew_All_cf_sr_end","tcf_2001_mn","cf_change_perc_sum_unpr_2001_16")
d4$cf_change_perc_sum_unpr_2001_16[d4$cf_change_perc_sum_unpr_2001_16=="NaN"] <- NA
d4 <- d4[complete.cases(d4),]
d4$tcf_2001_mn <- d4$tcf_2001_mn/10000

df <- d4
df$cf_change_perc_sum_unpr_2001_16 <- df$cf_change_perc_sum_unpr_2001_16*(-1)
df$cf_change_perc_sum_unpr_2001_16 <- df$cf_change_perc_sum_unpr_2001_16+1
attach(df)
library(ggrepel)
library(ggplot2)

addconst <- 1
col_Af <- rgb(27/255,158/255,119/255)
col_Am <- rgb(217/255,95/255,2/255)
col_As <- rgb(0,0,0)

maxx <- max(na.omit(df$cf_change_perc_sum_unpr_2001_16+addconst))
maxy <- max(na.omit(df$CntryStew_All_cf_sr_end+addconst))
# transform the variables
df$CntryStew_All_cf_sr_end <- log(df$CntryStew_All_cf_sr_end+addconst)
df$cf_change_perc_sum_unpr_2001_16 <- log(df$cf_change_perc_sum_unpr_2001_16)


# create the background
library(raster)
perc_hab_los <- raster(ncol=600, nrow=600, xmn=0, xmx=log(maxx), ymn=0, ymx=log(maxy+50))
tcf_reg_end  <- raster(ncol=600, nrow=600, xmn=0, xmx=log(maxx), ymn=0, ymx=log(maxy+50))

# build the perc_hab_loss
xy <- coordinates(perc_hab_los)
val <- seq(0,log(maxx),by=(log(maxx)/length(xy[,1])))[1:length(xy[,1])]
xy <- xy[order(xy[,1]),]
xy <- cbind(xy,val)
xy <- as.data.frame(xy)  
coordinates(xy) <- ~x+y
perc_hab_loss_r<-rasterize(xy,perc_hab_los)
plot(perc_hab_loss_r)
rm(xy)


# build the perc_hab_loss
xy <- coordinates(tcf_reg_end)
val <- seq(0,log(maxy),by=(log(maxy)/length(xy[,1])))[1:length(xy[,1])]
xy <- xy[order(xy[,2]),]
xy <- cbind(xy,val)
xy <- as.data.frame(xy)  
coordinates(xy) <- ~x+y
tcf_reg_end_r <- rasterize(xy,tcf_reg_end)
plot(tcf_reg_end_r)

# create the background
fun1 <- function(x){
  S1 <- exp(x[1])
  A <- exp(x[2])
  z <- 0.5
  S2 <- S1*(1-(((100-A)/100)^z))
  S2*(-1)
}

# create the background
fun2 <- function(x,z,A){
  S1 = x
  z = z
  S2 <- S1*(1-(((100-A)/100)^z))
  S2*(-1)
}

library(RColorBrewer)
library(spatstat)
library(maptools)

# backtransform
btran <- function(S2,z,A){
S1 = (S2 * 100^z) / (100^z-((100-A)^z)) 
S1
}

# if we want to calculate the losses for e.g. 3 species at 10% loss of another z value we need to backtransform
# eg. set the z here:
#fun2(btran(3,0.5,10),z,10)


st1 <- stack(tcf_reg_end_r[[2]],perc_hab_loss_r[[2]])
r1 <- calc(st1,fun=fun1)
r1[values(r1)<=(-1.51)] <- NA
r1[values(r1)>=(-0.005083737)] <- (0)

plot(r1)

image(r1)
points(df$cf_change_perc_sum_unpr_2001_16,df$CntryStew_All_cf_sr_end)

r1_df <- cbind(coordinates(r1),as.data.frame(r1))
r1_df$x <- log(r1_df$x)
coordinates(r1_df) <- ~x+y

df_sp <- df
df_sp <- df_sp[complete.cases(df_sp),]
coordinates(df_sp) <- ~cf_change_perc_sum_unpr_2001_16+CntryStew_All_cf_sr_end



ylab_loc <- c(log(1),log(2),log(3),log(6),log(11),log(101))
xlab_loc <- c(log(0.1),log(0.33),log(1),log(2.5),log(5),log(10),log(15),log(35))

ylab_vect <- c(exp(log(1))-1,exp(log(2))-1,exp(log(3))-1,exp(log(6))-1,exp(log(11))-1,exp(log(101))-1)
xlab_vect <- c(paste0(exp(log(0.1)),"%"),paste0(exp(log(0.33)),"%"),paste0(exp(log(1)),"%"),
                paste0(exp(log(2.5)),"%"),paste0(exp(log(5)),"%"),
                paste0(exp(log(10)),"%"),paste0(exp(log(15)),"%"),paste0(exp(log(35)),"%"))

#df$size1 <- df$Sum_of_total_cf_area_2001
df$size1 <- df$tcf_2001_mn
attach(df)
colvect <- df$cf_change_perc_sum_unpr_2001_16
colvect <- as.data.frame(colvect)
colvect$end <- df$CntryStew_All_cf_sr_end
colnames(colvect) <- c("x","y")
cfun <- function(m)
{
  x <- m[1]
  y <- m[2]
    c="black"
    if(y>=log(10)&&x>=log(5)|y>=log(10))
    {
      c="white"
    }
  c
}

cv1 <- apply(colvect[,c('x','y')],1,FUN=fun1)
cv <- cv1
cv[cv1<=(-0.25)] <- "white"
cv[cv1>(-0.25)] <- "black"

colfunc <- colorRampPalette(c("white", "grey", "black"))
ccv1 <- colfunc(length(cv1))[as.numeric(cut(cv1,breaks = length(cv1)-1))]

df$CntryStew_All_cf_sr_end[is.na(df$CntryStew_All_cf_sr_end)]<-0

pdf("C:/bio/Bio_Backup/TIN R Skripte/GIT/cloudforests/output/figure4_R2.pdf",height=7, width=8)
  p <- ggplot() +
    geom_raster(data = as.data.frame(r1, xy = TRUE), aes(x, y,fill=layer))+  
    scale_fill_viridis_c(option="magma",na.value="white",breaks=c(-1.5,-1.25,-1,-0.75,-0.5,-0.25, 0),labels=c("  3      1.5      0.3 ",
                                                                                                              "2.5    1.25    0.25",
                                                                                                              "  2       1        0.2 ",
                                                                                                              "1.5    0.75    0.15",
                                                                                                              "  1      0.5      0.1 ",
                                                                                                              "0.5    0.25    0.05",
                                                                                                              "  0       0         0"),
                        values=scales::rescale(c(-3,-1,-0.5,-0.1,0),c(0,1))) + 
    geom_contour(data = as.data.frame(r1, xy = TRUE),aes(x, y,z = layer), color = "grey75",binwidth = 0.5) + 
    geom_point(data = df, aes(x=cf_change_perc_sum_unpr_2001_16,y=CntryStew_All_cf_sr_end,size = size1), alpha = 0.5,colour=ccv1) +
    scale_size(range = c(0, 25),breaks=c(1000,5000,10000,50000,100000),labels = c("1,000", "5,000","10,000","50,000","100.000"))+
    geom_text_repel(data = df, aes(x=cf_change_perc_sum_unpr_2001_16,y=CntryStew_All_cf_sr_end,label = ISO3), colour=cv,size = 4)+
    guides(size= guide_legend(title=expression(paste("2001 TCF area (",km^2,")"),sep=""),override.aes = list(fill=NA)), fill = guide_colourbar(title = "Expected\nspecies loss\nz =    1     0.5     0.1"))+

    scale_x_continuous(name="TCF loss",breaks=xlab_loc,labels=as.character(xlab_vect), expand = c(0, 0),limits=c(0,log(maxx)))+
    scale_y_continuous(name="Number of TCF endemics",breaks=ylab_loc, expand = c(0, 0),labels=as.character(ylab_vect),limits=c(0,log(maxy+50)))+
    theme(axis.text.x = element_text(size=14),axis.text.y = element_text(size=14,angle=0),
          panel.grid.minor = element_blank(),
          panel.grid.major = element_blank(),
          panel.background = element_blank(),
          axis.title.x = element_text(face="bold", size=14),
          axis.title.y = element_text(face="bold", size=14),
          axis.line = element_line(colour = "black"),
          legend.key= element_blank(),
          legend.text=element_text(size=10))
  p

dev.off()

c(paste0(" ",as.character((-1)*round(fun2(btran(1.5,0.5,10),1,10),2)),"|","  1.50","|"," ",as.character((-1)*round(fun2(btran(1.5,0.5,10),0.1,10),2))),
  paste0(" ",as.character((-1)*round(fun2(btran(1.25,0.5,10),1,10),2)),"|","  1.25","|"," ",as.character((-1)*round(fun2(btran(1.25,0.5,10),0.1,10),2))),
  paste0(" ",as.character((-1)*round(fun2(btran(1,0.5,10),1,10),2)),"|","  1.00","|"," ",as.character((-1)*round(fun2(btran(1,0.5,10),0.1,10),2))),
  paste0(" ",as.character((-1)*round(fun2(btran(0.75,0.5,10),1,10),2)),"|","  0.75","|"," ",as.character((-1)*round(fun2(btran(0.75,0.5,10),0.1,10),2))),
  paste0(" ",as.character((-1)*round(fun2(btran(0.5,0.5,10),1,10),2)),"|","  0.50","|"," ",as.character((-1)*round(fun2(btran(0.5,0.5,10),0.1,10),2))),
  paste0(" ",as.character((-1)*round(fun2(btran(0.25,0.5,10),1,10),2)),"|","  0.25","|"," ",as.character((-1)*round(fun2(btran(0.25,0.5,10),0.1,10),2))),
  paste0("      0","|","      0 ","|","      0"))









