rm(list = ls()) # This clears everything from memory.

library(dplyr)
library(ggplot2)

setwd("~/Dropbox/BCI_Turnover")
load("BCI_turnover20150611.RData")
source("~/Dropbox/MS/TurnoverBCI/TurnoverBCImain/source.R")
# prepare data set
ab.data <- as.data.frame(sapply(D20m,function(x)apply(x,2,sum)))
ab.data$sp <- rownames(ab.data)
trait.temp <- data.frame(sp=rownames(trait),
           moist=trait$Moist,
           slope=trait$sp.slope.mean,
           slope.sd = trait$sp.slope.sd,
           convex=trait$sp.convex.mean,
           convex.sd=trait$sp.convex.sd,
           WSG=trait$WSG,
           slope10=trait$slope_size_10,
           slope20=trait$slope_size_20,
           slope30=trait$slope_size_30,
           slope40=trait$slope_size_40,
           slope50=trait$slope_size_50,
           slope60=trait$slope_size_60,
           slope70=trait$slope_size_70,
           slope80=trait$slope_size_80,
           slope90=trait$slope_size_90,
           slope100=trait$slope_size_100,
           convex10=trait$convex_size_10,
           convex20=trait$convex_size_20,
           convex30=trait$convex_size_30,
           convex40=trait$convex_size_40,
           convex50=trait$convex_size_50,
           convex60=trait$convex_size_60,
           convex70=trait$convex_size_70,
           convex80=trait$convex_size_80,
           convex90=trait$convex_size_90,
           convex100=trait$convex_size_100)

ab.t.data <- merge(ab.data,trait.temp,by="sp")
rownames(ab.t.data) <- ab.t.data$sp
ab.t.data2 <- na.omit(ab.t.data)

#this may be useful way to detect species.
#using the product of delta abundance and deviaiton from mean (or median) trait for each species
WSGab <- data.frame(sp = ab.t.data$sp,
        delta_ab = ab.t.data$census_2010/sum(ab.t.data$census_2010) -     ab.t.data$census_1982/sum(ab.t.data$census_1982),
        delta_ab2 = ab.t.data$census_2010 - ab.t.data$census_1982,
        delta_ab3 = ab.t.data$census_2010/ab.t.data$census_1982,
        WSG = ab.t.data$WSG,
        WSG_delta =ab.t.data$WSG - mean(ab.t.data$WSG,na.rm=T))
WSGab$index <- as.numeric(scale(WSGab$delta_ab)) * as.numeric(scale(WSGab$WSG_delta))

WSGab <- WSGab[order(WSGab$index),]

# moistab
moistab <- data.frame(sp = ab.t.data2$sp,
                    delta_ab = ab.t.data2$census_2010/sum(ab.t.data2$census_2010) - ab.t.data2$census_1982/sum(ab.t.data2$census_1982),
                    moist = ab.t.data2$moist,
                    moist_delta =ab.t.data2$moist - mean(ab.t.data2$moist))
moistab$index <- as.numeric(scale(moistab$delta_ab)) * as.numeric(scale(moistab$moist_delta))

# moistab$index2 <- moistab$delta_ab * moistab$moist_delta

moistab <- moistab[order(moistab$index),]

# convex100ab
convexab <- data.frame(sp = ab.t.data2$sp,
                    delta_ab = ab.t.data2$census_2010/sum(ab.t.data2$census_2010) - ab.t.data2$census_1982/sum(ab.t.data2$census_1982),
                    convex = ab.t.data2$convex,
                    convex_delta =ab.t.data2$convex - mean(ab.t.data2$convex))
convexab$index <- as.numeric(scale(convexab$delta_ab)) * as.numeric(scale(convexab$convex_delta))

# convexab$index2 <- convexab$delta_ab * convexab$_delta

convexab <- convexab[order(convexab$index),]

# slope100ab
slopeab <- data.frame(sp = ab.t.data2$sp,
                    delta_ab = ab.t.data2$census_2010/sum(ab.t.data2$census_2010) - ab.t.data2$census_1982/sum(ab.t.data2$census_1982),
                    slope = ab.t.data2$slope,
                    slope_delta =ab.t.data2$slope - mean(ab.t.data2$slope))
slopeab$index <- as.numeric(scale(slopeab$delta_ab)) * as.numeric(scale(slopeab$slope_delta))

slopeab <- slopeab[order(slopeab$index),]

#using the product of delta abundance and deviaiton from mean (or median) trait for each species
WSGab <- data.frame(sp = ab.t.data$sp,
                    delta_ab = ab.t.data$census_2010/sum(ab.t.data$census_2010) - ab.t.data$census_1982/sum(ab.t.data$census_1982),
                    WSG = ab.t.data$WSG,
                    WSG_delta =ab.t.data$WSG - mean(WSG100[[1]])) %>%
                    mutate(WSG_delta2 = WSG - mean(WSG, na.rm = T))

WSGab$index <- WSGab$delta_ab * WSGab$WSG_delta*100

WSGab <- WSGab[order(WSGab$index),]

# moistab
moistab <- data.frame(sp = ab.t.data$sp,
                    delta_ab = ab.t.data$census_2010/sum(ab.t.data$census_2010) - ab.t.data$census_1982/sum(ab.t.data$census_1982),
                    moist = ab.t.data$moist,
                    moist_delta = ab.t.data$moist - mean(Moist100[[1]]))
moistab$index <- moistab$delta_ab * moistab$moist_delta*100

moistab <- moistab[order(moistab$index),]

# convex100ab
convexab <- data.frame(sp = ab.t.data$sp,
                    delta_ab = ab.t.data$census_2010/sum(ab.t.data$census_2010) - ab.t.data$census_1982/sum(ab.t.data$census_1982),
                    convex = ab.t.data$convex,
                    convex_delta =ab.t.data$convex - mean(convex100[[1]]))
convexab$index <- convexab$delta_ab * convexab$convex_delta*100

convexab <- convexab[order(convexab$index),]
# convexab <- convexab[order(convexab$convex),]

# slopeab
slopeab <- data.frame(sp = ab.t.data$sp,
                    delta_ab = ab.t.data$census_2010/sum(ab.t.data$census_2010) - ab.t.data$census_1982/sum(ab.t.data$census_1982),
                    slope = ab.t.data$slope,
                    slope_delta =ab.t.data$slope - mean(slope100[[1]]))
slopeab$index <- slopeab$delta_ab * slopeab$slope_delta*100

slopeab <- slopeab[order(slopeab$index),]

# sp list for appendix ====================================================

taxa <- read.csv("~/Dropbox/MS/TurnoverBCI/nomenclature_R_20120305_Rready-2.csv")

sp_list <- WSGab %>%
  mutate(Wood_density = round(index, 4)) %>%
  mutate(Abundance_change = round(delta_ab, 4)) %>%
  dplyr::select(sp, Abundance_change, Wood_density, -index) %>%
  full_join(., moistab, by = "sp") %>%
  mutate(Moisture = round(index, 4)) %>%
  dplyr::select(-index) %>%
  full_join(., convexab, by = "sp") %>%
  mutate(Convexity = round(index, 4)) %>%
  dplyr::select(-index) %>%
  full_join(., slopeab, by = "sp") %>%
  mutate(Slope = round(index, 4), sp6 = sp) %>%
  left_join(., taxa, by = "sp6") %>%
  dplyr::select(sp, family, genus, species,
    Abundance_change, Wood_density, Moisture, Convexity, Slope) %>%
  arrange(sp) %>%
  mutate(species = paste(genus, species)) %>%
  dplyr::select(-genus)

write.csv(sp_list, "/Users/mattocci/Dropbox/MS/TurnoverBCI/sp_list.csv")

#
# par(mfrow = c(2,2))
# moge <- sp_list$Wood_density %>% sort(decreasing = T)
# wsg_posi <- moge[moge>0]
# plot(1:length(wsg_posi), 100 *cumsum(wsg_posi)/sum(moge,na.rm=T), type = "b",
#   ylab = "cumulative contributoin index of wood density (%)", xlab = "Number of species", ylim = c(0, max(100 *cumsum(wsg_posi)/sum(moge,na.rm=T))))
# abline(h = 100, lty = 2)
#
# moge <- sp_list$Moisture %>% sort(decreasing = T)
# moist_posi <- moge[moge>0]
# plot(1:length(moist_posi), 100 *cumsum(moist_posi)/sum(moge,na.rm=T), type = "b", ylab = "cumulative contributoin index of moisture (%)", xlab = "Number of species", ylim = c(0, max(100 *cumsum(moist_posi)/sum(moge,na.rm=T))))
# abline(h = 100, lty = 2)
#
#
# moge <- sp_list$Convexity %>% sort(decreasing = T)
# convex_posi <- moge[moge>0]
# plot(1:length(convex_posi), 100 *cumsum(convex_posi)/sum(moge,na.rm=T), type = "b", ylab = "cumulative contributoin index of convexity (%)", xlab = "Number of species",ylim = c(0, max(100 *cumsum(convex_posi)/sum(moge,na.rm=T))))
# abline(h = 100, lty = 2)
#
#
# moge <- sp_list$Slope %>% sort(decreasing = F)
# slope_posi <- moge[moge<0]
# plot(1:length(slope_posi), 100 *cumsum(slope_posi)/sum(moge,na.rm=T), type = "b", ylab = "cumulative contributoin index of slope (%)", xlab = "Number of species", ylim = c(0, max(100 *cumsum(slope_posi)/sum(moge,na.rm=T))))
# abline(h = 100, lty = 2)
# par(mfrow = c(1,1))

## don't use %
fig_dat <- sp_list %>%
  arrange(desc(Wood_density)) %>%
  mutate(wsg_sp = 1:nrow(sp_list)) %>%
  mutate(wsg_posi = cumsum(Wood_density) /sum(Wood_density, na.rm = T) * 100) %>%
  mutate(wsg_posi = cumsum(Wood_density)) %>%

  arrange(desc(Moisture)) %>%
  mutate(moist_sp = 1:nrow(sp_list)) %>%
  mutate(moist_posi = cumsum(Moisture) /sum(Moisture, na.rm = T) * 100) %>%
  mutate(moist_posi = cumsum(Moisture)) %>%

  arrange(desc(Convexity)) %>%
  mutate(convex_sp = 1:nrow(sp_list)) %>%
  mutate(convex_posi = cumsum(Convexity) /sum(Convexity, na.rm = T) * 100) %>%
  mutate(convex_posi = cumsum(Convexity)) %>%

  arrange(Slope) %>%
  mutate(slope_sp = 1:nrow(sp_list)) %>%
  mutate(slope_nega = cumsum(Slope) /sum(Slope, na.rm = T) * 100) %>%
  mutate(slope_nega = cumsum(Slope))

temp1 <- fig_dat %>%
  tidyr::gather("trait", "val", c(wsg_posi, moist_posi, convex_posi, slope_nega))

temp2 <- fig_dat %>%
  tidyr::gather("trait2", "n_sp", c(wsg_sp, moist_sp, convex_sp, slope_sp))

fig_dat2 <- temp1 %>%
  mutate(n_sp = temp2$n_sp) %>%
  mutate(trait = factor(trait, levels = c("wsg_posi", "moist_posi", "convex_posi", "slope_nega"))) %>%
  mutate(trait2 = factor(trait, labels = c("Wood density", "Moisture", "Convexity", "Slope")))

fig_dat3 <- fig_dat2 %>%
  filter(trait != "wsg_posi" | Wood_density > 0) %>%
  filter(trait != "moist_posi" | Moisture > 0) %>%
  filter(trait != "convex_posi" | Convexity > 0) %>%
  filter(trait != "slope_nega" | Slope < 0)

dummy1 <- data_frame(x = 1,
    trait2 = "Wood density",
    val = c(0, max(fig_dat3 %>% filter(trait == "wsg_posi") %>% .$val)))
dummy2 <- data_frame(x = 1,
  trait2 = "Moisture",
  val = c(0, max(fig_dat3 %>% filter(trait == "moist_posi") %>% .$val)))
dummy3 <- data_frame(x = 1,
    trait2 = "Convexity",
    val = c(0, max(fig_dat3 %>% filter(trait == "convex_posi") %>% .$val)))
dummy4 <- data_frame(x = 1,
    trait2 = "Slope",
    val = c(0, max(fig_dat3 %>% filter(trait == "slope_nega") %>% .$val)))

dummy <- bind_rows(dummy1, dummy2, dummy3, dummy4) %>%
  mutate(n_sp =1) %>%
  mutate(trait2 = factor(trait2, levels = c("Wood density", "Moisture", "Convexity", "Slope"))) %>%
  mutate(census_1982 = 1) %>%
  mutate(inc = "Increased")

dummy_line <- data_frame(x = 1,
    trait2 = c("Wood density", "Moisture", "Convexity", "Slope"),
    n_sp = 1,
    h = c(sum(fig_dat$Wood_density, na.rm = T),
      sum(fig_dat$Moisture, na.rm = T),
      sum(fig_dat$Convexity, na.rm = T),
      sum(fig_dat$Slope, na.rm = T))) %>%
        mutate(trait2 = factor(trait2, levels = c("Wood density", "Moisture", "Convexity", "Slope"))) %>%
    mutate(census_1982 = 1) %>%
    mutate(inc = "Increased")

fig_dat4 <- left_join(fig_dat3, ab.data, by = "sp") %>%
  mutate(inc = ifelse(census_2010 - census_1982 > 0, "Increased", "Decreased"))

##ver colour
postscript("~/Dropbox/MS/TurnoverBCI/fig/fig4_abs.eps", width = 6, height = 6.5)

  ggplot(fig_dat4, aes(x = n_sp, y= val, colour = inc)) +
    geom_line(col = "black") +
    geom_point() +
    facet_wrap(~ trait2, scale = "free") +
    theme_bw() +
    geom_blank(data = dummy) +
    geom_hline(data = dummy_line, aes(yintercept = h), lty = 2) +
    # geom_hline(yintercept = 100, lty = 2) +
    ylab("Cumulative contributoin index") +
    xlab("Number of species") +
    geom_text(data = fig_dat4 %>% filter(n_sp <6),
      aes(label = species), hjust= -0.2, vjust = 1,
      fontface="italic", size = 3) +
    geom_segment(data = fig_dat4 %>% filter(n_sp <6),
      mapping = aes(x = n_sp + 10, y = val - 0.05, xend = n_sp + 2, yend= val),
      arrow=arrow(length = unit(0.05, "inches")), size=0.25) +
    theme(legend.position = "bottom") +
    scale_colour_manual(values = c("red3", "royalblue2")) +
    guides(colour = guide_legend(title = "Abundance"))

dev.off()

###
# WSG
# Mean   :0.5586

yy<-dnorm(seq(-0.2,0.8, length=100), mean = 0.399, sd = 0.128)
xx <- seq(-0.2,0.8, length=100)
plot(yy ~ xx , type = "l")

yy<-dnorm(seq(-0.2,0.8, length=100), mean = 0.399 + 0.003, sd = 0.128)
xx <- seq(-0.2,0.8, length=100)
points(yy ~ xx , type = "l", col = "blue")

##ver white
postscript("~/Dropbox/MS/TurnoverBCI/fig/fig4_abs.eps", width = 6, height = 6.5)

  ggplot(fig_dat4, aes(x = n_sp, y= val)) +
    geom_line(col = "black") +
    geom_point() +
    facet_wrap(~ trait2, scale = "free") +
    theme_bw() +
    geom_blank(data = dummy) +
    geom_hline(data = dummy_line, aes(yintercept = h), lty = 2) +
    # geom_hline(yintercept = 100, lty = 2) +
    ylab("Cumulative contributoin index") +
    xlab("Number of species") +
    geom_text(data = fig_dat4 %>% filter(n_sp <6),
      aes(label = species), hjust= -0.2, vjust = 1,
      fontface="italic", size = 3) +
    geom_segment(data = fig_dat4 %>% filter(n_sp <6),
      mapping = aes(x = n_sp + 10, y = val - 0.05, xend = n_sp + 2, yend= val),
      arrow=arrow(length = unit(0.05, "inches")), size=0.25)

dev.off()


#Script to resample and mosaic mapbiomas data

rm(list=ls())

library(raster)

inpath <- "Data/MapBiomas/"
outpath <- "Data/Unclassified/"

#set years for analysis
startyr <- 2000
endyr <- 2018
stepyr <- 1
yrs <- seq(startyr,endyr,stepyr)
yrs <- yrs - 1984   #because 1985 is in band 1 of the MapBiomas tif files
labelyr <- paste0(startyr,"-",endyr,"-",stepyr)

#set biomes for analysis
biomes <- list("PAMPA", "PANTANAL","MATAATLANTICA","CAATINGA","CERRADO","AMAZONIA")

print(paste0("Start: ",Sys.time()))

#loop by biome to aggregate to 1km
for(b in biomes){

  print(b)
  sraw <- stack(paste0(inpath,b,".tif"))  #read 30m file to a stack
  sraw <- sraw[[yrs]]                   #select only required years

  #resample to 5km in two steps
  map1km <- aggregate(sraw, fact=33, fun=modal, expand=TRUE,
                      filename=paste0(inpath,b,"_",labelyr,"_1km.tif", overwrite=TRUE))

  #write to file as multi-layer tif
  writeRaster(map1km, paste0(inpath,b,"_",labelyr,"_1km.tif"), format="GTiff", bylayer=FALSE)
}

#reset years as the 1km tif layers may differ from the 30m tif
yrs <- seq(startyr,endyr,stepyr)
yrs <- yrs - startyr + 1   #+1 because raster reads multi-layer files with 1 index file

#loop by year to create Brazil mosaic and aggregate to 5km
for(y in yrs){

  year = y+startyr-1
  print(year)

  #for each biome read the 1km tif layer for this year
  P <- raster(paste0(inpath,"PAMPA","_",labelyr,"_1km.tif"),band=y)
  M <- raster(paste0(inpath,"MATAATLANTICA","_",labelyr,"_1km.tif"),band=y)
  C <- raster(paste0(inpath,"CAATINGA","_",labelyr,"_1km.tif"),band=y)
  O <- raster(paste0(inpath,"CERRADO","_",labelyr,"_1km.tif"),band=y)
  A <- raster(paste0(inpath,"AMAZONIA","_",labelyr,"_1km.tif"),band=y)
  L <- raster(paste0(inpath,"PANTANAL","_",labelyr,"_1km.tif"),band=y)

  #specify (in MapBiomas data) to NoData
  P <- reclassify(P, cbind(0, NA))
  M <- reclassify(M, cbind(0, NA))
  C <- reclassify(C, cbind(0, NA))
  O <- reclassify(O, cbind(0, NA))
  A <- reclassify(A, cbind(0, NA))
  L <- reclassify(L, cbind(0, NA))

  #1km base used to resample biomes to standard origin
  base1km <- raster(ncols=4505,
                    nrows=4455,
                    xmn=-75.00007,
                    ymn=-34.01103,
                    ymx=6.053681,
                    xmx=-34.48571,
                    crs=crs(P),
                    resolution=0.008993,
                    vals=NULL)

  #resample biomes to standard origin for mosaic below
  Pbase <- resample(P,base1km,method="ngb")
  Mbase <- resample(M,base1km,method="ngb")
  Cbase <- resample(C,base1km,method="ngb")
  Obase <- resample(O,base1km,method="ngb")
  Abase <- resample(A,base1km,method="ngb")
  Lbase <- resample(L,base1km,method="ngb")

  #mosaic the 1km map for all of Brazil
  mos1km <- mosaic(Pbase,Mbase,Cbase,Obase,Abase,Lbase, fun=max)

  #aggregate the 1km map to 5km
  mos5km <- aggregate(mos1km, fact=5, fun=modal, na.rm=T, expand=TRUE)

  #5km base for use to ensure identical origin to 1km
  base5km <- raster(ncols=901,
                    nrows=891,
                    xmn=-75.00007,
                    ymn=-34.01103,
                    ymx=6.053681,
                    xmx=-34.48571,
                    crs=crs(P),
                    resolution=0.044966,
                    vals=NULL)

  #resample to ensure identical origin to 1km
  mos5km_res <- resample(mos5km,base5km,method="ngb")

  #write Brazil 5km map for this year to file
  writeRaster(mos5km_res,paste0(outpath,"Brazil_",year,"_5km.asc"),format="ascii", overwrite=T)

}

print(paste0("End: ",Sys.time()))


########################################################
#####       Author: Diego Valle Jones
#####       Website: www.diegovalle.net
#####       Date Created: Sat Feb 27 22:38:37 2010
########################################################
#The counties with the highest homicide rates for women and men
#data source: Estadísticas Vitales INEGI

removeCommas <- function(hom, col2cvt) {
  hom[,col2cvt] <- lapply(hom[,col2cvt],
                          function(x){as.numeric(gsub(",", "", x))})
  hom
}

cleanHom <- function(hom) {
  names(hom)[1:4] <- c("Code","County","Year.of.Murder","Sex")
  hom$County <- iconv(hom$County, "windows-1252", "utf-8")
  hom$Code <- iconv(hom$Code, "windows-1252", "utf-8")
  hom <- hom[-grep("=CONCATENAR", hom$Code),]
  hom <- hom[-grep("Total", hom$County),]
  hom <- hom[-grep("No especificado", hom$County),]
  hom <- hom[-grep("Total", hom$Year.of.Murder),]
  hom <- hom[-grep("No especificado", hom$Year.of.Murder),]
  hom <- hom[-grep("Total", hom$Sex),]
  hom$X.4 <- NULL
  hom$Year.of.Murder <- as.numeric(as.numeric(gsub('[[:alpha:]]', '',
                                   hom$Year.of.Murder)))
  hom <- subset(hom, Year.of.Murder >= 1990)
  col2cvt <- 5:ncol(hom)
  hom <- removeCommas(hom, col2cvt)
  hom[is.na(hom)] <- 0
  hom$tot <- apply(hom[ , col2cvt], 1, sum)
  hom$CLAVE <- as.numeric(gsub(" ", "", hom$Code))
  hom
}

cleanPop <- function(filename, sex) {
  pop <- read.csv(filename)
  pop <- na.omit(pop)
  col2cvt <- 3:ncol(pop)
  pop[,col2cvt] <- lapply(pop[ ,col2cvt],
                          function(x){as.numeric(gsub(" ", "", x))})
  pop$Sex <- c(sex)
  names(pop)[1:2] <- c("CLAVE", "Mun")
  popm <- melt(pop, id = c("CLAVE", "Mun", "Sex"))
  popm$Mun <- iconv(popm$Mun, "windows-1252", "utf-8")
  popm$variable <- as.numeric(substring(popm$variable, 2))
  popm
}

#Some counties in Oaxaca have changed recently so we have to merge
#them by name instead of code
joinChangedMun <- function(hom, popm, hom.popm) {
  changed <- setdiff(hom$CLAVE, popm$CLAVE)
  hom.ch <- subset(hom, CLAVE %in% changed)
  hom.popm.ch <- merge(hom.ch, popm, by.x = c("County",
                                             "Year.of.Murder", "Sex"),
                    by.y = c("Mun", "variable", "Sex"))
  hom.popm.ch$CLAVE.x <- NULL
  hom.popm.ch$Mun <- hom.popm.ch$County
  names(hom.popm.ch)[25] <- "CLAVE"
  hom.popm <- rbind(hom.popm, hom.popm.ch)
  hom.popm$rate <- (hom.popm$tot / hom.popm$value) *
                        100000
  hom.popm
}

joinHomPop <- function(hom,popm){
  hom.popm <- merge(hom, popm, by.x =c("CLAVE", "Year.of.Murder",
                                       "Sex"),
                             by.y = c("CLAVE", "variable", "Sex"),
                             all.y = TRUE)
  hom.popm[is.na(hom.popm$tot), ]$tot <- 0
  hom.popm <- joinChangedMun(hom, popm, hom.popm)
}

getMeans <- function(hom.plot) {
    ddply(hom.plot, .(CLAVE), function(df) mean(df$rate))
}

getMun <- function(df, mostviol, size){
  hom.plot <- subset(df, value > size)
  means <- getMeans(hom.plot)
  if(mostviol) {
    means <- means[order(-means$V1), ]
  }
  else {
    means <- means[order(means$V1), ]
  }
  high.murder <- unique(means$CLAVE[1:25])
  high.murder
}

plotRate <- function(df, title="", mostviol = TRUE){
  size <- 50000
  hom.plot <- subset(df, CLAVE %in% getMun(df, mostviol, size))
  means <- getMeans(hom.plot)
  hom.plot <- merge(means, hom.plot, by = "CLAVE")
  hom.plot <- ddply(hom.plot, .(CLAVE), transform,
                    max = max(rate))
  ifelse(mostviol, hom.plot$Mun <- with(hom.plot, reorder(factor(Mun),
                                                        -max)),
                 hom.plot$Mun <- with(hom.plot, reorder(factor(Mun),
                                                        max)))
  if(9015 %in% hom.plot$CLAVE){
    hom.plot$Mun <- factor(hom.plot$Mun, levels =
                         c(levels(hom.plot$Mun),
                           "Benito Juarez (Cancun)", "Cuauhtémoc DF"))

    #hom.plot[hom.plot$CLAVE == 23005, ]$Mun = "Benito Juarez (Cancun)"
    hom.plot[hom.plot$CLAVE == 9015, ]$Mun = "Cuauhtémoc DF"
  }
  ggplot(hom.plot, aes(Year.of.Murder, rate)) +
       geom_line() + geom_point(aes(size = tot)) +
       facet_wrap(~ Mun) +
       theme_bw() +
       geom_hline(aes(yintercept = V1), linetype = 2, color="gray70") +
       scale_x_continuous(breaks = c(2005,2008)) +
                      # labels = c("05","06","07", "08")) +
       opts(title = title) +
       ylab("Homicide rate") + xlab("") +
       opts(axis.text.x=theme_text(angle=60, hjust=1.2 )) +
       scale_size("Number of\nHomicides")
}

hom <- read.csv(bzfile("states/data/homicide-mun-2008.csv.bz2"), skip=4)
hom <- cleanHom(hom)

#for men
popm <- cleanPop("most-violent-counties/data/poblacionh.csv.bz2", "Hombre")
hom.popm <- joinHomPop(hom, popm)
#for women
popf <- cleanPop("most-violent-counties/data/poblacionm.csv.bz2", "Mujer")
hom.popf <- joinHomPop(hom, popf)

print(plotRate(hom.popm, "Most violent municipalities for men (with more than 50,000 men)", TRUE))
dev.print(png, file="most-violent-counties/output/Most violent municipalities for men.png",
          width=800, height=600)

print(plotRate(hom.popf, "Most violent municipalities for women (with more than 50,000 women)", TRUE))
dev.print(png, file="most-violent-counties/output/Most violent municipalities for women.png",
          width=800, height=600)

print(plotRate(hom.popm, "Least violent municipalities for men (with more than 50,000 men)", FALSE))
dev.print(png, file="most-violent-counties/output/Least violent municipalities for men.png",
          width=800, height=600)

print(plotRate(hom.popf, "Least violent municipalities for women (with more than 50,000 women)", FALSE))
dev.print(png,file="most-violent-counties/output/Least violent municipalities for women.png",
          width=800, height=600)

juar <- subset(hom, CLAVE == "8037" & Sex == "Mujer")
ggplot(juar, aes(Year.of.Murder, tot)) +
    geom_line()
#According to the movie "on the edge" there were 437 femicides
#(I assume from 1993 to 2006, when the movie was released)
#http://political.detritus.net/juarez/
sum(subset(juar, Year.of.Murder > 2006 & Year.of.Murder < 2008)$tot)
#108 - 2008
#19 - 2007


library(ngram)

x <- "a b a c a b b"
ng <- ngram(x)

test <- babble(ng, seed=1234)
truth <- "b a c a b a c a b b c a b a c a b b b b c a b b a c a b b b a c a b a c a b a c a b b b b b b b a c a b a c a b b a b b b b a b b b a c a b a c a b a c a b b b a c a b b b b b b b b c a b a c a b b a b a c a b b b a c a b b a c a b a c a b b a c a b a c a b a c a b a c a b a c a b b a b a c a b a c "

stopifnot(all.equal(test, truth))


#' @title pie.draw
#' @description couldn't accurately describe
#' @param \code{x} NULL
#' @param \code{y} NULL
#' @param \code{z} NULL
#' @param \code{radius} NULL
#' @param \code{scale} NULL
#' @param \code{labels} NULL
#' @param \code{silent} NULL
#' @family plotting
#' @note
#' useage
#' data(landings)
#' data(coast)
#' xlim <- c(-12,-5)
#' ylim <- c(50,56)
#' xyz <- make.xyz(landings$Lon,landings$Lat,landings$LiveWeight,landings$Species)
#' col <- rainbow(5)
#' basemap(xlim, ylim, main = "Species composition of gadoid landings")
#' draw.shape(coast, col="cornsilk")
#' draw.pie(xyz$x, xyz$y, xyz$z, radius = 0.3, col=col)
#' legend.pie(-13.25,54.8,labels=c("cod","had","hke","pok","whg"), radius=0.3, bty="n", col=col,
#'  cex=0.8, label.dist=1.3)
#' legend.z <- round(max(rowSums(xyz$z,na.rm=TRUE))/10^6,0)
#' legend.bubble(-13.25,55.5,z=legend.z,round=1,maxradius=0.3,bty="n",txt.cex=0.6)
#' text(-12.25,56,"landings (kt)",cex=0.8)
#' @author  unknown, \email{<unknown>@@dfo-mpo.gc.ca}
#' @export
pie.draw <- function (x, y, z, radius, scale = T, labels = NA, silent = TRUE,
                      ...)
{
  nx <- length(x)
  nz <- dim(z)[2]
  if (length(y) != nx)
    stop("x and y should be vectors of the same length")
  if (length(dim(z)) != 2)
    stop("z should be a 2-dimensional array")
  if (dim(z)[1] != nx)
    stop("the number of rows in of z should match as the length of x and y")
  if (sum(z, na.rm = T) == 0)
    stop("z has no data")
  maxsumz <- max(rowSums(z), na.rm = T)
  #pm <- setProgressMsg(1, nx)
  for (i in 1:nx) {
    xi <- x[i]
    yi <- y[i]
    zi <- z[i, ]
    zi <- ifelse(is.na(zi), 0, zi)
    if (length(radius) > 1)
      radiusi <- radius[i]
    else radiusi = radius
    if (scale & length(radius) == 1)
      radiusi <- radius * sqrt(sum(zi, na.rm = T))/sqrt(maxsumz)
    if (sum(zi) > 0)
      pie.add(zi, xi, yi, labels, radius = radiusi, ...)
    if (!silent)
      iw=11
    #pm <- progressMsg(pm, i)
  }
}


cat(sapply(strsplit(readLines(tail(commandArgs(), n=1)), " "), function(s) {
  paste(apply(t(matrix(s, sqrt(length(s)))), 2, rev), collapse=" ")
}), sep="\n")


library(ggplot2)
aed <- read.table("all_aed_scores.txt",header=F,sep=" ")
names(aed) <- c("sample","AED")

ggplot(aed, aes(x = AED, color=sample)) +
  stat_ecdf(aes(x = AED), geom="line",lwd=1.4) +
  xlim(0,1.0) +
  theme_bw() +
  xlab("AED") +
  ylab("Cumulative fraction of gene annotations") +
  scale_color_discrete(limits=c("makerre","makerst","sunflower","tair10"),
                   labels=c("MAKER Arab. update","MAKER Arab. de novo",
                            "MAKER sunflower","TAIR10 annotations")) +
  theme(axis.text.x = element_text(size = 12),
        axis.text.y = element_text(size = 12),
        axis.title.x = element_text(size = 14),
        axis.title.y = element_text(size = 12),
        legend.title = element_blank())


## DEPDENCY #######################################################################################

source("https://raw.githubusercontent.com/oltkkol/vmod/master/basic_text.r", encoding="UTF-8")
source("https://raw.githubusercontent.com/oltkkol/vmod/master/basic_ml.r", encoding="UTF-8")

####################################################################################################
##  EXMAPLE 0
##  Simple examle with Bag Of Words
####################################################################################################

#  1. Read files & make Bag-Of-Words
adamFiles		<- GetFilesContentsFromFolder("D:/VMOD/DATASETY/Adam", "Adam")
henryFiles		<- GetFilesContentsFromFolder("D:/VMOD/DATASETY/HenryVegetarian", "HenryVegetarian")

adamTokens		<- TokenizeTexts(adamFiles)
henryTokens		<- TokenizeTexts(henryFiles)
allTokens		<- append(adamTokens, henryTokens)

allBOW			<- MakeBOWModel(allTokens)

#  2. Prepare datasets
allBOW			<- FirstColNameWordsToColumn(allBOW)
datasets		<- PrepareTrainAndTest(allBOW, "CLASS", 1/2, scaleBy="none", convertToFactors=TRUE)

#  3. Train Naive Bayes
modelNB			<- naiveBayes(datasets$Train$X, datasets$Train$Y)
EvaluateModelAndPlot(modelNB, datasets$Train, datasets$Test)

#  4. See inside Naive Bayes
InspectNaiveBayes(modelNB, "Adam")
InspectNaiveBayes(modelNB, "HenryVegetarian")

####################################################################################################
##	EXAMPLE 1
##	Bag Of Words vs language vs Authorship attribution
##	Naive approach
####################################################################################################

#  1. Read files & make Bag-Of-Words
asimovFiles			<- GetFilesContentsFromFolder("D:/VMOD/DATASETY/Asimov", "ASIMOV")
foglarFiles			<- GetFilesContentsFromFolder("D:/VMOD/DATASETY/Foglar", "FOGLAR")

asimovFileTokensAll	<- TokenizeTexts(asimovFiles)
foglarFileTokensAll	<- TokenizeTexts(foglarFiles)

numberOfTokens		<- 50
asimovFileTokens	<- LimitTokensInTexts(asimovFileTokensAll, count=numberOfTokens, takeRandom=TRUE)
foglarFileTokens	<- LimitTokensInTexts(foglarFileTokensAll, count=numberOfTokens, takeRandom=TRUE)

allTokens		<- append(asimovFileTokens, foglarFileTokens)
allBOW			<- MakeBOWModel(allTokens)
allBOW.Target   <- FirstColNameWordsToColumn(allBOW,  "AuthorTarget")

sprintf("Original BOW has %d words", ncol(allBOW))

#  2. Train Naive Bayes with binary features (YES/NO; see convertToFactors=TRUE)
datasets	<- PrepareTrainAndTest(allBOW.Target, "AuthorTarget", 2/3, scaleBy="binarize", convertToFactors=TRUE)
modelBayes	<- naiveBayes(datasets$Train$X, datasets$Train$Y)

EvaluateModelAndPlot(modelBayes, datasets$Train, datasets$Test)

#  3. Train SVM with binary features (numeric 1/0; see convertToFactors=FALSE)
datasets	<- PrepareTrainAndTest(allBOW.Target, "AuthorTarget", 2/3, scaleBy="binarize", convertToFactors=FALSE)
modelSVM    <- svm(datasets$Train$X, datasets$Train$Y)

EvaluateModelAndPlot(modelSVM, datasets$Train, datasets$Test)

####################################################################################################
##	EXAMPLE 2
##	Bag Of Words vs language vs Authorship attribution
##	Good approach
####################################################################################################

#  1. Read files & Tokenize them (+ limit to random X words)
asimovFiles			<- GetFilesContentsFromFolder("D:/VMOD/DATASETY/Asimov", "ASIMOV")
foglarFiles			<- GetFilesContentsFromFolder("D:/VMOD/DATASETY/Foglar", "FOGLAR")

asimovFileTokensAll	<- TokenizeTexts(asimovFiles)
foglarFileTokensAll	<- TokenizeTexts(foglarFiles)

numberOfTokens		<- 50
asimovFileTokensAll	<- LimitTokensInTexts(asimovFileTokensAll, count=numberOfTokens, takeRandom=TRUE)
foglarFileTokensAll	<- LimitTokensInTexts(foglarFileTokensAll, count=numberOfTokens, takeRandom=TRUE)

#  2. Bag of Words: per texts
allBOW				<- MakeBOWModel( append( asimovFileTokensAll, foglarFileTokensAll) )

#  3. Bag Of Words: per author
asimovCorpora   	<- MergeTokenizedTexts(asimovFileTokensAll)
foglarCorpora   	<- MergeTokenizedTexts(foglarFileTokensAll)

bowAsimovVsFoglar   <- MakeBOWModel( list(Asimov = asimovCorpora, Foglar = foglarCorpora) )

#  - calculate per author TF-IDF to identify author specific words:
weights             <- CalculateTFIDFOnBOW(bowAsimovVsFoglar, omitZeroWeightTerms=TRUE)
keepingWords		<- names(weights)
newAllBOW			<- KeepOnlyGivenColumns(allBOW, keepingWords)

sprintf("All BOW has: %d words. New authors specific BOW has: %d words", ncol(bowAsimovVsFoglar), ncol(newAllBOW))

#  5. Prepare datasets & Train
newAllBOW.Target	<- FirstColNameWordsToColumn(newAllBOW,  "AuthorTarget")

#  - see: binarize, factors=TRUE
datasets	<- PrepareTrainAndTest(newAllBOW.Target, "AuthorTarget", 2/3, scaleBy="binarize", convertToFactors=TRUE)
modelNB		<- naiveBayes(datasets$Train$X, datasets$Train$Y)
EvaluateModelAndPlot(modelNB, datasets$Train, datasets$Test)

InspectNaiveBayes(modelNB, "FOGLAR", 20)
InspectNaiveBayes(modelNB, "ASIMOV", 20)

#  - see: binarize, factors=FALSE
datasets	<- PrepareTrainAndTest(newAllBOW.Target, "AuthorTarget", 2/3, scaleBy="binarize", convertToFactors=FALSE)
modelSVM	<- svm(datasets$Train$X, datasets$Train$Y, kernel='linear')
EvaluateModelAndPlot(modelSVM, datasets$Train, datasets$Test)

####################################################################################################
##	EXAMPLE 3
##	Bag Of Words & Naive Bays: Sentiment Analysis
####################################################################################################

goodFiles		<- GetFilesContentsFromFolder("C:/DATA/Sentiment/GOOD", "GOOD") # 1000 files with positive reviews
badFiles		<- GetFilesContentsFromFolder("C:/DATA/Sentiment/BAD",  "BAD")  # 1000 files with negative reviews

goodTokens		<- TokenizeTexts(goodFiles)
badTokens		<- TokenizeTexts(badFiles)

# BOW per texts
allBOW			<- MakeBOWModel( append( goodTokens, badTokens) )

# BOW per sentiment
goodCorpora   	<- MergeTokenizedTexts(goodTokens)
badCorpora   	<- MergeTokenizedTexts(badTokens)
bowGoodVsBad	<- MakeBOWModel( list(Goods = goodCorpora, Bads = badCorpora) )

# Remove unsignificant words
weights         <- CalculateTFIDFOnBOW(bowGoodVsBad, omitZeroWeightTerms=TRUE)
newAllBOW		<- KeepOnlyGivenColumns(allBOW, names(weights))

# Prepare dataset & Train & Eval
newAllBOW.Target	<- FirstColNameWordsToColumn(newAllBOW,  "Sentiment")

datasets	<- PrepareTrainAndTest(newAllBOW.Target, "Sentiment", 2/3, scaleBy="binarize", convertToFactors=TRUE)
modelNB		<- naiveBayes(datasets$Train$X, datasets$Train$Y)

EvaluateModelAndPlot(modelNB, datasets$Train, datasets$Test)
InspectNaiveBayes(modelNB, "GOOD", 20)
InspectNaiveBayes(modelNB, "BAD", 20)


## get.2pl.params takes ranges of parameters and appends the
## appropriate variable names.
get.2pl.params <- function( theta.range, a.range,
                            b.range, sigma.range) {
        ## Append the variable names to the ranges
        if( !is.null(theta.range) ) {
                theta.range <- paste('theta.abl', theta.range)
        }
        if( !is.null(a.range    ) ) {
                a.range     <- paste('a.disc'   , a.range    )
        }
        if( !is.null(b.range    ) ) {
                b.range     <- paste('b.diff'   , b.range    )
        }
        if( !is.null(sigma.range ) ) {
                sigma.range  <-       'sigma.theta'
        }

        return( c(theta.range, a.range, b.range, sigma.range ))
}


#' Generate the fixed , single-node diffusion node rankings, starting from a given perturbed variable.
#'
#' This function calculates the node rankings starting from a given perturbed variable in a subset of variables in the background knowledge graph.
#' @param n - The index (out of a vector of node names) of the node ranking you want to calculate.
#' @param G - A list of probabilities with list names being the node names of the background graph.
#' @param S - A character vector of node names in the subset you want the network walker to find.
#' @param num.misses - The number of "misses" the network walker will tolerate before switching to fixed length codes for remaining nodes to be found.
#' @param verbose - If TRUE, print statements will execute as progress is made. Default is FALSE.
#' @return current_node_set - A character vector of node names in the order they were drawn by the probability diffusion algorithm.
#' @keywords probability diffusion
#' @keywords network walker
#' @export singleNode.getNodeRanksN
#' @examples
#' # Get node rankings for graph
#' ranks = list()
#' for (n in 1:length(G)) {
#'   print(sprintf("Generating node rankings starting with node %s", names(G)[n]))
#'   ranks[[n]] = singleNode.getNodeRanksN(n, G)
#' }
#' names(ranks) = names(G)
singleNode.getNodeRanksN = function(n, G, S=NULL, num.misses=NULL, verbose=FALSE) {
  if (!is.null(num.misses)) {
    if (is.null(S)) {
      print("You must supply a subset of nodes as parameter S if you supply num.misses.")
      return(0)
    }
  }
  all_nodes = names(G)
  if (verbose) {
    print(sprintf("Calculating node rankings %d of %d.", n, length(all_nodes)))
  }
  current_node_set = NULL
  stopIterating=FALSE
  startNode = all_nodes[n]
  currentGraph = G
  numMisses = 0
  current_node_set = c(current_node_set, startNode)
  while (stopIterating==FALSE) {
    # Clear probabilities
    currentGraph[1:length(currentGraph)] = 0 #set probabilities of all nodes to 0
    #determine base p0 probability
    baseP = p0/(length(currentGraph)-length(current_node_set))
    #set probabilities of unseen nodes to baseP
    currentGraph[!(names(currentGraph) %in% current_node_set)] = baseP
    # Sanity check. p0_event should add up to exactly p0 (global variable)
    p0_event = sum(unlist(currentGraph[!(names(currentGraph) %in% current_node_set)]))
    currentGraph = graph.diffuseP1(p1, startNode, currentGraph, current_node_set, 1, verbose=FALSE)
    # Sanity check. p1_event should add up to exactly p1 (global variable)
    p1_event = sum(unlist(currentGraph[!(names(currentGraph) %in% current_node_set)]))
    if (abs(p1_event-1)>thresholdDiff) {
      extra.prob.to.diffuse = 1-p1_event
      currentGraph[names(current_node_set)] = 0
      currentGraph[!(names(currentGraph) %in% names(current_node_set))] = unlist(currentGraph[!(names(currentGraph) %in% names(current_node_set))]) + extra.prob.to.diffuse/sum(!(names(currentGraph) %in% names(current_node_set)))
    }
    #Set startNode to a node that is the max probability in the new currentGraph
    maxProb = names(which.max(currentGraph))
    # Break ties: When there are ties, choose the first of the winners.
    startNode = names(currentGraph[maxProb[1]])
    if (!is.null(num.misses)) {
      if (startNode %in% S) {
        numMisses = 0
      } else {
        numMisses = numMisses + 1
      }
      current_node_set = c(current_node_set, startNode)
      if (numMisses>num.misses || length(c(startNode,current_node_set))>=(length(G))) {
        stopIterating = TRUE
      }
    } else {
      # Keep drawing until you've drawn all nodes.
      current_node_set = c(current_node_set, startNode)
      if (length(current_node_set)>=(length(G))) {
        stopIterating = TRUE
      }
    }

  }
  return(current_node_set)
}


# allocativ 3001.2021.0002

## Libraries
### Hadley Wickham
library(tidyverse) # All of the libraries above in one line of code
library(ggplot2) # ggplot2 is a system for declaratively creating graphics, based on The Grammar of Graphics. You provide the data, tell ggplot2 how to map variables to aesthetics, what graphical primitives to use, and it takes care of the details.
library(dplyr) # dplyr provides a grammar of data manipulation, providing a consistent set of verbs that solve the most common data manipulation challenges.
library(tidyr) # tidyr provides a set of functions that help you get to tidy data. Tidy data is data with a consistent form: in brief, every variable goes in a column, and every column is a variable.
library(readr) # readr provides a fast and friendly way to read rectangular data (like csv, tsv, and fwf). It is designed to flexibly parse many types of data found in the wild, while still cleanly failing when data unexpectedly changes.
library(purrr) # purrr enhances R’s functional programming (FP) toolkit by providing a complete and consistent set of tools for working with functions and vectors. Once you master the basic concepts, purrr allows you to replace many for loops with code that is easier to write and more expressive.
library(tibble) # tibble is a modern re-imagining of the data frame, keeping what time has proven to be effective, and throwing out what it has not. Tibbles are data.frames that are lazy and surly: they do less and complain more forcing you to confront problems earlier, typically leading to cleaner, more expressive code.
library(stringr) # stringr provides a cohesive set of functions designed to make working with strings as easy as possible. It is built on top of stringi, which uses the ICU C library to provide fast, correct implementations of common string manipulations.
library(forcats) # forcats provides a suite of useful tools that solve common problems with factors. R uses factors to handle categorical variables, variables that have a fixed and known set of possible values.
library(reshape2) # Long/wide conversions from Hadley Wickham
### DBMS
library(RSQLite) # SQLite databases in R
library(sqldf) # Use SQL commands on R dataframes
library(RPostgreSQL) # Postgre SQL databases in R
### Statistics
library(lme4) # Linear mixed effect modeling in R
library(arm) # Visualizations of linear mixed effect modeling using 'lme4' in R
library(lmtest) # Linear model tests including Breusch Pagan
library(lmerTest) # Linear mixed effect model tests allowing for Saittherwaier DOF and signficiance tests
library(DescTools) # Descriptive statistics including Jarque-Bera, Andrerson-Darling, Durbin-Watson, Cronbach's Alpha
library(ineq) # Gini coefficient and Lorenz curve
library(MASS) # Stepwise inclusion model with linear and logistic options and Box-Cox transformations
library(bestNormalize) # nromalization autmation including boxcox
library(performance) # Inter class correlation coefficient foir HLM
### Machine Learning
library(randomForest) # Popular random forest package for R
library(randomForestExplainer) # Complimentary to randfomForest package with tools for analysis
### Spatial
library(rpostgis) # PostGIS with Postgres in R
library(sp) # S4 classes for spatial data in R
library(ggmap) # General use mapping library with ggplot API
library(GWmodel) # Geographic weighted regression in R
library(rgdal)
library(rgeos)
library(maptools)
library(ggsn)
library(spdep)
library(DCluster)
library(gstat)
library(tigris)
library(raster)
library(dismo)
library(smacpod)
library(rsatscan)
library(spatstat)
### Visualization
library(RColorBrewer) # Creates nice looking color palettes especially for thematic maps in R

## Variables
day = Sys.Date() # Save dimple date as string
stamp = date() # Save Date and timestamp
directory = paste(local, subject, day, sep = "") # Set wd to project repository using variables

## Directories
setwd(directory) # Set working directory

## Database
con_1 = dbConnect(RSQLite::SQLite(), '_data/public.db') # create a connection to the postgres database


# Snow crab --- Areal unit modelling of habitat  -- no reliance upon stmv fields

# -------------------------------------------------
# Part 1 -- construct basic parameter list defining the main characteristics of the study
# require(aegis)

  year.assessment = 2021
  require(bio.snowcrab)   # loadfunctions("bio.snowcrab")

  # choose one:
  if (0) {
    # default: best DIC 31457.19, WAIC 32405.81
    # P(y) = Pois(y|y>0) ; p = exp(theta) / ( 1 + exp(theta) )
    family="poisson"
    carstm_model_label = "tesselation"

    # estimates suggest 30% prob of 0 overdispersion: DIC: 36196.11, WAIC 36850.04
    # P(y) = p 1_{y=0} + (1-p) Pois(y|y>0) ; pois is of positive valued only
    family="zeroinflatedpoisson0"
    carstm_model_label = "tesselation_zip0"

    # unstable ... will not complete due to singularities ... might be overparamterized
    # P(y) = p 1_{y=0} + (1-p) Pois(y) ; pois is of all values
    family="zeroinflatedpoisson1"
    carstm_model_label = "tesselation_zip1"

  }

  p = snowcrab_parameters(
    project_class="carstm",
    yrs=2000:year.assessment,
    areal_units_type="tesselation",
#    areal_units_constraint_ntarget = 20,
#    areal_units_constraint_nmin = 5,
    family=family,
    carstm_model_label = carstm_model_label,
    selection = list(type = "number")
  )

# ------------------------------------------------
# Part 2 -- spatiotemporal statistical model

  if ( spatiotemporal_model ) {

      if (0) {
        # polygon structure:: create if not yet made
        # adjust based upon RAM requirements and ncores
          # create if not yet made
        for (au in c("cfanorth", "cfasouth", "cfa4x", "cfaall" )) plot(polygon_managementareas( species="snowcrab", au))
        xydata = snowcrab.db( p=p, DS="areal_units_input", redo=TRUE )

        sppoly = areal_units( p=p, hull_alpha=15, redo=TRUE, verbose=TRUE )  # create constrained polygons with neighbourhood as an attribute
        plot( sppoly[, "npts"]  )

        MS = NULL

        # p$carstm_model_label = "tesselation_overdispersed"   # default is the name of areal_units_type
        # p$family  = "zeroinflatedpoisson0" #  "binomial",  # "nbinomial", "betabinomial", "zeroinflatedbinomial0" , "zeroinflatednbinomial0"
        # p$carstm_model_inla_control_familiy = NULL

      }

      sppoly = areal_units( p=p )  # to reload

      # -------------------------------------------------
      M = snowcrab.db( p=p, DS="carstm_inputs", redo=TRUE )  # will redo if not found
      M = NULL; gc()

      fit = carstm_model(
        p=p,
        data='snowcrab.db( p=p, DS="carstm_inputs" )',
        posterior_simulations_to_retain="predictions" ,
        scale_offsets = TRUE,  # required to stabilize  as offsets are so small, required for : inla.mode = "experimental"
        # redo_fit = FALSE,  # only to redo sims and extractions
        # toget="predictions",  # this updates a specific subset of calc
        control.inla = list( strategy='adaptive' ),  # strategy='laplace', "adaptive" int.strategy="eb"
        num.threads="4:2"
      )

      if (0) {
        # control.compute=list(smtp="default", dic=TRUE, waic=TRUE, cpo=FALSE, config=TRUE, return.marginals.predictor=TRUE)
        # control.fixed=list(prec=1,prec.intercept=1)
        # 151 configs and long optim .. 19 hrs
        # fit = carstm_model( p=p, DS="carstm_modelled_fit")

        # extract results
        # very large files .. slow
          fit = carstm_model( p=p, DS="carstm_modelled_fit" )  # extract currently saved model fit
          fit$summary$dic$dic
          fit$summary$dic$p.eff

          plot(fit)
          plot(fit, plot.prior=TRUE, plot.hyperparameters=TRUE, plot.fixed.effects=FALSE )

      }

      res = carstm_model( p=p, DS="carstm_modelled_summary"  ) # to load currently saved results

      map_centre = c( (p$lon0+p$lon1)/2 - 0.5, (p$lat0+p$lat1)/2 -0.8 )
      map_zoom = 5

      plot_crs = p$aegis_proj4string_planar_km

      require(tmap)

      additional_features =
        tm_shape( aegis.polygons::area_lines.db( DS="cfa.regions", returntype="sf", project_to=plot_crs ), projection=plot_crs ) +
          tm_lines( col="slategray", alpha=0.75, lwd=2)   +
        tm_shape( aegis.bathymetry::isobath_db(  depths=c( seq(0, 400, by=50), 1000), project_to=plot_crs  ), projection=plot_crs ) +
          tm_lines( col="slategray", alpha=0.5, lwd=0.5) +
        tm_shape( aegis.coastline::coastline_db( DS="eastcoast_gadm", project_to=plot_crs ), projection=plot_crs ) +
          tm_polygons( col="lightgray", alpha=0.5 , border.alpha =0.5)

      (additional_features)

      vn=c( "random", "space", "combined" )
      vn=c( "random", "spacetime", "combined" )
      vn="predictions"  # numerical density (km^-2)

      tmatch="2015"

      # densities
      carstm_map(  res=res, vn=vn, tmatch=tmatch,
          palette="-RdYlBu",
          plot_elements=c(  "compass", "scale_bar", "legend" ),
          additional_features=additional_features,
          tmap_zoom= c(map_centre, map_zoom),
          title =paste( vn, paste0(tmatch, collapse="-"), "no/km^2"  )
      )

      # map all :
      outputdir = file.path( p$modeldir, p$carstm_model_label, "predicted.numerical.densitites" )
      if ( !file.exists(outputdir)) dir.create( outputdir, recursive=TRUE, showWarnings=FALSE )

      vn="predictions"
      toplot = carstm_results_unpack( res, vn )
      brks = pretty(  quantile(toplot[,,"mean"], probs=c(0,0.975), na.rm=TRUE )  )

      for (y in res$time ){
          tmatch = as.character(y)
          fn_root = paste("Predicted_numerical_abundance", paste0(tmatch, collapse="-"), sep="_")
          fn = file.path( outputdir, paste(fn_root, "png", sep=".") )

            o = carstm_map(  res=res, vn=vn, tmatch=tmatch,
              breaks =brks,
              palette="-RdYlBu",
              plot_elements=c(    "compass", "scale_bar", "legend" ),
              additional_features=additional_features,
              title=paste("Predicted numerical density (no./km^2) ", paste0(tmatch, collapse="-") ),
              map_mode="plot",
              scale=0.75,
              outformat="tmap",
              outfilename=fn
            )

      }

      fit = meanweights_by_arealunit_modelled( p=p, redo=TRUE, returntype="carstm_modelled_fit" )  ## used in carstm_output_compute

         if (0) {
          fit = meanweights_by_arealunit_modelled( p=p, returntype="carstm_modelled_fit" )

          res = meanweights_by_arealunit_modelled( p=p, returntype="carstm_modelled_summary" )  ## used in carstm_output_compute

          map_centre = c( (p$lon0+p$lon1)/2 - 0.5, (p$lat0+p$lat1)/2 -0.8 )
          map_zoom = 5

          plot_crs = p$aegis_proj4string_planar_km

          additional_features =
            tm_shape( aegis.polygons::area_lines.db( DS="cfa.regions", returntype="sf", project_to=plot_crs ), projection=plot_crs ) +
              tm_lines( col="slategray", alpha=0.75, lwd=2)   +
            tm_shape( aegis.bathymetry::isobath_db( depths=c( seq(50, 400, by=50), 500), project_to=plot_crs  ), projection=plot_crs ) +
              tm_lines( col="slategray", alpha=0.5, lwd=0.5) +
            tm_shape( aegis.coastline::coastline_db( DS="eastcoast_gadm", project_to=plot_crs ), projection=plot_crs ) +
              tm_polygons( col="lightgray", alpha=0.5 , border.alpha =0.5)

          (additional_features)

          vn="predictions"
          tmatch = "2020"

          outputdir = file.path( p$modeldir, p$carstm_model_label, "predicted.mean.weight" )
          if ( !file.exists(outputdir)) dir.create( outputdir, recursive=TRUE, showWarnings=FALSE )

          fn_root = paste("Predicted_mean_size", paste0(tmatch, collapse="-"), sep="_")

          fn = file.path( outputdir, paste(fn_root, "png", sep=".") )

          carstm_map(  res=res, vn=vn, tmatch=tmatch,
              palette="-RdYlBu",
              plot_elements=c(  "compass", "scale_bar", "legend" ),
              additional_features=additional_features,
              tmap_zoom= c(map_centre, map_zoom),
              title =paste("Predicted  mean weight of individual (kg)", paste0(tmatch, collapse="-") )
          )

        }

      snowcrab.db(p=p, DS="carstm_output_compute" )

      RES = snowcrab.db(p=p, DS="carstm_output_timeseries" )

      bio = snowcrab.db(p=p, DS="carstm_output_spacetime_biomass" )
      num = snowcrab.db(p=p, DS="carstm_output_spacetime_number" )

      outputdir = file.path( p$modeldir, p$carstm_model_label, "aggregated_biomass_timeseries" )

      if ( !file.exists(outputdir)) dir.create( outputdir, recursive=TRUE, showWarnings=FALSE )

      ( fn = file.path( outputdir, "cfa_all.png") )
      png( filename=fn, width=3072, height=2304, pointsize=12, res=300 )
        plot( cfaall ~ yrs, data=RES, lty="solid", lwd=4, pch=20, col="slateblue", type="b", ylab="Biomass index (kt)", xlab="")
        lines( cfaall_lb ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
        lines( cfaall_ub ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
      dev.off()

      ( fn = file.path( outputdir, "cfa_south.png") )
      png( filename=fn, width=3072, height=2304, pointsize=12, res=300 )
        plot( cfasouth ~ yrs, data=RES, lty="solid", lwd=4, pch=20, col="slateblue", type="b", ylab="Biomass index (kt)", xlab="")
        lines( cfasouth_lb ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
        lines( cfasouth_ub ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
      dev.off()

      ( fn = file.path( outputdir, "cfa_north.png") )
      png( filename=fn, width=3072, height=2304, pointsize=12, res=300 )
        plot( cfanorth ~ yrs, data=RES, lty="solid", lwd=4, pch=20, col="slateblue", type="b", ylab="Biomass index (kt)", xlab="")
        lines( cfanorth_lb ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
        lines( cfanorth_ub ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
      dev.off()

      ( fn = file.path( outputdir, "cfa_4x.png") )
      png( filename=fn, width=3072, height=2304, pointsize=12, res=300 )
        plot( cfa4x ~ yrs, data=RES, lty="solid", lwd=4, pch=20, col="slateblue", type="b", ylab="Biomass index (kt)", xlab="")
        lines( cfa4x_lb ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
        lines( cfa4x_ub ~ yrs, data=RES, lty="dotted", lwd=2, col="slategray" )
      dev.off()

      # map it ..mean density

      sppoly = areal_units( p=p )  # to reload

      vn = paste("biomass", "predicted", sep=".")

      outputdir = file.path( p$modeldir, p$carstm_model_label, "predicted.biomass.densitites" )

      if ( !file.exists(outputdir)) dir.create( outputdir, recursive=TRUE, showWarnings=FALSE )

      B = apply( bio, c(1,2), mean )

      brks = pretty( quantile( B[], probs=c(0,0.975) )* 10^6 )

      for (i in 1:length(p$yrs) ){
        y = as.character( p$yrs[i] )
        sppoly[,vn] = B[,y]* 10^6
        fn = file.path( outputdir , paste( "biomass", y, "png", sep=".") )

          carstm_map(  sppoly=sppoly, vn=vn,
            breaks=brks,
            additional_features=additional_features,
            title=paste("Predicted biomass density", y ),
            outfilename=fn
          )
      }

      plot( fit, plot.prior=TRUE, plot.hyperparameters=TRUE, plot.fixed.effects=FALSE )
      plot( fit$marginals.hyperpar$"Phi for space_time", type="l")  # posterior distribution of phi nonspatial dominates
      plot( fit$marginals.hyperpar$"Precision for space_time", type="l")
      plot( fit$marginals.hyperpar$"Precision for setno", type="l")

    (res$summary)

  }

  ##########

  if (fishery_model) {

    # you need a stan installation on your system as well (outside of R), and the R-interface "cmdstanr":
    # install.packages("cmdstanr", repos = c("https://mc-stan.org/r-packages/", getOption("repos")))

    require(cmdstanr)

    p$fishery_model = fishery_model( DS = "logistic_parameters", p=p, tag=p$areal_units_type )
    p$fishery_model$stancode = stan_initialize( stan_code=fishery_model( p=p, DS="stan_surplus_production" ) )
    str( p$fishery_model)
    p$fishery_model$stancode$compile()
    to_look = c("K", "r", "q", "qc", "logtheta")
#    to_look = c("K", "r", "q", "qc" )

      if (0) {
        # testing other samplers and optimizsers ... faster , good for debugging

        # (penalized) maximum likelihood estimate (MLE)
        fit_mle =  p$fishery_model$stancode$optimize(data =p$fishery_model$standata, seed = 123)
        fit_mle$summary( to_look )
        u = stan_extract( as_draws_df(fit_mle$draws() ) )

        mcmc_hist(fit$draws("K")) + vline_at(fit_mle$mle(), size = 1.5)

        # Variational Bayes
        fit_vb = p$fishery_model$stancode$variational( data =p$fishery_model$standata, seed = 123, output_samples = 4000)
        fit_vb$summary(to_look)
        fit_vb$cmdstan_diagnose()
        fit_vb$cmdstan_summary()

        u = stan_extract( as_draws_df(fit_vb$draws() ) )

        bayesplot_grid(
          mcmc_hist(fit$draws("K"), binwidth = 0.025),
          mcmc_hist(fit_vb$draws("K"), binwidth = 0.025),
          titles = c("Posterior distribution from MCMC", "Approximate posterior from VB")
        )

        color_scheme_set("gray")
        mcmc_dens(fit$draws("K"), facet_args = list(nrow = 3, labeller = ggplot2::label_parsed ) ) + facet_text(size = 14 )
        # mcmc_hist( fit$draws("K"))

        # obtain mcmc samples from vb solution
        res_vb = fishery_model(
          DS="logistic_model",
          p=p,
          tag=p$areal_units_type,
          fit = fit_vb
        )

        names(res_vb$mcmc)

      }

      fit = p$fishery_model$stancode$sample(
        data=p$fishery_model$standata,
        iter_warmup = 15000,
        iter_sampling = 10000,
        seed = 123,
        chains = 3,
        parallel_chains = 3,  # The maximum number of MCMC chains to run in parallel.
        max_treedepth = 16,
        adapt_delta = 0.99,
        refresh = 1000
      )

      if (0) {
        fit = fishery_model( p=p,   DS="fit", tag=p$areal_units_type )  # to load samples (results)
        fit$summary(c("K", "r", "q", "qc"))
        print( fit, max_rows=30 )
        fit$cmdstan_diagnose()
        fit$cmdstan_summary()

      }

      fit$summary(to_look)

      # save fit and get draws
      res = fishery_model( p=p, DS="logistic_model", tag=p$areal_units_type, fit=fit )       # from here down are params for cmdstanr::sample()

      # frequency density of key parameters
      fishery_model( DS="plot", vname="K", res=res )
      fishery_model( DS="plot", vname="r", res=res )
      fishery_model( DS="plot", vname="q", res=res, xrange=c(0.5, 2.5))
      fishery_model( DS="plot", vname="FMSY", res=res  )
      # fishery_model( DS="plot", vname="bosd", res=res  )
      # fishery_model( DS="plot", vname="bpsd", res=res  )

      # timeseries
      fishery_model( DS="plot", type="timeseries", vname="biomass", res=res  )
      fishery_model( DS="plot", type="timeseries", vname="fishingmortality", res=res)

      # Summary table of mean values for inclusion in document
      biomass.summary.table(x)

      # Harvest control rules
      fishery_model( DS="plot", type="hcr", vname="default", res=res  )
      fishery_model( DS="plot", type="hcr", vname="simple", res=res  )

      # diagnostics
      # fishery_model( DS="plot", type="diagnostic.errors", res=res )
      # fishery_model( DS="plot", type="diagnostic.phase", res=res  )

      NN = res$p$fishery_model$standata$N

      # bosd
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(res$mcmc$bosd[,i] ), main="")
      ( qs = apply(  res$mcmc$bosd[,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )

      # bpsd
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(res$mcmc$bpsd[,i] ), main="")
      ( qs = apply(  res$mcmc$bpsd[,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )

      # rem_sd
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(res$mcmc$rem_sd[,i] ), main="")
      ( qs = apply(  res$mcmc$rem_sd[,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )

    # qc
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(res$mcmc$qc[,i] ), main="")
      ( qs = apply(  res$mcmc$qc[,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )

     # b0
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(res$mcmc$b0[,i] ), main="")
      ( qs = apply(  res$mcmc$b0[,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )

      # K
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(res$mcmc$K[,i] ), main="")
      ( qs = apply(  res$mcmc$K[,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )

      # R
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(res$mcmc$r[,i] ), main="")
      ( qs = apply(  res$mcmc$r[,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )

      # q
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(res$mcmc$q[,i] ), main="")
      ( qs = apply(  res$mcmc$q[,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )

      # FMSY
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(res$mcmc$FMSY[,i] ), main="")
      ( qs = apply(  res$mcmc$FMSY[,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )

      # densities of biomass estimates for the year.assessment
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(res$mcmc$B[,NN,i] ), main="")
      ( qs = apply(  res$mcmc$B[,NN,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )

      # densities of biomass estimates for the previous year
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density( res$mcmc$B[,NN-1,i] ), main="")
      ( qs = apply(  res$mcmc$B[,NN-1,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )

      # densities of F in assessment year
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(  res$mcmc$F[,NN,i] ), xlim=c(0.01, 0.6), main="")
      ( qs = apply(  res$mcmc$F[,NN,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )
      ( qs = apply(  res$mcmc$F[,NN,], 2, mean ) )

      # densities of F in previous year
      plot.new()
      layout( matrix(c(1,2,3), 3, 1 ))
      par(mar = c(4.4, 4.4, 0.65, 0.75))
      for (i in 1:3) plot(density(  res$mcmc$F[,NN-1,i] ), xlim=c(0.01, 0.6), main="")
      ( qs = apply(  res$mcmc$F[,NN-1,], 2, quantile, probs=c(0.025, 0.5, 0.975) ) )
      ( qs = apply(  res$mcmc$F[,NN-1,], 2, mean ) )

      # F for table ---
      summary( res$mcmc$F, median)
  }

# end


# Test script localy
wdpaid <- '11.3_53.6_15.5_55.9'
#wdpaid <- 'minlon_minlat_maxlon_maxlat'
wdpaidsplit <- unlist(strsplit(wdpaid, "[_]"))
xmin <- as.numeric(wdpaidsplit[1])
ymin <- as.numeric(wdpaidsplit[2])
xmax <- as.numeric(wdpaidsplit[3])
ymax <- as.numeric(wdpaidsplit[4])
temp_path<- "c:/temp"

library(knitr)
library(kableExtra)

library(rgdal)
library(downloader)
library(ggplot2)
library(mapdata)
library(geojsonio)
library(ggmap)
library(ggrepel)

library("rgdal")
library("rasterVis")
library("downloader")
library("ggplot2")

library("XML")
library("RCurl")
library("bitops")
library("lattice")
library("latticeExtra")
library("RColorBrewer")
library("mapdata")
library("maps")
library("maptools")
library("wq")
library("xtable")
library("zoo")
library("jsonlite")
library(ncdf4)

require(xtable)

library(lattice)

# Script for Wekeo environment
sr=SpatialPolygons(list(Polygons(list(Polygon(cbind(c(xmin, xmin, xmax, xmax),c(ymax, ymin, ymin, ymax)))),"1")))
mpa=SpatialPolygonsDataFrame(sr, data.frame(cbind(1:1), row.names=c("1")))
proj4string(mpa)<-CRS("+proj=longlat +datum=WGS84")

bbox<-paste(xmin,ymin,xmax,ymax,sep=",")

#FUNCTION GET VESSELDENSITY
#=================================================

getvesseldensityLite<-function (name = "emodnet:2017_01_st_All", resolution = "30 arcsec / 900m", xmin = 15, xmax = 20.5, ymin = 30, ymax = 32.5)
{
bbox <- paste(xmin, ymin, xmax, ymax, sep = ",")
con <- paste(ogc_url,"/wcs?service=wcs&version=1.0.0&request=getcoverage&coverage=",name,"&crs=EPSG:4326&BBOX=", bbox, "&format=image/tiff&interpolation=nearest&resx=0.00833333&resy=0.00833333", sep = "")
#con <- paste("http://77.246.172.208/geoserver/emodnet/wcs?service=wcs&version=1.0.0&request=getcoverage&coverage=",name,"&crs=EPSG:3035&BBOX=", bbox, "&format=image/tiff&interpolation=nearest&resx=0.00833333&resy=0.00833333", sep = "")
nomfich <- paste(name, "img.tiff", sep = "_")
nomfich <- tempfile(nomfich)
download(con, nomfich, quiet = TRUE, mode = "wb")
img <- raster(nomfich)
img[img == 0] <- NA
#img[img < 0] <- 0
#img[img > 100] <- 0
names(img) <- paste(name)
return(img)
}

getvesseldensity_byvesseltype<-function (name = "emodnet:2017_01_st_All", vessel_type= "st_09" ,resolution = "30 arcsec / 900m", xmin = 15, xmax = 20.5, ymin = 30, ymax = 32.5)
{
##################### getvesseldensityLite2017
for (month in c('01','02','03','04','05','06','07','08','09','10','11','12')){
	print(paste("The month is", month))
	img<-getvesseldensityLite(name = paste("emodnet:2017_",month,"_",vessel_type, sep=""), resolution = "30 arcsec", xmin, xmax, ymin, ymax)
	names(img) <- paste("2017-",month, sep="")
	if (month == '01') {imgs <- img
} else {
 	imgs <- stack(imgs, img)
	}
}
mpa_vesselAll2017<-imgs
##################### getvesseldensityLite2018
for (month in c('01','02','03','04','05','06','07','08','09','10','11','12')){
	print(paste("The month is", month))
	img<-getvesseldensityLite(name = paste("emodnet:2018_",month,"_",vessel_type, sep=""), resolution = "30 arcsec", xmin, xmax, ymin, ymax)
	names(img) <- paste("2018-",month, sep="")
	if (month == '01') {imgs <- img
} else {
 	imgs <- stack(imgs, img)
	}
}
mpa_vesselAll2018<-imgs
##################### getvesseldensityLite2019
for (month in c('01','02','03','04','05','06','07','08','09','10','11','12')){
	print(paste("The month is", month))
	img<-getvesseldensityLite(name = paste("emodnet:2019_",month,"_",vessel_type, sep=""), resolution = "30 arcsec", xmin, xmax, ymin, ymax)
	names(img) <- paste("2019-",month, sep="")
	if (month == '01') {imgs <- img
} else {
 	imgs <- stack(imgs, img)
	}
}
mpa_vesselAll2019<-imgs

mpa<-stack(mpa_vesselAll2017,mpa_vesselAll2018,mpa_vesselAll2019)

return(mpa)
}

#####################
layer_title<-"Vessel density (Cargo) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_09"

mpa_cargo<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (dredging or underwater ops) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_03"

mpa_dredging<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (High Speed Craft) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_06"

mpa_speedcraft<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (Fishing) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_01"

mpa_fishing<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (Military and Law Enforcement) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_11"

mpa_military<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (Passenger) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_08"

mpa_passenger<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (Pleasure Craft) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_05"

mpa_pleasure<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (Sailing) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_04"

mpa_sailing<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (Service) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_02"

mpa_service<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (Tanker) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_10"

mpa_tanker<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (Tug and Towing) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_07"

mpa_tug<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)

#####################
layer_title<-"Vessel density (Unknown) 2017-2019"
ogc_url <- "https://ows.emodnet-humanactivities.eu"
vessel_type <- "st_12"

mpa_unknown<-getvesseldensity_byvesseltype(name, vessel_type, resolution = "30 arcsec/900m", xmin, xmax, ymin, ymax)


make_three_panel_plots <- function(data_country, covariates_long,
                                   jobid, country, label=label){

  data_cases_95 <- data.frame(data_country$date, data_country$cases_min,
                              data_country$cases_max)
  names(data_cases_95) <- c("date", "cases_min", "cases_max")
  data_cases_95$key <- rep("nintyfive", length(data_cases_95$date))
  data_cases_50 <- data.frame(data_country$date, data_country$cases_min2,
                              data_country$cases_max2)
  names(data_cases_50) <- c("date", "cases_min", "cases_max")
  data_cases_50$key <- rep("fifty", length(data_cases_50$date))
  data_cases <- rbind(data_cases_95, data_cases_50)
  levels(data_cases$key) <- c("ninetyfive", "fifty")

  p1 <- ggplot(data_country) +
    geom_bar(data = data_country, aes(x = date, y = reported_cases),
             fill = "coral4", stat='identity', alpha=0.5) +
    geom_ribbon(data = data_cases,
                aes(x = date, ymin = cases_min, ymax = cases_max, fill = key)) +
    xlab("") +
    ylab("Daily number of infections") +
    scale_x_date(date_breaks = "2 weeks", labels = date_format("%e %b")) +
    scale_y_continuous(labels = comma, expand=c(0,0.1)) +
    scale_fill_manual(name = "", labels = c("50%", "95%"),
                      values = c(alpha("deepskyblue4", 0.55),
                                 alpha("deepskyblue4", 0.45))) +
    theme_bw() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1),
          legend.position = "None") +
    guides(fill=guide_legend(ncol=1)) +
    ggtitle(country)

  data_deaths_95 <- data.frame(data_country$date, data_country$deaths_min,
                               data_country$deaths_max)
  names(data_deaths_95) <- c("date", "death_min", "death_max")
  data_deaths_95$key <- rep("nintyfive", length(data_deaths_95$date))
  data_deaths_50 <- data.frame(data_country$date, data_country$deaths_min2,
                               data_country$deaths_max2)
  names(data_deaths_50) <- c("date", "death_min", "death_max")
  data_deaths_50$key <- rep("fifty", length(data_deaths_50$date))
  data_deaths <- rbind(data_deaths_95, data_deaths_50)
  levels(data_deaths$key) <- c("ninetyfive", "fifty")

  p2 <-   ggplot(data_country, aes(x = date)) +
    geom_bar(data = data_country, aes(y = reported_deaths, fill = "reported"),
             fill = "coral4", stat='identity', alpha=0.5) +
    geom_ribbon(
      data = data_deaths,
      aes(ymin = death_min, ymax = death_max, fill = key)) +
    xlab("") +
    ylab("Daily number of deaths") +
    scale_y_continuous(labels = comma, expand=c(0,0.1)) +
    scale_x_date(date_breaks = "2 weeks", labels = date_format("%e %b")) +
    scale_fill_manual(name = "", labels = c("50%", "95%"),
                      values = c(alpha("deepskyblue4", 0.55),
                                 alpha("deepskyblue4", 0.45))) +
    theme_bw() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1),
          legend.position = "None") +
    guides(fill=guide_legend(ncol=1))

  # Plotting interventions
  data_rt_95 <- data.frame(data_country$date,
                           data_country$rt_min, data_country$rt_max)
  names(data_rt_95) <- c("date", "rt_min", "rt_max")
  data_rt_95$key <- rep("nintyfive", length(data_rt_95$date))
  data_rt_50 <- data.frame(data_country$date, data_country$rt_min2,
                           data_country$rt_max2)
  names(data_rt_50) <- c("date", "rt_min", "rt_max")
  data_rt_50$key <- rep("fifty", length(data_rt_50$date))
  data_rt <- rbind(data_rt_95, data_rt_50)
  levels(data_rt$key) <- c("ninetyfive", "fifth")

  plot_labels <- c("Lockdown", "Public events banned", "School and universities closed", "Self isolate if ill", "Social distancing encouraged")

  p3 <- ggplot(data_country) +
    geom_ribbon(data = data_rt, aes(x = date, ymin = rt_min, ymax = rt_max,
                                        group = key,
                                        fill = key)) +
    geom_hline(yintercept = 1, color = 'black', size = 1) +
    geom_segment(data = covariates_long,
                 aes(x = value, y = 0, xend = value, yend = max(x, na.rm=TRUE)),
                 linetype = "dashed", colour = "grey", alpha = 0.75) +
    geom_point(data = covariates_long, aes(x = value,
                                           y = x,
                                           group = key,
                                           shape = key,
                                           col = key), size = 2) +
    xlab("") +
    ylab(expression(R[t])) +
    scale_fill_manual(name = "", labels = c("50%", "95%"),
                      values = c(alpha("seagreen", 0.75), alpha("seagreen", 0.5))) +
    scale_shape_discrete(name = "Interventions", labels = plot_labels) +
    scale_colour_discrete(name = "Interventions", labels = plot_labels) +
    scale_x_date(date_breaks = "2 weeks", labels = date_format("%e %b"),
                 limits = c(data_country$date[1],
                            data_country$date[length(data_country$date)])) +
    scale_y_continuous(expand=c(0,0.1)) +
    theme_bw() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
    theme(legend.position="right")

  p <- plot_grid(p1, p2, p3, ncol = 3, rel_widths = c(1, 1, 2))
  save_plot(filename = paste0("Italy//figures/", country, "-three-panel-", label, "-", jobid, ".png"),
            p, base_width = 14)

  return (p)
}


#Title: estimate_normalization_factor
#Auther: Naoto Imamachi
#ver: 1.0.0
#Date: 2015-10-07

###Estimate_normalization_factor_function###
BridgeRNormalizationFactorsHK <- function(InputFile, group, hour, InforColumn = 4, InforHKGenes = 2, HKGenes = c("GAPDH","PGK1","PPIA","ENO1","ATP5B","ALDOA"), OutputFile = "BridgeR_3B_Normalizaion_factor_from_House_keeping_genes.txt"){
    ###Calc_normalization_factor###
    group_number <- length(group)
    time_points <- length(hour)
    input_file <- fread(InputFile, header=T)

    ###Output_file_infor###nfname
    hour_label <- NULL
    for(x in hour){
        label <- x
        if(x < 10){
            label <- paste("0",x,sep="")
        }
        hour_label <- append(hour_label, paste("T", label, "_0", sep=""))
    }
    cat('Sample',hour_label, sep="\t", file=OutputFile)
    cat("\n", file=OutputFile, append=T)

    for(a in 1:group_number){
        ###Search_House-keeping_genes###
        HKgenes_infor <- input_file[[InforHKGenes]]
        HKgenes_infor_index <- NULL
        for(x in 1:length(HKGenes)){
            HKgenes_infor_index <- append(HKgenes_infor_index, which(HKgenes_infor == HKGenes[x]))
        }

        ###Information&exp_data column###
        infor_st <- 1 + (a - 1)*(time_points + InforColumn)
        infor_ed <- (InforColumn)*a + (a - 1)*time_points
        exp_st <- infor_ed + 1
        exp_ed <- infor_ed + time_points

        HKGenes_raw_data <- NULL
        for(x in 1:length(HKgenes_infor_index)){
            if(x == 1){
                HKGenes_raw_data <- input_file[HKgenes_infor_index[x],exp_st:exp_ed,with=F]
            }else{
                HKGenes_raw_data <- rbind(HKGenes_raw_data,input_file[HKgenes_infor_index[x],exp_st:exp_ed,with=F])
            }
        }

        nf <- NULL
        for(x in 1:length(HKgenes_infor_index)){
            if(x == 1){
                nf <- as.numeric(as.vector(as.matrix(HKGenes_raw_data[x,])))
            }else{
                nf <- as.numeric(HKGenes_raw_data[x,]) * nf
            }
        }

        nf <- nf^(1/length(HKGenes))

        cat(group[a],nf, sep="\t", file=OutputFile, append=T)
        cat("\n", file=OutputFile, append=T)

    }
}


#' Class ngram
#'
#' An n-gram is an ordered sequence of n "words" taken from a body of "text".
#' The terms "words" and "text" can easily be interpreted literally, or with a
#' more loose interpretation.
#'
#' For example, consider the sequence "A B A C A B B".  If we examine the
#' 2-grams (or bigrams) of this sequence, they are
#'
#' A B, B A, A C, C A, A B, B B
#'
#' or without repetition:
#'
#' A B, B A, A C, C A, B B
#'
#' That is, we take the input string and group the "words" 2 at a time (because
#' \code{n=2}).  Notice that the number of n-grams and the number of words are
#' not obviously related; counting repetition, the number of n-grams is equal
#' to
#'
#' \code{nwords - n + 1}
#'
#' Bounds ignoring repetition are highly dependent on the input.  A correct but
#' useless bound is
#'
#' \code{\#ngrams = nwords - (\#repeats - 1) - (n - 1)}
#'
#' An \code{ngram} object is an S4 class container that stores some basic
#' summary information (e.g., n), and several external pointers.  For
#' information on how to construct an \code{ngram} object, see
#' \code{\link{ngram}}.
#'
#' @slot str_ptr
#' A pointer to a copy of the original input string.
#' @slot strlen
#' The length of the string.
#' @slot n
#' The eponymous 'n' as in 'n-gram'.
#' @slot ngl_ptr
#' A pointer to the processed list of n-grams.
#' @slot ngsize
#' The length of the ngram list, or in other words, the number of
#' unique n-grams in the input string.
#' @slot sl_ptr
#' A pointer to the list of words from the input string.
#'
#' @name ngram-class
#' @seealso \code{\link{ngram}}
#' @keywords Tokenization
setClass("ngram",
  representation(
    str_ptr = "externalptr",
    strlen = "integer",
    n = "integer",
    ngl_ptr = "externalptr",
    ngsize = "integer",
    sl_ptr = "externalptr"
  )
)


#' Output genes cell modules footprint matrix with metadata on the cell modules
#'
#' @param mc_id meta cell object id
#' @param gstat_id gstat object id
#' @param T_gene_tot minimal number of umis to include gene (to reduce table size)
#' @param T_fold threshold for maximal fold change over metacells
#' @param metadata_fields  metadata field names to be used as factors and breakdown over mcs
#'
#' @return Nothing. But save a table in the figure directory that can be loaded to excel
#'
#' @export
#'
mcell_mc_export_tab = function(mc_id, gstat_id = NULL, mat_id = NULL,
											T_gene_tot = 50,
											T_fold = 1, # should we also export genes with depletion (i.e. below certain threshold)?
											metadata_fields = c("batch_set_id"))
{
	mc = scdb_mc(mc_id)
	gstat = scdb_gstat(gstat_id)
	scmat = scdb_mat(mat_id)
	if(is.null(mc)) {
		stop("MC-ERR non existing mc_id ", mc_id, " when trying to export fp table")
	}

	if(is.null(gstat)) {
		stop("MC-ERR non existing gstat id ", gstat_id, " when trying to export fp table")
	}

	if(is.null(scmat)) {
		stop("MC-ERR non existing mat id ", mat_id, " when trying to export fp table")
	}

	# add #cells per clust, mean #umis (~ cell size) and assigned group (if exist)
	if (nrow(mc@color_key) > 0) {
		col2group = as.character(mc@color_key$group)
		names(col2group) = as.character(mc@color_key$color)

		groups = col2group[mc@colors]
	}
	else {
		groups = rep(NA, max(mc@mc))
	}

	out_df = rbind(tapply(colSums(scmat@mat[, names(mc@mc)]), mc@mc, mean), table(mc@mc), groups, seq_along(groups))
	out_df = cbind(rep("", nrow(out_df)), out_df)
	rownames(out_df) = c('mean_umis', 'n_cells', 'group', 'mc_id')

	# add required breakdown to features
	if (!is.null(metadata_fields)) {
		for (s in metadata_fields) {
		    new_df = table(scmat@cell_metadata[names(mc@mc), s], mc@mc)
		    new_df = cbind(rep(s, nrow(new_df)), new_df)
			out_df = rbind(new_df, out_df)
		}
	}

	fp_max = apply(mc@mc_fp, 1, max)
	fp_tot = gstat[intersect(rownames(mc@mc_fp), rownames(gstat)), "tot"]

	# genes to export
	f = fp_max > T_fold & fp_tot > T_gene_tot

	# actual clust_fp
	out_df = rbind(out_df, cbind(rep("", sum(f)), round(log2(mc@mc_fp[f,]), 2)))

	out_df = cbind(out_df[, 1], rownames(out_df), out_df[, -1])
	tab_clust_fp_fn = sprintf("%s/%s.log2_mc_fp.txt", .scfigs_base, mc_id)
	write.table(out_df, tab_clust_fp_fn, sep = "\t", quote = F, row.names = F, col.names = F)
}


#!/usr/bin/Rscript --vanilla
# Author: Miguel Morard and modified by Peris

library(ggplot2)
library(gridExtra)

args <- commandArgs(TRUE)
inputName <- args[1] #PATH of the converted file
chromosomeInfo <- args[2] #"pairwiseDivFile_chromosome.txt"

f = read.table(inputName,sep= "\t", header = T) #Lee la tabla 000.vcf.qaf.tab

chromosome_properties = read.csv(chromosomeInfo,header=TRUE,sep='\t')
allchr <- c(as.character(chromosome_properties$NAME))
chrlen <- list()
for (i in 1:length(chromosome_properties[,1])){
  chrlen[[i]] <- subset(chromosome_properties, chromosome_properties$NAME == allchr[i])
}

lista_p = list() #lista para almacenar los ggplots
subs = list() #lista para almacenar los datos de cada cromosoma
for (i in 1:length(allchr)){
  subs[[i]] <- subset(f, f$CHR == allchr[i])
}

color_species <- c("#ff0000","#cc6600","#008000","#00ffff","#0070c0","#7030a0","#ff00ff")
pdf(paste0(inputName,"_distr.pdf"),height=6,width=14)

print(ggplot(f, aes(x=AFA)) +
  geom_freqpoly(aes(y=..count..),binwidth = 0.03) +
  geom_histogram(binwidth = 0.03) +
  theme_classic() +
  scale_colour_manual(values = mycolor) +
  scale_linetype_manual(values = myshapes) +
  #ggtitle("Total counts") +
  #scale_x_continuous(limits = c(0.0,1.5)) +
  theme(axis.line.x = element_line(colour = "black"),axis.line.y = element_line(colour = "black")))

lista_p = list()
chromCHECK <- c(1,17,33,49,65,81,97)
names_plots <- c()
count <- 1
for(i in 1:length(chrlen)){
  if(i %in% chromCHECK){
    color2plot <- color_species[count]
    lista_p[[i]] <- ggplot(subs[[i]], aes_string(x="POS",y="AFA")) +
    theme(panel.background = element_rect(fill = "#FFFFFF"),plot.title = element_text(hjust = 0.5, colour ="#429221",size = 11),axis.text.x=element_blank(),axis.ticks.x=element_blank(),axis.title.y = element_blank(),axis.text.y = element_text(face = "bold", size = 16)) +
    geom_point(colour = color2plot, size=1) +
    scale_y_continuous(limits = c(0,1),breaks = c(0,0.5,1)) +
    scale_x_continuous(limits = c(0,chrlen[[i]]$LEN)) +
    xlab(unique(as.character(subs[[i]]$CHR)))
    count <- count + 1
  }else{
    lista_p[[i]] <- ggplot(subs[[i]], mapping = aes_string(x="POS",y="AFA")) +
    theme(panel.background = element_rect(fill = "#FFFFFF"),plot.title = element_text(hjust = 0.5, colour ="#429221",size = 11),axis.text.x=element_blank(),axis.ticks.x=element_blank(),axis.title.y = element_blank(),axis.text.y = element_blank()) +
      geom_point(colour = color2plot, size=1) +
      scale_y_continuous(limits = c(0,1)) +
      scale_x_continuous(limits = c(0,chrlen[[i]]$LEN)) +
      xlab(unique(as.character(subs[[i]]$CHR)))
  }
  names_plots <- c(lista_p, paste0("p",i))
}
print(do.call(grid.arrange,c(lista_p, ncol=16)))
#Show a allele frequency distribution (f)

dev.off()


###VISUALISE MODEL OUTPUTS###
library(tidyverse)
library(ggpubr)

#get folder directory
folder <- dirname(rstudioapi::getSourceEditorContext()$path)
folder_inputs = file.path(folder, '..', 'results')

#get peru cost data
data_per = read.csv(file.path(folder_inputs, 'PER', 'cost_item_results.csv'))
data_per$country = "Peru (PER)"

per_deciles = select(data_per, modeling_region, pop_density_km2)
per_deciles = unique(per_deciles)
per_deciles$pop_d_decile <- cut(per_deciles$pop_density_km2,
                          breaks = quantile(per_deciles$pop_density_km2, probs = seq(0, 1, 0.1)),
                          labels = 10:1, include.lowest = TRUE)
per_deciles$modeling_region = NULL
data_per <- merge(data_per,per_deciles,by="pop_density_km2")

#get indonesia cost data
folder <- dirname(rstudioapi::getSourceEditorContext()$path)
folder_inputs = file.path(folder, '..', 'results')

data_idn = read.csv(file.path(folder_inputs, 'IDN', 'cost_item_results.csv'))
data_idn$country = ifelse(grepl("Papua", data_idn$names),
                          "Papua (IDN)", "Kalimantan (IDN)")

papua = data_idn[data_idn$country == 'Papua (IDN)',]
kalimantan = data_idn[data_idn$country == 'Kalimantan (IDN)',]

###papua
papua_deciles = select(papua, modeling_region, pop_density_km2)
papua_deciles = unique(papua_deciles)
papua_deciles$pop_d_decile <- cut(papua_deciles$pop_density_km2,
                            breaks = quantile(papua_deciles$pop_density_km2,
                                              probs = seq(0, 1, 0.1)),
                            labels = 10:1, include.lowest = TRUE)
papua_deciles$modeling_region = NULL
papua <- merge(papua,papua_deciles,by="pop_density_km2")

###kalimantan
kalimantan_deciles = select(kalimantan, modeling_region, pop_density_km2)
kalimantan_deciles = unique(kalimantan_deciles)
kalimantan_deciles$pop_d_decile <- cut(kalimantan_deciles$pop_density_km2,
                                 breaks = quantile(kalimantan_deciles$pop_density_km2,
                                                   probs = seq(0, 1, 0.1)),
                                 labels = 10:1, include.lowest = TRUE)
kalimantan_deciles$modeling_region = NULL
kalimantan <- merge(data_idn,kalimantan_deciles,by="pop_density_km2")

###combine
data_idn = rbind(papua, kalimantan)
data = rbind(data_per, data_idn)
remove(data_per, data_idn, papua, kalimantan, per_deciles, papua_deciles, kalimantan_deciles)

data$strategy = factor(data$strategy,
                       levels=c('clos', 'nlos'),
                       labels=c('CLOS-Only', 'Hybrid CLOS-NLOS'))

data$pop_d_decile = as.factor(as.character(data$pop_d_decile))
data$pop_d_decile = factor(data$pop_d_decile,
                           levels=c(1,2,3,4,5,6,7,8,9,10),
                           labels=c(1,2,3,4,5,6,7,8,9,10))

data$cost_usd = data$cost_usd / 1e6

data <- data[!(data$asset_type == "radio_installation"),]

data$asset_type = factor(data$asset_type, levels=c(
  'two_60cm_antennas_usd', 'two_90cm_antennas_usd',
  'cost_freq_for_link_usd', #or radio_costs_usd
  'tower_10_m_usd',
  'site_survey_and_acquisition', 'power_system'),
  labels=c('Antennas', 'Antennas', 'Radios',
           'Tower/Transport',
           'Site Survey/Acquisition',
           'Power System'))

data$strategy = factor(data$strategy, levels=c(
  'CLOS-Only', 'Hybrid CLOS-NLOS'),
  labels=c('CLOS-Only', 'Hybrid CLOS-NLOS'))

totals <- data %>%
  select(country, strategy, pop_d_decile, cost_usd) %>%
  group_by(country, strategy, pop_d_decile) %>%
  summarize(total = round(sum(cost_usd)))

pop_costs = ggplot(data, aes(x=pop_d_decile, y=cost_usd, fill=asset_type)) +
  geom_bar(stat="identity") +
  theme(legend.position = 'bottom') +
  scale_y_continuous(expand = c(0, 0), #breaks = seq(0,60,100),
                     limits = c(0, 110)) +
  labs(colour=NULL,
       title = "(A) Aggregate Cost by Population Density Deciles",
       subtitle = "Deciles labelled from the highest density to the lowest (1-10)",
       x = 'Population Density Deciles', y = "Cost (Millions $USD)",
       fill='') + #Cost\nType
  theme(panel.spacing = unit(0.6, "lines"),
        axis.text.x = element_text(angle = 45)) +
  expand_limits(y=0) +
  guides() +
  geom_text(
    aes(pop_d_decile, total + 5, label = total, fill = NULL), #total + 225
    size=2.5, data = totals) +
  facet_grid(strategy~country, scales = "free")

##################
##########ID Range
#get folder directory
folder <- dirname(rstudioapi::getSourceEditorContext()$path)
folder_inputs = file.path(folder, '..', 'results')

#get peru cost data
data_per = read.csv(file.path(folder_inputs, 'PER', 'cost_item_results.csv'))
data_per$country = "Peru (PER)"

per_deciles = select(data_per, modeling_region, id_range_m)
per_deciles = unique(per_deciles)
per_deciles$id_decile <- cut(per_deciles$id_range_m,
                                breaks = quantile(per_deciles$id_range_m, probs = seq(0, 1, 0.1)),
                                labels = 10:1, include.lowest = TRUE)
per_deciles$modeling_region = NULL
data_per <- merge(data_per,per_deciles,by="id_range_m")

#get indonesia cost data
folder <- dirname(rstudioapi::getSourceEditorContext()$path)
folder_inputs = file.path(folder, '..', 'results')

data_idn = read.csv(file.path(folder_inputs, 'IDN', 'cost_item_results.csv'))
data_idn$country = ifelse(grepl("Papua", data_idn$names),
                          "Papua (IDN)", "Kalimantan (IDN)")

papua = data_idn[data_idn$country == 'Papua (IDN)',]
kalimantan = data_idn[data_idn$country == 'Kalimantan (IDN)',]

###papua
papua_deciles = select(papua, modeling_region, id_range_m)
papua_deciles = unique(papua_deciles)
papua_deciles$id_decile <- cut(papua_deciles$id_range_m,
                                  breaks = quantile(papua_deciles$id_range_m,
                                                    probs = seq(0, 1, 0.1)),
                                  labels = 10:1, include.lowest = TRUE)
papua_deciles$modeling_region = NULL
papua <- merge(papua,papua_deciles,by="id_range_m")

###kalimantan
kalimantan_deciles = select(kalimantan, modeling_region, id_range_m)
kalimantan_deciles = unique(kalimantan_deciles)
kalimantan_deciles$id_decile <- cut(kalimantan_deciles$id_range_m,
                                       breaks = quantile(kalimantan_deciles$id_range_m,
                                                         probs = seq(0, 1, 0.1)),
                                       labels = 10:1, include.lowest = TRUE)
kalimantan_deciles$modeling_region = NULL
kalimantan <- merge(data_idn,kalimantan_deciles,by="id_range_m")

###combine
data_idn = rbind(papua, kalimantan)
data = rbind(data_per, data_idn)
remove(data_per, data_idn, papua, kalimantan, per_deciles, papua_deciles, kalimantan_deciles)

data$strategy = factor(data$strategy,
                       levels=c('clos', 'nlos'),
                       labels=c('CLOS-Only', 'Hybrid CLOS-NLOS'))

data$id_decile = as.factor(as.character(data$id_decile))
data$id_decile = factor(data$id_decile,
                        levels=c(10,9,8,7,6,5,4,3,2,1),
                        labels=c(1,2,3,4,5,6,7,8,9,10))#

data$cost_usd = data$cost_usd / 1e6

data <- data[!(data$asset_type == "radio_installation"),]

data$asset_type = factor(data$asset_type, levels=c(
  'two_60cm_antennas_usd', 'two_90cm_antennas_usd',
  'cost_freq_for_link_usd', #or radio_costs_usd
  'tower_10_m_usd',
  'site_survey_and_acquisition', 'power_system'),
  labels=c('Antennas', 'Antennas', 'Radios',
           'Tower/Transport',
           'Site Survey/Acquisition',
           'Power System'))

data$strategy = factor(data$strategy, levels=c(
  'CLOS-Only', 'Hybrid CLOS-NLOS'),
  labels=c('CLOS-Only', 'Hybrid CLOS-NLOS'))

totals <- data %>%
  select(country, strategy, id_decile, cost_usd) %>%
  group_by(country, strategy, id_decile) %>%
  summarize(total = round(sum(cost_usd)))

terrain_costs = ggplot(data, aes(x=id_decile, y=cost_usd, fill=asset_type)) +
  geom_bar(stat="identity") +
  theme(legend.position = 'bottom') +
  scale_y_continuous(expand = c(0, 0), #breaks = seq(0,60,100),
                     limits = c(0, 110)) +
  labs(colour=NULL,
       title = "(B) Aggregate Cost by Terrain Irregularity Decile",
       subtitle = "Deciles labelled from the lowest terrain iregularity to the highest (1-10)",
       x = 'Terrain Irregularity Deciles', y = "Cost (Millions $USD)",
       fill='') +
  theme(panel.spacing = unit(0.6, "lines"),
        axis.text.x = element_text(angle = 45)) +
  expand_limits(y=0) +
  guides() +
  geom_text(
    aes(id_decile, total + 5, label = total, fill = NULL), #total + 225
    size=2.5, data = totals) +
  facet_grid(strategy~country, scales = "free")

combined <- ggarrange(pop_costs, terrain_costs,
                      ncol = 1, nrow = 2,
                      common.legend = TRUE, legend="bottom")

path = file.path(folder, 'figures', 'cost_panel_plot.png')
ggsave(path, units="in", width=7, height=9, dpi=300)
print(combined)
dev.off()


#=============================================================
# c:/1work/Python/djcode/fn_portal/utils/rwt_tlen_coefs.r
# Created: 16 Sep 2016 14:13:34
#
# DESCRIPTION:
#
# A. Cottrill
#=============================================================

# LIBRARIES:
library(RODBC)
library(reshape2)
library(ggplot2)
library(plyr)

#=============================================================

DBASE <- 'C:/1work/ScrapBook/Biomass_per_net.mdb'
DBConnection <- odbcConnectAccess(DBASE, uid = "", pwd = "")
DF <- sqlFetch(DBConnection, 'get_tlen_rwt_data', colnames=FALSE,
               rownames=FALSE, stringsAsFactors=FALSE)
names(DF) <- toupper(names(DF))
head(DF)
str(DF)
nrow(DF)
odbcClose(DBConnection)

wt_length<- function(x){
  # a helper function used by plyr to fit a von-bert curve to the
  # data in x (x is a dataframe that must contain the variables AGE
  # and FLEN.
  x <- subset(x, !is.na(x$TLEN) & !is.na(x$RWT))

  x$logrwt = log(x$RWT)
  x$logtlen = log(x$TLEN)

  fit <- try( lm(logrwt ~ logtlen, data=x), silent=TRUE)
  if(inherits(fit, 'try-error')){
    return(data.frame(alpha=NA, beta=NA))
  } else {
    coefs = coef(fit)
    return(data.frame(alpha=coefs[2], beta=coefs[1]))
  }

  }

wtlength_coefs <-  ddply(DF, 'SPC', wt_length)

(nrow(wtlength_coefs))

wtlength_coefs <- subset(wtlength_coefs, !is.na(wtlength_coefs$alpha)
                         & wtlength_coefs$alpha>0)
wtlength_coefs$SPC <- sprintf('%03d', wtlength_coefs$SPC)

DBConnection <- odbcConnectAccess(DBASE, uid = "", pwd = "")
sqlSave(DBConnection, wtlength_coefs, safer = FALSE, fast = TRUE,
        rownames=FALSE)
odbcClose(DBConnection)