#-------------------------------------------------------------------------------
# Script to run the assessment of Jack Mackerel and look at outputs
#-------------------------------------------------------------------------------

setwd("N:/Projecten/SouthPacific/2011/Assessment2/")

rm(list=ls())
memory.size(4000)

  # Set libraries & source code
library(lattice)
require(PBSadmb)
library(RColorBrewer)
source("R/ADMB2R.r")

  # Define population characteristics
popSettings     <- scan("mod1_Proj.dat",what='numeric', quiet=TRUE,sep="\n",comment.char="#",allowEscapes=T)
popSettingsMods <- scan("Mod_Schedules_ForNiels.txt",what='numeric',quiet=TRUE,sep="\n",comment.char="#",allowEscapes=T)
recrYrs         <- 5

ages            <- 2:12
natmort         <- na.omit(an(unlist(strsplit(popSettings[13]," "))))
stockwt         <- na.omit(an(unlist(strsplit(popSettings[15]," "))))
mat             <- na.omit(an(unlist(strsplit(popSettings[14]," "))))/2
spwn            <- na.omit(an(popSettings[10]))/12
landwt          <- na.omit(an(unlist(strsplit(popSettings[16]," "))))
fpattern        <- na.omit(an(unlist(strsplit(popSettings[17]," "))))

fpattern        <- matrix(c(c(0.047435075,0.210153162,0.460193999,0.722022158,0.813072429,0.771646581,0.947260551,1,0.928219578,0.928219578,0.928219578),
                            c(0.063793696,0.283687898,0.57459911,0.907039853,1,0.896024784,0.935015955,0.994236322,0.915103449,0.915103449,0.915103449),
                            c(0.046168417,0.208166215,0.458854538,0.732492445,0.848439077,0.806886618,0.947484642,1,0.953838298,0.953838298,0.953838298)),
                          nrow=3,ncol=length(ages),dimnames=list(model=1:3,ages=ages),byrow=T)
N2011           <- matrix(c(c(12488800,4555270,3626240,1026310,398459,215514,290787,166396,   70561,  55213.4,   60371.1),
                            c(15662100,5933790,5588200,1760890,755634,396340,520966,331232,  163681,   136339,  158328),
                            c(8632520, 3152440,2445910,706608, 272997,136430,167424,93548.2,40340.2,  32978.3,  36713.5)),
                          nrow=3,ncol=length(ages),dimnames=list(model=1:3,ages=ages),byrow=T)
recr            <- matrix(c(c(2786050,2423700,3501710,7428160,6043840),
                            c(3440060,3499960,5000230,10419100,7721940),
                            c(2588660,2159060,2891570,5532510,4275660)),
                          nrow=3,ncol=5,dimnames=list(model=1:3,years=2006:2010),byrow=T)
  # Get projection settings
projSettings    <- scan("mod1.prj",what='numeric', quiet=TRUE,sep="\n",comment.char="#",allowEscapes=T)
projYrs         <- an(projSettings[7])
simNum          <- an(projSettings[8])
scnNum          <- 5
ImYCatch        <- an(projSettings[13])

  # Store variables
SSB             <- array(NA,dim=c(1,            projYrs,simNum,scnNum,3),dimnames=list(ages=1,   years=1:projYrs,iter=1:simNum,scenario=1:scnNum,model=1:3))
F               <- array(NA,dim=c(length(ages), projYrs,simNum,scnNum,3),dimnames=list(ages=ages,years=1:projYrs,iter=1:simNum,scenario=1:scnNum,model=1:3))
Fmult           <- array(NA,dim=c(1,            projYrs,simNum,scnNum,3),dimnames=list(ages=1,   years=1:projYrs,iter=1:simNum,scenario=1:scnNum,model=1:3))
yield           <- array(NA,dim=c(length(ages), projYrs,simNum,scnNum,3),dimnames=list(ages=ages,years=1:projYrs,iter=1:simNum,scenario=1:scnNum,model=1:3))
N               <- array(NA,dim=c(length(ages), projYrs,simNum,scnNum,3),dimnames=list(ages=ages,years=1:projYrs,iter=1:simNum,scenario=1:scnNum,model=1:3))

  # Random structures
for(iMod in 1:3){
  meanR         <- mean(recr[iMod,])
  HmeanR        <- 1 / mean( 1 / recr[iMod,])
  gamm            <- meanR / HmeanR
  gi_beta         <- meanR
  delta           <- 1 / (gamm - 1)
  cvrec           <- sqrt(1 / delta)
  psi             <- rnorm(projYrs*simNum*scnNum,0,1)^2
  omega           <- gi_beta * (1 + (psi -sqrt(4 * delta * psi + psi^2)) / (2 * delta))
  zeta            <- gi_beta * (1 + (psi +sqrt(4 * delta * psi + psi^2)) / (2 * delta))
  gtheta          <- gi_beta / (gi_beta + omega)

    runifs        <- runif(projYrs*simNum*scnNum,0,1)
  N[1,,,,iMod][which(runifs <= gtheta)]     <- omega[which(runifs <= gtheta)]
  N[1,,,,iMod][which(runifs >  gtheta)]     <- zeta[which(runifs >  gtheta)]
}
for(iMod in 1:3) N[,1,,,iMod]               <- rep(N2011[iMod,],simNum*scnNum)

  # Functions needed for projection calculation
calcCatch   <-  function(x,f,m,n,fwt,tac){
                  catch <- sum(f*x / (f*x + m) * n * (1 - exp(-(f*x+m))) *fwt)
                return(sqrt((tac-catch)^2))}

# Simulate projections
for(iYr in 1:(projYrs-1)){
  for(iScn in 1:scnNum){
    if(iScn == 1) target <- 520000
    if(iScn == 2) target <- 390000
    if(iScn == 3) target <- 260000
    if(iScn == 4) target <- 130000
    if(iScn == 5) target <-   5000
    if(iYr == 1)  target <-         ImYCatch
    for(iTer in 1:simNum){
      for(iMod in 1:3){
        Fmult[,iYr,iTer,iScn,iMod] <- optim(1,fn=calcCatch,lower=0,upper=3,method="L-BFGS-B",f=fpattern[iMod,],m=natmort,n=N[,iYr,iTer,iScn,iMod],fwt=landwt,tac=target)$par
      }
    }
  }
  for(iMod in 1:3){
    F[,iYr,,,iMod]              <- outer(fpattern[iMod,],Fmult[,iYr,,,iMod],"*")
  }
  survivors                     <- N[,iYr,,,] * exp(-sweep(F[,iYr,,,],1,natmort,"+"))
  N[2:length(ages),iYr+1,,,]    <- survivors[-dim(survivors)[1],,,]
  # Plusgroup
  N[length(ages),iYr+1,,,]      <- N[length(ages),iYr+1,,,] + survivors[dim(survivors)[1],,,]
  SSB[,iYr,,,]                  <- apply(sweep(N[,iYr,,,],1,stockwt * mat,"*") * exp(-sweep(F[,iYr,,,]*spwn,1,natmort*spwn,"+")),2:4,sum)
}
save.image("projections.RData")

SSBmed  <- apply(SSB,  c(2,4:5),median,na.rm=T)
Fmean   <- apply(F,    c(2:5),  mean,na.rm=T)
Fmed    <- apply(Fmean,c(1,3:4),median,na.rm=T)

projRes <- as.data.frame(cbind(year=rep(2011:2024,5*3),F=Fmed,SSB=SSBmed,scenario=rep(rep(1:5,each=14),3),model=rep(1:3,each=14*5)))

#- Figures
  # Legend to figures
  ikey        <- simpleKey(text=c("99%","75%","50%","25%","0%"),
                           points=T,lines=T,columns = 3)
  ikey$points$pch <- c(3,8,15,16,17)
  ikey$points$col <- c("darkblue","red","green","purple","cyan")
  ikey$lines$lwd  <- 2
  ikey$lines$col  <- c("darkblue","red","green","purple","cyan")

Fmedrange <- c(0,0.4)#c(0,range(Fmed,na.rm=T)[2])
xyplot(F~year,data=subset(projRes,year %in% 2011:2021 & model == 1),
       groups=scenario,xlab="Years",ylab="Fishing mortality",main="Model 1",
       type="b",col=c("darkblue","red","green","purple","cyan"),
       pch=c(3,8,15,16,17),
       key=ikey,prepanel=function(...) {list(ylim=c(0,Fmedrange))})
xyplot(F~year,data=subset(projRes,year %in% 2011:2021 & model == 2),
       groups=scenario,xlab="Years",ylab="Fishing mortality",main="Model 2",
       type="b",col=c("darkblue","red","green","purple","cyan"),
       pch=c(3,8,15,16,17),
       key=ikey,prepanel=function(...) {list(ylim=c(0,Fmedrange))})
xyplot(F~year,data=subset(projRes,year %in% 2011:2021 & model == 3),
       groups=scenario,xlab="Years",ylab="Fishing mortality",main="Model 3",
       type="b",col=c("darkblue","red","green","purple","cyan"),
       pch=c(3,8,15,16,17),
       key=ikey,prepanel=function(...) {list(ylim=c(0,Fmedrange))})
savePlot("./Results/Model1_F.png",type="png")

SSBmedrange <- c(0,8000000)#c(0,range(SSBmed,na.rm=T)[2])
xyplot(SSB~year,data=subset(projRes,year %in% 2011:2021 & model == 1),
       groups=scenario,xlab="Years",ylab="Spawning Stock Biomass",main="Model 1",
       type="b",col=c("darkblue","red","green","purple","cyan"),
       pch=c(3,8,15,16,17),
       key=ikey,prepanel=function(...) {list(ylim=c(0,SSBmedrange))})
xyplot(SSB~year,data=subset(projRes,year %in% 2011:2021 & model == 2),
       groups=scenario,xlab="Years",ylab="Spawning Stock Biomass",main="Model 2",
       type="b",col=c("darkblue","red","green","purple","cyan"),
       pch=c(3,8,15,16,17),
       key=ikey,prepanel=function(...) {list(ylim=c(0,SSBmedrange))})
xyplot(SSB~year,data=subset(projRes,year %in% 2011:2021 & model == 3),
       groups=scenario,xlab="Years",ylab="Spawning Stock Biomass",main="Model 3",
       type="b",col=c("darkblue","red","green","purple","cyan"),
       pch=c(3,8,15,16,17),
       key=ikey,prepanel=function(...) {list(ylim=c(0,SSBmedrange))})

savePlot("./Results/Model1_B.png",type="png")


library(readr)
library(dplyr)
mammals <- read_csv("data-raw/mammals.csv")
mammals_sub <- mammals %>%
    mutate(offspring.year = litter_size * litters_inyear) %>%
    mutate(log.oy = log(offspring.year)) %>%
    mutate(log.wm = log(weaning_month)) %>%
    mutate(log.ml = log(max_life_month)) %>%
    mutate(log.AFR = log(AFR_mo)) %>%
    filter(order == 'Artiodactyla' | order == 'Carnivora' | order == 'Cetacea' | order == 'Insectivora' | order == 'Lagomorpha' | order == 'Primates' | order == 'Rodentia' )

devtools::use_data(mammals, mammals_sub, overwrite = TRUE)


# clean
rm(list=ls())

# load libs
library(doParallel)
library(raster)

# open cluster
cl <- makeCluster(35)
registerDoParallel(cl)

# load raster ref
grid_ref <- readRDS("./data/futClimGrid/rasterClim/res1000/rcp85-MIROC_ESM_CHEM-1985-2000.rda")

######### WINDOW 1985-2000

# list files
probs2000_files <- list.files("./data/futStatesGrid/probs",full.names=TRUE,pattern="1985-2000")
# prep stack res
TempGrids2000 <- stack()

foreach(i=1:length(probs2000_files),.packages=c('raster','rgdal'))%do%{

  # read file and compute temperate prob
  probsGrid <- read.csv(probs2000_files[i])
  probsGrid$ProbTemp <- probsGrid$T + probsGrid$M

  # set coordinates from grid_ref
  probsGrid <- cbind(probsGrid,coordinates(grid_ref))

  # Turn df into raster
  df_probsTemp <- probsGrid[,c(8,7,6)]
  coordinates(df_probsTemp) <- ~ x + y
  gridded(df_probsTemp) <- TRUE
  rs_probsTemp <- raster(df_probsTemp)

  TempGrids2000 <- addLayer(TempGrids2000,rs_probsTemp)

}

metadata <- unlist(lapply(strsplit(probs2000_files,"[./-]"),function(x) x[7]))
projection(TempGrids2000) <- projection(grid_ref)
names(TempGrids2000) <- metadata

saveRDS(TempGrids2000,"./res/2000_tempProbSolved.rda")

######### WINDOW 2000-2015

# list files
probs2015_files <- list.files("./data/futStatesGrid/probs",full.names=TRUE,pattern="2000-2015")
# prep stack res
TempGrids2015 <- stack()

foreach(i=1:length(probs2015_files),.packages=c('raster','rgdal'))%do%{

  # read file and compute temperate prob
  probsGrid <- read.csv(probs2015_files[i])
  probsGrid$ProbTemp <- probsGrid$T + probsGrid$M

  # set coordinates from grid_ref
  probsGrid <- cbind(probsGrid,coordinates(grid_ref))

  # Turn df into raster
  df_probsTemp <- probsGrid[,c(8,7,6)]
  coordinates(df_probsTemp) <- ~ x + y
  gridded(df_probsTemp) <- TRUE
  rs_probsTemp <- raster(df_probsTemp)

  TempGrids2015 <- addLayer(TempGrids2015,rs_probsTemp)

}

metadata <- unlist(lapply(strsplit(probs2015_files,"[./-]"),function(x) x[7]))
projection(TempGrids2015) <- projection(grid_ref)
names(TempGrids2015) <- metadata

saveRDS(TempGrids2015,"./res/2015_tempProbSolved.rda")

######### WINDOW 2045-2030

# list files
probs2045_files <- list.files("./data/futStatesGrid/probs",full.names=TRUE,pattern="2030-2045")
# prep stack res
TempGrids2045 <- stack()

foreach(i=1:length(probs2045_files),.packages=c('raster','rgdal'))%do%{

  # read file and compute temperate prob
  probsGrid <- read.csv(probs2045_files[i])
  probsGrid$ProbTemp <- probsGrid$T + probsGrid$M

  # set coordinates from grid_ref
  probsGrid <- cbind(probsGrid,coordinates(grid_ref))

  # Turn df into raster
  df_probsTemp <- probsGrid[,c(8,7,6)]
  coordinates(df_probsTemp) <- ~ x + y
  gridded(df_probsTemp) <- TRUE
  rs_probsTemp <- raster(df_probsTemp)

  TempGrids2045 <- addLayer(TempGrids2045,rs_probsTemp)

}

metadata <- unlist(lapply(strsplit(probs2045_files,"[./-]"),function(x) x[7]))
projection(TempGrids2045) <- projection(grid_ref)
names(TempGrids2045) <- metadata

saveRDS(TempGrids2045,"./res/2045_tempProbSolved.rda")

######### WINDOW 2080-2095

# list files
probs2095_files <- list.files("./data/futStatesGrid/probs",full.names=TRUE,pattern="2080-2095")
# prep stack res
TempGrids2095 <- stack()

foreach(i=1:length(probs2095_files),.packages=c('raster','rgdal'))%do%{

  # read file and compute temperate prob
  probsGrid <- read.csv(probs2095_files[i])
  probsGrid$ProbTemp <- probsGrid$T + probsGrid$M

  # set coordinates from grid_ref
  probsGrid <- cbind(probsGrid,coordinates(grid_ref))

  # Turn df into raster
  df_probsTemp <- probsGrid[,c(8,7,6)]
  coordinates(df_probsTemp) <- ~ x + y
  gridded(df_probsTemp) <- TRUE
  rs_probsTemp <- raster(df_probsTemp)

  TempGrids2095 <- addLayer(TempGrids2095,rs_probsTemp)

}

metadata <- unlist(lapply(strsplit(probs2095_files,"[./-]"),function(x) x[7]))
projection(TempGrids2095) <- projection(grid_ref)
names(TempGrids2095) <- metadata

saveRDS(TempGrids2095,"./res/2095_tempProbSolved.rda")


# 3. faza: Vizualizacija podatkov

#starejši manj izgubljenih žog
izgubljene_36 <- per.36.stats[,c(3, 24)]
izgubljene_36$TOV <- round(izgubljene_36$TOV)

izgubljene_annual <- annual.totals[,c(3, 4, 19)]
izgubljene_annual$TOV <- round(izgubljene_annual$TOV/izgubljene_annual$G)
izgubljene_annual <- izgubljene_annual[,c(1, 3)]

izgubljene_36 <- ddply(izgubljene_36, .(Age, TOV), nrow)
izgubljene_annual <- ddply(izgubljene_annual, .(Age, TOV), nrow)

graf_izgubljene_36 <- ggplot(izgubljene_36 %>% filter(TOV < 20), aes(x = Age, y = TOV, fill=V1, color=V1, size = V1)) +
  geom_point() + ggtitle("Na 36 minut") +
  labs(fill = "Število košarkarjev") +
  scale_color_gradient(low="green", high="purple") +
  scale_fill_gradient(low="green",high="purple") +
  guides(color = FALSE, size = FALSE)

graf_izgubljene_annual <- ggplot(izgubljene_annual, aes(x = Age, y = TOV, color = V1, fill=V1, size = V1)) + geom_point() +
  ggtitle("Na tekmo")+
  scale_color_gradient(low="green", high="purple") +
  scale_fill_gradient(low="green",high="purple") +
  guides(color = FALSE, size = FALSE, fill=FALSE)

graf_izgubljene <- ggarrange(graf_izgubljene_36, graf_izgubljene_annual,
                             nrow = 1, common.legend = TRUE, legend="bottom")

#starejši manj skokov
skoki_36 <- per.36.stats[,c(3, 20)]
skoki_36$TRB <- round(skoki_36$TRB)

skok_annual <- annual.totals[,c(3, 4, 16)]
skok_annual$TRB <- round(skok_annual$TRB/skok_annual$G)
skok_annual <- skok_annual[,c(1, 3)]

skoki_36 <- ddply(skoki_36, .(Age, TRB), nrow)
skok_annual <- ddply(skok_annual, .(Age, TRB), nrow)

graf_skoki_36 <- ggplot(skoki_36 %>% filter(TRB < 30), aes(x=Age, y=TRB)) + geom_point(aes(size = V1,fill=V1 ,color=V1)) +
  ggtitle("Na 36 minut") + labs(fill = "Število košarkarjev") +
  scale_color_gradient(low="green", high="purple") +
  scale_fill_continuous(low="green",high="purple", breaks = c(50, 150, 250)) +
  guides(color = FALSE, size = FALSE)

graf_skoki_annual <- ggplot(skok_annual, aes(x=Age, y=TRB)) + geom_point(aes(size = V1, fill=V1 ,color=V1)) +
  ggtitle("Na tekmo") +
  scale_color_gradient(low="green", high="purple") +
  scale_fill_continuous(low="green",high="purple") +
  guides(color = FALSE, size = FALSE, fill=FALSE)

graf_skoki <- ggarrange(graf_skoki_36, graf_skoki_annual, nrow = 1,
                        common.legend = TRUE, legend="bottom")

#višji igralci več skokov, blokad
graf_visina_skoki <- ggplot(per.36.stats %>% filter(TRB < 30), aes(x = Height, y=TRB)) +
  geom_point() + geom_smooth(method = 'loess', color="green") +
  ggtitle("Skoki")

graf_visina_blokade <- ggplot(per.36.stats %>% filter(BLK < 30) , aes(x = Height, y = BLK)) +
  geom_point() + geom_smooth(method = 'loess', color="green") +
  ggtitle("Blokade")

graf_visina <- ggarrange(graf_visina_skoki, graf_visina_blokade, nrow =1)

#nižji več asistenc
nizji_ast_36 <- aggregate(AST~Height, per.36.stats[,c(28, 21)], mean)

nizji_ast_annual <- annual.totals %>%
  select(AST, Height, G)
nizji_ast_annual_ast <- aggregate(AST~Height, nizji_ast_annual[,c(1, 2)], sum)
nizji_ast_annual_game <- aggregate(G~Height, nizji_ast_annual[,c(2, 3)], sum)
nizji_ast_annual <- left_join(nizji_ast_annual_ast, nizji_ast_annual_game)
nizji_ast_annual$AST <- round(nizji_ast_annual$AST/nizji_ast_annual$G, 2)

graf_nizji_ast_36 <- ggplot(nizji_ast_36, aes(x=Height, y=AST)) +
  geom_line() +
  ggtitle("Na 36 minut")

graf_nizji_ast_annual <- ggplot(nizji_ast_annual, aes(x=Height, y=AST)) +
  geom_line() + ggtitle("Na tekmo")

graf_nizji_ast <- ggarrange(graf_nizji_ast_36, graf_nizji_ast_annual, nrow = 1)

#nižji boljši odtotki prostih metov in metov iz igre
nizji_ft_fg_36 <- per.36.stats[,c(28, 7, 8, 16, 17)]
nizji_ft_fg_annual <- annual.totals[,c(25, 24, 13, 21, 7)]

graf_nizji_ft_36 <- ggplot(nizji_ft_fg_36 %>% filter(FTA >= 2), aes(x=Height, y =FT_procent)) +
  geom_point() + ggtitle("Uspešnost pri FT na 36 min") +
  geom_smooth(color="purple")

graf_nizji_ft_annual <- ggplot(nizji_ft_fg_annual %>% filter(FTA >= 2), aes(x=Height, y =FT_procent)) +
  geom_point() + ggtitle("Uspešnost pri FT na tekmo") +
  geom_smooth(color="purple")

graf_nizji_fg_36 <- ggplot(nizji_ft_fg_36 %>% filter(FGA >= 2), aes(x=Height, y =FG_procent)) +
  geom_point() + ggtitle("Uspešnost pri FG na 36 min") +
  geom_smooth(color="green")

graf_nizji_fg_annual <- ggplot(nizji_ft_fg_annual %>% filter(FGA >= 2), aes(x=Height, y =FG_procent)) +
  geom_point() + ggtitle("Uspešnost pri FG na tekmo") +
  geom_smooth(color="green")

#zemljevid
zemljevid <- map_data("world")
annual.totals$Birth_State <- gsub("District of Columbia", "Maryland", annual.totals$Birth_State)
igralci_drzave <- annual.totals[!duplicated(annual.totals[,c('Player')]),][,c(1, 28)]
drzave <- data.frame(table(igralci_drzave$Birth_State))
vsota_ameriskih <- 0
for (state in drzave$Var1) {
  if (state %in% state.name) {
  vsota_ameriskih <- vsota_ameriskih + drzave$Freq[drzave$Var1 == state]
  }
}

'%ni%' <- Negate('%in%')
USA <- data.frame("USA", vsota_ameriskih)
names(USA) <- c("Var1", "Freq")
drzave <- rbind(drzave, USA)
drzave <- drzave %>% filter(Var1  %ni% state.name)
names(drzave)[1] <- "region"
zemljevid <- full_join(drzave, zemljevid, by= "region")

map_svet <- ggplot(zemljevid, aes(x = long, y = lat, group=group)) +
  geom_polygon(data = zemljevid %>% filter(region != "USA"), aes(fill=Freq)) +
  scale_fill_gradientn(colors=c("blue", "yellow", "green")) +
  geom_polygon(data = zemljevid %>% filter(region == "USA"), fill = "red")+
  theme_void()+ theme(legend.position="bottom") +labs(fill="Število košarkarjev")

#zemljevid - ZDA

amerika_states <- data.frame(table(igralci_drzave$Birth_State)) %>%
  filter(Var1 %in% state.name)
names(amerika_states)[1] <- "region"
amerika_states$region <- tolower(amerika_states$region)
amerika_states <- full_join(amerika_states, map_data("state"), by="region")

zemljevid_zda <- ggplot(amerika_states, aes(x = long, y = lat, group = group))+
  geom_polygon(aes(fill = Freq)) + theme_void() +
  scale_fill_gradientn(colors=c("blue", "yellow", "green")) +
  labs(fill="Število košarkarjev")

#AST TOV ratio
drzave_ast_tov <- annual.totals[c("Birth_State", "TOV", "AST")] %>%
  group_by(Birth_State) %>% summarise_each(funs(sum))
vsota_ast <- 0
vsota_tov <- 0
for (state in drzave_ast_tov$Birth_State) {
  if (state %in% state.name) {
    vsota_ast <- vsota_ast + drzave_ast_tov$AST[drzave_ast_tov$Birth_State == state]
    vsota_tov <- vsota_tov + drzave_ast_tov$TOV[drzave_ast_tov$Birth_State == state]
    }
}

USA_ast_tov <- data.frame("USA", vsota_tov, vsota_ast)
names(USA_ast_tov) <- c("Birth_State", "TOV", "AST")
drzave_ast_tov <- rbind(drzave_ast_tov, USA_ast_tov)
drzave_ast_tov <- drzave_ast_tov %>% filter(Birth_State  %ni% state.name)
names(drzave_ast_tov)[1] <- "region"
drzave_ast_tov$ast_tov <- round(drzave_ast_tov$AST/drzave_ast_tov$TOV, 2)

zemljevid_ast_tov <- full_join(drzave_ast_tov, zemljevid, by="region")

map_ast_tov <- ggplot(zemljevid_ast_tov, aes(x = long, y = lat, group = group))+
  geom_polygon(aes(fill = ast_tov)) + theme_void() +
  scale_fill_gradientn(colors=c("blue", "yellow", "green")) +
  labs(fill ="AST/TOV")


library(tikzDevice)
 library(raster)
library(rgdal)
library(ggplot2)
library(RColorBrewer)
library("grid")
load("../data/clim.R")
#  map<-cru_raster_10min_window$val[,,2]
#  Longitude<<-cru_raster_10min_window$lon
#  Latitude<<-cru_raster_10min_window$lat
# x<-vector()
# y<-vector()
# z<-vector()
# k<-1
#  for(i in 1:length(Longitude)){
# 	 for(j in 1: length(Latitude)){
# 		 z[k]<-map[i,j]
# 		 x[k]<-Longitude[i]
# 		 y[k]<-Latitude[j]
# 		 k<-k+1
# 		 }
# 	 }
# 	map<-data.frame(lon=x,lat=y,val=z)
# 	map<-map[which(!is.na(map$val)),]

# read shapefile
wmap <- readOGR(dsn="ne_110m_land", layer="ne_110m_land")
# convert to dataframe
wmap_df <- fortify(wmap)

# # create a blank ggplot theme
theme_opts <- list(theme(
			panel.grid.minor = element_blank(),
                        panel.grid.major = element_blank(),
                        panel.background = element_rect(color = "black",fill=NA,  size = 0.4, linetype = "solid"),
                        #panel.border=element_rect(color = "black",fill=NA,  size = 0.4, linetype = "solid"),
                        plot.background = element_blank(),
                        #plot.background=element_blank(),
                        #panel.border = element_blank(),
                        axis.line = element_blank(),
                        axis.text.x = element_blank(),
                        axis.text.y = element_blank(),
                        axis.ticks = element_blank(),
                        panel.margin = unit(5,"lines"),
                        #axis.title.x = element_blank(),
                        #axis.title.y = element_blank(),
                        plot.title = element_text()))
#
# # plot map
a<-ggplot(wmap_df, aes(long,lat, group=group)) +   geom_polygon() +   labs(title="World map (longlat)") +
  coord_equal() +   theme_opts

ggsave("map1.png",  width=12.5, height=8.25, dpi=72)

wmap_robin <- spTransform(wmap, CRS("+proj=robin"))
wmap_df_robin <- fortify(wmap_robin)
ggplot(wmap_df_robin, aes(long,lat, group=group)) +
  geom_polygon() +
  labs(title="World map (robinson)") +
  coord_equal() +
  theme_opts

ggsave("map2.png", width=12.5, height=8.25, dpi=72)

ggplot(wmap_df_robin, aes(long,lat, group=group, fill=hole)) +
  geom_polygon() +
  labs(title="World map (robin)") +
  coord_equal() +
  theme_opts
ggsave("map3.png", width=12.5, height=8.25, dpi=72)

#
# ggplot(wmap_df_robin, aes(long,lat, group=group, fill=hole)) +
#   geom_polygon() +
#   labs(title="World map (Robinson)") +
#   coord_equal() +
#   theme_opts +
#   scale_fill_manual(values=c("#262626", "#e6e8ed"), guide="none") # change colors & remove legend
#
# ggsave("map4.png", width=12.5, height=8.25, dpi=72)
# #
# #
# #
# #
# #
# #
# #
grat <- readOGR("ne_110m_graticules_all", layer="ne_110m_graticules_15")
grat_df <- fortify(grat)

bbox <- readOGR("ne_110m_graticules_all", layer="ne_110m_wgs84_bounding_box")
bbox_df<- fortify(bbox)
#
# a<-ggplot(bbox_df, aes(long,lat, group=group)) +
#   geom_polygon(fill="white") +
#   geom_polygon(data=wmap_df, aes(long,lat, group=group, fill=hole)) +
#   geom_path(data=grat_df, aes(long, lat, group=group, fill=NULL), linetype="dashed", color="grey50") +
#   labs(title="World map + graticule (longlat)") +
#   coord_equal()  +
#    theme_opts +
#    scale_fill_manual(values=c("black", "white"), guide="none") # change colors & remove legend
#
# #ggsave("map5.png", width=12.5, height=8.25, dpi=72)
# #
# # graticule (Robin)
grat_robin <- spTransform(grat, CRS("+proj=robin"))  # reproject graticule
grat_df_robin <- fortify(grat_robin)
bbox_robin <- spTransform(bbox, CRS("+proj=robin"))  # reproject bounding box
bbox_robin_df <- fortify(bbox_robin)
#
# ggplot(bbox_robin_df, aes(long,lat, group=group)) +
#   geom_polygon(fill="white") +
#   geom_polygon(data=wmap_df_robin, aes(long,lat, group=group, fill=hole)) +
#   geom_path(data=grat_df_robin, aes(long, lat, group=group, fill=NULL), linetype="dashed", color="grey50") +
#   labs(title="World map (Robinson)") +
#   coord_equal() +
#   theme_opts +
#   scale_fill_manual(values=c("black", "white"), guide="none") # change colors & remove legend
#
# ggsave("map6.png", width=12.5, height=8.25, dpi=72)
#
#
#
#
# # add country borders
# countries <- readOGR("ne_110m_admin_0_countries", layer="ne_110m_admin_0_countries")
# countries_robin <- spTransform(countries, CRS("+proj=robin"))
# countries_robin_df <- fortify(countries_robin)
#
# ggplot(bbox_robin_df, aes(long,lat, group=group)) +
#   geom_polygon(fill="white") +
#     theme_opts +
#   geom_polygon(data=countries_robin_df, aes(long,lat, group=group, fill=hole)) +
#   geom_path(data=countries_robin_df, aes(long,lat, group=group, fill=hole), color="white", size=0.3) +
#   geom_path(data=grat_df_robin, aes(long, lat, group=group, fill=NULL), linetype="dashed", color="grey50") +
#   labs(title="World map (Robinson)") +
#   coord_equal() + xlim(-2e6,5e6)	   +    ylim(2e6,7e6)+
#   scale_fill_manual(values=c("black", "white"), guide="none") # change colors & remove legend
#
 myPalette <- colorRampPalette(rev(brewer.pal(11, "Spectral")), space="Lab")
# #
# # zp1 <- ggplot(longData,
# # aes(x = Var2, y = Var1, fill = value))
# # zp1 <- zp1 + geom_tile()
# #  zp1 <- zp1 + scale_fill_gradientn(colours = myPalette(100))

#===============
#scale bottom (a)
#===============
# plot.title = "General Circulation Models Climate Data Output"
# plot.subtitle = 'created by GCM runs'
#
# a<-ggplot(map,aes(lon,lat,fill=val))+
# geom_raster(hjust = 0, vjust = 0)+
# scale_fill_gradientn(colours = myPalette(100),breaks=c(-15,-10, -5,10,5, 0,5,15),
# 		     guide= guide_colorbar(title=expression(Surface~Temperature~degree~C), title.position="top",
# 			     barwidth = 25, barheight = 1,nbin=100,
# 			     draw.ulim = FALSE, draw.llim = FALSE ))+
# #geom_path(data=wmap_df,aes(long,lat,group=group,fill=NULL))+
# #coord_cartesian()+coord_map()+
# geom_path(data=grat_df,aes(long,lat,group=group,fill=NULL),linetype="dashed", color="grey50")+
# geom_path(data=countries,aes(long,lat,goup=group,fill=NULL))+
# xlim(min(map$lon),max(map$lon))+ylim(min(map$lat),max(map$lat))+
# theme_opts+theme(legend.position="bottom", legend.background = element_rect(color = "black",
#     fill = "grey90", size = 0.4, linetype = "solid"))+
# coord_equal()+
# ggtitle(bquote(atop(.(plot.title), atop(italic(.(plot.subtitle)), "")))) +
# labs( x = "", y="")
# # #labs(title="Mean Surface Temperature ",x="GCM")#+
# # #scale_x_discrete(grat@data$display)
# # #expression(Depth[mm])
# #  ggsave("map10.png",width=12.5,height=6,dpi=72)
# #===============
# #scale right (b)
# #===============
# b<-ggplot(map,aes(lon,lat,fill=val))+
# geom_raster(hjust = 0, vjust = 0)+
# scale_fill_gradientn(colours = myPalette(100),breaks=c(-15,-10, -5,10,5, 0,5,15),
# 		     guide= guide_colorbar(title=expression(degree~C), title.position="top",
# 			     barwidth = 1, barheight = 15,#nbin=100,
# 			     draw.ulim = FALSE, draw.llim = FALSE ))+
# #geom_path(data=wmap_df,aes(long,lat,group=group,fill=NULL))+
# #coord_cartesian()+coord_map()+
# geom_path(data=grat_df,aes(long,lat,group=group,fill=NULL),linetype="dashed", color="grey50")+
# geom_path(data=countries,aes(long,lat,goup=group,fill=NULL))+
# xlim(min(map$lon),max(map$lon))+ylim(min(map$lat),max(map$lat))+
# theme_opts+theme(legend.position="right", legend.background = element_rect(color = "black",
#     fill = "white", size = 0.4, linetype = "solid"))+
# coord_equal()+
# ggtitle(bquote(atop(.(plot.title), atop(italic(.(plot.subtitle)), "")))) +
# labs( x = "", y="")
# #labs(title="Mean Surface Temperature ",x="GCM")#+
# #scale_x_discrete(grat@data$display)
# #expression(Depth[mm])
# # ggsave("map10.png",width=12.5,height=6,dpi=72)
# #===============
# #scale inside (c)
# #===============
# plot.title = "General Circulation Models Climate Data Output"
# plot.subtitle = 'created by GCM runs'
#
# c<-ggplot(map,aes(lon,lat,fill=val))+
# geom_raster(hjust = 0, vjust = 0)+
# scale_fill_gradientn(colours = myPalette(100),breaks=c(-15,-10, -5,10,5, 0,5,15),
# 		     guide= guide_colorbar(title=expression(degree~C), title.position="top",
# 			 #    barwidth = 25, barheight = 1,nbin=100,
# 			     draw.ulim = FALSE, draw.llim = FALSE ))+
# #geom_path(data=wmap_df,aes(long,lat,group=group,fill=NULL))+
# #coord_cartesian()+coord_map()+
# geom_path(data=grat_df,aes(long,lat,group=group,fill=NULL),linetype="dashed", color="grey50")+
# geom_path(data=countries,aes(long,lat,goup=group,fill=NULL))+
# xlim(min(map$lon),max(map$lon))+ylim(min(map$lat),max(map$lat))+
# theme_opts+theme(legend.position=c(0.9,0.3), legend.background = element_rect(color = "black",
#     fill = "grey90", size = 0.4, linetype = "solid"))+
# coord_equal()+
# ggtitle(bquote(atop(.(plot.title), atop(italic(.(plot.subtitle)), "")))) +
# labs( x = "", y="")

#===============
#scale inside (d)
#===============
# plot.title = "GCM Surface Temperature"
# plot.subtitle = 'created by GCM runs'
# # plot.title = ""
# # plot.subtitle = ''
# # mr<-fortify(map_robin)
# d<-ggplot(map,aes(long,lat,fill=group))+
# geom_tile(hjust = 0, vjust = 0)+
# scale_fill_gradientn(colours= myPalette(10),breaks=c(15,5,0,-5,-15),
# 		     guide= guide_legend(title=expression(degree~C), title.position="top",
# 			 #    barwidth = 25, barheight = 1,nbin=100,
# 			     draw.ulim = FALSE, draw.llim = FALSE ))+
#
# #scale_color_manual(values=myPalette(1000))+
# # scale_fill_brewer(palette="Spectral")+
# #geom_path(data=wmap_df,aes(long,lat,group=group,fill=NULL))+
# #coord_cartesian()+coord_map()+
# #geom_path(data=grat_df,aes(long,lat,group=group,fill=NULL),linetype="dashed", color="grey50")+
# #geom_path(data=countries,aes(long,lat,goup=group,fill=NULL))+
# xlim(min(map$lon),max(map$lon))+ylim(min(map$lat),max(map$lat))+
# theme_opts+theme(legend.position=c(0.9,0.3), legend.background = element_rect(color = "black",
#     fill = "grey90", size = 0.4, linetype = "solid"))+
# coord_equal()+
# ggtitle(bquote(atop(.(plot.title), atop(italic(.(plot.subtitle)), "")))) +
# labs( x = "", y="")
#  ggsave("map10.png",width=12.5,height=6,dpi=72)

# names(map)<-c("long","lat","val")
# grid<-expand.grid(lon=unique(map$lon),lat=unique(map$lat))
# val<-array(NA,dim(grid)[1] )
# for(i in 1:dim(map)[1]){
# 	val[i]<-map$val[which(grid$lon==map$lon[i]&grid$lat==map$lat[i])]
# }
##  coordinates (map)= ~long+lat
 projection(map)<-CRS("+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0")
# k<-spTransform(map,CRS("+proj=robin"))
#
# cor<-as.data.frame(k@coords)
# pp<-data.frame("long"=cor$x,"lat"=cor$y,"val"=k@data)
#
# ggplot(pp,aes(long,lat,fill=z))+geom_tile()#+scale_fill_gradientn(colours= myPalette(10))
#

coordinates (map)= ~long+lat
projection(map)<-CRS("+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0")
pp_robin<-spTransform(pp,CRS("+proj=robin"))
a<-data.frame(pp_robin@coords,pp_robin@data)

map_pj_c$lat<-round(map_pj$lat/10000)

# s100 <- matrix(c(267573.9, 2633781, 213.29545, 262224.4, 2633781, 69.78261, 263742.7, 2633781, 51.21951, 259328.4, 2633781, 301.98413, 264109.8, 2633781, 141.72414, 255094.8, 2633781, 88.90244),  ncol=3,  byrow=TRUE)
# colnames(s100) <- c('X', 'Y', 'Z')
#
# library(raster)
# # set up an 'empty' raster, here via an extent object derived from your data
# e <- extent(s100[,1:2])
# e <- e + 1000 # add this as all y's are the same
#
# r <- raster(e, ncol=10, nrow=2)
# # or r <- raster(xmn=, xmx=,  ...
#
# # you need to provide a function 'fun' for when there are multiple points per cell
# x <- rasterize(s100[, 1:2], r, s100[,3], fun=mean)
# plot(x)


library(testthat)
library(htnorm)

test_check("htnorm")


#The image import has the wrong names, tritc is actually cy5

# Do this for multiple folders.  So i am going to select.list ll the folders
#in my current directory that hass all my experiments listed.

#first select the folder that contains ALL experiments
main.dir<-"E:/Data/Lee Leavitt"
# Change Directory manually to you folder Ex: "E:/Data/Mario/"
setwd(main.dir)
# select the folder for each experimetn from the list
exp.dir<-select.list(list.dirs(), multiple=T)

#Create names for the experiments you will assess today.
#rd.names<-paste("RD.",sub("rotocol ","",sub("/",".",sub("./","",exp.dir))), sep="")
rd.names<-paste("RD.",sub("/",".",sub("./","",exp.dir)), sep="")

#select your um for pixel conversion
area.conversion<-1.625

#Input the names of the files that CP created
cell.data.name<-"celldatacells_filtered.txt"
video.data.name<-"video_dataROI.txt"

#Names of the files you want loaded into the RD file
img1.1<-"bf.gfp.tritc.start.png"
img2.1<-"gfp.tritc.dapi.start.ci.ltl.rs.png"
img3.1<-"tritc.start.ci.ltl.rs.png"
img4.1<-"tritc.dapi.end.ci.ltl.rs.png"
img5.1<-"gfp.dapi.end.ci.ltl.rs.png"
img6.1<-"fura2.png"
img7.1<-"bf.end.lab.png"
img8.1<-"dapi.end.lab.png"

setwd(main.dir)

for(i in 1:length(rd.names)){
setwd(exp.dir[i])

# read in cell data.  This is a big data frame, but we only need a
# few collumns for now.
c.dat<-read.delim(cell.data.name, header=T, sep="\t")

#These are the collumns needed for analysis
c.dat.names<-c(
	"ObjectNumber",
	"AreaShape_Area",
	"AreaShape_Center_X",
	"AreaShape_Center_Y",
	"AreaShape_FormFactor",
	"AreaShape_Perimeter",
	"Intensity_MeanIntensity_CGRP_start_ci",
	"Intensity_MeanIntensity_CGRP_end_ci",
	"Intensity_MeanIntensity_IB4_start_ci",
	"Intensity_MeanIntensity_IB4_end_ci",
	"Intensity_MeanIntensity_DAPI_ci",
	"Intensity_MeanIntensity_BF_start",
	"Location_Center_X",
	"Location_Center_Y")

	c.dat.1<-c.dat[,c.dat.names]

	# i like to rename the collumns for my procpharm
names(c.dat.1)<-c(
	"id",
	"area",
	"center.x.simplified",
	"center.y.simplified",
	"circularity",
	"perimeter",
	"mean.gfp.start",
	"mean.gfp.end",
	"mean.cy5.start",
	"mean.cy5.end",
	"mean.dapi",
	"mean.bf",
	"center.x",
	"center.y")
c.dat<-cbind(c.dat.1, c.dat)

# Now read in video Data
require(data.table)
f2.img<-fread(video.data.name)
#cell names

##Mean Trace
t.340<-xtabs(Intensity_MeanIntensity_f2_340~ImageNumber+ObjectNumber, f2.img)
t.380<-xtabs(Intensity_MeanIntensity_f2_380~ImageNumber+ObjectNumber, f2.img)
t.dat<-t.340/t.380

# add time info from file exported on nis veiwer
time.info<-read.delim("time.info.txt", sep="\t", fileEncoding="UCS-2LE")
if(length(which(is.na(time.info[3]), arr.ind=T)[,1])>=1){
	time.info<-time.info[-which(is.na(time.info[3]), arr.ind=T)[,1],]
}else{time.info<-time.info}#remove any nas
time.min<-round(time.info["Time..s."]/60, digits=3)

# Create row.names
cell.names<-paste("X.",c.dat$id,sep="")
c.dat[,"id"]<-cell.names
row.names(c.dat)<-cell.names

t.340<-cbind(time.min[,1], t.340)
t.340<- t.340[unique(row.names(t.340)),]#incase of duplicated rownames
colnames(t.340)<- c("Time",cell.names)
row.names(t.340)<-time.min[,1]
t.340<-as.data.frame(t.340)

t.380<-cbind(time.min[,1], t.380)
t.380<- t.380[unique(row.names(t.380)),]#incase of duplicated rownames
colnames(t.380)<- c("Time",cell.names)
row.names(t.380)<-time.min[,1]
t.380<-as.data.frame(t.380)

t.dat<-cbind(time.min[,1], t.dat)
t.dat<- t.dat[unique(row.names(t.dat)),]#incase of duplicated rownames
colnames(t.dat) <- c("Time",cell.names)
row.names(t.dat)<-time.min[,1]
t.dat<-as.data.frame(t.dat)

##LowerQuartile Trace
#tlq.340<-xtabs(Intensity_LowerQuartileIntensity_f2_340~ImageNumber+ObjectNumber, f2.img)
#tlq.380<-xtabs(Intensity_LowerQuartileIntensity_f2_380~ImageNumber+ObjectNumber, f2.img)
#tlq.dat<-tlq.340/tlq.380

#tlq.340<-cbind(time.min[,1], tlq.340)
#tlq.340<- tlq.340[unique(row.names(tlq.340)),]#incase of duplicated rownames
#colnames(tlq.340)<- c("Time",cell.names)
#row.names(tlq.340)<-time.min[,1]
#tlq.340<-as.data.frame(tlq.340)

#tlq.380<-cbind(time.min[,1], tlq.380)
#tlq.380<- tlq.380[unique(row.names(tlq.380)),]#incase of duplicated rownames
#colnames(tlq.380)<- c("Time",cell.names)
#row.names(tlq.380)<-time.min[,1]
#tlq.380<-as.data.frame(tlq.380)

#tlq.dat<-cbind(time.min[,1], tlq.dat)
#tlq.dat<- tlq.dat[unique(row.names(tlq.dat)),]#incase of duplicated rownames
#colnames(tlq.dat) <- c("Time",cell.names)
#row.names(tlq.dat)<-time.min[,1]
#tlq.dat<-as.data.frame(tlq.dat)

##upperQuartile Trace
#tuq.340<-xtabs(Intensity_UpperQuartileIntensity_f2_340~ImageNumber+ObjectNumber, f2.img)
#tuq.380<-xtabs(Intensity_UpperQuartileIntensity_f2_380~ImageNumber+ObjectNumber, f2.img)
#tuq.dat<-tuq.340/tuq.380

#tuq.340<-cbind(time.min[,1], tuq.340)
#tuq.340<- tuq.340[unique(row.names(tuq.340)),]#incase of duplicated rownames
#colnames(tuq.340)<- c("Time",cell.names)
#row.names(tuq.340)<-time.min[,1]
#tuq.340<-as.data.frame(tuq.340)

#tuq.380<-cbind(time.min[,1], tuq.380)
#tuq.380<- tuq.380[unique(row.names(tuq.380)),]#incase of duplicated rownames
#colnames(tuq.380)<- c("Time",cell.names)
#row.names(tuq.380)<-time.min[,1]
#tuq.380<-as.data.frame(tuq.380)

#tuq.dat<-cbind(time.min[,1], tuq.dat)
#tuq.dat<- tuq.dat[unique(row.names(tuq.dat)),]#incase of duplicated rownames
#colnames(tuq.dat) <- c("Time",cell.names)
#row.names(tuq.dat)<-time.min[,1]
#tuq.dat<-as.data.frame(tuq.dat)

##edge Trace
#te.340<-xtabs(Intensity_MeanIntensityEdge_f2_340~ImageNumber+ObjectNumber, f2.img)
#te.380<-xtabs(Intensity_MeanIntensityEdge_f2_380~ImageNumber+ObjectNumber, f2.img)
#te.dat<-te.340/te.380

#te.340<-cbind(time.min[,1], te.340)
#te.340<- te.340[unique(row.names(te.340)),]#incase of duplicated rownames
#colnames(te.340)<- c("Time",cell.names)
#row.names(te.340)<-time.min[,1]
#te.340<-as.data.frame(te.340)

#te.380<-cbind(time.min[,1], te.380)
#te.380<- te.380[unique(row.names(te.380)),]#incase of duplicated rownames
#colnames(te.380)<- c("Time",cell.names)
#row.names(te.380)<-time.min[,1]
#te.380<-as.data.frame(te.380)

#te.dat<-cbind(time.min[,1], te.dat)
#te.dat<- te.dat[unique(row.names(te.dat)),]#incase of duplicated rownames
#colnames(te.dat) <- c("Time",cell.names)
#row.names(te.dat)<-time.min[,1]
#te.dat<-as.data.frame(te.dat)

##MaxIntenistyEdge Trace
#tme.340<-xtabs(Intensity_MaxIntensityEdge_f2_340~ImageNumber+ObjectNumber, f2.img)
#tme.380<-xtabs(Intensity_MaxIntensityEdge_f2_380~ImageNumber+ObjectNumber, f2.img)
#tme.dat<-tme.340/tme.380

#tme.340<-cbind(time.min[,1], tme.340)
#tme.340<- tme.340[unique(row.names(tme.340)),]#incase of duplicated rownames
#colnames(tme.340)<- c("Time",cell.names)
#row.names(tme.340)<-time.min[,1]
#tme.340<-as.data.frame(tme.340)

#tme.380<-cbind(time.min[,1], tme.380)
#tme.380<- tme.380[unique(row.names(tme.380)),]#incase of duplicated rownames
#colnames(tme.380)<- c("Time",cell.names)
#row.names(tme.380)<-time.min[,1]
#tme.380<-as.data.frame(tme.380)

#tme.dat<-cbind(time.min[,1], tme.dat)
#tme.dat<- tme.dat[unique(row.names(tme.dat)),]#incase of duplicated rownames
#colnames(tme.dat) <- c("Time",cell.names)
#row.names(tme.dat)<-time.min[,1]
#tme.dat<-as.data.frame(tme.dat)

## Proof my dataframes are already sorting in the correct way.
#first create a dataframe from the video file x and y location data
#t.loc.x<-matrix(f2.img[,"Location_Center_X"],byrow=FALSE, nrow=max(cell.names))[,1]
#t.loc.y<-matrix(f2.img[,"Location_Center_Y"],byrow=FALSE, nrow=max(cell.names))[,1]
#t.loc<-cbind(t.loc.x, t.loc.y)
#t.loc<-round(t.loc, digits=3) #Then round dataframe to three digits

## Create datatrame from c.dat(c created above)
#c.xy<-c.dat[,c("center.x", "center.y")]
#c.xy<-round(c.xy, digits=3) # also round to three digits
#setdiff(t.loc[,2], c.xy[,2]) #There should be no difference between the two data frames

#setequal(t.loc[,1], c.xy[,1])#There should be no difference between the two data frame
#setequal(t.loc[,2], c.xy[,2])#There should be no difference between the two data frame

#example
#a<-seq(from=1,to=10,by=10)
#b<-seq(from=1,to=10,by=10)

############ wr1 import
wrdef<-"wr1.csv"
if(!is.null(wrdef))
	{
		wr <- ReadResponseWindowFile(wrdef)
		Wr<-length(wr[,1])#complete and revise this section
		if(length(colnames(wr))<2){w.dat<-WrMultiplex(t.dat,wr,n=Wr)}
		else{w.dat <- MakeWr(t.dat,wr)}
		}

# Initial and simple Data processing
tmp.rd <- list(t.dat=t.dat,w.dat=w.dat,c.dat=c.dat)
levs<-setdiff(unique(as.character(w.dat[,2])),"")
	snr.lim=5;hab.lim=.05;sm=2;ws=3;blc="SNIP"
pcp <- ProcConstPharm(tmp.rd,sm,ws,blc)
scp <- ScoreConstPharm(tmp.rd,pcp$blc,pcp$snr,pcp$der,snr.lim,hab.lim,sm)
bin <- bScore(pcp$blc,pcp$snr,snr.lim,hab.lim,levs,tmp.rd$w.dat[,"wr1"])
bin <- bin[,levs]
bin["drop"] <- 0 #maybe try to generate some drop criteria from the scp file.
bin<-pf.function(bin,levs)

# Add images
require(png)
img1<-tryCatch(png::readPNG(img1.1), error=function(e)NULL)
img2<-tryCatch(png::readPNG(img2.1), error=function(e)NULL)
img3<-tryCatch(png::readPNG(img3.1), error=function(e)NULL)
img4<-tryCatch(png::readPNG(img4.1), error=function(e)NULL)
img5<-tryCatch(png::readPNG(img5.1), error=function(e)NULL)
img6<-tryCatch(png::readPNG(img6.1), error=function(e)NULL)
img7<-tryCatch(png::readPNG(img7.1), error=function(e)NULL)
img8<-tryCatch(png::readPNG(img8.1), error=function(e)NULL)
#png::readPNG("bf.gfp.tritc.dapi.png")

#img.t<-png::readPNG("tritc.png")
#img.b<-png::readPNG("bf.png")
#img.bl<-png::readPNG("bf.lab.png")
#img.f<-png::readPNG("fura2.png")

tmp.rd <- list(t.dat=t.dat,t.340=t.340,t.380=t.380,
#tlq.dat=tlq.dat, tlq.340=tlq.340,tlq.380=tlq.380,
#tuq.dat=tuq.dat,tuq.340=tuq.340,tuq.380=tuq.380,
#te.dat=te.dat,te.340=te.340,te.380=te.380,
#tme.dat=tme.dat,tme.340=tme.340,tme.380=tme.380,
w.dat=w.dat,c.dat=c.dat, bin=bin, scp=scp, snr=pcp$snr, blc=pcp$blc, der=pcp$der,
img1=img1,img2=img2,img3=img3,img4=img4,img5=img5,img6=img6,img7=img7, img8=img8)
#img.gtd=img.gtd, img.g=img.g, img.t=img.t, img.b=img.b,img.bl=img.bl, img.f=img.f)

tmp.rd$c.dat[,"area"]<-tmp.rd$c.dat$area*area.conversion

## Check for duplicated rows
if(length(which(duplicated(row.names(t.dat))))>=1){
dup<-which(duplicated(row.names(t.dat)))
paste(dup)
t.dat<-t.dat[-dup,]
w.dat<-w.dat[-dup,]
}

##DESPIKE
wts <- tmp.rd$t.dat
for(j in 1:5) #run the despike 5 times.
{
	wt.mn3 <- Mean3(wts)
	wts <- SpikeTrim2(wts,1,-1)
	print(sum(is.na(wts))) #this prints out the number of points removed should be close to 0 after 5 loops.
	wts[is.na(wts)] <- wt.mn3[is.na(wts)]
}
tmp.rd$mp <- wts

#170127
# Take the despiked data, subtract the minimum value from the trace, then divide by the maximun value
# to create traces that are all on the same 0 to 1 scale
tmp.dat<-tmp.rd$mp

for(k in 1:length(colnames(tmp.rd$mp))){

	tmp.dat[,k]<-tmp.rd$mp[,k]-min(tmp.rd$mp[,k])
	tmp.dat[,k]<-tmp.dat[,k]/max(tmp.dat[,k])

}
tmp.dat[,1]<-tmp.rd$t.dat[,1]

tmp.rd$mp.1<-tmp.dat

rd.name<-rd.names[i]
f.name <- paste(rd.name,".Rdata",sep="")
assign(rd.name,tmp.rd)
save(list=rd.name,file=f.name)

rm(f2.img)
rm(rd.name)
rm(tmp.rd)
rm(c.dat)
rm(cell.names)
setwd(main.dir)
}


# Information about code:
# This code corresponds to exploratory data analyses for my MSc thesis.
# They are pertaining to EDA for the authors
# (relevant for Chapter 3, the section on Determinants of taxonomic resources flow).
# @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

# Set up
source('2019-06-19-jsa-type/init/init.R')
source('2019-06-19-jsa-type/subset.r')

# Libraries
library(networkD3)
library(ggplot2)

# Read lookup
lu <- get_lp_statoid()

# @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
# Section - resource flow
# @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
print(paste0(Sys.time(), " --- resource flow"))

# Summarising where there is flow
spp <- get_df1(write=F)
spp1 <- spp[,c("idx", "type.country.n", "full.name.of.describer")]
spp2 <- get_df2(write=F)[status=="Synonym"][,c("idx", "type.country.n", "full.name.of.describer")]

spp_s <- rbind(spp1, spp2)
spp_s <- data.table(spp_s %>% separate_rows(full.name.of.describer, sep="; "))
des <- get_des(write=F)
des <- des[, c("full.name.of.describer.n", "residence.country.describer.n")]
des <- data.table(des %>% separate_rows(residence.country.describer.n, sep="; "))
des <- des[, id := seq_len(.N), by = full.name.of.describer.n][
        order(full.name.of.describer.n, id),][!duplicated(full.name.of.describer.n)]
spp_s <- merge(spp_s, des, by.x="full.name.of.describer", by.y="full.name.of.describer.n",
               all.x=T, all.y=F)
spp_s <- spp_s[, c("type.country.n", "residence.country.describer.n", "idx")]
spp_s <- unique(spp_s)

t <- table(spp_s$type.country.n, spp_s$residence.country.describer.n)
t <- data.table(t)
dim(t); t <- t[N!=0]; dim(t)
names(t) <- c("type.country", "residence.country", "N")
dim(t); t <- t[!(type.country == "" | residence.country=="[unknown]")]; dim(t)
to_merge1 <- lookup.cty[, c("DL", "centroid_lat", "centroid_lon")]
to_merge2 <- lookup.cty[, c("DL", "centroid_lat", "centroid_lon")]
t <- merge(t, to_merge1, by.x="type.country", by.y="DL", all.x=T, all.y=F)
t <- merge(t, to_merge2, by.x="residence.country", by.y="DL", all.x=T, all.y=F,
           suffixes=c("_type.country", "_residence.country"))
t[is.na(centroid_lat_type.country)]
t[is.na(centroid_lat_residence.country)]$residence.country
names(t) <- c("ori", "des", "N", "dY", "dX", "oY", "oX")
t$Geom <- paste0("LINESTRING (", as.character(t$oX),
                " ", as.character(t$oY), ", ",
                as.character(t$dX), " ", as.character(t$dY), ")")
t$no_flow <- t$ori == t$des

write.csv(t,
          paste0(dir_data_ch3_flow, "2019-09-22-flow-map-type-loc-des-country.csv"),
          na='', row.names=F, fileEncoding="UTF-8")

write.csv(t,
          paste0(dir_shiny, "eda1.1_shiny/data/2019-09-22-flow-map-type-loc-des-country.csv"),
          na='', row.names=F, fileEncoding="UTF-8")


##' Significance Plot with D3 (vertical)
##'
##' Makes an errorbar plot using the D3.js library with a hover-over
##' effect that highlights all cagtegories that are significantly differnet
##' than the one being hovered over.
##'
##' @aliases sigd3.default sigd3.mcmc.list sigd3.mcmc
##'
##' @param object A model that has a categorical predictor.  The function
##' uses both \code{ggpredict} from the \pkg{ggeffects} package and
##' \code{factorplot} from the \pkg{factorplot} package (with the
##' variable given by the \code{factor.var=term} argument), so the object
##' must be amenable to these manipulations. Alternatively, it could be
##' an mcmc object in which case all columns will be plotted.
##' @param term The term from the model to be plotted.
##' @param fname Name of the file to which the html code will be written.
##' @param height Height of the plot in pixels
##' @param width Width of the plot in pixels
##' @param return_iFrame Logical indicating whether an \code{iframe}
##' should be returned to hold the plot.  If \code{FALSE} only the html
##' file is produced and the function prpduces no other visible output.
##' @param ylab Label to put on y-axis.
##' @param level Confidence level at which to do the test (or in the mcmc case, credibility level for the credible intervals).
##' @param axfont Font size for axis tick mark labels (in px).
##' @param labfont Font size for y-axis label (in px).
##' @param labfam Font-family for y-axis label (must be one of "serif" or "sans-serif").
##' @param colors Vector of three colors the first for the selected items, the second for the un-selected items and the third for when no points are hovered over.
##' @param ptSize Vector of two point sizes - the first for selected observations and the second for unselected ones.
##' @param lineSize Vector of line widths - the first for selected observations and the second for unselected ones.
##' @param names An optional vector of names for the parameters.
##' @param order How should parameters be organized by size-ascending, size-descending or natural (i.e., the order in the data).
##'
##' @importFrom ggeffects ggpredict
##' @importFrom factorplot factorplot
##' @importFrom dplyr mutate rename select bind_cols arrange
##' @importFrom magrittr %>%
##' @importFrom jsonlite toJSON
##' @importFrom htmltools tags
##' @importFrom stats quantile
##' @importFrom utils combn
##' @importFrom rlang .data
##'
##' @return Either an html file or an iframe linked to the html file.
##' @export

sigd3 <-
  function(object,
           term,
           fname,
           height = 500,
           width = 625,
           return_iFrame = TRUE,
           level = .95,
           ylab = paste0("Effect of ", term),
           axfont = 12,
           labfont = 12,
           labfam = c("sans-serif", "serif"),
           colors = c("#B80000", "#000000", "#000000"),
           ptSize = c(7, 5),
           lineSize = c(3, 1.5),
           names = NULL,
           order = c("size-descending", "size-ascending", "natural")) {
    UseMethod("sigd3")
  }

##' @method sigd3 default
##' @export
sigd3.default <-
  function(object,
           term,
           fname,
           height = 500,
           width = 625,
           return_iFrame = TRUE,
           level = .95,
           ylab = paste0("Effect of ", term),
           axfont = 12,
           labfont = 12,
           labfam = c("sans-serif", "serif"),
           colors = c("#B80000", "#000000", "#000000"),
           ptSize = c(7, 5),
           lineSize = c(3, 1.5),
           names = NULL,
           order = c("size-descending", "size-ascending", "natural")) {

    labfam <- match.arg(labfam)
    order <- match.arg(order)
    g <- ggpredict(object, terms = term)
    g <- g %>% mutate(obs = 1:nrow(g)) %>%
      rename("y" = "predicted", "ylow" = "conf.low", "yup" = "conf.high") %>%
      select("x", "y", "ylow", "yup", "obs")

    if (!is.null(names)) {
      if (length(names) == nrow(g)) {
        g <- mutate(x = names)
      } else{
        stop(
          paste0("mismatch between vector lengths names: (", length(names),
                 ") and parameters: (", nrow(g), ").\n")
        )
      }
    }

    fp <- factorplot(object, factor.var = term, pval = 1 - level)
    mat <- matrix(0, nrow = nrow(fp$pval) + 1, ncol = ncol(fp$pval) + 1)
    mat[upper.tri(mat, diag = FALSE)] <-
      fp$pval[upper.tri(fp$pval, diag = TRUE)]
    mat <- t(mat)
    mat[upper.tri(mat, diag = FALSE)] <-
      fp$pval[upper.tri(fp$pval, diag = TRUE)]
    mat <- ifelse(mat < .05, 1, 0)
    diag(mat) <- 0

    mat <- as.data.frame(mat)
    names(mat) <- paste0("g", 1:ncol(mat))
    g <- g %>% bind_cols(mat)

    if (order == "size-ascending") {
      g <- g %>% arrange(.data$y)
    } else if (order == "size-descending") {
      g <- g %>% arrange(-.data$y)
    }

    h <- '<!doctype html>

<html lang="en">
<head>
  <meta charset="utf-8">

  <title>sigd3.default</title>
  <script src="https://d3js.org/d3-selection.v1.min.js"></script>
  <script src="https://d3js.org/d3.v4.js"></script>
  <script src="https://code.jquery.com/jquery-3.5.1.min.js"></script>

</head>
<body>

  <script>'

    b <- paste0('  </script>
  <script>
    let height = ',height,', width = ',width,',
      margin = {top: height * .02, right: width * .15, bottom: height * 0.15, left: width * .1},
      adjustedWidth = width - margin.left - margin.right,
      adjustedHeight = height - margin.top - margin.bottom,
      colors = ["',colors[1],'", "',colors[2],'", "',colors[3],'"],
      pointSize = [',ptSize[1],', ',ptSize[2],'], lineSize = [',lineSize[1],', ',lineSize[2],'],
      labelFontFamily = "',labfam[1],'", yLabel = "',ylab,'",
      labelFont = ',labfont,', axesFont = ',axfont,';

    // Append svg to the body
    let svg = d3.select("body")
      .append("svg")
      .attr("width", adjustedWidth + margin.left + margin.right)
      .attr("height", adjustedHeight + margin.top + margin.bottom)
      .append("g")
      .attr("transform", "translate(" + margin.left + "," + margin.top + ")");

    // Various mapping functions
    const xMap = (d) => x(d.x);
    const yMap = (d) => y(d.y);
    const ylMap = (d) => y(d.ylow);
    const yuMap = (d) => y(d.yup);

    // Axes initialization
    let rgX = [0];
    let deltaX = adjustedWidth / (data.length - 1)
    for (let j = 1; j < data.length; j++) {
      rgX.push(j * deltaX);
    }

    const x = d3.scaleOrdinal()
      .domain(Array.from(data, el => el.x))
      .range(rgX);

    const y = d3.scaleLinear()
      .domain([d3.min(data, (d) => d.ylow), d3.max(data, (d) => d.yup)])
      .range([adjustedHeight, 0]);

    svg.append("g")
      .attr("transform", "translate(0," + adjustedHeight * 1.075 + ")")
      .call(d3.axisBottom(x));

    svg.append("g")
      .attr("transform", `translate(${-adjustedWidth * .035},0)`)
      .call(d3.axisLeft(y));

    d3.selectAll(".tick").style("font-size", `${axesFont}px`)

    // Mouseover highlight function
    const highlight = ((d) => {
      for (let i = 0; i < data.length; i++) {
        if (data[i][`g${d.obs}`] === 1) {
          d3.selectAll(`circle[cx="${xMap(data[i])}"]`)
            .transition()
            .duration(50)
            .style("fill", colors[0])
            .attr("r", pointSize[0])
          d3.select(`line[x1="${xMap(data[i])}"]`)
            .transition()
            .duration(50)
            .style("stroke", colors[0])
            .attr("stroke-width", lineSize[0])
        }
      }
    });

    // Mouseleave highlight function
    const doNotHighlight = function () {
      d3.selectAll(".dot")
        .transition()
        .duration(200)
        .style("fill", colors[2])
        .attr("r", pointSize[1])

      d3.selectAll(".line")
        .transition()
        .duration(200)
        .style("stroke", colors[2])
        .attr("stroke-width", lineSize[1])
    }

    // Vertical label
    svg.append("text")
      .attr("transform", "rotate(-90)")
      .attr("y", 0 - margin.left)
      .attr("x", 0 - (adjustedHeight / 2))
      .attr("dy", "1em")
      .style("text-anchor", "middle")
      .style("font-size", `${labelFont}px`)
      .text(yLabel)
      .style("font-family", labelFontFamily);

    // Graph dot lines
    for (let m = 0; m < data.length; m++) {
      svg.append("line")
        .attr("class", "line")
        .attr("x1", xMap(data[m]))
        .attr("y1", ylMap(data[m]))
        .attr("x2", xMap(data[m]))
        .attr("y2", yuMap(data[m]))
        .attr("stroke", colors[2])
        .attr("stroke-width", lineSize[1])
    }

    // Graph points
    svg.selectAll(".dot")
      .data(data)
      .enter()
      .append("circle")
      .attr("class", "dot")
      .attr("r", pointSize[1])
      .attr("cx", xMap)
      .attr("cy", yMap)
      .on("mouseover", highlight)
      .on("mouseleave", doNotHighlight)

  </script>
</body>
</html>')

    cat(h, "\n", sep = "", file = fname, append = FALSE)
    cat("let data = ", toJSON(g), ";\n", sep = "", file = fname, append = TRUE)
    cat(b, sep = "", file = fname, append = TRUE)

    tags$iframe(src = fname, height = height * 1.05, width = width * 1.05, style = "border: none")

    r2d3(data=g, options = list(axfont = 12, colors = c("#B80000", "#000000", "#000000"), ptSize = c(7,5), lineSize = c(3,1.5), labfont = 12, ylab = "Effect of Region", labfam = c("sans-serif", "serif")), script = "sigd3.js", height="500", width="750")
  }

##' @method sigd3 mcmc.list
##' @export
sigd3.mcmc.list <-
  function(object,
           term,
           fname,
           height = 500,
           width = 625,
           return_iFrame = TRUE,
           level = .95,
           ylab = paste0("Effect of ", term),
           axfont = 12,
           labfont = 12,
           labfam = c("sans-serif", "serif"),
           colors = c("#B80000", "#000000", "#000000"),
           ptSize = c(7, 5),
           lineSize = c(3, 1.5),
           names = NULL,
           order = c("size-descending", "size-ascending", "natural")) {
    object <- do.call(rbind, object)
    sigd3.mcmc(
      object,
      term = term,
      height = height,
      width = width,
      return_iFrame = return_iFrame,
      level = level,
      ylab = ylab,
      axfont = axfont,
      labfont = labfont,
      labfam = labfam,
      colors = colors,
      ptSize = ptSize,
      lineSize = lineSize,
      names = names,
      order = order
    )
  }

##' @method sigd3 mcmc
##' @export
sigd3.mcmc <-
  function(object,
           term,
           fname,
           height = 500,
           width = 625,
           return_iFrame = TRUE,
           level = .95,
           ylab = paste0("Effect of ", term),
           axfont = 12,
           labfont = 12,
           labfam = c("sans-serif", "serif"),
           colors = c("#B80000", "#000000", "#000000"),
           ptSize = c(7, 5),
           lineSize = c(3, 1.5),
           names = NULL,
           order = c("size-descending", "size-ascending", "natural")) {
    labfam <- match.arg(labfam)
    order <- match.arg(order)

    if (!is.null(names)) {
      if (length(names) == ncol(object)) {
        colnames(object) = names
      } else {
        stop(
          paste0(
            "mismatch between vector lengths names: )", length(names),
            ") and object: (", ncol(object), ").\n"
          )
        )
      }
    }

    g <- data.frame(
      x = colnames(object),
      y = colMeans(object),
      ylow = apply(object, 2, quantile, (1 - level) / 2),
      yup = apply(object, 2, quantile, 1 - (1 - level) / 2),
      obs = 1:ncol(object)
    )

    combs <- combn(nrow(g), 2)
    m1 <- object[, combs[1, ]]
    m2 <- object[, combs[2, ]]
    diffs <- m2 - m1
    g0 <- apply(diffs, 2, function(x)
      mean(x > 0))

    mat <- matrix(0, nrow = ncol(object), ncol = ncol(object))
    mat[cbind(combs[1, ], combs[2, ])] <- g0
    mat <- t(mat)
    mat[cbind(combs[1, ], combs[2, ])] <- g0
    mat <- ifelse(mat > level | mat < (1 - level), 1, 0)
    diag(mat) <- 0
    mat <- as.data.frame(mat)
    names(mat) <- paste0("g", 1:ncol(mat))
    g <- g %>% bind_cols(mat)

    if (order == "size-ascending") {
      g <- g %>% arrange(.data$y)
    } else  if (order == "size-descending") {
      g <- g %>% arrange(-.data$y)
    }

    h <- '<!doctype html>

<html lang="en">
<head>
  <meta charset="utf-8">

  <title>sigd3.default</title>
  <script src="https://d3js.org/d3-selection.v1.min.js"></script>
  <script src="https://d3js.org/d3.v4.js"></script>
  <script src="https://code.jquery.com/jquery-3.5.1.min.js"></script>

</head>
<body>

  <script>'

    b <- paste0('  </script>
  <script>
    let height = ',height,', width = ',width,',
      margin = {top: height * .02, right: width * .15, bottom: height * 0.15, left: width * .1},
      adjustedWidth = width - margin.left - margin.right,
      adjustedHeight = height - margin.top - margin.bottom,
      colors = ["',colors[1],'", "',colors[2],'", "',colors[3],'"],
      pointSize = [',ptSize[1],', ',ptSize[2],'], lineSize = [',lineSize[1],', ',lineSize[2],'],
      labelFontFamily = "',labfam[1],'", yLabel = "',ylab,'",
      labelFont = ',labfont,', axesFont = ',axfont,';

    // Append svg to the body
    let svg = d3.select("body")
      .append("svg")
      .attr("width", adjustedWidth + margin.left + margin.right)
      .attr("height", adjustedHeight + margin.top + margin.bottom)
      .append("g")
      .attr("transform", "translate(" + margin.left + "," + margin.top + ")");

    // Various mapping functions
    const xMap = (d) => x(d.x);
    const yMap = (d) => y(d.y);
    const ylMap = (d) => y(d.ylow);
    const yuMap = (d) => y(d.yup);

    // Axes initialization
    let rgX = [0];
    let deltaX = adjustedWidth / (data.length - 1)
    for (let j = 1; j < data.length; j++) {
      rgX.push(j * deltaX);
    }

    const x = d3.scaleOrdinal()
      .domain(Array.from(data, el => el.x))
      .range(rgX);

    const y = d3.scaleLinear()
      .domain([d3.min(data, (d) => d.ylow), d3.max(data, (d) => d.yup)])
      .range([adjustedHeight, 0]);

    svg.append("g")
      .attr("transform", "translate(0," + adjustedHeight * 1.075 + ")")
      .call(d3.axisBottom(x));

    svg.append("g")
      .attr("transform", `translate(${-adjustedWidth * .035},0)`)
      .call(d3.axisLeft(y));

    d3.selectAll(".tick").style("font-size", `${axesFont}px`)

    // Mouseover highlight function
    const highlight = ((d) => {
      for (let i = 0; i < data.length; i++) {
        if (data[i][`g${d.obs}`] === 1) {
          d3.selectAll(`circle[cx="${xMap(data[i])}"]`)
            .transition()
            .duration(50)
            .style("fill", colors[0])
            .attr("r", pointSize[0])
          d3.select(`line[x1="${xMap(data[i])}"]`)
            .transition()
            .duration(50)
            .style("stroke", colors[0])
            .attr("stroke-width", lineSize[0])
        }
      }
    });

    // Mouseleave highlight function
    const doNotHighlight = function () {
      d3.selectAll(".dot")
        .transition()
        .duration(200)
        .style("fill", colors[2])
        .attr("r", pointSize[1])

      d3.selectAll(".line")
        .transition()
        .duration(200)
        .style("stroke", colors[2])
        .attr("stroke-width", lineSize[1])
    }

    // Vertical label
    svg.append("text")
      .attr("transform", "rotate(-90)")
      .attr("y", 0 - margin.left)
      .attr("x", 0 - (adjustedHeight / 2))
      .attr("dy", "1em")
      .style("text-anchor", "middle")
      .style("font-size", `${labelFont}px`)
      .text(yLabel)
      .style("font-family", labelFontFamily);

    // Graph dot lines
    for (let m = 0; m < data.length; m++) {
      svg.append("line")
        .attr("class", "line")
        .attr("x1", xMap(data[m]))
        .attr("y1", ylMap(data[m]))
        .attr("x2", xMap(data[m]))
        .attr("y2", yuMap(data[m]))
        .attr("stroke", colors[2])
        .attr("stroke-width", lineSize[1])
    }

    // Graph points
    svg.selectAll(".dot")
      .data(data)
      .enter()
      .append("circle")
      .attr("class", "dot")
      .attr("r", pointSize[1])
      .attr("cx", xMap)
      .attr("cy", yMap)
      .on("mouseover", highlight)
      .on("mouseleave", doNotHighlight)

  </script>
</body>
</html>'
    )

    cat(h, "\n", sep = "", file = fname, append = FALSE)
    cat("var data = ", toJSON(g), ";\n", sep = "", file = fname, append = TRUE)
    cat(b, sep = "", file = fname, append = TRUE)

    tags$iframe(src = fname, height = height * 1.05, width = width * 1.05, style = "border: none")

    r2d3(data=g, options = list(axfont = 12, colors = c("#B80000", "#000000", "#000000"), ptSize = c(7,5), lineSize = c(3,1.5), labfont = 12, ylab = "Effect of Region", labfam = c("sans-serif", "serif")), script = "sigd3.js", height="500", width="750")
  }

##' Significance Plot with D3 (horizontal)
##'
##' Makes an errorbar plot using the D3.js library with a hover-over
##' effect that highlights all cagtegories that are significantly differnet
##' than the one being hovered over. The orientation of this plot is
##' horizontal rather than vertical
##'
##' @aliases sigd3h.default sigd3h.mcmc.list sigd3h.mcmc
##'
##' @param object A model that has a categorical predictor.  The function
##' uses both \code{ggpredict} from the \pkg{ggeffects} package and
##' \code{factorplot} from the \pkg{factorplot} package (with the
##' variable given by the \code{factor.var=term} argument), so the object
##' must be amenable to these manipulations.  Alternatively, it could be
##' an mcmc object in which case all columns will be plotted.
##' @param term The term from the model to be plotted.
##' @param fname Name of the file to which the html code will be written.
##' @param height Height of the plot in pixels
##' @param width Width of the plot in pixels
##' @param return_iFrame Logical indicating whether an \code{iframe}
##' should be returned to hold the plot.  If \code{FALSE} only the html
##' file is produced and the function prpduces no other visible output.
##' @param ylab Label to put on y-axis.
##' @param level Confidence level at which to do the test (or in the mcmc case, credibility level for the credible intervals).
##' @param axfont Font size for axis tick mark labels (in px).
##' @param labfont Font size for y-axis label (in px).
##' @param lmexpand Factor by which the left-margin should be expanded to accommodate tick mark labels.
##' @param labfam Font-family for y-axis label (must be one of "serif" or "sans-serif").
##' @param colors Vector of three colors the first for the selected items, the second for the un-selected items and the third for when no points are hovered over.
##' @param ptSize Vector of two point sizes - the first for selected observations and the second for unselected ones.
##' @param lineSize Vector of line widths - the first for selected observations and the second for unselected ones.
##' @param names An optional vector of names for the parameters.
##' @param order How should parameters be organized by size-ascending, size-descending or natural (i.e., the order in the data).

##'
##' @importFrom ggeffects ggpredict
##' @importFrom factorplot factorplot
##' @importFrom dplyr mutate rename select bind_cols
##' @importFrom magrittr %>%
##' @importFrom jsonlite toJSON
##' @importFrom htmltools tags
##' @importFrom stats quantile
##' @importFrom utils combn
##'
##' @return Either an html file or an iframe linked to the html file.
##' @export
sigd3h <-
  function(object,
           term,
           fname,
           height = 500,
           width = 625,
           return_iFrame = TRUE,
           level = .95,
           ylab = paste0("Effect of ", term),
           axfont = 12,
           labfont = 12,
           lmexpand = .15,
           labfam = c("sans-serif", "serif"),
           colors = c("#B80000", "#000000", "#000000"),
           ptSize = c(7, 5),
           lineSize = c(3, 1.5),
           names = NULL,
           order = c("size-descending", "size-ascending", "natural")) {
    UseMethod("sigd3h")
  }

##' @method sigd3h default
##' @export
sigd3h.default <-
  function(object,
           term,
           fname,
           height = 500,
           width = 625,
           return_iFrame = TRUE,
           level = .95,
           ylab = paste0("Effect of ", term),
           axfont = 12,
           labfont = 12,
           lmexpand = .15,
           labfam = c("sans-serif", "serif"),
           colors = c("#B80000", "#000000", "#000000"),
           ptSize = c(7, 5),
           lineSize = c(3, 1.5),
           names = NULL,
           order = c("size-descending", "size-ascending", "natural")) {
    labfam = match.arg(labfam)
    order <- match.arg(order)
    g <- ggpredict(object, terms = term)
    g <- g %>% mutate(obs = 1:nrow(g)) %>%
      rename(
        "y" = "x",
        "x" = "predicted",
        "xlow" = "conf.low",
        "xup" = "conf.high"
      ) %>%
      select("x", "y", "xlow", "xup", "obs")
    if (!is.null(names)) {
      if (length(names) == nrow(g)) {
        g <- mutate(y = names)
      } else{
        stop(
          paste0(
            "names vector (length ",
            length(names),
            " has to be the same as the number of parameters (length, ",
            nrow(g),
            ").\n"
          )
        )
      }
    }
    fp <- factorplot(object, factor.var = term, pval = 1 - level)
    mat <- matrix(0, nrow = nrow(fp$pval) + 1, ncol = ncol(fp$pval) + 1)
    mat[upper.tri(mat, diag = FALSE)] <-
      fp$pval[upper.tri(fp$pval, diag = TRUE)]
    mat <- t(mat)
    mat[upper.tri(mat, diag = FALSE)] <-
      fp$pval[upper.tri(fp$pval, diag = TRUE)]
    mat <- ifelse(mat < .05, 1, 0)
    diag(mat) <- 0

    mat <- as.data.frame(mat)
    names(mat) <- paste0("g", 1:ncol(mat))
    g <- g %>% bind_cols(mat)
    if (order == "size-ascending") {
      g <- g %>% arrange(.data$x)
    }
    if (order == "size-descending") {
      g <- g %>% arrange(-.data$x)
    }

    h <- '
    <meta charset="utf-8">
    <head>
    </head>
    <body>
    <script src="https://d3js.org/d3-selection.v1.min.js"></script>
    <script src="https://d3js.org/d3.v4.js"></script>
    <script src="https://code.jquery.com/jquery-3.5.1.min.js"></script>

    <script>'

    b <- paste0(
      '
  </script>

  <script>
    var  h=',
      height,
      ';
    var w =',
      width,
      ';
    var margin = {top: h*.02, left: w*',
      lmexpand,
      ', bottom: h*',
      (0.1 * (axfont / 8)),
      ', right: w*.05},
      width = w - margin.left - margin.right,
      height = h - margin.top - margin.bottom;

    var rgY = [0];
    var deltaY = height/(data.length-1);
    var j;
    for(j =1; j<data.length; j++){
      rgY.push(j*deltaY);
    }

// append the svg object to the body of the page
var svg = d3.select("body")
  .append("svg")
  .attr("width", width + margin.left + margin.right)
  .attr("height", height + margin.top + margin.bottom)
  .append("g")
  .attr("transform",
        "translate(" + margin.left + "," + margin.top + ")");

  var xValue = function(d){return d.x};
  var yValue = function(d){return d.y};
  var xlValue = function(d){return d.xlow};
  var xuValue = function(d){return d.xup};

  var yDom =[];
  data.forEach(d => yDom.push(d.y));

  var y = d3.scaleOrdinal()
  .domain(yDom)
  .range(rgY);

  var x = d3.scaleLinear()
  .domain([d3.min(data, xlValue), d3.max(data, xuValue)])
  .range([0, width]);

  var xMap = function(d){return x(xValue(d))}
  var xlMap = function(d){return x(xlValue(d))}
  var xuMap = function(d){return x(xuValue(d))}
  var yMap = function(d){return y(yValue(d))}

var highlight = function(d){
  var sel = d.obs;
  var gvar = `g${sel}`;
  var i;
  for(i = 0; i < data.length; i++){
    if(data[i][gvar] === 1){
      document.querySelector(`circle[cy="${yMap(data[i])}"]`).classList.add("dot-selected");
      document.querySelector(`circle[cy="${yMap(data[i])}"]`).classList.remove("dot-unselected");
      document.querySelector(`line[y1="${yMap(data[i])}"]`).classList.add("line-selected");
      document.querySelector(`line[y1="${yMap(data[i])}"]`).classList.remove("line-unselected");
    }else{
      document.querySelector(`circle[cy="${yMap(data[i])}"]`).classList.remove("dot-selected");
      document.querySelector(`circle[cy="${yMap(data[i])}"]`).classList.add("dot-unselected");
      document.querySelector(`line[y1="${yMap(data[i])}"]`).classList.remove("line-selected");
      document.querySelector(`line[y1="${yMap(data[i])}"]`).classList.add("line-unselected");
    }
  }

  d3.selectAll(".dot-selected")
  .transition()
  .duration(50)
  .style("fill", "',
      colors[1],
      '")
  .attr("r",',
      ptSize[1],
      ')

  d3.selectAll(".line-selected")
  .transition()
  .duration(50)
  .style("stroke", "',
      colors[1],
      '")
  .attr("stroke-width",',
      lineSize[1],
      ')

  d3.selectAll(".dot-unselected")
  .transition()
  .duration(50)
  .style("fill", "',
      colors[2],
      '")
  .attr("r",',
      ptSize[2],
      ')

  d3.selectAll(".line-unselected")
  .transition()
  .duration(50)
  .style("stroke", "',
      colors[2],
      '")
  .attr("stroke-width",',
      lineSize[2],
      ')
}

// Highlight the specie that is hovered
var doNotHighlight = function(){
  d3.selectAll(".dot")
  .transition()
  .duration(200)
  .style("fill", "', colors[3], '")
  .attr("r",', ptSize[2], ')

  d3.selectAll(".line")
  .transition()
  .duration(200)
  .style("stroke", "', colors[3], '")
  .attr("stroke-width",', lineSize[2], ')

}

svg.append("g")
.attr("transform", "translate(0," + height*1.025 + ")")
.call(d3.axisBottom(x).tickSizeOuter(0));

svg
.append("g")
.attr("transform", `translate(${-width*.035},0)`)
.call(d3.axisLeft(y));

svg.append("text")
.attr("y", 0 - margin.bottom)
.attr("y2",0 - width/2)
.attr("dy", "1em")
.style("text-anchor", "middle")
.style("font-size","', labfont, 'px")
.text("', ylab, '")
.style("font-family", "', labfam, '");

var m;
for(m=0; m<data.length; m++){
  svg
  .append("line")
  .attr("class", "line")
  .attr("x1", xlMap(data[m]))
  .attr("y1", yMap(data[m]))
  .attr("x2", xuMap(data[m]))
  .attr("y2", yMap(data[m]))
  .attr("stroke", "', colors[3], '")
  .attr("stroke-width",', lineSize[2], ')
}

svg
.selectAll(".dot")
.data(data)
.enter()
.append("circle")
.attr("class", "dot")
.attr("r",', ptSize[2], ')
.attr("cx", xMap)
.attr("cy", yMap)
.on("mouseover", highlight)
.on("mouseleave", doNotHighlight )

d3.selectAll(".tick").style("font-size", "', axfont, 'px")

</script>
</body>
')

    cat(h,
        "\n",
        sep  =  "",
        file  =  fname,
        append  =  FALSE)

    cat(
      "var data = ",
      toJSON(g),
      ";\n",
      sep  =  "",
      file  =  fname,
      append  =  TRUE
    )

    cat(b,
        sep  =  "",
        file  =  fname,
        append  =  TRUE)

    if (return_iFrame) {
      tags$iframe(
        src  =  fname,
        height  =  height  *  1.05,
        width  =  width  *  1.05,
        style  =  "border: none"
      )
    }
  }

##' @method sigd3h mcmc.list
##' @export
sigd3h.mcmc.list <-
  function(object,
           term,
           fname,
           height = 500,
           width = 625,
           return_iFrame = TRUE,
           level = .95,
           ylab = paste0("Effect of ", term),
           axfont = 12,
           labfont = 12,
           lmexpand = .15,
           labfam = c("sans-serif", "serif"),
           colors = c("#B80000", "#000000", "#000000"),
           ptSize = c(7, 5),
           lineSize = c(3, 1.5),
           names = NULL,
           order = c("size-descending", "size-ascending", "natural")) {
    object <- do.call(rbind, object)

    sigd3h.mcmc(
      object = object,
      term = term,
      fname = fname,
      height = height,
      width = width,
      return_iFrame = return_iFrame,
      level = level,
      ylab = ylab,
      axfont = axfont,
      labfont = labfont,
      lmexpand = lmexpand,
      labfam = labfam,
      colors = colors,
      ptSize = ptSize,
      lineSize = lineSize,
      names = names,
      order = order
    )
  }

##' @method sigd3h mcmc
##' @export
sigd3h.mcmc <-
  function(object,
           term,
           fname,
           height = 500,
           width = 625,
           return_iFrame = TRUE,
           level = .95,
           ylab = paste0("Effect of ", term),
           axfont = 12,
           labfont = 12,
           lmexpand = .15,
           labfam = c("sans-serif", "serif"),
           colors = c("#B80000", "#000000", "#000000"),
           ptSize = c(7, 5),
           lineSize = c(3, 1.5),
           names = NULL,
           order = c("size-descending", "size-ascending", "natural")) {
    labfam = match.arg(labfam)
    order <- match.arg(order)

    if (!is.null(names)) {
      if (length(names) == ncol(object)) {
        colnames(object) = names
      } else{
        stop(
          paste0(
            "names vector (length ",
            length(names),
            " has to be the same as the number of parameters (length, ",
            ncol(object),
            ").\n"
          )
        )
      }

    }
    g <- data.frame(
      y = colnames(object),
      x = colMeans(object),
      xlow = apply(object, 2, quantile, (1 - level) / 2),
      xup = apply(object, 2, quantile, 1 - (1 - level) / 2),
      obs = 1:ncol(object)
    )

    combs <- combn(ncol(object), 2)
    m1 <- object[, combs[1, ]]
    m2 <- object[, combs[2, ]]
    diffs <- m2 - m1
    g0 <- apply(diffs, 2, function(x)
      mean(x > 0))

    mat <- matrix(0, nrow = ncol(object), ncol = ncol(object))
    mat[cbind(combs[1, ], combs[2, ])] <- g0
    mat <- t(mat)
    mat[cbind(combs[1, ], combs[2, ])] <- g0
    mat <- ifelse(mat > level | mat < (1 - level), 1, 0)
    diag(mat) <- 0
    mat <- as.data.frame(mat)
    names(mat) <- paste0("g", 1:ncol(mat))
    g <- g %>% bind_cols(mat)
    if (order == "size-ascending") {
      g <- g %>% arrange(.data$x)
    }
    if (order == "size-descending") {
      g <- g %>% arrange(-.data$x)
    }

    h <- '
    <meta charset="utf-8">
    <head>
    </head>
    <body>
    <script src="https://d3js.org/d3-selection.v1.min.js"></script>
    <script src="https://d3js.org/d3.v4.js"></script>
    <script src="https://code.jquery.com/jquery-3.5.1.min.js"></script>

    <script>'

    b <- paste0(
      '
  </script>

  <script>
    var  h=',
      height,
      ';
    var w =',
      width,
      ';
    var margin = {top: h*.02, left: w*',
      lmexpand,
      ', bottom: h*',
      (0.1 * (axfont / 8)),
      ', right: w*.05},
      width = w - margin.left - margin.right,
      height = h - margin.top - margin.bottom;

    var rgY = [0];
    var deltaY = height/(data.length-1);
    var j;
    for(j =1; j<data.length; j++){
      rgY.push(j*deltaY);
    }

// append the svg object to the body of the page
var svg = d3.select("body")
  .append("svg")
  .attr("width", width + margin.left + margin.right)
  .attr("height", height + margin.top + margin.bottom)
  .append("g")
  .attr("transform",
        "translate(" + margin.left + "," + margin.top + ")");

  var xValue = function(d){return d.x};
  var yValue = function(d){return d.y};
  var xlValue = function(d){return d.xlow};
  var xuValue = function(d){return d.xup};

  var yDom =[];
  data.forEach(d => yDom.push(d.y));

  var y = d3.scaleOrdinal()
  .domain(yDom)
  .range(rgY);

  var x = d3.scaleLinear()
  .domain([d3.min(data, xlValue), d3.max(data, xuValue)])
  .range([0, width]);

  var xMap = function(d){return x(xValue(d))}
  var xlMap = function(d){return x(xlValue(d))}
  var xuMap = function(d){return x(xuValue(d))}
  var yMap = function(d){return y(yValue(d))}

var highlight = function(d){
  var sel = d.obs;
  var gvar = `g${sel}`;
  var i;
  for(i = 0; i < data.length; i++){
    if(data[i][gvar] === 1){
      document.querySelector(`circle[cy="${yMap(data[i])}"]`).classList.add("dot-selected");
      document.querySelector(`circle[cy="${yMap(data[i])}"]`).classList.remove("dot-unselected");
      document.querySelector(`line[y1="${yMap(data[i])}"]`).classList.add("line-selected");
      document.querySelector(`line[y1="${yMap(data[i])}"]`).classList.remove("line-unselected");
    }else{
      document.querySelector(`circle[cy="${yMap(data[i])}"]`).classList.remove("dot-selected");
      document.querySelector(`circle[cy="${yMap(data[i])}"]`).classList.add("dot-unselected");
      document.querySelector(`line[y1="${yMap(data[i])}"]`).classList.remove("line-selected");
      document.querySelector(`line[y1="${yMap(data[i])}"]`).classList.add("line-unselected");
    }
  }

  d3.selectAll(".dot-selected")
  .transition()
  .duration(50)
  .style("fill", "',
      colors[1],
      '")
  .attr("r",',
      ptSize[1],
      ')

  d3.selectAll(".line-selected")
  .transition()
  .duration(50)
  .style("stroke", "',
      colors[1],
      '")
  .attr("stroke-width",',
      lineSize[1],
      ')

  d3.selectAll(".dot-unselected")
  .transition()
  .duration(50)
  .style("fill", "',
      colors[2],
      '")
  .attr("r",',
      ptSize[2],
      ')

  d3.selectAll(".line-unselected")
  .transition()
  .duration(50)
  .style("stroke", "',
      colors[2],
      '")
  .attr("stroke-width",',
      lineSize[2],
      ')
}

// Highlight the specie that is hovered
var doNotHighlight = function(){
  d3.selectAll(".dot")
  .transition()
  .duration(200)
  .style("fill", "', colors[3], '")
  .attr("r",', ptSize[2], ')

  d3.selectAll(".line")
  .transition()
  .duration(200)
  .style("stroke", "', colors[3], '")
  .attr("stroke-width",', lineSize[2], ')

}

svg.append("g")
.attr("transform", "translate(0," + height*1.025 + ")")
.call(d3.axisBottom(x).tickSizeOuter(0));

svg
.append("g")
.attr("transform", `translate(${-width*.035},0)`)
.call(d3.axisLeft(y));

svg.append("text")
.attr("y", 0 - margin.bottom)
.attr("y2",0 - width/2)
.attr("dy", "1em")
.style("text-anchor", "middle")
.style("font-size","', labfont, 'px")
.text("', ylab, '")
.style("font-family", "', labfam, '");

var m;
for(m=0; m<data.length; m++){
  svg
  .append("line")
  .attr("class", "line")
  .attr("x1", xlMap(data[m]))
  .attr("y1", yMap(data[m]))
  .attr("x2", xuMap(data[m]))
  .attr("y2", yMap(data[m]))
  .attr("stroke", "', colors[3], '")
  .attr("stroke-width",', lineSize[2], ')
}

svg
.selectAll(".dot")
.data(data)
.enter()
.append("circle")
.attr("class", "dot")
.attr("r",', ptSize[2], ')
.attr("cx", xMap)
.attr("cy", yMap)
.on("mouseover", highlight)
.on("mouseleave", doNotHighlight )

d3.selectAll(".tick").style("font-size", "', axfont, 'px")

</script>
</body>
')

    cat(h,
        "\n",
        sep  =  "",
        file  =  fname,
        append  =  FALSE)

    cat(
      "var data = ",
      toJSON(g),
      ";\n",
      sep  =  "",
      file  =  fname,
      append  =  TRUE
    )

    cat(b,
        sep  =  "",
        file  =  fname,
        append  =  TRUE)

    if (return_iFrame) {
      tags$iframe(
        src  =  fname,
        height  =  height  *  1.05,
        width  =  width  *  1.05,
        style  =  "border: none"
      )
    }
  }

#' Corporatism
#'
#' A dataset from Alvarez, Garrett and Lange's 1991 APSR article.
#'
#' @format A list with the following variables for 16 countries over 14 years:
#' \describe{
#'   \item{y}{Economic growth}
#'   \item{country}{Country indicator variable}
#'   \item{imports}{Imports price movement}
#'   \item{exports}{Export price movement}
#'   \item{left}{Leftist government}
#'   \item{demand}{Demand}
#'   \item{growth.lag}{Lag of economic growth}
#'   \item{labor.org}{Labor organizations prevalence, only one observation per country}
#' }
#' @source \url{https://spia.uga.edu/faculty_pages/rbakker/bayes/POLS%20Bayes.htm}
"corp"


library(lattice)
eval.polyglot(path = 'babylonian-demo/fibonacci-complete.js')

# <Example :name="fib" func="import('fibonacci')" start="0" end="20" />
plotFunction <- function(func, start, end) {
  x <- seq(from = start, to = end, by = 1)
  # <Probe />
  y <- lapply(x, (function(n) func(n)))
  svg()
  print(xyplot(y ~ x, type="p", cex=2, pch=16))
  grDevices:::svg.off()
}


##%######################################################%##
#                                                          #
####                 2. Model selection                 ####
#                                                          #
##%######################################################%##

# This script carries out the model selection process using the dataset generated
# in the previous script. Models are run for 2 biodiversity metrics.

rm(list = ls())

# load libraries
library(devtools)
#install_github(repo = "timnewbold/StatisticalModels")
library(StatisticalModels)
library(cowplot)
library(gridGraphics)

# directories
datadir <- "1_PREDICTS_PLUS_VARIABLES/"
outdir <- "2_MODEL_SELECTION/"
if(!dir.exists(outdir)) dir.create(outdir)

# read in the PREDICTS datasets with landscape variables

load(paste0(datadir, "/PREDICTS_dataset_TRANS_INSECTS.rdata")) # final.data.trans

#### Run model selection process including landscape variables that are not correlated ####

##%######################################################%##
#                                                          #
####                1. Species richness                 ####
#                                                          #
##%######################################################%##

#### 1. Species richness models ####

### A. ALL INSECTS ###

# run the model selection process

system.time({sr1 <- GLMERSelect(modelData = final.data.trans,
                                responseVar = "Species_richness",
                                fitFamily = "poisson",
                                fixedFactors = c("Predominant_land_use", "Use_intensity", "fields"),
                                fixedTerms = list(pest_H_RS = 1, ncrop_RS = 1, percNH_RS = 1),
                                randomStruct = "(1|SS)+(1|SSB)+(1|SSBS)",
                                fixedInteractions = c("Predominant_land_use:pest_H_RS",
                                                      "Predominant_land_use:ncrop_RS",
                                                      "Predominant_land_use:percNH_RS",
                                                      "Predominant_land_use:fields",
                                                      "Use_intensity:pest_H_RS",
                                                      "Use_intensity:ncrop_RS",
                                                      "Use_intensity:percNH_RS",
                                                      "Use_intensity:fields",
                                                      "Predominant_land_use:Use_intensity"), verbose = F)})
# save the output
save(sr1, file = paste0(outdir, "/SPECIESRICHNESS_Model_selection_INSECTS.rdata"))

# take a look at the model output
summary(sr1$model)

# extract the stats produced as part of the model selection process
sr1stats <- as.data.frame(sr1$stats)

# save these
write.csv(sr1stats, file = paste0(outdir, "/sr_stats_INSECTS.csv"), row.names = F)

# Non selection version to assess all variables

sr2 <- GLMER(modelData = final.data.trans,responseVar = "Species_richness",fitFamily = "poisson",
             fixedStruct = "Predominant_land_use +  Use_intensity + fields + pest_H_RS + ncrop_RS + percNH_RS + Predominant_land_use:pest_H_RS + Predominant_land_use:ncrop_RS + Predominant_land_use:percNH_RS + Predominant_land_use:fields + Use_intensity:pest_H_RS + Use_intensity:ncrop_RS + Use_intensity:percNH_RS+ Use_intensity:fields + Predominant_land_use:Use_intensity",
             randomStruct = "(1|SS)+(1|SSB)+(1|SSBS")

summary(sr2$model)

# save the output
save(sr2, file = paste0(outdir, "/RICHNESS_Model_Set_INSECTS.rdata"))

##%######################################################%##
#                                                          #
####                    2. Abundance                    ####
#                                                          #
##%######################################################%##

model_data <- final.data.trans[!is.na(final.data.trans$logAbun), ] # 4681 rows

length(unique(model_data$SS)) # 229
length(unique(model_data$SSBS)) # 4681

### A. ALL INSECTS ######SSBS A. ALL INSECTS ###

system.time({ab1 <- GLMERSelect(modelData = final.data.trans,
                                responseVar = "logAbun",
                                fitFamily = "gaussian",
                                fixedFactors = c("Predominant_land_use", "Use_intensity", "fields"),
                                fixedTerms = list(pest_H_RS = 1, ncrop_RS = 1, percNH_RS = 1),
                                randomStruct = "(1|SS)+(1|SSB)",
                                fixedInteractions = c("Predominant_land_use:pest_H_RS",
                                                      "Predominant_land_use:ncrop_RS",
                                                      "Predominant_land_use:percNH_RS",
                                                      "Predominant_land_use:fields",
                                                      "Use_intensity:pest_H_RS",
                                                      "Use_intensity:ncrop_RS",
                                                      "Use_intensity:percNH_RS",
                                                      "Use_intensity:fields",
                                                      "Predominant_land_use:Use_intensity"), verbose = F)})
# take a look at the model output
summary(ab1$model)

# save the output
save(ab1, file = paste0(outdir, "/ABUNDANCE_Model_Selection_INSECTS.rdata"))

# extract the stats produced as part of the model selection process
ab1stats <- as.data.frame(ab1$stats)

# save these
write.csv(ab1stats, file = paste0(outdir, "/ab_stats_INSECTS.csv"), row.names = F)

# Non selection version to assess all variables

ab2 <- GLMER(modelData = final.data.trans,responseVar = "logAbun",fitFamily = "gaussian",
      fixedStruct = "Predominant_land_use +  Use_intensity + fields + pest_H_RS + ncrop_RS + percNH_RS + Predominant_land_use:pest_H_RS + Predominant_land_use:ncrop_RS + Predominant_land_use:percNH_RS + Predominant_land_use:fields + Use_intensity:pest_H_RS + Use_intensity:ncrop_RS + Use_intensity:percNH_RS+ Use_intensity:fields + Predominant_land_use:Use_intensity",
      randomStruct = "(1|SS)+(1|SSB)")

summary(ab2$model)

# save the output
save(ab2, file = paste0(outdir, "/ABUNDANCE_Model_Set_INSECTS.rdata"))

##%######################################################%##
#                                                          #
####        Run final selected model using REML         ####
#                                                          #
##%######################################################%##

### selected model for species richness ###

# one model with ncrop, one without #

### A. ALL INSECTS ###

# rerun the selected models, using REML

srmod_IN <- GLMER(modelData = final.data.trans, responseVar = "Species_richness", fitFamily = "poisson",
               fixedStruct = "Predominant_land_use + Forest_biome + Use_intensity + Tropical + percNH + ncrop + Predominant_land_use:percNH + Predominant_land_use:Use_intensity + Tropical:percNH",
               randomStruct = "(1|SS) + (1|SSB) + (1|SSBS)", REML = TRUE)

srmod_IN2 <- GLMER(modelData = final.data.trans, responseVar = "Species_richness", fitFamily = "poisson",
                   fixedStruct = "Predominant_land_use + Forest_biome + Use_intensity + Tropical + percNH + Predominant_land_use:percNH + Predominant_land_use:Use_intensity + Tropical:percNH",
                   randomStruct = "(1|SS) + (1|SSB) + (1|SSBS)", REML = TRUE)

# Warning messages: none

# take a look at the model output
summary(srmod_IN$model)
summary(srmod_IN2$model)

# extract the coefficents of the model
coefs <- fixef(srmod_IN$model)
coefs2 <- fixef(srmod_IN2$model)

# save the coefficients
write.csv(coefs, file = paste0(outdir, "/SPECIESRICHNESS_coefs_INSECTS_ncrops.csv"), row.names = F)
write.csv(coefs2, file = paste0(outdir, "/SPECIESRICHNESS_coefs_INSECTS.csv"), row.names = F)

# save the model output
save(srmod_IN, file = paste0(outdir, "/SRMOD_output_INSECTS_ncrops.rdata"))
save(srmod_IN2, file = paste0(outdir, "/SRMOD_output_INSECTS.rdata"))

### B. POLLINATORS ###

# selected model for species richness:

# rerun the selected models, using REML

srmod_PO <- GLMER(modelData = final.data.trans.pols, responseVar = "Species_richness", fitFamily = "poisson",
                  fixedStruct = "Predominant_land_use + Use_intensity + percNH + ncrop + Predominant_land_use:Use_intensity",
                  randomStruct = "(1|SS) + (1|SSB) + (1|SSBS)", REML = TRUE)

srmod_PO2 <- GLMER(modelData = final.data.trans.pols, responseVar = "Species_richness", fitFamily = "poisson",
                   fixedStruct = "Predominant_land_use + Use_intensity + percNH + Predominant_land_use:Use_intensity",
                   randomStruct = "(1|SS) + (1|SSB) + (1|SSBS)", REML = TRUE)

# Warning messages: none

# take a look at the model output
summary(srmod_PO$model)
summary(srmod_PO2$model)

# extract the coefficents of the model
coefs <- fixef(srmod_PO$model)
coefs2 <- fixef(srmod_PO2$model)

# save the coefficients
write.csv(coefs, file = paste0(outdir, "/SPECIESRICHNESS_coefs_POLLINATORS_ncrop.csv"), row.names = F)
write.csv(coefs2, file = paste0(outdir, "/SPECIESRICHNESS_coefs_POLLINATORS.csv"), row.names = F)

# save the model output
save(srmod_PO, file = paste0(outdir, "/SRMOD_output_POLLINATORS_ncrop.rdata"))
save(srmod_PO2, file = paste0(outdir, "/SRMOD_output_POLLINATORS.rdata"))

### C. PEST CONTROLLERS ###

# selected model for species richness:

# rerun the selected models, using REML

srmod_PC <- GLMER(modelData = final.data.trans.pc, responseVar = "Species_richness", fitFamily = "poisson",
                  fixedStruct = "Predominant_land_use + Forest_biome + Use_intensity + ncrop + percNH + landcovers.5k + Predominant_land_use:ncrop + Predominant_land_use:landcovers.5k +  Use_intensity:ncrop + Use_intensity:percNH",
                  randomStruct = "(1|SS) + (1|SSB) + (1|SSBS)", REML = TRUE)

srmod_PC2 <- GLMER(modelData = final.data.trans.pc, responseVar = "Species_richness", fitFamily = "poisson",
                  fixedStruct = "Predominant_land_use + Forest_biome + Use_intensity + pest_H_log + percNH + landcovers.5k + Predominant_land_use:pest_H_log + Use_intensity:percNH",
                  randomStruct = "(1|SS) + (1|SSB) + (1|SSBS)", REML = TRUE)

# Warning messages: none

# take a look at the model output
summary(srmod_PC$model)
summary(srmod_PC2$model)

# extract the coefficents of the model
coefs <- fixef(srmod_PC$model)
coefs2 <- fixef(srmod_PC2$model)

# save the coefficients
write.csv(coefs, file = paste0(outdir, "/SPECIESRICHNESS_coefs_PESTC_ncrop.csv"), row.names = F)
write.csv(coefs2, file = paste0(outdir, "/SPECIESRICHNESS_coefs_PESTC.csv"), row.names = F)

# save the model output
save(srmod_PC, file = paste0(outdir, "/SRMOD_output_PESTC_ncrop.rdata"))
save(srmod_PC2, file = paste0(outdir, "/SRMOD_output_PESTC.rdata"))

### Selected model for abundance ###

### A. ALL INSECTS ###

# selected model:

# run selected model with REML

abmod_IN <- GLMER(modelData = final.data.trans, responseVar = "logAbun", fitFamily = "gaussian",
               fixedStruct = "Predominant_land_use + Forest_biome + Use_intensity + pest_H_log + Use_intensity:pest_H_log + Predominant_land_use:Use_intensity",
               randomStruct = "(1|SS) + (1|SSB)", REML = TRUE)

abmod_IN2 <- GLMER(modelData = final.data.trans, responseVar = "logAbun", fitFamily = "gaussian",
                  fixedStruct = "Predominant_land_use + Forest_biome + Use_intensity + pest_H_log + Use_intensity:pest_H_log + Predominant_land_use:Use_intensity",
                  randomStruct = "(1|SS) + (1|SSB)", REML = TRUE)

# warnings: none

# take a look at the model output
summary(abmod_IN$model)
summary(abmod_IN2$model)

# extract the coefficents of the model
coefs <- fixef(abmod_IN$model)
coefs2 <- fixef(abmod_IN2$model)

# save the coefficients
write.csv(coefs, file = paste0(outdir, "/ABUNDANCE_coefs_INSECTS_ncrop.csv"), row.names = F)
write.csv(coefs2, file = paste0(outdir, "/ABUNDANCE_coefs_INSECTS.csv"), row.names = F)

# save the model output
save(abmod_IN, file = paste0(outdir, "/ABMOD_output_INSECTS_ncrop.rdata"))
save(abmod_IN, file = paste0(outdir, "/ABMOD_output_INSECTS.rdata"))

### B. POLLINATORS ###

# selected model:

# run selected model with REML

abmod_PO <- GLMER(modelData = final.data.trans.pols, responseVar = "logAbun", fitFamily = "gaussian",
                  fixedStruct = "Predominant_land_use + Use_intensity + Predominant_land_use:Use_intensity",
                  randomStruct = "(1|SS) + (1|SSB)", REML = TRUE)

# both models were the same with and without ncrop variable

# warnings: none

# take a look at the model output
summary(abmod_PO$model)

# extract the coefficents of the model
coefs <- fixef(abmod_PO$model)

# save the coefficients
write.csv(coefs, file = paste0(outdir, "/ABUNDANCE_coefs_POLLINATORS.csv"), row.names = F)

# save the model output
save(abmod_PO, file = paste0(outdir, "/ABMOD_output_POLLINATORS.rdata"))

### C. PEST CONTROLLERS ###

# selected model:

# run selected model with REML

abmod_PC <- GLMER(modelData = final.data.trans.pc, responseVar = "logAbun", fitFamily = "gaussian",
                  fixedStruct = "Predominant_land_use + Forest_biome + Use_intensity + percNH + ncrop + landcovers.5k + Predominant_land_use:ncrop + Predominant_land_use:landcovers.5k + Predominant_land_use:percNH + Use_intensity:ncrop + Predominant_land_use:Use_intensity",
                  randomStruct = "(1|SS) + (1|SSB)", REML = TRUE)

abmod_PC2 <- GLMER(modelData = final.data.trans.pc, responseVar = "logAbun", fitFamily = "gaussian",
                  fixedStruct = "Predominant_land_use + Forest_biome + Use_intensity + percNH + pest_H_log + landcovers.5k + Predominant_land_use:percNH + Predominant_land_use:landcovers.5k + Use_intensity:pest_H_log + Predominant_land_use:Use_intensity",
                  randomStruct = "(1|SS) + (1|SSB)", REML = TRUE)

# warnings:

# take a look at the model output
summary(abmod_PC$model)
summary(abmod_PC2$model)

# extract the coefficents of the model
coefs <- fixef(abmod_PC$model)
coefs2 <- fixef(abmod_PC2$model)

# save the coefficients
write.csv(coefs, file = paste0(outdir, "/ABUNDANCE_coefs_PESTC_ncrop.csv"), row.names = F)
write.csv(coefs2, file = paste0(outdir, "/ABUNDANCE_coefs_PESTC.csv"), row.names = F)

# save the model output
save(abmod_PC, file = paste0(outdir, "/ABMOD_output_PESTC_ncrop.rdata"))
save(abmod_PC2, file = paste0(outdir, "/ABMOD_output_PESTC.rdata"))