### stratified sampling (matching)


library(raster)
library(dplyr)
set.seed(1980)
# read in the data
tcf_change <- raster("/mnt/lud11/karger/cloudforest_loss/tcf_loss_v16.tif")
strata     <- raster("/mnt/lud11/karger/cloudforest_loss/strata1.tif")
cf_regions <- shapefile("/mnt/lud11/karger/revision1/cloud_forest_regions_reshaped [ID].shp")
pa_stat_all<- shapefile("/mnt/lud11/karger/revision1/Intersect [cloud_forest_regions_reshaped [ID]]-[Intersect_cfRegions_IUCN_cf [ID]].shp")

st1<-stack(tcf_change,strata)

dd2<-c(NA,NA,NA,NA,NA)
for(n in unique(pa_stat_all$ID))
{
  try(pa_sel     <- pa_stat_all[pa_stat_all$ID==as.character(n),])
  try(region_sel <- cf_regions[cf_regions$ID==as.character(n),])
  
  try(cf_crop<-crop(st1,region_sel))
  try(pa_ras <-rasterize(pa_sel,cf_crop))
  try(pa_ras[values(pa_ras)>=0]<-1)
  try(cf_crop<-stack(cf_crop,pa_ras))
  
  try(e1<-extract(cf_crop,region_sel))
  try(e1<-as.data.frame(e1))
  
  try(e1<-e1[!is.na(e1$tcf_loss),])
  try(e1$layer[is.na(e1$layer)]<-0)
  try(e1<-e1[complete.cases(e1),])
  try(prot<-e1[e1$layer==1,])
  try(unpr<-e1[e1$layer==0,])
  
  if(length(prot[,1])<=length(unpr[,1]))
  {
    pr1<-prot
    if(length(pr1[,1])>=20000)
    {
      pr1<-pr1[sample(nrow(pr1)),20000]
    }
    try(s1<-unpr[sample(nrow(unpr), length(pr1[,1])), ])
    try(dd1<-c(NA,NA,NA,NA,NA))
    for (m in unique(s1$strata1))
    {
      try(sx<-s1[s1$strata1==m,])
      try(d1<-merge(sx,pr1,by="strata1"))
      try(d1$ID<-n)
      try(dd1<-rbind(dd1,d1))
    }
  }
  
  if(length(prot[,1])>length(unpr[,1]))
  {
    un1<-unpr
    if(length(un1[,1])>=20000)
    {
      un1<-un1[sample(nrow(un1)),20000]
    }
    try(s1<-prot[sample(nrow(prot), length(un1[,1])), ])
    try(dd1<-c(NA,NA,NA,NA,NA))
    for (m in unique(s1$strata1))
    {
      try(sx<-s1[s1$strata1==m,])
      try(d1<-merge(sx,un1,by="strata1"))
      try(d1$ID<-n)
      try(dd1<-rbind(dd1,d1))
    }
  }
  try(dd2<-rbind(dd2,dd1))
}
write.table(dd2,"/mnt/lud11/karger/revision1/cf_matching.txt")

### done sampling

dd2<-read.table("/mnt/lud11/karger/revision1/cf_matching.txt",header=TRUE)

dd3<-dd2[complete.cases(dd2),]
colnames(dd3)<-c("strata","tcf_loss_1","layer1","tcf_loss_2","layer2","ID")


dd4<-dd3[sample(nrow(dd3), 1500000), ]
ns<-table(unlist(dd4$strata))

#pdf("/mnt/lud11/karger/revision1/cf_matching.pdf",height=8,width=6)
par(mfrow=c(1,5), mar=c(3,3,1,1))
for(n in 2:6)
{
ddf<-dd4[dd4$strata==n&dd4$layer1==0,]
ddf2<-dd4[dd4$strata==n&dd4$layer1==1,]
ddf3<-ddf2
ddf3$tcf_loss_1<-ddf2$tcf_loss_2
ddf3$tcf_loss_2<-ddf2$tcf_loss_1
ddf4<-rbind(ddf,ddf3)
ddf4[ddf4$tcf_loss_1>=0,]<-0
ddf4[ddf4$tcf_loss_2>=0,]<-0
if(n==2)
{
boxplot(ddf4$tcf_loss_1/10,ddf4$tcf_loss_2/10,xlab=c(""),ylim=c(-3, 0.1),main=n,col=c("dodgerblue","goldenrod1"),
        outline=FALSE,names=c("unprot.","protect."),axes=T,las=1)
}else{
  boxplot(ddf4$tcf_loss_1/10,ddf4$tcf_loss_2/10,xlab=c(""),ylim=c(-3, 0.1),main=n,col=c("dodgerblue","goldenrod1"),
          outline=FALSE,names=c("unprot.","protect."),axes=FALSE) 
}
  }
#dev.off()


dd3<-dd2[complete.cases(dd2),]
colnames(dd3)<-c("strata","tcf_loss_1","layer1","tcf_loss_2","layer2","ID")


dd4<- dd3[sample(nrow(dd3), 250000), ]


dfn1<-dd4[,c(1,2,3,6)]
dfn2<-dd4[,c(1,4,5,6)]
colnames(dfn1)<-c("strata","tcf_loss","layer","ID")
colnames(dfn2)<-c("strata","tcf_loss","layer","ID")
dfnx<-rbind(dfn1,dfn2)
dfnx<-as.data.frame(dfnx)
dfnx$layer<-as.factor(dfnx$layer)
dfnx$stratalayer<-paste0(as.character(dfnx$strata),as.character(dfnx$layer))



dfn1<-dd4[,c(1,2,3,6)]
dfn2<-dd4[,c(1,4,5,6)]
colnames(dfn1)<-c("strata","tcf_loss","layer","ID")
colnames(dfn2)<-c("strata","tcf_loss","layer","ID")
dfnx<-rbind(dfn1,dfn2)
dfnx<-as.data.frame(dfnx)
dfnx$layer<-as.factor(dfnx$layer)
cols<-rep(c("goldenrod1","dodgerblue1"),5)
dfnx$stratalayer<-paste0(as.character(dfnx$strata),as.character(dfnx$layer))
dfnx<-dfnx[!dfnx$strata>=9999,]
#dfnx[dfnx$tcf_loss>0,2]<-0
c1<-c()
for (n in 2:6)
{
dftest<-dfnx[dfnx$stratalayer==paste0(n,"0")|dfnx$stratalayer==paste0(n,"1"),]
dftest$stratalayer<-as.factor(dftest$stratalayer)
res1<-wilcox.test(dftest$tcf_loss~dftest$stratalayer,exact=T)#"
c1<-c(c1,length(dftest[,1]))
print(res1)
}
c1<-c1/2

library(shape)



gm_mean = function(x, na.rm=TRUE){
  exp(sum(log(x[x > 0]), na.rm=na.rm) / length(x))
}


pdf("/mnt/lud11/karger/cloudforest_loss/fig6_R2.pdf",height=7,width = 7)
{
boxplot(dfnx$tcf_loss/100~dfnx$stratalayer,col=cols,las=1,outline=F,axes=FALSE,ylab="TCF loss [%]", xlab="strata")
par(xpd=T)
axis(2, at=0:5, labels=seq(0,5,1),las=2)
axis(1, at=1:10, labels=c("1-un.","1-pr.","2-un.","2-pr.","3-un.","3-pr.","4-un.","4-pr.","5-un.","5-pr."),las=2)
Arrows(x0=1,y0=4.9,x1=10,y1=4.9,arr.type="triangle",col="grey50")
text(x=5,y=5,"Accessibility")
xx<-seq(1,10,2)
for (n in 1:5)
{
  text(x=xx[n]+0.5,y=4.5,paste0("n=",c1[n]))
}
par(xpd=NA)
}
dev.off()

dfnx$stratalayer<-as.factor(dfnx$stratalayer)
tcf_means<- aggregate(dfnx$tcf_loss,by=list(dfnx$stratalayer),FUN=function(x){mean(x)})
tcf_sds  <- aggregate(dfnx$tcf_loss,by=list(dfnx$stratalayer),FUN=function(x){sd(na.omit(x))})

plot(tcf_means$Group.1, tcf_means$x,
     ylim=range(c(tcf_means$x-tcf_sds$x, tcf_means$x+tcf_sds$x)),
     pch=19, xlab="Measurements", ylab="Mean +/- SD",
     main="Scatter plot with std.dev error bars"
)
n=length(tcf_sds[,1])
x=1:n
# hack: we draw arrows but with very special "arrowheads"

library(simpleboot)

library(stats4)

function (eta) 
  .Call(C_logit_linkinv, eta)

fam <- family(glm1)
ilink <- fam$linkinv
quasibinomial()$linkinv

means<-c()
upper_ci<-c()
lower_ci<-c()
nn<-c()
for (n in 1:length(unique(dfnx$stratalayer)))
{
  df1<-dfnx[dfnx$stratalayer==unique(dfnx$stratalayer)[n],]
  df1$tcf_loss<-df1$tcf_loss/10000
  nn<-c(nn,unique(dfnx$stratalayer)[n])
  glm1<-glm(df1$tcf_loss~1,family=quasibinomial(link = logit))
  means<-c(means,boot::inv.logit(coefficients(glm1))[1]) 
  ## grad the inverse link function
  ilink <- family(glm1)$linkinv
  ## add fit and se.fit on the **link** scale
  ndata <- bind_cols(df1, setNames(as_tibble(predict(glm1, df1, se.fit = TRUE)[1:2]),
                                   c('fit_link','se_link')))
  ndata <- mutate(ndata,
                  fit_resp  = ilink(fit_link),
                  right_upr = ilink(fit_link + (2 * se_link)),
                  right_lwr = ilink(fit_link - (2 * se_link)))
  upper_ci<-c(upper_ci,max(ndata$right_upr))
  lower_ci<-c(lower_ci,min(ndata$right_lwr))
}
dfx1<-cbind(as.data.frame(means),as.data.frame(upper_ci),as.data.frame(lower_ci),as.data.frame(nn))
dfx1<-dfx1[order(dfx1$nn),]
dfx1$nn2<-c(1.25,1.75,3.25,3.75,5.25,5.75,7.25,7.75,9.25,9.75)


pdf("/mnt/lud11/karger/cloudforest_loss/fig6_R2.pdf",height=7,width = 7)
par( yaxs="i")
plot(dfx1$nn2, dfx1$means,
     ylim=range(c(dfx1$means-dfx1$lower_ci, dfx1$means+dfx1$upper_ci)),
     pch=15, xlab="Accessibility", ylab=expression(paste0("TCF loss per 1km"^2," pixel [%]")),
     main="",
     col=rep(c("goldenrod1","dodgerblue"),5),
     axes=F,
     cex=2,
     cex.lab=1.25
)
ymax=0.05
axis(side=2, at=seq(0,ymax,ymax/5), labels = seq(0,ymax,ymax/5),las=2,cex.axis=1.125)
axis(side=1, at=c(1.5,3.5,5.5,7.5,9.5), labels = rev(seq(1,5,1)),cex.axis=1.125)

#box()
arrows(dfx1$nn2, dfx1$means-dfx1$lower_ci, dfx1$nn2, dfx1$means+dfx1$upper_ci, length=0.05, angle=90, code=3,col = rep(c("goldenrod1","dodgerblue"),5),lwd=1.5)
#points(dfx1$nn, dfx1$means,type="l",col="black")
for (n in 1:5)
{
  text(x=xx[n]+0.5,y=0.0475,paste0("n=",c1[n]))
}
for (n in 2:5)
{
  text(x=xx[n]+0.5,y=0.05,paste0("*"),cex=2)
}
dev.off()



dfnx_pr<-dfnx[dfnx$layer==0,]
dfnx_un<-dfnx[dfnx$layer==1,]
dfnx_pr$tcf_loss<-dfnx_pr$tcf_loss/10000
dfnx_un$tcf_loss<-dfnx_un$tcf_loss/10000
glm_pr<-glm(tcf_loss~strata,family = quasibinomial(link = logit),data=dfnx_pr)
glm_un<-glm(tcf_loss~strata,family = quasibinomial(link = logit),data=dfnx_un)

pre1<-seq(1,5,1)
pre1<-as.data.frame(pre1)
colnames(pre1)<-c("strata")
pred1<-predict(glm_pr,pre1,type="response")
pred2<-predict(glm_un,pre1,type="response")
#points(seq(1.5,10.5,2),pred1,col="dodgerblue",lwd=2,type="l")
#points(seq(1.5,10.5,2),pred2,col="goldenrod1",lwd=2,type="l")







betareg1<-glm(dfx1$means~dfx1$nn,family=quasibinomial(link = logit))
points(predict(betareg1,dfx1,type="response"),dfx1$nn,type="l")

# Having fun with mixed models
df_pr<-dfnx[dfnx$layer==1,]
df_un<-dfnx[dfnx$layer==0,]

df_pr<-df_pr[order(df_pr$ID),]
df_un<-df_un[order(df_un$ID),]

df_a <-cbind(df_pr[,c(1:2,4)] , df_un[,2])

colnames(df_a)<-c("strata", "tcf_loss_pr", "ID", "tcf_loss_un")
df_a<-as.data.frame(df_a)
df_a$delta_loss<-df_a$tcf_loss_pr/100-df_a$tcf_loss_un/100
df_a<-df_a[order(df_a$strata,df_a$ID),]
pairs<-c()

library(splitstackshape)
ids<-getanID(df_a, 'ID')[]
ids<-ids[ids$delta_loss!=0,]



library(lme4)
ids$strata<-as.factor(ids$strata)
ids$ID<-as.factor(ids$ID)
model1 <- lmer(delta_loss ~ strata + (1|ID) ,data = ids)
print(summary(model1), corr = FALSE)
confint(model1, 1:3, oldNames=FALSE)

model2 <- lmer(delta_loss ~ 1 + (1|ID) ,data = ids)
print(summary(model1), corr = FALSE)
confint(model1, 1:3, oldNames=FALSE)

anova(model1,model2)

ylim=range(c(dfx1$means-dfx1$lower_ci, dfx1$means+dfx1$upper_ci))


dfx1$means<-dfx1$means*100
dfx1$upper_ci<-dfx1$upper_ci*100
dfx1$lower_ci<-dfx1$lower_ci*100


pdf("/mnt/lud11/karger/cloudforest_loss/fig6_R2.pdf",height=9,width = 9)
{
a<-0.125
dfx1$nn2<-c(1-a,1+a,2-a,2+a,3-a,3+a,4-a,4+a,5-a,5+a)

plot(dfx1$nn2, log(dfx1$means+1),
  pch=15, xlab="Inaccessibility [1=low - 5=high]", ylab="TCF loss [%]",
  main="",
  col=rep(c("goldenrod1","dodgerblue"),5),
  axes=F,
  cex=2,
  cex.lab=1.25,
  ylim=c(0,log(100+1))
)
ymax=4
base=3
axis(side=2, at=c(log(0+1),log(0.5+1),log(1+1),log(2+1),log(4+1),log(10+1),log(30+1),log(100+1)),
     labels = c(0,0.5,1,2,5,10,30,100),las=2,cex.axis=1.5)
axis(side=1, at=seq(1,5,1), labels = seq(1,5,1),cex.axis=1.5)
par(xpd=NA)
vioplot(log(dfnx[dfnx$layer==1,]$tcf_loss/100+1)~dfnx[dfnx$layer==1,]$strata,ylim=c(0,10),
        col=rep(c("slategray2"),5),side="right",add=T,border=F,plotCentre = "line",
        pchMed = 0, colMed = NA, colMed2 = NA, rectCol= NA, lineCol=NA,axes=F,areaEqual=T,names="")
par(xpd=T)
vioplot(log(dfnx[dfnx$layer==0,]$tcf_loss/100+1)~dfnx[dfnx$layer==0,]$strata,ylim=c(0,10),
        col=rep(c("gold"),5),side="left",add=T,border=F,plotCentre = "line",
        pchMed = 0, colMed = NA, colMed2 = NA, rectCol= NA, lineCol=NA,axes=F,areaEqual=T,names="")

points(dfx1$nn2, log(dfx1$means+1),
     pch=15,ylim=c(0,10), 
     col=rep(c("black"),10),cex=2)
arrows(dfx1$nn2, log(dfx1$means-dfx1$lower_ci+1), dfx1$nn2,
       log(dfx1$means+dfx1$upper_ci+1), length=0.05, angle=90, code=3,col = rep(c("black"),10),lwd=2)
points(dfx1$nn2, log(dfx1$means+1),
       pch=15,ylim=c(0,10), 
       col=rep(c("goldenrod1","slategray2"),5),cex=1.25)
}
for (n in 1:5)
{
  text(x=seq(1,5,1)[n],y=4.5,paste0("n=", format(c1[n],big.mark=",",scientific=FALSE)),cex=1.3)
}
text(x=1,y=4.7,paste0("NS"),cex=1.2)
for (n in 2:5)
{
  text(x=seq(1,5,1)[n],y=4.7,paste0("*"),cex=2.5)
}
dev.off()


# mixed effect model with nested random effects
ids$strata<-as.factor(ids$strata)
ids$ID<-as.factor(ids$ID)

model1 <- lmer(delta_loss ~ 1 + (1|ID/strata) ,data = ids)
print(summary(model1), corr = FALSE)
confint(model1, 1:4, oldNames=FALSE)

lm_pr<-glm(tcf_loss_pr/10000 ~ as.numeric(strata),family = quasibinomial(link = logit),data = ids)

lm_un<-glm(tcf_loss_un/10000 ~ as.numeric(strata),family = quasibinomial(link = logit),data = ids)
