# Read table of coefficients output from logit models
coefs <- read.table(paste0(parentdir, "/output/logmod_data/coefs/coefs_full.txt"),
  header=F, stringsAsFactors=F)
names(coefs) <- c("Cov", "Est", "SE", "Z", "pval", "Sequence", "Category")
coefs$Category <- ifelse(substr(coefs$Sequence, 4, 5)=="CG",
  paste0("cpg_", coefs$Category), coefs$Category)

coefsout <- coefs %>%
  mutate(Category = plyr::mapvalues(Category, orderedcats1, orderedcats2))
coefsout$Category <- factor(coefsout$Category, levels=orderedcats2)

write.table(coefsout, paste0(parentdir,
  "/output/logmod_data/coefs/supplementary_table_7.txt"),
  quote=F, col.names=T, row.names=F, sep="\t")

# ratefile <- paste0(parentdir, "/output/7bp_1000k_rates.txt")
# rates <- read.table(ratefile, header=T, stringsAsFactors=F)
rates <- ratelist[[4]]

rates2 <- rates %>%
  mutate(Category=Type) %>%
  mutate(Sequence=substr(Motif, 0, 7))

rates2$Category <- ifelse(substr(rates2$Sequence, 4, 5)=="CG",
  paste0("cpg_", rates2$Category), rates2$Category)

rates <- rates %>%
  mutate(Category=gsub("cpg_", "", Type)) %>%
  mutate(Sequence=substr(Motif, 0, 7))
motifdat <- rates %>%
  dplyr::select(Category, Sequence, rel_prop=ERV_rel_rate)

orderedcovs <- c("H3K9me3", "RR", "TIME", "H3K27me3",
  "H3K36me3", "DHS", "GC", "CpGI")

sigcoefs <- merge(coefs, rates2, by=c("Category", "Sequence")) %>%
  filter(nERVs>=20) %>%
  filter(!(Cov %in% c("(Intercept)", "DP"))) %>%
  group_by(Cov, Category) %>%
  # group_by(Category, Sequence) %>%
  mutate(qval=p.adjust(pval, method="fdr")) %>%
  filter(qval<0.05) %>%
  filter(!grepl("Intercept|DP", Cov)) %>%
  ungroup() %>%
  mutate(dir=ifelse(Est>0, "Up", "Down"),
    Est=ifelse(Cov=="RR", Est*10, Est),
    Est=ifelse(Cov=="GC", Est/10, Est)) %>%
  ungroup() %>%
  group_by(Cov, Category, dir) %>%
  mutate(n=n())

sigcoefs$Category2 <- plyr::mapvalues(sigcoefs$Category, orderedcats1, orderedcats2)
sigcoefs$Category2 <- factor(sigcoefs$Category2, levels=orderedcats2)

sig10txt <- sigcoefs %>%
  mutate(Estmax=ifelse(dir=="Up", 3, 0.5)) %>%
  mutate(Estmax=ifelse(Cov=="CpGI", ifelse(dir=="Up", 10, 0.125), Estmax),
    label=n) %>%
  filter(n>=10)

##############################################################################
# Theme for plotting coefficient distributions
##############################################################################
theme_coef <- function(base_size = 12, base_family = ""){
  theme_bw(base_size = base_size) %+replace%
  theme(legend.position="bottom",
    legend.title=element_blank(),
    strip.text=element_text(size=12),
    axis.text.x=element_blank(),
    axis.title.x=element_blank(),
    axis.text.y=element_text(size=10),
    axis.title.y=element_text(size=12, angle=90))
}

##############################################################################
# Plot all effects (incl. NS)
##############################################################################
coefs <- coefs %>%
  mutate(Category = plyr::mapvalues(Category, orderedcats1, orderedcats2))

coefs$Category <- factor(coefs$Category, levels=orderedcats2)
coefs %>%
  filter(!grepl("Intercept", Cov)) %>%
  filter(exp(Est)<10) %>%
  ggplot(aes(fill=Category))+
    geom_hline(yintercept=1, linetype="dashed")+
    geom_violin(aes(x=Category, y=exp(Est), fill=Category))+
    scale_fill_manual(values=gp_cols, drop=FALSE)+
    scale_colour_manual(values=gp_cols, drop=FALSE)+
    facet_wrap(~Cov, ncol=4, scales="free_y")+
    ylab("odds ratio for mutability")+
    guides(fill = guide_legend(nrow = 3))+
    theme_coef()
ggsave(paste0(parentdir, "/images/coef_violin_full.pdf"), width=9, height=8)

##############################################################################
# Plot all significant effects
##############################################################################
sigcoefs %>%
  ggplot(aes(x=Category2, y=exp(Est), alpha=factor(dir), fill=Category2))+
    geom_hline(yintercept=1, linetype="dashed")+
    geom_violin(position="identity", scale="area")+
    scale_fill_manual(values=gp_cols, drop=FALSE)+
    scale_colour_manual(values=gp_cols, drop=FALSE)+
    scale_x_discrete(drop=FALSE)+
    scale_y_log10(breaks=c(0.5, 1, 2, 4))+
    scale_alpha_discrete(range = c(0.95, 0.96), guide=F)+
    facet_wrap(~Cov, ncol=4, drop=F)+
    ylab("odds ratio for mutability")+
    guides(fill = guide_legend(nrow = 3))+
    theme_coef()
ggsave(paste0(parentdir, "/images/coef_violin.pdf"), width=6.5, height=6.5)

##############################################################################
# Plot non-CpG effects (w/ >10 subtypes)
##############################################################################
non_cpg_covs <- c("H3K9me3", "RR", "TIME",
  "H3K36me3", "DHS", "GC")

non_cpg_plotdat <- sigcoefs %>%
  filter(Cov %in% non_cpg_covs) %>%
  filter(n>=10) %>%
  mutate(Est=ifelse(Cov=="TIME", -Est, Est))
non_cpg_plotdat$Cov <- factor(non_cpg_plotdat$Cov, levels=non_cpg_covs)
sig10txt1 <- sig10txt %>%
  group_by(Cov, dir, Category2) %>%
  summarise(label=max(label), Estmax=max(Estmax)) %>%
  ungroup() %>%
  mutate(Estmax=ifelse(Cov=="TIME", 1/Estmax, Estmax)) %>%
  filter(Cov %in% non_cpg_covs)
sig10txt1$Cov <- factor(sig10txt1$Cov, levels=non_cpg_covs)

non_cpg_plotdat %>%
  ggplot(aes(x=Category2, y=exp(Est), alpha=factor(dir), fill=Category2))+
    geom_hline(yintercept=1, linetype="dashed")+
    geom_text(data=sig10txt1,
      aes(x=Category2, y=Estmax, label=label, colour=Category2),
      vjust=1, size=4, angle=90)+
    geom_violin(position="identity", scale="area")+
    scale_fill_manual(values=gp_cols, drop=FALSE)+
    scale_colour_manual(values=gp_cols, drop=FALSE)+
    scale_x_discrete(drop=FALSE)+
    # scale_y_log10(breaks=c(.125, .25, 0.5, 1, 2, 4, 8))+
    scale_y_log10(breaks=c(0.5, 1, 2, 4))+
    scale_alpha_discrete(range = c(0.95, 0.96), guide=F)+
    facet_wrap(~Cov, ncol=3, drop=F)+
    ylab("odds ratio for mutability")+
    guides(fill = guide_legend(nrow = 3))+
    theme_coef()
ggsave(paste0(parentdir, "/images/coef_violin_10.pdf"), width=6.5, height=6.5)

non_cpg_plotdat %>%
  ggplot(aes(x=exp(Est), y=Category2, alpha=factor(dir), colour=Category2, fill=Category2))+
    geom_vline(yintercept=1, linetype="dashed")+
    geom_text(data=sig10txt1,
      aes(x=Estmax, y=Category2, label=label, colour=Category2),
      vjust=1, size=4, angle=90)+
    geom_bar(position="identity", scale="area")+
    scale_fill_manual(values=gp_cols, drop=FALSE)+
    scale_colour_manual(values=gp_cols, drop=FALSE)+
    scale_x_discrete(drop=FALSE)+
    # scale_y_log10(breaks=c(.125, .25, 0.5, 1, 2, 4, 8))+
    scale_y_log10(breaks=c(0.5, 1, 2, 4))+
    scale_alpha_discrete(range = c(0.95, 0.96), guide=F)+
    facet_wrap(~Cov, ncol=3, drop=F)+
    ylab("odds ratio for mutability")+
    guides(fill = guide_legend(nrow = 3))+
    theme_coef()
ggsave(paste0(parentdir, "/images/coef_hist_10.pdf"), width=6.5, height=6.5)

# non_cpg_plotdat %>%
#   ggplot(aes(x=exp(Est), y=Category, alpha=factor(dir), fill=Category))+
#     # geom_hline(yintercept=1, linetype="dashed")+
#     # geom_text(data=sig10txt1,
#     #   aes(x=Category2, y=Estmax, label=label, colour=Category2),
#     #   vjust=1, size=4, angle=90)+
#     geom_joy()+
#     scale_fill_manual(values=gp_cols, drop=FALSE)+
#     scale_colour_manual(values=gp_cols, drop=FALSE)+
#     # scale_x_discrete(drop=FALSE)+
#     # scale_y_log10(breaks=c(.125, .25, 0.5, 1, 2, 4, 8))+
#     # scale_x_log10(breaks=c(0.5, 1, 2, 4))+
#     # scale_alpha_discrete(range = c(0.95, 0.96), guide=F)+
#     facet_wrap(~Cov, ncol=3, drop=F)#+
#     # ylab("odds ratio for mutability")+
#     # guides(fill = guide_legend(nrow = 3))+
#     # theme_coef()
# ggsave(paste0(parentdir, "/images/coef_joy_10.pdf"), width=6.5, height=6.5)

##############################################################################
# Plot CpG island effects (w/ >10 subtypes)
##############################################################################
cpgi_covs <- c("CpGI", paste0("BLANK", 1:5))

cpgi_plotdat <- sigcoefs %>%
  filter(Cov %in% cpgi_covs) %>%
  filter(n>=10)
cpgi_plotdat$Cov <- factor(cpgi_plotdat$Cov, levels=cpgi_covs)
sig10txt2 <- sig10txt %>%
  group_by(Cov, dir, Category2) %>%
  filter(Cov %in% cpgi_covs) %>%
  summarise(label=max(label), Estmax=max(Estmax))
sig10txt2$Cov <- factor(sig10txt2$Cov, levels=cpgi_covs)

cpgi_plotdat %>%
  ggplot(aes(x=Category2, y=exp(Est), alpha=factor(dir), fill=Category2))+
    geom_hline(yintercept=1, linetype="dashed")+
    geom_text(data=sig10txt2,
      aes(x=Category2, y=Estmax, label=label, colour=Category2),
      vjust=1, size=4, angle=90)+
    geom_violin(position="identity", scale="area")+
    scale_fill_manual(values=gp_cols, drop=FALSE)+
    scale_colour_manual(values=gp_cols, drop=FALSE)+
    scale_x_discrete(drop=FALSE)+
    # scale_y_log10(breaks=c(.125, .25, 0.5, 1, 2, 4, 8))+
    scale_y_log10(breaks=c(.125, .25, 0.5, 1, 2, 4, 8), labels=c(.125, .25, 0.5, 1, 2, 4, 8))+
    scale_alpha_discrete(range = c(0.95, 0.96), guide=F)+
    facet_wrap(~Cov, ncol=3, drop=F)+
    ylab("odds ratio for mutability")+
    guides(fill = guide_legend(nrow = 3))+
    theme_coef()
ggsave(paste0(parentdir, "/images/coef_violin_cpgi.pdf"), width=6.5, height=6.5)

##############################################################################
# Plot CpG-specific effects
##############################################################################

cpg_covs <- c("LAMIN", "EXON", "H3K4me1", "H3K4me3", "H3K27ac")

cpg_plotdat <- sigcoefs %>%
  filter(Cov %in% cpg_covs) %>%
  filter(n>=10)

cpg_plotdat$Cov <- factor(cpg_plotdat$Cov, levels=cpg_covs)
sig10txt3 <- sig10txt %>%
  filter(Cov %in% cpg_covs)
sig10txt3$Cov <- factor(sig10txt3$Cov, levels=cpg_covs)

cpg_plotdat %>%
  filter(exp(Est) > 0.4) %>%
  ggplot(aes(x=Cov, y=exp(Est), alpha=factor(dir), fill=Category2))+
    geom_hline(yintercept=1, linetype="dashed")+
    geom_text(data=sig10txt3,
      aes(x=Cov, y=Estmax, label=label, colour=Category2),
      vjust=1, size=6, angle=90)+
    geom_violin(position="identity", scale="area")+
    scale_fill_manual(values=gp_cols, drop=FALSE)+
    scale_colour_manual(values=gp_cols, drop=FALSE)+
    scale_x_discrete(drop=FALSE)+
    # scale_y_log10(breaks=c(.125, .25, 0.5, 1, 2, 4, 8))+
    scale_y_log10(breaks=c(0.5, 1, 2, 4), limits=c(0.25,5))+
    scale_alpha_discrete(range = c(0.95, 0.96), guide=F)+
    # facet_wrap(~Cov, ncol=4, drop=F)+
    ylab("odds ratio for mutability")+
    guides(fill = FALSE, colour=FALSE)+
    theme_coef()+
    theme(axis.text.x=element_text(angle=90))
ggsave(paste0(parentdir, "/images/coef_violin_cpg_effects.pdf"), width=6.5, height=6.5)

##############################################################################
# Code below is used to validate specific results of feature-associated subtypes
# -Must already have read in DNM data
#
# runTest() function counts the total observed number of DNMs within
# feature-associated subtypes, the number of these within each feature, and the
# expected number assuming no effect of genomic features, then tests for
# difference between expected/observed
##############################################################################
getfeats <- function(sitedf){
  # Add histone marks to site data
  hists <- c("H3K4me1", "H3K4me3", "H3K9ac", "H3K9me3",
    "H3K27ac", "H3K27me3", "H3K36me3")
  dflist <- list()
  for(i in 1:length(hists)){
    mark <- hists[i]
    file <- paste0(parentdir, "/reference_data/sort.E062-",
      mark, ".bed")
    hist <- binaryCol(sitedf, file)
    dflist[[i]] <- hist
  }

  df <- as.data.frame(do.call(cbind, dflist))
  names(df) <- hists
  sitedf <- cbind(sitedf, df)

  # Add other features
  sitedf$EXON <- binaryCol(sitedf,
    paste0(parentdir, "/reference_data/GRCh37_RefSeq_sorted.bed"))
  sitedf$CpGI <- binaryCol(sitedf,
    paste0(parentdir, "/reference_data/cpg_islands_sorted.bed"))
  sitedf$RR <- rcrCol(sitedf,
    paste0(parentdir, "/reference_data/recomb_rate.bed"))
  sitedf$LAMIN <- binaryCol(sitedf,
    paste0(parentdir, "/reference_data/lamin_B1_LADS2.bed"))
  sitedf$DHS <- binaryCol(sitedf,
    paste0(parentdir, "/reference_data/DHS.bed"))
  sitedf$TIME <- repCol(sitedf,
    paste0(parentdir, "/reference_data/lymph_rep_time.txt"))
  sitedf$GC <- gcCol(sitedf,
    paste0(parentdir, "/reference_data/gc10kb.bed"))

  return(sitedf)
}

runTest <- function(cov, dir){
  covtmp <- covdat %>% filter(Cov==cov)
  if(dir=="Up"){
    covdir <- covtmp %>% filter(Est>0)
    diralt <- "greater"
  } else {
    covdir <- covtmp %>% filter(Est<0)
    diralt <- "less"
  }

  covdirsub <- paste0(covdir$Category, "_", covdir$Sequence)

  # subset DNMs to those in associated subtypes
  dnmstmp <- input_dnms %>%
    mutate(Category2 = ifelse(substr(SEQ, 4, 5)=="CG",
      paste0("cpg_", Category), Category)) %>%
    mutate(subtype=paste0(Category, "_", substr(SEQ, 1, 7))) %>%
    # filter(subtype %in% paste0(covdir$Category, "_", covdir$Sequence))
    mutate(insub=ifelse(subtype %in% covdirsub, 1, 0))
    # filter(Category2 == "cpg_GC_AT")
    # filter(Category %in% covdir$Category &
    #   substr(SEQ, 1, 7) %in% covdir$Sequence)

  dnms2 <- dnmstmp %>%
    filter(insub==1) %>%
    mutate(DNM=1)
  dirlist <- sapply(unlist(covdir$Sequence),
    function(x)
      paste0(parentdir, "/output/logmod_data/motifs3/", x, ".txt"))

  motif_positions <- do.call(rbind,
    lapply(dirlist,
      function(x) read.table(x, header=F, stringsAsFactors=F)))

  mut_cats <- c("AT_CG", "AT_GC", "AT_TA", "GC_AT", "GC_CG", "GC_TA")
  names(motif_positions) <- c("CHR", "POS", "Sequence", mut_cats, "DP")
  sites <- merge(motif_positions, dnms2[,c("CHR", "POS", "DNM")],
    by=c("CHR", "POS"), all.x=TRUE) %>%
    mutate(DNM=ifelse(DNM==1, 1, 0))

  sites2 <- sites %>%
    sample_n(100000)

  sites2 <- rbind(sites2, sites[sites$DNM==1,])

  sites3 <- getfeats(sites2)
  dnm_mod_formula <- as.formula(paste("DNM ~",
    paste(names(sites3)[-(1:12)], collapse="+")))
  dnm_mod <- glm(dnm_mod_formula, data=sites3, family="binomial")

  result <- tidy(dnm_mod) %>% filter(term==cov)
  row <- c(dir, result)
  return(row)
  ###
}

##############################################################################
# Test for mutation rate differences in dnms
##############################################################################
covdat <- sigcoefs
covdat$Category <- gsub("cpg_", "", covdat$Category)
covs <- unique(covdat$Cov)
# covs <- covs[grepl("H3", covs)]
testdat <- data.frame()
dnmdat <- data.frame()
covdir <- covdat %>%
  mutate(Dir=ifelse(Est>=0, "Up", "Down")) %>%
  group_by(Cov, Dir) %>%
  summarise(n=n())
for(i in 1:nrow(covdir)){
# for(i in 1:5){
  cov <- covdir[i,]$Cov
  dir <- covdir[i,]$Dir
  cat("Running tests on", cov, dir, "\n")
  if(covdir[i,]$n >= 10){
    tmpdata <- runTest(cov, dir)
    # testrow <- tmpdata$test
    testdat <- rbind(testdat, tmpdata)

    # tmpdnms <- tmpdata$dnms
    # dnmdat <- rbind(dnmdat, tmpdnms)
  }
}

dnmdat %>%
  mutate(cov=ifelse(dir=="Down" & cov=="TIME", "TIME_LATE", cov)) %>%
  mutate(cov=ifelse(dir=="Up" & cov=="TIME", "TIME_EARLY", cov)) %>%
  mutate(dir=ifelse(dir=="Down" & cov=="TIME_LATE", "Up", dir)) %>%
  filter(inside %in% c(0,1)) %>%
  ggplot(aes(x=cov, y=log(MU), colour=factor(inside)))+
    geom_violin()+
    geom_boxplot(fill=NA)+
    # geom_point(aes(colour=factor(inside)), alpha=0.1,
    #   position=position_jitterdodge())+
    facet_wrap(~dir, scales="free", nrow=2)+
    ylab("log(relative mutation rate)")
ggsave(paste0(parentdir, "/images/covbars_full.png"), width=12, height=8)

cov_ord <- c("H3K9me3", "RR", "H3K27me3",
  "H3K27ac", "EXON", "H3K4me1", "H3K4me3", "LAMIN",
  "GC", "H3K36me3", "CpGI", "TIME", "DHS")

testdat$cov <- factor(testdat$cov, levels=cov_ord)

testdat %>%
  filter(cov %in% cov_ord) %>%
  dplyr::select(cov, dir,
    Inside=estimate2, Outside=estimate1,
    statistic, df=parameter, p.value) %>%
    arrange(cov)

##############################################################################
# Test for mutation rate differences in dnms, excluding CpGs
##############################################################################
covdat <- sigcoefs %>%
  filter(!grepl("cpg", Category))
covdat$Category <- gsub("cpg_", "", covdat$Category)
covs <- unique(covdat$Cov)
# covs <- covs[grepl("H3", covs)]
testdat3 <- data.frame()
covdir <- covdat %>%
  mutate(Dir=ifelse(Est>=0, "Up", "Down")) %>%
  group_by(Cov, Dir) %>%
  summarise(n=n())
for(i in 1:nrow(covdir)){
  cov <- covdir[i,]$Cov
  dir <- covdir[i,]$Dir
  if(covdir[i,]$n > 10){
    row <- runTest(cov, dir)
    testdat3 <- rbind(testdat3, row)
  }
}

##############################################################################
# Test for mutation rate differences in DHS CCAAT-box motifs
##############################################################################
covdat <- sigcoefs %>%
  filter(Category == "AT_GC" & substr(Sequence, 1, 5)=="CCAAT")
covdat$Category <- gsub("cpg_", "", covdat$Category)
covs <- unique(covdat$Cov)

row <- runTest("DHS", "Up")

# covs <- covs[grepl("H3", covs)]
testdat2 <- data.frame()
covdir <- covdat %>%
  mutate(Dir=ifelse(Est>=0, "Up", "Down")) %>%
  group_by(Cov, Dir) %>%
  summarise(n=n())
for(i in 1:nrow(covdir)){
  cov <- covdir[i,]$Cov
  dir <- covdir[i,]$Dir
  if(covdir[i,]$n > 10){
    row <- runTest(cov, dir)
    testdat2 <- rbind(testdat2, row)
  }
}

###
testdat[testdat$cov=="TIME",]$dir <- "Up"
names(testdat)[3:4]<-c("Observed", "Expected")

td2 <- testdat %>%
  gather(group, value, c(Observed:Expected))
td3 <- data.frame()
for(i in 1:nrow(td2)){
  row <- td2[i,]
  ci <- prop.test(row$value, row$n)$conf.int[1:2]*row$n
  names(ci) <- c("lo", "hi")
  if(row$dir=="Up"){
    binom.pval <- binom.test(x=as.integer(row$value), n=row$n, p=row$propexp,
      alternative="greater")$p.value
  } else {
    binom.pval <- binom.test(x=as.integer(row$value), n=row$n, p=row$propexp,
      alternative="less")$p.value
  }

  newrow <- data.frame(c(row, ci, binom.pval=binom.pval), stringsAsFactors=F)
  td3 <- rbind(td3, newrow)
}

limits <- aes(ymax=hi, ymin=lo)

dirlabels <- c(Down="Subtypes with predicted depletion",
  Up="Subtypes with predicted enrichment")

td3$gp <- paste0(td3$dir, " (", td3$group, ")")
# td3$gp <- as.factor(paste0(td3$dir, " (", td3$group, ")"))
# levels(td3$group) <- c("Expected", "Observed")
# levels(td3$gp) <- unique(td3$gp)[c(3:4, 1:2)]

ggplot(td3[td3$value>60,],
    aes(x=cov, y=value, colour=gp, fill=gp, group=group))+
  geom_bar(stat="identity", position="dodge")+
  geom_errorbar(limits, position="dodge", colour="black")+
  # scale_y_log10(limits=c(60, 2000))+
  facet_wrap(~dir, scales="free", nrow=2, labeller=labeller(dir=dirlabels))+
  scale_colour_manual(values=rb[c(1:2,4:5)])+
  scale_fill_manual(values=rb[c(1:2,4:5)],
    labels=rep(c("Expected #DNMs under null\n(features have no effect)",
      "Observed #DNMs"), 2))+
  ylab("#DNMs")+
  theme_classic()+
  theme(legend.title=element_blank(),
    legend.key.size = unit(1.1, "cm"),
    strip.text.x = element_text(size=16),
    axis.title.y = element_text(size=16),
    axis.text.x = element_text(size=14, angle=45, vjust=1, hjust=1),
    axis.title.x=element_blank())+
  guides(colour=FALSE)
ggsave(paste0(parentdir, "/images/covbars_full.png"), width=12, height=8)


require(tidyverse)
######### Kachemak Bay Birders Bay --- West Data ##############
# Import data - Available form Kachemak Bay Birders
# west.ketch <- read.csv('West_data.csv', header = T)

a <- filter(west.ketch, grepl('census', Source.Comments))

# Group into date, then filter out non relavent species
west.clean <-
  west.ketch %>%
  filter(grepl('census', Source.Comments)) %>%
  dplyr::select(-Source.Comments, -Code.No) %>%
  group_by(Date, Species, Location) %>% #
  dplyr::summarize(Sum.count = sum(No, na.rm=T), n.sites= n()) %>% # Location1= Location %in% first(Location),Location2 = last(Location)
  filter(!is.na(Sum.count)) %>%
  tidyr::spread(Species, Sum.count ) %>% # spread count column into species counts
#   dplyr::select(n.sites, Date,DUNL, WESA ) %>%
  group_by(Date) %>%
  dplyr::summarize(DUNL = sum(DUNL, na.rm = T), WESA = sum(WESA, na.rm=T), nsites = sum(n.sites, na.rm=T)) %>%
  mutate(Year = format(as.Date(Date), format = "%Y"), # Extract date information
         Month = format(as.Date(Date), format = "%m"),
         Day = format(as.Date(Date), format = "%d"),
         Day.of.Year = as.integer(format(as.Date(Date) , format = "%j")),
         Site = 'Kachemak Bay',
         SiteID = 'KABA') %>%
  filter(Day.of.Year > 110 & Day.of.Year < 150 ) %>%#& Year <= 1994 & Year != 1988) %>%
  arrange(Date) %>%
  mutate_each(funs(as.character))

west.clean$WESA[is.na(west.clean$WESA)] <- 0 # Replace NAs with zeros
west.clean$DUNL[is.na(west.clean$DUNL)] <- 0

multiple.locations <- west.ketch %>% group_by(Date, Location) %>% summarize(n.1 = n()) %>% group_by(Date) %>% summarize(n.2 = length(Location)) %>%
  arrange(desc(n.2)) %>% filter(n.2 > 1) %>% dplyr::select(Date)

# datebyloc <- filter(west.ketch, Date %in% multiple.locations$Date )%>%
#   group_by(Date, Location)%>% summarize() %>% distinct() %>% tidyr::spread(Location, Date)

######### Kachemack Bay --- KB Birders ##############
KB.Birders.ketch <- read.csv('Kachemak_Redone.csv', header = T)
KB2.clean <-
  KB.Birders.ketch %>%
  rename(WESA = Western.Sandpiper,
         LESA = Least.Sandpiper,
         SESA = Semipalmated.Sandpiper,
         DUNL = Dunlin,
         sm.peeps = LESA.WESA.SESA) %>%
  mutate(Month = ifelse(Month == 'April', '04', '05')) %>%
  mutate(Date = as.Date(paste(Year, '-', Month, "-", Day, sep = ""), format = "%Y-%m-%d"),
         Day.of.Year = as.integer(format(Date, format = "%j"))) %>%
  group_by(Year, Day.of.Year) %>%
    mutate(prop.W = WESA / max(1,WESA + LESA + SESA),
         WESA.2 = WESA + sm.peeps ) %>% ungroup %>%  #* prop.W
    mutate(
         Site = 'Kachemak Bay',
         SiteID = 'KABA',
         Year = as.character(Year)) %>%
  rename(WESA.base = WESA,
         WESA = WESA.2) %>%
  dplyr::select(Site, SiteID, Date, Month, Day, Year, Day.of.Year, WESA, DUNL, prop.W) %>%
  mutate_each(funs(as.character))

## Dealingwith2016
require(lubridate)
kbsupp2016 <- read.csv("KABA_Supplimentary_2016_raw_ebird.csv") %>%
  mutate(Date = mdy(DATE),
         Year = year(Date),
         Month = month(Date),
         Day = day(Date),
         Day.of.Year = yday(Date)) %>%
  group_by(Date, Year, Month, Day, COMMON.NAME, Day.of.Year, LOCALITY) %>%
  summarize(COUNT = max(COUNT, na.rm=T)) %>%
  group_by(Date, Year, Month, Day, COMMON.NAME, Day.of.Year) %>%
  summarize(COUNT = sum(COUNT)) %>% ungroup %>%
  spread(key = COMMON.NAME, value = COUNT, fill = 0) %>% filter(Day.of.Year >100) %>%
  rename(WESA = `Western Sandpiper`,
          LESA = `Least Sandpiper`,
         SESA = `Semipalmated Sandpiper`,
         DUNL = Dunlin,
         sm.peeps = `peep sp.`) %>%
  mutate(Date = as.character(Date),
         Site = 'Kachemak Bay',
         SiteID = 'KABA',
         Year = Year) %>%
  group_by(Day.of.Year, Year) %>%
  mutate(prop.W = WESA / max(1,WESA + LESA + SESA),
         WESA.2 = WESA + sm.peeps  ) %>% ungroup %>% #* prop.W
  rename(WESA.base = WESA,
         WESA = WESA.2) %>%
  dplyr::select(Site, SiteID, Date, Month, Day, Year, Day.of.Year, WESA, DUNL, prop.W) %>%
  mutate_each(funs(as.character))

# KABA - Supplimentary Counts ---------------------------------------------
KB.Birders.ketch.supp <- read.csv('KABA_Supplimentary.csv', header = T, stringsAsFactors = F)
KB2.supp.clean <-
  KB.Birders.ketch.supp %>%
  rename(WESA = Western.Sandpiper,
         LESA = Least.Sandpiper,
         SESA = Semipalmated.Sandpiper,
         DUNL = Dunlin,
         sm.peeps = LESA.WESA.SESA) %>%
  mutate(Month = ifelse(Month == 'April', '04', '05')) %>%
  mutate(Date = as.Date(paste(Year, '-', Month, "-", Day, sep = ""), format = "%Y-%m-%d"),
         Day.of.Year = as.integer(format(Date, format = "%j")),
         # prop.W = WESA / max(1,WESA + LESA + SESA),
         # WESA.2 = WESA + sm.peeps * prop.W,
         Site = 'Kachemak Bay',
         SiteID = 'KABA',
         Year = as.character(Year)) %>%
  group_by(Day.of.Year, Year) %>%
  mutate(prop.W = WESA / max(1,WESA + LESA + SESA),
         WESA.2 = WESA + sm.peeps ) %>% ungroup %>% # * prop.W
  rename(WESA.base = WESA,
         WESA = WESA.2) %>%
  dplyr::select(Site, SiteID, Date, Month, Day, Year, Day.of.Year, WESA, DUNL, prop.W) %>%
  mutate_each(funs(as.character)) %>% filter(!(Day.of.Year == 132 & Year == 2014)) %>%
  bind_rows(kbsupp2016)

yrs <- unique(KB2.supp.clean$Year)
KB.supp.filtered <- KB2.supp.clean
for (i in yrs){
  days <- KB2.clean$Day.of.Year[which(KB2.clean$Year == i)] %>% unique
  # print(days)
  KB.supp.filtered <- filter(KB.supp.filtered, Year != i | !Day.of.Year %in% days)

}

KB2.w.supp <- bind_rows(KB2.clean, KB.supp.filtered)

######### Tofino ##############
# Available through Environment and Climate Change Canada
Tofino <- read.csv('Tofino.csv', header = T)
Tofino.clean <-
  Tofino %>% dplyr::select(Date, DOY, Year, Location, WESA, DUNL) %>%
  group_by(Date, DOY, Year) %>%
  dplyr::summarise_each(funs(mean)) %>%
  dplyr::select(-Location) %>%
  filter(!is.na(DOY)) %>%
  mutate( # Extract date information
    Month = format(as.Date(Date, format = "%d-%m-%Y"), format = "%m"),
    Day = format(as.Date(Date, format = "%d-%m-%Y"), format = "%d"),
    Site = 'Tofino',
    SiteID = 'TOFN') %>%
  rename(Day.of.Year = DOY) %>%
  ungroup() %>%
  mutate_each(funs(as.character))

######### Roberts Bank ##############
  # Available through Environment and Climate Change Canada
RBBP <- read_tsv('RBBP.csv') # Import

# Remove non-count days and add date variables
RBBP.clean <-
  RBBP %>% filter(!is.na(count)) %>%
  dplyr::select(DATE, DUNL, WESA, Year, DOY ) %>%
  mutate( # Extract date information
         D = mdy(DATE),
         Month = month(D),#format(as.Date(DATE, format = "%d-%m-%Y"), format = "%m"),
         Day = day(D),#format(as.Date(DATE, format = "%d-%m-%Y"), format = "%d"),
         doy = yday(D),
         Site = 'Roberts Bank',
         SiteID = 'RBBP') %>%
  rename(Day.of.Year = DOY, Date = DATE) %>%
  mutate_each(funs(as.character))

qnt <-Hmisc::wtd.quantile(RBBP.clean$Day.of.Year, weights = as.numeric(RBBP.clean$WESA), probs = c(0.33,0.67))

# R2 <-
# RBBP.clean %>% mutate(timing = ifelse(Day.of.Year < qnt[1],'early', ifelse(Day.of.Year< qnt[2], "late", 'mid') )) %>%
#   group_by(timing, Year) %>%
#   summarize(WESA = mean(WESA, na.rm=T))

######### Kennedy Creek  ##############
# Contact Joseph B. Buchanan for data access
KENN <- read.csv('KENN.csv', header = T, sep = '\t')

KENN.clean <-
  KENN %>% dplyr::select(-BBPL) %>%
  mutate(Date = as.Date(paste(Year, '-', Month, "-", Day, sep = "")),
         Day.of.Year = as.integer(format(Date, format = "%j")),
         Site = 'Kennedy Creek',
         SiteID = 'KENN') %>%
  mutate_each(funs(as.character))

KENN2 <- read_csv("KENN_2013_2016.csv")
require(lubridate)
KENN2.clean <-
  KENN2 %>% tidyr::separate(col = Date, into = c("Day", "MonthName"), sep = "-", remove = F) %>%
    mutate(Month = ifelse(MonthName == "Mar", 3, ifelse(MonthName == "Apr", 4,5 )),
      Date.cln = as_date(paste0(Year, "-", Month,"-",  Day)),
      Day.of.Year = yday(Date.cln),
      Site = 'Kennedy Creek',
      SiteID = 'KENN') %>%
  mutate_each(funs(as.character))

######### Copper River Delta  ##############
# Original Data with Mary Ann's species predictions
# CRD <- read.csv('../DataReview/cleaned_data/CRD_Cleaned.txt', header = T, sep = '\t')
# CRD.clean <-
#   CRD %>% dplyr::select(-X) %>%
#   rename(Day.of.Year = Date) %>%
#   mutate(Date = format(as.Date(paste(Year, "-", Day.of.Year, sep = ""), format = "%Y-%j"), format = "%d-%m-%Y"),
#          Month = format(as.Date(paste(Year, "-", Day.of.Year, sep = ""), format = "%Y-%j"), format = "%m"),
#          Day = format(as.Date(paste(Year, "-", Day.of.Year, sep = ""), format = "%Y-%j"), format = "%d"),
#          Site = 'Copper River Delta',
#          SiteID = 'CRD',
#          Year = as.character(Year)) %>%
#   mutate_each(funs(as.character))

########### Running version with Linear interpolation
# Daily counts from linear interpolation described in CRD_species_composition.R
CRD <- read.csv('predicted DUNL and WESA.csv', header = T)
CRD.clean <-
  CRD %>% dplyr::select(Date, Totals,WESA, DUNL,  pred.WESA, pred.DUNL, Year ) %>%
  rename(Day.of.Year = Date) %>%
  mutate(
        WESA = ifelse(is.na(WESA), pred.WESA, WESA),
        DUNL = ifelse(is.na(DUNL), pred.DUNL, DUNL),
        Date = format(as.Date(paste(Year, "-", Day.of.Year, sep = ""), format = "%Y-%j"), format = "%d-%m-%Y"),
         Month = format(as.Date(paste(Year, "-", Day.of.Year, sep = ""), format = "%Y-%j"), format = "%m"),
         Day = format(as.Date(paste(Year, "-", Day.of.Year, sep = ""), format = "%Y-%j"), format = "%d"),
         Site = 'Copper River Delta',
         SiteID = 'CRD',
         Year = as.character(Year)) %>% select(-pred.WESA, -pred.DUNL) %>%
  mutate_each(funs(as.character))

############ Join the data together ####################3

spring.counts <-
  CRD.clean %>%
  bind_rows(west.clean) %>%
  bind_rows(KB2.clean) %>%
  bind_rows(RBBP.clean) %>%
  bind_rows(Tofino.clean) %>%
  bind_rows(KENN.clean) %>%
  bind_rows(KENN2.clean) %>%
  mutate(Day.of.Year = as.numeric(Day.of.Year),
         Totals = as.numeric(Totals),
         WESA = as.numeric(WESA),
         DUNL= as.numeric(DUNL),
         Year= as.numeric(Year),
         Month= as.numeric(Month),
         Day= as.numeric(Day)
         ) %>%
    filter(as.numeric(Month) == 4 | Month ==5 )

spring.counts.w.supp <-
  CRD.clean %>%
  bind_rows(west.clean) %>%
  bind_rows(KB2.w.supp) %>%
  bind_rows(RBBP.clean) %>%
  bind_rows(Tofino.clean) %>%
  bind_rows(KENN.clean) %>%
  bind_rows(KENN2.clean) %>%
  mutate(Day.of.Year = as.numeric(Day.of.Year),
         Totals = as.numeric(Totals),
         WESA = as.numeric(WESA),
         DUNL= as.numeric(DUNL),
         Year= as.numeric(Year),
         Month= as.numeric(Month),
         Day= as.numeric(Day)
  ) %>%
  filter(as.numeric(Month) == 4 | Month ==5 )

saveRDS(spring.counts, "./datafiles/spring.counts.rds")
saveRDS(spring.counts.w.supp, "./datafiles/spring.counts.w.supp.rds")


#' get signature loadings
#' @param widedat Output from get_nmf_input
#' @param nmfdat Output from nmf
#' @importFrom dplyr mutate
#' @importFrom tidyr gather
#' @importFrom stats coef
#' @import magrittr
#' @return Signature loadings
#' @export
get_loads <- function(widedat, nmfdat){
  sigloads <- data.frame(subtype=names(widedat),
                         sig1=coef(nmfdat)[1,],
                         sig2=coef(nmfdat)[2,],
                         sig3=coef(nmfdat)[3,]) %>%
    mutate(sig1=sig1/sum(sig1), sig2=sig2/sum(sig2), sig3=sig3/sum(sig3)) %>%
    gather(sig, value, sig1:sig3)

  names(sigloads) <- c("subtype", "sig", "value")
  sigloads <- sigloads %>%
    mutate(Category=substr(subtype, 1, 5),
           Sequence=substr(subtype, 7, 14))

  return(sigloads)
}

#' plot signature loadings
#' @importFrom ggplot2 ggplot geom_bar facet_grid theme_bw theme
#' @param sigloads Signature loadings from get_loads
#' @return ggplot2 object with signature loads plot
#' @export
plot_loads <- function(sigloads){
  p <- ggplot(sigloads, aes(x=Sequence, y=value, fill=sig))+
    geom_bar(stat="identity")+
    facet_grid(sig~Category, scales="free_x")+
    theme_bw()+
    theme(axis.text.x=element_text(angle=90, hjust=1),
          strip.text=element_text(size=16),
          legend.position="none")
  return(p)
}

#' plot signature contribution across individuals
#' @importFrom ggplot2 ggplot geom_line aes scale_x_discrete scale_y_continuous facet_wrap ylab theme_bw theme
#' @param sigdat Signature loadings from get_loads
#' @return ggplot2 object with signature by individual loads plot
#' @export
plot_ind_sigs <- function(sigdat){
  p <- ggplot(sigdat,
      aes(x=ID, y=prob, group=cluster, colour=cluster)) +
    geom_line()+
    scale_x_discrete(expand=c(0,0))+
    scale_y_continuous(expand=c(0,0), limits=c(0,1))+
    facet_wrap(~Study, scales="free_x", nrow=1)+
    ylab("signature contribution")+
    theme_bw()+
    theme(axis.text.x=element_blank(),
      legend.position="bottom")

  return(p)
}


data<-read.table(parSampleFile1, sep="\t", header=F, stringsAsFactor=F)

targetscan_folder = parFile1

comparisons <- unique(data$V3)

comparison<-comparisons[1]
for ( comparison in comparisons ) {
  cdata<-data[data$V3 == comparison,]
  miRNA_file = cdata[cdata$V2=="miRNA", "V1"]
  mRNA_file = cdata[cdata$V2=="mRNA", "V1"]
  species = cdata[cdata$V2=="species", "V1"]

  prediction = "All"
  project_name = comparison
  miRNA <- fread(miRNA_file, data.table = F)
  miRNA <- miRNA[,c("V1", "log2FoldChange")]
  colnames(miRNA) <- c("Feature_miRNA_name", "log2FoldChange_miRNA")

  mRNA <- fread(mRNA_file, data.table = F)
  mRNA <- mRNA[,c("Feature_gene_name", "log2FoldChange")]
  colnames(mRNA) <- c("Feature_gene_name", "log2FoldChange_mRNA")

  save_targets<-TRUE

  targetscan_DE(miRNA, mRNA, targetscan_folder = targetscan_folder, species = species, prediction = prediction, save_targets=save_targets, project_name = project_name)
}


# obtained from SingleR package
# understand how to score cell types

input=<seurat.obj>
output=<prefix>

library(celldex)
ref.hpca <- HumanPrimaryCellAtlasData()
ref.immgen <- ImmGenData()
library(SingleR)
pred=SingleR(test=as.SingleCellExperiment(d),
        ref=ref.hpca,labels=ref.hpca$label.main, assay.type.test=1)
saveRDS(pred,file=paste0(output,".singler_hpca.rds"))

SingleR = function (method = "single", sc_data, ref_data, types, clusters = NULL,
    genes = "de", quantile.use = 0.8, p.threshold = 0.05, fine.tune = TRUE,
    fine.tune.thres = 0.05, sd.thres = 1, do.pvals = T, numCores = SingleR.numCores,
    ...)
{
    rownames(ref_data) = tolower(rownames(ref_data))
    rownames(sc_data) = tolower(rownames(sc_data))
    A = intersect(rownames(ref_data), rownames(sc_data))
    sc_data = as.matrix(sc_data[A, ])
    ref_data = ref_data[A, ]
    if (ncol(sc_data) > 1) {
        not.use = rowSums(is.na(ref_data)) > 0 | rowSums(is.na(sc_data)) >
            0 | rowSums(ref_data) == 0
        ref_data = ref_data[!not.use, ]
        sc_data = sc_data[!not.use, ]
    }
    mat = medianMatrix(ref_data, types)
    if (typeof(genes) == "list") {
        utypes = unique(types)
        n = round(500 * (2/3)^(log2(c(ncol(mat)))))
        genes.filtered = unique(unlist(unlist(lapply(utypes,
            function(j) lapply(utypes, function(i) genes[[i]][[j]][1:n])))))
        genes.filtered = intersect(genes.filtered, rownames(mat))
        print(paste0("Number of DE genes:", length(genes.filtered)))
    }
    else if (genes[1] == "de") {
        n = round(500 * (2/3)^(log2(c(ncol(mat)))))
        genes.filtered = unique(unlist(unlist(lapply(1:ncol(mat),
            function(j) {
                lapply(1:ncol(mat), function(i) {
                  s = sort(mat[, j] - mat[, i], decreasing = T)
                  s = s[s > 0]
                  names(s)[1:min(n, length(s))]
                })
            }))))[-1]
        print(paste0("Number of DE genes:", length(genes.filtered)))
    }
    else if (genes[1] == "sd") {
        sd = rowSds(as.matrix(mat))
        genes.filtered = intersect(rownames(mat)[sd > sd.thres],
            rownames(sc_data))
        print(paste0("Number of genes with SD>", sd.thres, ": ",
            length(genes.filtered)))
    }
    else {
        genes.filtered = intersect(tolower(genes), intersect(tolower(rownames(sc_data)),
            tolower(rownames(ref_data))))
        print(paste("Number of genes using in analysis:", length(genes.filtered)))
    }
    cell.names = colnames(sc_data)
    if (method == "single") {
        if (dim(sc_data)[2] > 2) {
            print(paste("Number of cells:", dim(sc_data)[2]))
        }
    }
    else if (method == "cluster") {
        n = length(levels(clusters))
        print(paste("Number of clusters:", n))
        data = matrix(nrow = dim(sc_data)[1], ncol = n)
        for (i in 1:n) {
            data[, i] = rowSums(as.matrix(sc_data[, is.element(clusters,
                levels(clusters)[i])]))
        }
        colnames(data) = levels(clusters)
        rownames(data) = rownames(sc_data)
        sc_data = data
    }
    else {
        print("Error: method must be 'single' or 'cluster'")
        return(0)
    }
    output = SingleR.ScoreData(sc_data, ref_data, genes.filtered,
        types, quantile.use, numCores = numCores, ...)
    if (do.pvals == T) {
        output$pval = SingleR.ConfidenceTest(output$scores)
    }
    if (fine.tune == TRUE & length(unique(types)) > 2) {
        labels = SingleR.FineTune(sc_data, ref_data, types, output$scores,
            quantile.use, fine.tune.thres, genes = genes, sd.thres,
            mat, numCores = numCores)
        output$labels1 = as.matrix(output$labels)
        output$labels = as.matrix(labels)
        output$labels1.thres = c(output$labels)
        if (do.pvals == T)
            output$labels1.thres[output$pval > p.threshold] = "X"
    }
    else {
        labels = as.matrix(output$labels)
        output$labels.thres = c(output$labels)
        if (do.pvals == T)
            output$labels.thres[output$pval > p.threshold] = "X"
    }
    output$cell.names = cell.names
    output$quantile.use = quantile.use
    output$types = types
    output$method = method
    return(output)
}
<bytecode: 0x55791b681588>
<environment: namespace:SingleR>


library(tidyverse)
library(RColorBrewer)
library(rgeos)
library(maptools)
library(scales)

#set path
path_inputs <- "C:\\Users\\edwar\\Desktop\\GitHub\\digital_comms\\results\\digital_transport"
path_shapes <- "C:\\Users\\edwar\\Desktop\\GitHub\\digital_comms\\data\\digital_comms\\raw\\simplified_LADs"
path_figures <- "C:\\Users\\edwar\\Dropbox\\DfT ITS Project\\figures"

#set working directory
setwd(path_inputs)

# Get the files names
files = list.files(pattern=glob2rx("spend*.csv"))

# First apply read.csv, then rbind
all_scenarios = do.call(rbind, lapply(files, function(x) read.csv(x, stringsAsFactors = FALSE)))

all_scenarios$road_type[all_scenarios$road_function == 'Dense Motorway' & all_scenarios$urban_rural == 'urban'] <- 'Dense Motorway (Urban)'
all_scenarios$road_type[all_scenarios$road_function == 'Dense Motorway' & all_scenarios$urban_rural == 'rural'] <- 'Dense Motorway (Rural)'
all_scenarios$road_type[all_scenarios$road_function == 'Motorway' & all_scenarios$urban_rural == 'urban'] <- 'Motorway (Urban)'
all_scenarios$road_type[all_scenarios$road_function == 'Motorway' & all_scenarios$urban_rural == 'rural'] <- 'Motorway (Rural)'
all_scenarios$road_type[all_scenarios$road_function == 'A Road' & all_scenarios$urban_rural == 'urban'] <- 'A Road (Urban)'
all_scenarios$road_type[all_scenarios$road_function == 'A Road' & all_scenarios$urban_rural == 'rural'] <- 'A Road (Rural)'
all_scenarios$road_type[all_scenarios$road_function == 'B Road' & all_scenarios$urban_rural == 'urban'] <- 'B Road (Urban)'
all_scenarios$road_type[all_scenarios$road_function == 'B Road' & all_scenarios$urban_rural == 'rural'] <- 'B Road (Rural)'
all_scenarios$road_type[all_scenarios$road_function == 'Minor Road' & all_scenarios$urban_rural == 'urban'] <- 'Minor Road (Urban)'
all_scenarios$road_type[all_scenarios$road_function == 'Minor Road' & all_scenarios$urban_rural == 'rural'] <- 'Minor Road (Rural)'
all_scenarios$road_type[all_scenarios$road_function == 'Local Road' & all_scenarios$urban_rural == 'urban'] <- 'Local Road (Urban)'
all_scenarios$road_type[all_scenarios$road_function == 'Local Road' & all_scenarios$urban_rural == 'rural'] <- 'Local Road (Rural)'

all_scenarios$road_type <- factor(all_scenarios$road_type,
                                  levels = c("Dense Motorway (Urban)",
                                             "Dense Motorway (Rural)",
                                             "Motorway (Urban)",
                                             "Motorway (Rural)",
                                             "A Road (Urban)",
                                             "A Road (Rural)",
                                             "B Road (Urban)",
                                             "B Road (Rural)",
                                             "Minor Road (Urban)",
                                             "Minor Road (Rural)",
                                             "Local Road (Urban)",
                                             "Local Road (Rural)"))

all_scenarios$year <- as.factor(all_scenarios$year)

#######################
# Vehicle Rollout and Subscription Take-up
#######################

vehicle_rollout_and_take_up <- all_scenarios[(all_scenarios$scenario == 'baseline' |
                                                all_scenarios$strategy == 'cellular_V2X_full_greenfield'),]

vehicle_rollout_and_take_up <- select(all_scenarios, year, total_cars, annual_CAV_capability, annual_CAV_take_up)

vehicle_rollout_and_take_up <- vehicle_rollout_and_take_up %>%
  group_by(year) %>%
  summarise(total_cars = sum(total_cars),
            annual_CAV_capability = sum(annual_CAV_capability),
            annual_CAV_take_up = sum(annual_CAV_take_up))

vehicle_rollout_and_take_up <- gather(vehicle_rollout_and_take_up, metric, value, total_cars, annual_CAV_capability, annual_CAV_take_up)

CAV_rollout_figure <- ggplot(data=vehicle_rollout_and_take_up, aes(x=year, y=(value/1000000), fill=metric)) +
  geom_bar(position="dodge", stat="identity")  +
  scale_y_continuous(expand = c(0, 0), limits=c(0,45)) +
  ylab("Vehicles (Millions)") +
  scale_fill_manual(values = c("orange2","green4", "light blue"),
                    name = "Type",
                    labels = c("Enabled CAVs", "Subscribers", "Total Registered Vehicles")) +
  theme(legend.position = "bottom", axis.title.x=element_blank(), axis.text.x = element_text(angle = 45, hjust = 1)) +
  guides(fill = guide_legend(reverse = FALSE)) +
  labs(title="Enabled CAVs and Subscription Take-up ", subtitle="Vehicle registration annual growth rate: 0.09%")

### EXPORT TO FOLDER
setwd(path_figures)
tiff('CAV_rollout_figure.tiff', units="in", width=7, height=5, res=300)
print(CAV_rollout_figure)
dev.off()

rm(vehicle_rollout_and_take_up, CAV_rollout_figure)

#######################
# CAV road density
#######################

CAV_density <- all_scenarios[(all_scenarios$scenario == 'baseline' |
                                all_scenarios$scenario == 'low' |
                                all_scenarios$scenario == 'high'),]

CAV_density <- CAV_density[(CAV_density$strategy == 'cellular_V2X_full_greenfield'),]

CAV_density <- select(CAV_density, year, scenario, road_function, length_m,
                      total_cars, annual_CAV_capability, annual_CAV_take_up)

CAV_density$road_function <- factor(CAV_density$road_function,
                                    levels = c("Dense Motorway",
                                               "Motorway",
                                               "A Road",
                                               "B Road",
                                               "Minor Road",
                                               "Local Road"))

scenario_labels <- c(`high` = "High (10 Mb/s, £20 ARPU)",
                     `baseline` = "Baseline (4 Mb/s, £4 ARPU)",
                     `low` = "Low (1 Mb/s, £2 ARPU)")

CAV_density$scenario <- factor(CAV_density$scenario,
                               levels = c("low",
                                          "baseline",
                                          "high"))

road_function_labels <- c('Dense Motorway' = "Dense Motorway",
                          `Motorway` = "Motorway",
                          `A Road` = "A Road",
                          `B Road` = "B Road",
                          `Minor Road` = "Minor Road",
                          `Local Road` = "Local Road")

CAV_density <- CAV_density %>%
  group_by(year, scenario, road_function) %>%
  mutate(total_car_density_km = round(total_cars/round(as.numeric(length_m)/1000,2),2),
         CAV_enabled_density_km = round(annual_CAV_capability/round(as.numeric(length_m/1000),2),2),
         CAV_take_up_density_km = round(annual_CAV_take_up/round(as.numeric(length_m/1000),2),2))

CAV_density <- select(CAV_density, year, scenario, road_function,
                      total_car_density_km, CAV_enabled_density_km, CAV_take_up_density_km)

CAV_density <- gather(CAV_density, metric, value, total_car_density_km, CAV_enabled_density_km, CAV_take_up_density_km)

CAV_density_figure <- ggplot(data=CAV_density, aes(x=year, y=value, fill=metric)) +
  geom_bar(position="dodge", stat="identity")  +
  scale_y_continuous(expand = c(0, 0), limits=c(0,250)) +
  scale_fill_manual(values = c("orange2","green4", "light blue"),
                    name = "Type",
                    labels = c("Enabled CAVs", "Subscribers", "Total Registered Vehicles")) +
  ylab("Average Vehicle Density (Km)") +
  theme(legend.position = "bottom", axis.title.x=element_blank(), axis.text.x = element_text(angle = 45, hjust = 1)) +
  guides(fill = guide_legend(reverse = FALSE)) +
  labs(title="Average Density of Enabled CAVs and Subscribers", subtitle="Results reported by scenario, road type and metric type") +
  facet_grid(road_function~scenario, labeller = labeller(scenario = scenario_labels, road_function = road_function_labels))

### EXPORT TO FOLDER
setwd(path_figures)
tiff('CAV_density_figure_vertical.tiff', units="in", width=8, height=11, res=300)
print(CAV_density_figure)
dev.off()

CAV_density$scenario <- factor(CAV_density$scenario,
                               levels = c("high",
                                          "baseline",
                                          "low"))

CAV_density_figure <- ggplot(data=CAV_density, aes(x=year, y=value, fill=metric)) +
  geom_bar(position="dodge", stat="identity")  +
  scale_y_continuous(expand = c(0, 0), limits=c(0,230)) +
  scale_fill_manual(values = c("orange2","green4", "light blue"),
                    name = "Type",
                    labels = c("Enabled CAVs", "Subscribers", "Total Registered Vehicles")) +
  ylab("Average Vehicle Density (Km)") +
  theme(legend.position = "bottom", axis.title.x=element_blank(), axis.text.x = element_text(angle = 60, hjust = 1)) +
  guides(fill = guide_legend(reverse = FALSE)) +
  labs(title="Average Density of Enabled CAVs and Subscribers", subtitle="Results reported by scenario, road type and metric type") +
  facet_grid(scenario~road_function, labeller = labeller(scenario = scenario_labels, road_function = road_function_labels))

### EXPORT TO FOLDER
setwd(path_figures)
tiff('CAV_density_figure_horizontal.tiff', units="in", width=9, height=7, res=300)
print(CAV_density_figure)
dev.off()

rm(CAV_density, CAV_density_figure)

#######################
# DEMAND PER ROAD
#######################

data_demand_per_km <- all_scenarios[(all_scenarios$scenario == 'baseline' |
                                 all_scenarios$scenario == 'low' |
                                 all_scenarios$scenario == 'high'),]

data_demand_per_km <- data_demand_per_km[(data_demand_per_km$strategy == 'cellular_V2X_full_greenfield'),]

data_demand_per_km <- select(data_demand_per_km, year, scenario, road_function, length_m, CAV_mbps_demand)

data_demand_per_km <- data_demand_per_km %>%
  group_by(year, scenario, road_function) %>%
  summarise(length_m = sum(length_m),
            CAV_mbps_demand = sum(CAV_mbps_demand))

data_demand_per_km$road_function <- factor(data_demand_per_km$road_function,
                                    levels = c("Dense Motorway",
                                               "Motorway",
                                               "A Road",
                                               "B Road",
                                               "Minor Road",
                                               "Local Road"))

scenario_labels <- c(`high` = "High (10 Mb/s, £20 ARPU)",
                     `baseline` = "Baseline (4 Mb/s, £4 ARPU)",
                     `low` = "Low (1 Mb/s, £2 ARPU)")

data_demand_per_km$scenario <- factor(data_demand_per_km$scenario,
                               levels = c("low",
                                          "baseline",
                                          "high"))

road_function_labels <- c('Dense Motorway' = "Dense Motorway",
                          `Motorway` = "Motorway",
                          `A Road` = "A Road",
                          `B Road` = "B Road",
                          `Minor Road` = "Minor Road",
                          `Local Road` = "Local Road")

data_demand_per_km <- data_demand_per_km %>%
  group_by(year, scenario, road_function) %>%
  mutate(CAV_mbps_demand_density_km = round(CAV_mbps_demand/round(as.numeric(length_m)/1000,1),1))

data_demand_per_km <- select(data_demand_per_km, year, scenario, road_function,
                              CAV_mbps_demand_density_km)

data_demand_per_km <- gather(data_demand_per_km, metric, value, CAV_mbps_demand_density_km)

data_demand_figure_vertical <- ggplot(data=data_demand_per_km, aes(x=year, y=value, fill=metric)) +
  geom_bar(position="dodge", stat="identity") + geom_text(aes(label=value), hjust=-0.2, size=2.3, angle = 90) +
  scale_y_continuous(expand = c(0, 0), limits=c(0,1190)) +
  scale_fill_manual(values = c("orange2"),
                    name = "Type",
                    labels = c("Average Data Demand")) +
  ylab("Mb/s per Kilometre") +
  theme(legend.position = "none", axis.title.x=element_blank(), axis.text.x = element_text(angle = 45, hjust = 1)) +
  guides(fill = guide_legend(reverse = FALSE)) +
  labs(title="Average Data Demand", subtitle="Results reported by scenario and road type") +
  facet_grid(road_function~scenario, labeller = labeller(road_function = road_function_labels, scenario = scenario_labels))

### EXPORT TO FOLDER
setwd(path_figures)
tiff('data_demand_figure_vertical.tiff', units="in", width=8, height=12, res=300)
print(data_demand_figure_vertical)
dev.off()

data_demand_per_km$scenario <- factor(data_demand_per_km$scenario,
                                      levels = c("high",
                                                 "baseline",
                                                 "low"))

data_demand_figure_horizontal <- ggplot(data=data_demand_per_km, aes(x=year, y=value, fill=metric)) +
  geom_bar(position="dodge", stat="identity")  +
  scale_y_continuous(expand = c(0, 0)) +
  scale_fill_manual(values = c("orange2"),
                    name = "Type",
                    labels = c("Average Data Demand")) +
  ylab("Mb/s per Kilometre") +
  theme(legend.position = "none", axis.title.x=element_blank(), axis.text.x = element_text(angle = 45, hjust = 1)) +
  guides(fill = guide_legend(reverse = FALSE)) +
  labs(title="Average Data Demand", subtitle="Results reported by scenario and road type") +
  facet_grid(scenario~road_function, labeller = labeller(scenario = scenario_labels, road_function = road_function_labels))

### EXPORT TO FOLDER
setwd(path_figures)
tiff('data_demand_figure_horizontal.tiff', units="in", width=12, height=8, res=300)
print(data_demand_figure_horizontal)
dev.off()

#######################
# COST PER KM
#######################

cost_per_km <- all_scenarios[(all_scenarios$scenario == 'baseline' |
                                 all_scenarios$scenario == 'low' |
                                 all_scenarios$scenario == 'high'),]

cost_per_km <- cost_per_km[(cost_per_km$year == '2020'),]

cost_per_km <- select(cost_per_km, scenario, strategy, road_type, length_m,
                       RAN_cost, small_cell_mounting_cost, fibre_backhaul_cost)

cost_per_km <- cost_per_km %>%
  group_by(scenario, strategy, road_type) %>%
  summarise(length_km = sum(length_m/1000),
            RAN_cost = sum(RAN_cost),
            small_cell_mounting_cost = sum(small_cell_mounting_cost),
            fibre_backhaul_cost = sum(as.numeric(fibre_backhaul_cost)))

cost_per_km <- gather(cost_per_km, metric, value, RAN_cost, small_cell_mounting_cost, fibre_backhaul_cost)

cost_per_km$value_per_km <- round(cost_per_km$value*4,0)

cost_per_km$value_per_km <- round(cost_per_km$value/cost_per_km$length_km,0)

cost_per_km$metric <- factor(cost_per_km$metric,
                              levels = c("RAN_cost",
                                         "small_cell_mounting_cost",
                                         "fibre_backhaul_cost"),
                              labels = c("Small Cell TCO",
                                         "Small Cell Civil Works",
                                         "Fibre Backhaul TCO"))

cost_per_km$road_type <- factor(cost_per_km$road_type,
                              levels = c("Local Road (Urban)",
                                         "Local Road (Rural)",
                                         "Minor Road (Urban)",
                                         "Minor Road (Rural)",
                                         "B Road (Urban)",
                                         "B Road (Rural)",
                                         "A Road (Urban)",
                                         "A Road (Rural)",
                                         "Motorway (Urban)",
                                         "Motorway (Rural)",
                                         "Dense Motorway (Urban)",
                                         "Dense Motorway (Rural)"))

cost_per_km$scenario <- factor(cost_per_km$scenario,
                                   levels = c("high",
                                              "baseline",
                                              "low"))

scenario_labels <- c(`high` = "High (10 Mb/s, £20 ARPU)",
                     `baseline` = "Baseline (4 Mb/s, £4 ARPU)",
                     `low` = "Low (1 Mb/s, £2 ARPU)")

strategy_labels <- c(`cellular_V2X_full_greenfield` = "Greenfield Cellular V2X",
                     `cellular_V2X_NRTS` = "Cellular V2X with NRTS",
                     `DSRC_full_greenfield` = "Greenfield DSRC",
                     `DSRC_NRTS` = "DSRC with NRTS")

cost_per_km_figure_horizontal <- ggplot(data=cost_per_km, aes(x=road_type, y=value_per_km)) + geom_bar(stat="identity", aes(fill=metric)) +
  facet_grid(scenario~strategy, labeller = labeller(strategy = strategy_labels, scenario = scenario_labels)) +
  ylab("Investment Cost Per Kilometer (GBP)") +
  scale_y_continuous(expand = c(0, 0), labels = comma, limits=c(0,22000)) +
  scale_fill_brewer(palette="Spectral", name = expression('Cost Type'), direction=-1) +
  theme(legend.position = "bottom", axis.title.x=element_blank(), axis.text.x = element_text(angle = 60, hjust = 1)) +
  guides(fill = guide_legend(reverse = FALSE)) +
  labs(title="Cost per Kilometer by Road Type", subtitle="Results reported by scenario, strategy and cost type")

### EXPORT TO FOLDER
setwd(path_figures)
tiff('cost_per_km_figure_horizontal.tiff', units="in", width=12, height=8, res=300)
print(cost_per_km_figure_horizontal)
dev.off()

cost_per_km_figure_vertical <- ggplot(data=cost_per_km, aes(x=road_type, y=value_per_km)) + geom_bar(stat="identity", aes(fill=metric)) +
  facet_grid(scenario~strategy, labeller = labeller(strategy = strategy_labels, scenario = scenario_labels)) +
  ylab("Investment Cost Per Kilometer (GBP)") +
  scale_y_continuous(expand = c(0, 0), labels = comma, limits=c(0,22000)) +
  scale_fill_brewer(palette="Spectral", name = expression('Cost Type'), direction=-1) +
  theme(legend.position = "bottom", axis.title.x=element_blank(), axis.text.x = element_text(angle = 60, hjust = 1)) +
  guides(fill = guide_legend(reverse = FALSE)) +
  labs(title="Cost per Kilometer by Road Type", subtitle="Results reported by scenario, strategy and cost type")

### EXPORT TO FOLDER
setwd(path_figures)
tiff('cost_per_km_figure_vertical.tiff', units="in", width=8, height=9, res=300)
print(cost_per_km_figure_vertical)
dev.off()

rm(cost_per_km, cost_per_km_figure)

#######################
# AGGREGATE COST
#######################

aggregate_cost <- select(all_scenarios, year, scenario, strategy, road_type, length_m,
                         RAN_cost, small_cell_mounting_cost, fibre_backhaul_cost)

aggregate_cost <- aggregate_cost %>%
  group_by(scenario, strategy, road_type) %>%
  summarise(RAN_cost = sum(RAN_cost),
            small_cell_mounting_cost = sum(small_cell_mounting_cost),
            fibre_backhaul_cost = sum(as.numeric(fibre_backhaul_cost)))

aggregate_cost <- gather(aggregate_cost, metric, value, RAN_cost, small_cell_mounting_cost, fibre_backhaul_cost)

scenario_labels <- c(`high` = "High (10 Mb/s, £20 ARPU)",
                     `baseline` = "Baseline (4 Mb/s, £4 ARPU)",
                     `low` = "Low (1 Mb/s, £2 ARPU)")

aggregate_cost$scenario <- factor(aggregate_cost$scenario,
                                  levels = c("high",
                                             "baseline",
                                             "low"))

strategy_labels <- c(`cellular_V2X_full_greenfield` = "Greenfield Cellular V2X",
                     `cellular_V2X_NRTS` = "Cellular V2X with NRTS",
                     `DSRC_full_greenfield` = "Greenfield DSRC",
                     `DSRC_NRTS` = "DSRC with NRTS")

aggregate_cost$metric <- factor(aggregate_cost$metric,
                                levels = c("RAN_cost",
                                           "small_cell_mounting_cost",
                                           "fibre_backhaul_cost"),
                                labels = c("Small Cell TCO",
                                           "Small Cell Civil Works",
                                           "Fibre Backhaul TCO"))

aggregate_cost_figure_horizontal <- ggplot(data=aggregate_cost, aes(x=reorder(road_type, value), y=(value/1000000000))) +
  geom_bar(stat="identity", aes(fill=metric))  +
  ylab("Investment Cost (Billions GBP)") +
  scale_y_continuous(expand = c(0, 0), limits=c(0,7)) +
  scale_fill_brewer(palette="Spectral", name = expression('Cost Type'), direction=-1) +
  theme(legend.position = "bottom", axis.title.x=element_blank(), axis.text.x = element_text(angle = 70, hjust = 1)) +
  guides(fill = guide_legend(reverse = FALSE)) +
  labs(title="Aggregate Cost by Road Type", subtitle="Results reported by scenario, strategy and cost type") +
  facet_grid(scenario~strategy, labeller = labeller(strategy = strategy_labels, scenario = scenario_labels))

### EXPORT TO FOLDER
setwd(path_figures)
tiff('aggregate_cost_figure_horizontal.tiff', units="in", width=12, height=8, res=300)
print(aggregate_cost_figure_horizontal)
dev.off()

aggregate_cost_figure_vertical <- ggplot(data=aggregate_cost, aes(x=reorder(road_type, value), y=(value/1000000000))) +
  geom_bar(stat="identity", aes(fill=metric))  +
  ylab("Investment Cost (Billions GBP)") +
  scale_y_continuous(expand = c(0, 0), limits=c(0,7)) +
  scale_fill_brewer(palette="Spectral", name = expression('Cost Type'), direction=-1) +
  theme(legend.position = "bottom", axis.title.x=element_blank(), axis.text.x = element_text(angle = 70, hjust = 1)) +
  guides(fill = guide_legend(reverse = FALSE)) +
  labs(title="Aggregate Cost by Road Type", subtitle="Results reported by scenario, strategy and cost type") +
  facet_grid(scenario~strategy, labeller = labeller(strategy = strategy_labels, scenario = scenario_labels))

### EXPORT TO FOLDER
setwd(path_figures)
tiff('aggregate_cost_figure_vertical.tiff', units="in", width=8, height=9, res=300)
print(aggregate_cost_figure_vertical)
dev.off()

rm(aggregate_cost, aggregate_cost_figure)

#######################
# REQUIRED UNITS
#######################

units_per_km <- all_scenarios[(all_scenarios$year == '2020' |
                                  all_scenarios$wtp_scenario == 'baseline'),]

units_per_km <- select(units_per_km, scenario, strategy, wtp_scenario, road_type, length_m,
                       RAN_units, small_cell_mounting_points, fibre_backhaul_m)

units_per_km <- units_per_km %>%
  group_by(scenario, strategy, wtp_scenario, road_type) %>%
  summarise(length_km = sum(as.numeric(length_m/1000)),
            RAN_units = sum(RAN_units),
            small_cell_mounting_points = sum(small_cell_mounting_points),
            fibre_backhaul_km = sum(as.numeric(fibre_backhaul_m)/1000))

#######################
# COST BENEFIT METRICS
#######################

total_CBA <- select(all_scenarios, year, scenario, strategy, CAV_revenue, total_tco)

total_CBA <- total_CBA %>%
  group_by(year, scenario, strategy) %>%
  summarise(CAV_revenue = sum(as.numeric(CAV_revenue)),
            total_tco = sum(as.numeric(total_tco)))

total_CBA$scenario <- factor(total_CBA$scenario,
                             levels = c("high",
                                        "baseline",
                                        "low"))

total_CBA <- gather(total_CBA, metric, value, CAV_revenue, total_tco)

total_CBA_figure <- ggplot(data=total_CBA, aes(x=year, y=(value/1000000000), fill=metric)) +
  geom_bar(position="dodge", stat="identity")  +
  ylab("Investment Cost (Billions GBP)") +
  scale_y_continuous(expand = c(0, 0), limits=c(0, 4.5)) +
  scale_fill_manual(values = c("green4","orange2"),
                    name = "Type",
                    labels = c("Revenue", "Cost")) +
  theme(legend.position = "bottom", axis.title.x=element_blank(), axis.text.x = element_text(angle = 45, hjust = 1)) +
  guides(fill = guide_legend(reverse = FALSE)) +
  labs(title="Strategy Performance by Scenario: All Roads", subtitle="Results reported by scenario, strategy and performance metric") +
  facet_grid(scenario~strategy, labeller = labeller(strategy = strategy_labels, scenario = scenario_labels))

### EXPORT TO FOLDER
setwd(path_figures)
tiff('total_CBA_figure.tiff', units="in", width=8, height=9, res=300)
print(total_CBA_figure)
dev.off()

##########################################
# COST BENEFIT METRICS MOTORWAYS & A Roads
##########################################

SRN_CBA <- all_scenarios

SRN_CBA$total_tco[SRN_CBA$road_function == 'B Road'] <- 0
SRN_CBA$total_tco[SRN_CBA$road_function == 'Minor Road'] <- 0
SRN_CBA$total_tco[SRN_CBA$road_function == 'Local Road'] <- 0

SRN_CBA <- select(SRN_CBA, year, scenario, strategy, CAV_revenue, total_tco)

SRN_CBA <- SRN_CBA %>%
  group_by(year, scenario, strategy) %>%
  summarise(CAV_revenue = sum(as.numeric(CAV_revenue)),
            total_tco = sum(as.numeric(total_tco)))

SRN_CBA$scenario <- factor(SRN_CBA$scenario,
                           levels = c("high",
                                      "baseline",
                                      "low"))

SRN_CBA <- gather(SRN_CBA, metric, value, CAV_revenue, total_tco)

SRN_CBA_figure <- ggplot(data=SRN_CBA, aes(x=year, y=(value/1000000000), fill=metric)) +
  geom_bar(position="dodge", stat="identity")  +
  scale_y_continuous(expand = c(0, 0), limits=c(0,0.75)) +
  ylab("Investment Cost (Billions GBP)") +
  scale_fill_manual(values = c("green4","orange2"),
                    name = "Type",
                    labels = c("Revenue", "Cost")) +
  theme(legend.position = "bottom", axis.title.x=element_blank(), axis.text.x = element_text(angle = 45, hjust = 1)) +
  guides(fill = guide_legend(reverse = FALSE)) +
  labs(title="Strategy Performance by Scenario: Strategic Road Network", subtitle="Results reported by scenario, strategy and performance metric") +
  facet_grid(scenario~strategy, labeller = labeller(strategy = strategy_labels, scenario = scenario_labels))

### EXPORT TO FOLDER
setwd(path_figures)
tiff('SRN_CBA_figure.tiff', units="in", width=8, height=9, res=300)
print(SRN_CBA_figure)
dev.off()

rm(SRN_CBA, SRN_CBA_figure, total_CBA, total_CBA_figure)

##########################################
# COST BENEFIT METRICS MOTORWAYS
##########################################

motorway_CBA <- all_scenarios

motorway_CBA$total_tco[motorway_CBA$road_function == 'A Road'] <- 0
motorway_CBA$total_tco[motorway_CBA$road_function == 'B Road'] <- 0
motorway_CBA$total_tco[motorway_CBA$road_function == 'Minor Road'] <- 0
motorway_CBA$total_tco[motorway_CBA$road_function == 'Local Road'] <- 0

motorway_CBA <- select(motorway_CBA, year, scenario, strategy, CAV_revenue, total_tco)

motorway_CBA <- motorway_CBA %>%
  group_by(year, scenario, strategy) %>%
  summarise(CAV_revenue = sum(as.numeric(CAV_revenue)),
            total_tco = sum(as.numeric(total_tco)))

motorway_CBA$scenario <- factor(motorway_CBA$scenario,
                           levels = c("high",
                                      "baseline",
                                      "low"))

motorway_CBA <- gather(motorway_CBA, metric, value, CAV_revenue, total_tco)

motorway_CBA_figure <- ggplot(data=motorway_CBA, aes(x=year, y=(value/1000000000), fill=metric)) +
  geom_bar(position="dodge", stat="identity")  +
  scale_y_continuous(expand = c(0, 0), limits=c(0,0.45)) +
  ylab("Investment Cost (Billions GBP)") +
  scale_fill_manual(values = c("green4","orange2"),
                    name = "Type",
                    labels = c("Revenue", "Cost")) +
  theme(legend.position = "bottom", axis.title.x=element_blank(), axis.text.x = element_text(angle = 45, hjust = 1)) +
  guides(fill = guide_legend(reverse = FALSE)) +
  labs(title="Strategy Performance by Scenario: Motorways", subtitle="Results reported by scenario, strategy and performance metric") +
  facet_grid(scenario~strategy, labeller = labeller(strategy = strategy_labels, scenario = scenario_labels))

### EXPORT TO FOLDER
setwd(path_figures)
tiff('motorway_CBA_figure.tiff', units="in", width=8, height=9, res=300)
print(motorway_CBA_figure)
dev.off()

rm(motorway_CBA, motorway_CBA_figure)

#######################
# IMPORT COST PER LAD
#######################

#set working directory
setwd(path_inputs)

# Get the files names
files = list.files(pattern=glob2rx("lad_*.csv"))

# First apply read.csv, then rbind
all_scenarios = do.call(rbind, lapply(files, function(x) read.csv(x, stringsAsFactors = FALSE)))

all_scenarios$road_type[all_scenarios$road_function == 'Dense Motorway' & all_scenarios$urban_rural == 'urban'] <- 'Dense Motorway (Urban)'
all_scenarios$road_type[all_scenarios$road_function == 'Dense Motorway' & all_scenarios$urban_rural == 'rural'] <- 'Dense Motorway (Rural)'
all_scenarios$road_type[all_scenarios$road_function == 'Motorway' & all_scenarios$urban_rural == 'urban'] <- 'Motorway (Urban)'
all_scenarios$road_type[all_scenarios$road_function == 'Motorway' & all_scenarios$urban_rural == 'rural'] <- 'Motorway (Rural)'
all_scenarios$road_type[all_scenarios$road_function == 'A Road' & all_scenarios$urban_rural == 'urban'] <- 'A Road (Urban)'
all_scenarios$road_type[all_scenarios$road_function == 'A Road' & all_scenarios$urban_rural == 'rural'] <- 'A Road (Rural)'
all_scenarios$road_type[all_scenarios$road_function == 'B Road' & all_scenarios$urban_rural == 'urban'] <- 'B Road (Urban)'
all_scenarios$road_type[all_scenarios$road_function == 'B Road' & all_scenarios$urban_rural == 'rural'] <- 'B Road (Rural)'
all_scenarios$road_type[all_scenarios$road_function == 'Minor Road' & all_scenarios$urban_rural == 'urban'] <- 'Minor Road (Urban)'
all_scenarios$road_type[all_scenarios$road_function == 'Minor Road' & all_scenarios$urban_rural == 'rural'] <- 'Minor Road (Rural)'
all_scenarios$road_type[all_scenarios$road_function == 'Local Road' & all_scenarios$urban_rural == 'urban'] <- 'Local Road (Urban)'
all_scenarios$road_type[all_scenarios$road_function == 'Local Road' & all_scenarios$urban_rural == 'rural'] <- 'Local Road (Rural)'

all_scenarios$road_type <- factor(all_scenarios$road_type,
                                  levels = c("Dense Motorway (Urban)",
                                             "Dense Motorway (Rural)",
                                             "Motorway (Urban)",
                                             "Motorway (Rural)",
                                             "A Road (Urban)",
                                             "A Road (Rural)",
                                             "B Road (Urban)",
                                             "B Road (Rural)",
                                             "Minor Road (Urban)",
                                             "Minor Road (Rural)",
                                             "Local Road (Urban)",
                                             "Local Road (Rural)"))

all_scenarios$year <- as.factor(all_scenarios$year)

all_scenarios$lad[all_scenarios$lad == 'E06000057'] <-'E06000048'
all_scenarios$lad[all_scenarios$lad == 'E07000242'] <-'E07000097'
all_scenarios$lad[all_scenarios$lad == 'E07000243'] <-'E07000101'
all_scenarios$lad[all_scenarios$lad == 'E08000037'] <-'E08000020'

#######################
# COST PER LAD
#######################

aggregate_cost <- select(all_scenarios, lad, scenario, strategy, total_tco)

aggregate_cost <- aggregate_cost %>%
  group_by(lad, scenario, strategy) %>%
  summarise(total_tco = sum(total_tco))

aggregate_cost$total_tco <- aggregate_cost$total_tco/1000000

breaks <- c(0, 5, 10, 15, 20, 25, 30, 35, 40, 45, 50, 500)
aggregate_cost$total_tco_binned <- cut(aggregate_cost$total_tco, breaks)

aggregate_cost$total_tco_binned = factor(aggregate_cost$total_tco_binned,
                                         levels=c("(0,5]",
                                                  "(5,10]",
                                                  "(10,15]",
                                                  "(15,20]",
                                                  "(20,25]",
                                                  "(25,30]",
                                                  "(30,35]",
                                                  "(35,40]",
                                                  "(40,45]",
                                                  "(45,50]",
                                                  "(50,500]"),
                                         labels=c('(0-5)',
                                                  '(5-10)',
                                                  '(10-15)',
                                                  '(15-20)',
                                                  '(20-25)',
                                                  '(25-30)',
                                                  '(30-35)',
                                                  '(35-40)',
                                                  '(40-45)',
                                                  '(45-50)',
                                                  '(>50)'))

aggregate_cost$total_tco_binned = forcats::fct_rev(factor(aggregate_cost$total_tco_binned))

scenario_labels <- c(`high` = "High (10 Mb/s, £20 ARPU)",
                     `baseline` = "Baseline (4 Mb/s, £4 ARPU)",
                     `low` = "Low (1 Mb/s, £2 ARPU)")

aggregate_cost$scenario <- factor(aggregate_cost$scenario,
                                  levels = c("high",
                                             "baseline",
                                             "low"))

strategy_labels <- c(`cellular_V2X_full_greenfield` = "Greenfield Cellular V2X",
                     `cellular_V2X_NRTS` = "Cellular V2X with NRTS",
                     `DSRC_full_greenfield` = "Greenfield DSRC",
                     `DSRC_NRTS` = "DSRC with NRTS")
setwd(path_shapes)

all.shp <- readShapeSpatial("simplified_LADS_WGS84")

all.shp <- fortify(all.shp, region = "LAD12CD")

all.shp <- merge(all.shp, aggregate_cost, by.x="id", by.y="lad", all.y = TRUE)

all.shp <- all.shp[order(all.shp$order),]

cost_by_lad <- ggplot() + geom_polygon(data = all.shp, aes(x = long, y = lat, group=group,
                                                           fill = total_tco_binned)) +
  coord_equal() +
  guides(fill = guide_legend(reverse = FALSE)) +
  scale_fill_brewer(palette=("Spectral"), name = expression('Cost\n(£ Millions)', direction=1)) +
  labs(title="Total Road Network Aggregate Cost by LAD", subtitle="Results reported by scenario, strategy and cost ") +
  theme(legend.position="right", axis.text = element_blank(), axis.title=element_blank(), axis.ticks=element_blank()) +
  facet_grid(scenario ~ strategy, labeller = labeller(scenario = scenario_labels, strategy = strategy_labels))

### EXPORT TO FOLDER
setwd(path_figures)
tiff('cost_by_lad.tiff', units="in", width=8, height=9, res=300)
print(cost_by_lad)
dev.off()

#######################
# COST PER LAD for SRN
#######################

aggregate_cost_SRN <- all_scenarios[which(all_scenarios$road_function == 'Dense Motorway' |
                                            all_scenarios$road_function == 'Motorway' |
                                            all_scenarios$road_function == 'A Road'),]

aggregate_cost_SRN <- select(aggregate_cost_SRN, lad, scenario, strategy, total_tco)

aggregate_cost_SRN <- aggregate_cost_SRN %>%
  group_by(lad, scenario, strategy) %>%
  summarise(total_tco = sum(total_tco))

aggregate_cost_SRN$total_tco <- aggregate_cost_SRN$total_tco/1000000

breaks <- c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 500)
aggregate_cost_SRN$total_tco_binned <- cut(aggregate_cost_SRN$total_tco, breaks)

aggregate_cost_SRN$total_tco_binned = factor(aggregate_cost_SRN$total_tco_binned,
                                         levels=c("(0,1]",
                                                  "(1,2]",
                                                  "(2,3]",
                                                  "(3,4]",
                                                  "(4,5]",
                                                  "(5,6]",
                                                  "(6,7]",
                                                  "(7,8]",
                                                  "(8,9]",
                                                  "(9,10]",
                                                  "(10,500]"),
                                         labels=c('(0-1)',
                                                  '(1-2)',
                                                  '(2-3)',
                                                  '(3-4)',
                                                  '(4-5)',
                                                  '(5-6)',
                                                  '(6-7)',
                                                  '(7-8)',
                                                  '(8-9)',
                                                  '(9-10)',
                                                  '(>10)'))

aggregate_cost_SRN$total_tco_binned = forcats::fct_rev(factor(aggregate_cost_SRN$total_tco_binned))

scenario_labels <- c(`high` = "High (10 Mb/s, £20 ARPU)",
                     `baseline` = "Baseline (4 Mb/s, £4 ARPU)",
                     `low` = "Low (1 Mb/s, £2 ARPU)")

aggregate_cost_SRN$scenario <- factor(aggregate_cost_SRN$scenario,
                                      levels = c("high",
                                                 "baseline",
                                                 "low"))

strategy_labels <- c(`cellular_V2X_full_greenfield` = "Greenfield Cellular V2X",
                     `cellular_V2X_NRTS` = "Cellular V2X with NRTS",
                     `DSRC_full_greenfield` = "Greenfield DSRC",
                     `DSRC_NRTS` = "DSRC with NRTS")

setwd(path_shapes)

all.shp <- readShapeSpatial("simplified_LADS_WGS84")

all.shp <- fortify(all.shp, region = "LAD12CD")

all.shp <- merge(all.shp, aggregate_cost_SRN, by.x="id", by.y="lad", all.y = TRUE)

all.shp <- all.shp[order(all.shp$order),]

SRN_cost_by_lad <- ggplot() + geom_polygon(data = all.shp, aes(x = long, y = lat, group=group,
                                                               fill = total_tco_binned)) +
  coord_equal() +
  guides(fill = guide_legend(reverse = FALSE)) +
  scale_fill_brewer(palette="Spectral", name = expression('Cost\n(£ Millions)')) +
  labs(title="SRN Aggregate Cost by LAD", subtitle="Results reported by scenario, strategy and cost ") +
  theme(legend.position="right", axis.text = element_blank(), axis.title=element_blank(), axis.ticks=element_blank()) +
  facet_grid(scenario ~ strategy, labeller = labeller(scenario = scenario_labels, strategy = strategy_labels))

### EXPORT TO FOLDER
setwd(path_figures)
tiff('SRN_cost_by_lad.tiff', units="in", width=8, height=9, res=300)
print(SRN_cost_by_lad)
dev.off()

#######################
# COST PER LAD for MOTORWAYS
#######################

aggregate_cost_motorways <- all_scenarios[which(all_scenarios$road_function == 'Dense Motorway' |
                                                all_scenarios$road_function == 'Motorway' |
                                                all_scenarios$road_function == 'A Road'),]

aggregate_cost_motorways$total_tco[aggregate_cost_motorways$road_function == 'A Road'] <- 0

aggregate_cost_motorways <- select(aggregate_cost_motorways, lad, scenario, strategy, total_tco)

aggregate_cost_motorways <- aggregate_cost_motorways %>%
  group_by(lad, scenario, strategy) %>%
  summarise(total_tco = sum(total_tco))

aggregate_cost_motorways$total_tco <- aggregate_cost_motorways$total_tco/1000000

breaks <- c(-Inf, 0.5, 1, 1.5, 2, 2.5, 3, 3.5, 4, 4.5, 5,100)
aggregate_cost_motorways$total_tco_binned <- cut(aggregate_cost_motorways$total_tco, breaks)

aggregate_cost_motorways$total_tco_binned = factor(aggregate_cost_motorways$total_tco_binned,
                                             levels=c("(-Inf,0.5]",
                                                      "(0.5,1]",
                                                      "(1,1.5]",
                                                      "(1.5,2]",
                                                      "(2,2.5]",
                                                      "(2.5,3]",
                                                      "(3,3.5]",
                                                      "(3.5,4]",
                                                      "(4,4.5]",
                                                      "(4.5,5]",
                                                      "(5,100]"),
                                             labels=c('(0-0.5)',
                                                      '(0.5-1)',
                                                      '(1-1.5)',
                                                      '(1.5-2)',
                                                      '(2-2.5)',
                                                      '(2.5-3)',
                                                      '(3-3.5)',
                                                      '(3.5-4)',
                                                      '(4-4.5)',
                                                      '(4.5-5)',
                                                      '(>5)'))

aggregate_cost_motorways$total_tco_binned = forcats::fct_rev(factor(aggregate_cost_motorways$total_tco_binned))

scenario_labels <- c(`high` = "High (10 Mb/s, £20 ARPU)",
                     `baseline` = "Baseline (4 Mb/s, £4 ARPU)",
                     `low` = "Low (1 Mb/s, £2 ARPU)")

aggregate_cost_motorways$scenario <- factor(aggregate_cost_motorways$scenario,
                                      levels = c("high",
                                                 "baseline",
                                                 "low"))

strategy_labels <- c(`cellular_V2X_full_greenfield` = "Greenfield Cellular V2X",
                     `cellular_V2X_NRTS` = "Cellular V2X with NRTS",
                     `DSRC_full_greenfield` = "Greenfield DSRC",
                     `DSRC_NRTS` = "DSRC with NRTS")

setwd(path_shapes)

all.shp <- readShapeSpatial("simplified_LADS_WGS84")

all.shp <- fortify(all.shp, region = "LAD12CD")

all.shp <- merge(all.shp, aggregate_cost_motorways, by.x="id", by.y="lad")

all.shp <- all.shp[order(all.shp$order),]

motorway_cost_by_lad <- ggplot() + geom_polygon(data = all.shp, aes(x = long, y = lat, group=group,
                                                               fill = total_tco_binned)) +
  coord_equal() +
  guides(fill = guide_legend(reverse = FALSE)) +
  scale_fill_brewer(palette="Spectral", name = expression('Cost\n(£ Millions)')) +
  labs(title="Aggregate Cost for Motorways by LAD", subtitle="Results reported by scenario, strategy and cost ") +
  theme(legend.position="right", axis.text = element_blank(), axis.title=element_blank(), axis.ticks=element_blank()) +
  facet_grid(scenario ~ strategy, labeller = labeller(scenario = scenario_labels, strategy = strategy_labels))

### EXPORT TO FOLDER
setwd(path_figures)
tiff('motorway_cost_by_lad.tiff', units="in", width=8, height=9, res=300)
print(motorway_cost_by_lad)
dev.off()

##################################
# TOTAL COST OUTPUT METRICS
##################################

total_cost <- select(all_scenarios, scenario, strategy, total_tco)

total_cost <- total_cost %>%
  group_by(scenario, strategy) %>%
  summarise(annual_tco = round(sum(as.numeric(total_tco)/1000000000)/4,2),
            total_tco = round(sum(as.numeric(total_tco)/1000000000),2))

##################################
# TOTAL COST OUTPUT METRICS
##################################

aggregate_cost_by_road_type <- select(all_scenarios, scenario, strategy, road_type, total_tco)

aggregate_cost_by_road_type <- aggregate_cost_by_road_type %>%
  group_by(scenario, strategy, road_type) %>%
  summarise(total_tco = sum(as.numeric(total_tco)/1000000000))

##################################
# COMPONENT COST STRUCTURE
##################################

cost_per_km <- all_scenarios[(all_scenarios$scenario == 'baseline' |
                                 all_scenarios$scenario == 'low' |
                                 all_scenarios$scenario == 'high'),]

cost_per_km <- cost_per_km[(cost_per_km$year == '2020'),]

cost_per_km <- select(cost_per_km, scenario, strategy,
                       RAN_cost, small_cell_mounting_cost, fibre_backhaul_cost, total_tco)

cost_per_km <- cost_per_km %>%
  group_by(scenario, strategy) %>%
  summarise(RAN_cost = sum(RAN_cost),
            small_cell_mounting_cost = sum(small_cell_mounting_cost),
            fibre_backhaul_cost = sum(as.numeric(fibre_backhaul_cost)),
            total_tco = sum(total_tco))

cost_per_km <- cost_per_km %>%
  group_by(scenario, strategy) %>%
  summarise(perc_RAN_cost = round(RAN_cost/total_tco*100,1),
            perc_small_cell_mounting_cost = round(small_cell_mounting_cost/total_tco*100,1),
            perc_fibre_backhaul_cost = round(as.numeric(fibre_backhaul_cost)/total_tco*100,1))


cat("\nHEJ FMSY-matrix\n")

cat("\nscenario.dir:",scenario.dir,"\n")
if (my.area=='North Sea') {
  #source(file.path(prog.path,"FMSY_matrix_scenarios.r"))

  first.sc<-22  # first screen for plot

  #a<-droplevels(subset(a,(COD<=0.4 & POK<=0.4) & SPR<0.6))
  out.file='option1'
  out.types<-c('Yield','SSB','Recruit','Fbar','belowBlim', 'belowBpa')
  plot.matrix(tit='Probability (%) of SSB below Blim',  type=out.types[5],spNames=sp.names[17:24],my.dev='png',out.file=out.file,scenario.dir=scenario.dir)

  plot.matrix(tit='Yield',type=out.types[1],spNames=sp.names[17:24],my.dev='png',out.file=out.file,scenario.dir=scenario.dir)
  plot.matrix(tit='SSB',  type=out.types[2],spNames=sp.names[17:24],my.dev='png',out.file=out.file,scenario.dir=scenario.dir)

  table.MSY(a,out.file=out.file)
}


#!/usr/bin/env Rscript
library(parallel)
library("optparse")
library(data.table)
checkhead<-function(head,Data, type){
if(length(which(head %in% names(Data)))==0){
print(names(Data))
print(paste('not found ', head,'for',type ,'data'))
q(2)
}
}

option_list = list(
  make_option(c( "--gwas"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--chr_gwas"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--ps_gwas"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--p_gwas"), type="character", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--wind"), type="numeric", default=NULL,
              help="dataset file name", metavar="character"),
  make_option(c("--nrep"), type="integer", default=NULL,
              help="dataset file name", metavar="integer"),
  make_option(c("--cpus"), type="character", default=NULL,
              help="dataset file name", metavar="integer"),
  make_option(c("--out"), type="character", default="out.txt",
              help="output file name [default= %default]", metavar="character")
);

opt_parser = OptionParser(option_list=option_list);
opt = parse_args(opt_parser);

headse=opt[['se_gwas']];headbp=opt[['ps_gwas']];headchr=opt[['chr_gwas']];headpval=opt[['p_gwas']]
headchrcat=opt[['chr_gwascat']];headbpcat=opt[['ps_gwascat']];
outhead=opt[['out']]
around=opt[['wind']]*1000
nrep=opt[['nrep']]

datagwas<-fread(opt[['gwas']], header=T)
checkhead(headpval, datagwas,'pval');checkhead(headbp, datagwas,'bp');checkhead(headchr, datagwas, 'chr')

nrep=min(nrep, nrow(datagwas)-1)
listtmp<-sample(1:nrow(datagwas), nrep)
resumeres<-mclapply(listtmp, function(x){
infopos<-as.data.frame(datagwas[x,]);bp<-infopos[,headbp];chr<-infopos[,headchr];begin<-bp-around;end<-bp+around
balise<-(datagwas[[headbp]]>=begin & datagwas[[headbp]]<=end) & datagwas[[headchr]]==chr
pval<-datagwas[balise,..headpval]
Min<-min(pval)
Nb<-nrow(pval)
return(c(Min,Nb))
}, mc.cores=opt[['cpus']])

minpval<-sapply(resumeres, function(x)x[1])
writeLines(as.character(minpval), con=opt[['out']])


# MAIN FUNCTION
# Function stmodel is a parser rebuilding the string and sending it trough bash with the system() function.
# Each argument corresponds to the stmodel option which can be displayed with ./build/stmodel -help
# stmodel output will be write at the location refered by the outland argument

stmodel_local <- function(params=params,inland=inland,outland=outland,x=x,y=y,a=a,b=b,clim_file=clim_file,writeStep=1,disturb=0,transProb=1,global=FALSE){

    stmodel <- paste("./model/build/stmodel -x",  x ,"-y",  y ,"-a",  a, "-b",  b, "-s -c", clim_file, "-p", params,"-i",inland, "-t", writeStep, "-d", disturb,"-e",transProb, ">", outland, "2>/dev/null")

    if(global == TRUE){
    stmodel <- paste("./model/build/stmodel -x",  x ,"-y",  y ,"-a",  a, "-b",  b, "-g -s -c", clim_file, "-p", params,"-i",inland, "-t", writeStep, "-d", disturb,"-e",transProb, ">", outland, "2>/dev/null")
    }

    system(stmodel)

}


# The code of this module is gonna be seen by all nodes, and hence all used variables here can be called in other function that will be run in the nodes..

source(paste(p_src_code, "src/build_np1/code/netprophet1/global.lars.regulators.r", sep=""))

# setting the seed, and create the folds of cross validation has to be here
set.seed(seed)
all.folds <- cv.folds(dim(df_expr_target)[2], nbr_cv_fold)

# submit every fold of CV to a different node
fold <- mpi.comm.rank()
cat("fold number", fold, "\n")
# TODO to describe the cv.obj here
cv.obj <- lars.multi.cv.singlefold(df_expr_target
                                   , df_expr_reg
                                   , df_perturbed
                                   , df_prior
                                   , df_allowed
                                   , nbr_cv_fold
                                   , seed
                                   , fold)

# save(cv.obj,file=file.path(p_out_dir, paste("cv.",fold,sep="")))

get_fold_nbr <- function()
{
	fold
}


##
## R function to call and score "somatic mutations", "RNA editing", or similar events.
## Function takes data in a format output by Bamformatics variantdetails.
## Function scores events based on coverage counts in pairs of samples (e.g.
## coverage in a "normal" sample and a "tumor" sample)
##
## Author: Tomasz Konopka
##

##' Find change events within a pair of samples using a variants details table
##' as output from Bamformatics variantdetails.
##'
##' @param tab data frame with variant details
##' @param sA  character string with sample name. tab should contain columns called sA.qual etc.
##'            Sample A is interpreted as the reference sample (e.g. normal tissue)
##' @param sB  character string with sample name. tab should contain columns called sB.qual etc.
##'            Sample B is interpreted as the probant sample (e.g. tumor tissue)
##' @param okfilters character vector. Function gives candidates that have one of these
##'            filter codes. (If variant set has multiple filters that are "ok", e.g.
##'            PASS, exons, exons;cds, all these filter codes and combinations must be specified
##' @param mindepthA numeric, minimum depth in sampleA to call an event
##' @param mindepthB numeric, minimum depth in sampleB to call an event.
##' @param maxAPA numeric, maximum allelic proportion in sample A
##' @param minAPB numeric, maximum allelic proportion in sample B
##' @param minscoreAB numeric, minimum joint score, calculated from data on both samples A and B
##' @param checklow logical. Determines if same criteria must apply for "low" quality counts
##'                   (recommended value is TRUE for SNVs and FALSE for indels)
##'
getVarChangeEvents = function(tab, sA, sB,
  okfilters="PASS",
  mindepthA=4, maxAPA=0.05,
  mindepthB=4, minAPB=0.05, minaltB=3,
  minscoreAB=20, checklow=FALSE) {

  ## Helper-function - a wrapper for paste
  ## It concatenates some string without putting in additional spaces
  ## Name of function stands for Pasta Sep Zero
  PSZ = function(...) {
    return(paste(...,sep=""))
  }

  ## Helper function - computes allelic proportion and uncertainty
  ## refcount - number of reads with reference base
  ## altcount - number of reads with alternate base
  ## darkcount - used for
  ##
  ## returns - a matrix with three columns.
  ## First column is the allelic proportion (AP), aka the BAF
  ## Second column is an estimate for the uncertainty on the AP based on
  ## a normal approximateion to a poisson model
  ## Third column is a "score", which is the 10* AP / error
  allelicproportion = function(refcount, altcount, darkcount=1) {
    AP = altcount/(refcount+altcount)
    APnumerator = sqrt((refcount+darkcount)*(altcount+darkcount))
    APdenominator = ((refcount+altcount+(2*darkcount))^(3/2))
    APerr = APnumerator / APdenominator
    return (cbind(AP, APerr, score=10*AP/APerr))
  }

  ## take the input table and get rid of the unnecessary columns
  ABcols = c(".qual",".cov",".cov.low",".ref",".ref.low",".alt",".alt.low",".filter")
  basecols = c("chr","position","dbSNP","refBase","altBase")
  tab = tab[,c(basecols, PSZ(sA,ABcols), PSZ(sB,ABcols))]

  ## make sure .ref and .alt rows are all zero or positive
  for (xx in c(".ref",".ref.low",".alt",".alt.low")) {
    tab[tab[,PSZ(sA,xx)]<0, PSZ(sA,xx)] = 0
    tab[tab[,PSZ(sB,xx)]<0, PSZ(sB,xx)] = 0
  }

  ## impose thresholds on sample A
  tab = tab[tab[,PSZ(sA,".cov")]>=mindepthA, ,drop=FALSE]
  tab = tab[tab[,PSZ(sA,".alt")]/tab[,PSZ(sA,".cov")] < maxAPA, ,drop=FALSE]
  temp.alt = tab[,PSZ(sA, ".alt")]+tab[,PSZ(sA, ".alt.low")]
  temp.cov = tab[,PSZ(sA, ".cov")]+tab[,PSZ(sA, ".cov.low")]
  tab = tab[(temp.alt/temp.cov) < maxAPA, ,drop=FALSE]
  rm(temp.alt, temp.cov)

  ## impose threshold on sample B
  tab = tab[tab[,PSZ(sB,".cov")]>=mindepthB, ,drop=FALSE]
  tab = tab[tab[,PSZ(sB,".alt")]/tab[,PSZ(sB,".cov")] > minAPB, ,drop=FALSE]
  temp.alt = tab[,PSZ(sB, ".alt")]+tab[,PSZ(sB, ".alt.low")]
  temp.cov = tab[,PSZ(sB, ".cov")]+tab[,PSZ(sB, ".cov.low")]
  tab = tab[(temp.alt/temp.cov)>minAPB, ,drop=FALSE]
  rm(temp.alt, temp.cov)
  tab = tab[tab[,PSZ(sB,".alt")]>=minaltB, ,drop=FALSE]
  tab = tab[tab[,PSZ(sB,".filter")] %in% okfilters, ,drop=FALSE]

  ## calculate the event score
  ## impose threshold on joint AB
  apA = allelicproportion(tab[,PSZ(sA,".ref")], tab[,PSZ(sA,".alt")])
  apB = allelicproportion(tab[,PSZ(sB,".ref")], tab[,PSZ(sB,".alt")])
  apA[!is.finite(apA[,1]),1] = 0
  apB[!is.finite(apB[,1]),1] = 0
  apAB = apB[,1]-apA[,1]
  apUnc = sqrt((apB[,2])^2 + (apA[,2])^2)
  tab = cbind(tab, event.score=10*apAB/apUnc)
  tab = tab[,c(basecols, "event.score", PSZ(sA, ABcols), PSZ(sB, ABcols))]

  ## get only hits with a minimal score
  tab = tab[tab[,"event.score"]>= minscoreAB, ,drop=FALSE]

  ## repeat some of the simple threshold on the low quality items
  if (checklow) {
    temp = tab[,PSZ(sA,".alt.low")]/tab[,PSZ(sA,".cov.low")] < maxAPA
    temp[!is.finite(temp)] = FALSE
    tab = tab[temp, ,drop=FALSE]
  }

  ## finally, add columns for the AP in sample A and B
  apA = tab[,PSZ(sA,".alt")]/tab[,PSZ(sA,".cov")]
  apB = tab[,PSZ(sB,".alt")]/tab[,PSZ(sB,".cov")]

  tab = cbind(tab[,c(basecols,"event.score")], apA=apA, apB=apB)
  colnames(tab) = c(basecols,"event.score", PSZ(sA,".BAF"), PSZ(sB,".BAF"))

  return(tab)
}


#run the viability classifier
run_viability <- function(input, values, session){
    if (is.null(values$markerMapping)){
        return (NULL)
    }

    #Read in the viability classifier
    classifier <- readRDS(system.file("extdata", "Viability_classifier.RDS", package="cytoclops"))
    housekeepers <- rownames(classifier$importance)

    #extract the markers that we use
    mark <- sapply(housekeepers,function(x)input[[paste0("Housekeeper_", x)]])
    markers <- values$markerMapping[mark]

    #add a progress bar
    withProgress(message = 'Running viability classifier ... ',
                 detail = 'This may take a while...',
                 value = 0.0, {

                     #next process one sample at a time
                     lapply(1:length(values$flowset),
                            classify,
                            input,
                            values,
                            session,
                            markers,
                            mark,
                            housekeepers,
                            classifier)
                 })

    #update the panels and lists
    update_current_gate(session, input, values)
    update_children_table(session, input, values)
    replace_gating_list(input, values, session, selected = names(values$gatingPanels)[1])
}

#next process one sample at a time
classify <- function(idx, input, values, session,
                     markers, mark, housekeepers,
                     classifier){

    #extract the right data
    # + 1 to avoid median divisions by 0 and inf values generated by log2
    mat <- exprs(values$flowset[[idx]])[,markers] + 1
    colnames(mat) <- housekeepers

    #transform the data (log2 + median centering)
    mat <- log2(sweep(mat ,2,colMedians(mat),'/'))

    #run the model,
    pred <- predict(classifier, mat, type = "prob")

    #extract the indices
    indices <- (1:nrow(pred))[pred[, 2] > input$ViabilitySlider]

    #drop all the gatings that have been done before
    current_nam <- paste0('G',idx)
    values$currentID <- (1:length(values$gatingPanels))[names(values$gatingPanels) == current_nam]

    #remove all children of the current gate if there are any
    if (length(values$gatingPanels[[values$currentID]]@children) > 0){
        remove_child(input, values, session, values$currentID, paste0(current_nam,'_'))
    }

    #add a new gatingPanel with the viable cells
    add_new_child(input,
                  values,
                  session,
                  indices = indices,
                  name = 'Viable cells',
                  xmarker = mark[1],
                  ymarker = mark[3])

    #increment the progress bar
    incProgress(amount = 1 / length(values$flowset))

}