pdf('output.geneBodyCoverage.pdf')
x=1:100
y=c(0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,1.0,0.0,0.0,1.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,1.0,1.0,1.0,0.0,0.0,1.0,1.0,1.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,1.0,1.0,1.0,0.0,1.0,1.0,1.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0)
plot(x,y/7,xlab="percentile of gene body (5'->3')",ylab='average wigsum',type='s')
dev.off()


library(tidyverse)
library(ggplot2)
library(dplyr)
library(ggpubr)
library(patchwork)

#Load data
main_data <- read_csv("conv.csv")

data1 %>%
  count(continent) %>%
  View()

data1 <- data1%>%
  mutate(
    continent =
      ifelse(continent == "Oceania",
             "New Zealand", continent
      )
  )

data1 <- main_data %>%
  group_by(country) %>%
  select("continent",
         "farm_type",
         "host",
         "antimicrobial_compound",
         "antimicrobial_class",
         "pathogen",
         "percent_resistant",
         "no_isolates" )

#changing percentage resistance into numeric class and rounding off
data1$percent_resistant <- as.numeric(as.character
                                          (data1$percent_resistant))

data1$percent_resistant <- round(data1$percent_resistant, digits = 2)

data2 <- data1 %>%
  select("continent",
         "farm_type",
         "host",
         "antimicrobial_compound",
         "antimicrobial_class",
         "pathogen",
         "percent_resistant",
         "no_isolates" )

##isolate calculation
isolate <- data2 %>%select("continent",
                           "farm_type",

                           "antimicrobial_compound",

                           "pathogen",
                           "percent_resistant",
                           "no_isolates" )%>%
  filter(continent == "Asia", pathogen == "Staphylococcus")

data3 <- aggregate(percent_resistant~continent+farm_type+
                     antimicrobial_compound+
                         pathogen+percent_resistant, data2, mean) %>%
  arrange(continent)

data3 <- data3 %>%select("continent",
                         "farm_type",
                         "antimicrobial_compound",

                         "pathogen",
                         "percent_resistant")%>%
filter(pathogen != "Arcanobacterium pyogenes", pathogen != "Corynebacterium bovis",
           pathogen != "Environmental streptococci")

#changing percentage resistance into numeric class and rounding off
data3$percent_resistant <- as.numeric(as.character
                                      (data3$percent_resistant))

data3$percent_resistant <- round(data3$percent_resistant, digits = 0)

##Asia e.coli bar plot

asia.ecoli <- data3 %>%
  filter(continent == "Asia", pathogen == "E.coli")

asia.ecoli.plot <- ggbarplot(asia.ecoli, "antimicrobial_compound", "percent_resistant",
          fill = "farm_type", position = position_dodge(0.7),
          subtitle = "Asia, E.coli = 215",
          xlab = "Antimicrobial", ylab = "Percentage resistance",
          legend.title = "Farm type", font.x = "bold", font.y = "bold",
          font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

asia.ecoli.plot

##Asia enterococcus bar plot

asia.entero <- data3 %>%
  filter(continent == "Asia", pathogen == "Enterococcus")

asia.entero.plot <- ggbarplot(asia.entero, "antimicrobial_compound", "percent_resistant",
                             fill = "farm_type", position = position_dodge(0.7),
                             subtitle = "Asia, Enterococcus = 104",
                             xlab = "Antimicrobial", ylab = "Percentage resistance",
                             legend.title = "Farm type", font.x = "bold", font.y = "bold",
                             font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

asia.entero.plot

##Asia listeria bar plot

asia.list <- data3 %>%
  filter(continent == "Asia", pathogen == "Listeria")

asia.listeria.plot <- ggbarplot(asia.list, "antimicrobial_compound", "percent_resistant",
                              fill = "farm_type", position = position_dodge(0.7),
                              subtitle = "Asia, Listeria = 96",
                              xlab = "Antimicrobial", ylab = "Percentage resistance",
                              legend.title = "Farm type", font.x = "bold", font.y = "bold",
                              font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

asia.listeria.plot

##Asia Salmonella bar plot

asia.sal <- data3 %>%
  filter(continent == "Asia", pathogen == "Salmonella")

asia.salmonella.plot <- ggbarplot(asia.sal, "antimicrobial_compound", "percent_resistant",
                                fill = "farm_type", position = position_dodge(0.7),
                                subtitle = "Asia, Salmonella = 556",
                                xlab = "Antimicrobial", ylab = "Percentage resistance",
                                legend.title = "Farm type", font.x = "bold", font.y = "bold",
                                font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

asia.salmonella.plot

##Asia Staphylococcus bar plot

asia.staph <- data3 %>%
  filter(continent == "Asia", pathogen == "Staphylococcus")

asia.Staphylococcus.plot <- ggbarplot(asia.staph, "antimicrobial_compound", "percent_resistant",
                                  fill = "farm_type", position = position_dodge(0.7),
                                  subtitle = "Asia, Staphylococcus = 162",
                                  xlab = "Antimicrobial", ylab = "Percentage resistance",
                                  legend.title = "Farm type", font.x = "bold", font.y = "bold",
                                  font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

asia.Staphylococcus.plot

##Europe Campylobacter bar plot

europe.campy <- data3 %>%
  filter(continent == "Europe", pathogen == "Campylobacter")

europe.Campylobacter.plot <- ggbarplot(europe.campy, "antimicrobial_compound", "percent_resistant",
                                      fill = "farm_type", position = position_dodge(0.7),
                                      subtitle = "Europe, Campylobacter = 712",
                                      xlab = "Antimicrobial", ylab = "Percentage resistance",
                                      legend.title = "Farm type", font.x = "bold", font.y = "bold",
                                      font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

europe.Campylobacter.plot

##Europe E.coli bar plot

europe.ecoli <- data3 %>%
  filter(continent == "Europe", pathogen == "E.coli")

europe.ecoli.plot <- ggbarplot(europe.ecoli, "antimicrobial_compound", "percent_resistant",
                                     fill = "farm_type", position = position_dodge(0.7),
                                     subtitle = "Europe, E.coli = 5,313",
                                     xlab = "Antimicrobial", ylab = "Percentage resistance",
                                     legend.title = "Farm type", font.x = "bold", font.y = "bold",
                                     font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

europe.ecoli.plot

##Europe Enterococcus bar plot

europe.entero <- data3 %>%
  filter(continent == "Europe", pathogen == "Enterococcus")

europe.enterococcus.plot <- ggbarplot(europe.entero, "antimicrobial_compound", "percent_resistant",
                               fill = "farm_type", position = position_dodge(0.7),
                               subtitle = "Europe, Enterococcus = 184",
                               xlab = "Antimicrobial", ylab = "Percentage resistance",
                               legend.title = "Farm type", font.x = "bold", font.y = "bold",
                               font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

europe.enterococcus.plot

##Europe Listeria bar plot

europe.list <- data3 %>%
  filter(continent == "Europe", pathogen == "Listeria")

europe.listeria.plot <- ggbarplot(europe.list, "antimicrobial_compound", "percent_resistant",
                                      fill = "farm_type", position = position_dodge(0.7),
                                      subtitle = "Europe, Listeria = 71",
                                      xlab = "Antimicrobial", ylab = "Percentage resistance",
                                      legend.title = "Farm type", font.x = "bold", font.y = "bold",
                                      font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

europe.listeria.plot

##Europe MRSA bar plot

europe.MRSA <- data3 %>%
  filter(continent == "Europe", pathogen == "MRSA")

europe.MRSA.plot <- ggbarplot(europe.MRSA, "antimicrobial_compound", "percent_resistant",
                                  fill = "farm_type", position = position_dodge(0.7),
                                  subtitle = "Europe, MRSA = 273",
                                  xlab = "Antimicrobial", ylab = "Percentage resistance",
                                  legend.title = "Farm type", font.x = "bold", font.y = "bold",
                                  font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

europe.MRSA.plot

##Europe S.aureus bar plot

europe.saureus <- data3 %>%
  filter(continent == "Europe", pathogen == "S.aureus")

europe.s.aureus.plot <- ggbarplot(europe.saureus, "antimicrobial_compound", "percent_resistant",
                              fill = "farm_type", position = position_dodge(0.7),
                              subtitle = "Europe, S.aureus = 688",
                              xlab = "Antimicrobial", ylab = "Percentage resistance",
                              legend.title = "Farm type", font.x = "bold", font.y = "bold",
                              font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

europe.s.aureus.plot

##North America, campylobacter bar plot

N.A.campylobacter <- data3 %>%
  filter(continent == "North America", pathogen == "Campylobacter")

N.A.campylobacter.plot <- ggbarplot(N.A.campylobacter, "antimicrobial_compound", "percent_resistant",
                                  fill = "farm_type", position = position_dodge(0.7),
                                  subtitle = "North America, Campylobacter = 9,219",
                                  xlab = "Antimicrobial", ylab = "Percentage resistance",
                                  legend.title = "Farm type", font.x = "bold", font.y = "bold",
                                  font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

N.A.campylobacter.plot

##North America, E.coli bar plot

N.A.ecoli <- data3 %>%
  filter(continent == "North America", pathogen == "E.coli")

N.A.ecoli.plot <- ggbarplot(N.A.ecoli, "antimicrobial_compound", "percent_resistant",
                                    fill = "farm_type", position = position_dodge(0.7),
                                    subtitle = "North America, E.coli = 12,509",
                                    xlab = "Antimicrobial", ylab = "Percentage resistance",
                                    legend.title = "Farm type", font.x = "bold", font.y = "bold",
                                    font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

N.A.ecoli.plot

##North America, Enterococcus bar plot

N.A.entero <- data3 %>%
  filter(continent == "North America", pathogen == "Enterococcus")

N.A.entero.plot <- ggbarplot(N.A.entero, "antimicrobial_compound", "percent_resistant",
                            fill = "farm_type", position = position_dodge(0.7),
                            subtitle = "North America, Enterococcus = 546",
                            xlab = "Antimicrobial", ylab = "Percentage resistance",
                            legend.title = "Farm type", font.x = "bold", font.y = "bold",
                            font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

N.A.entero.plot

##North America, S.aureus bar plot

N.A.saureus <- data3 %>%
  filter(continent == "North America", pathogen == "S.aureus")

N.A.saureus.plot <- ggbarplot(N.A.saureus, "antimicrobial_compound", "percent_resistant",
                             fill = "farm_type", position = position_dodge(0.7),
                             subtitle = "North America, S.aureus = 486",
                             xlab = "Antimicrobial", ylab = "Percentage resistance",
                             legend.title = "Farm type", font.x = "bold", font.y = "bold",
                             font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

N.A.saureus.plot

##North America, Salmonella bar plot

N.A.sal <- data3 %>%
  filter(continent == "North America", pathogen == "Salmonella")

N.A.salmonella.plot <- ggbarplot(N.A.sal, "antimicrobial_compound", "percent_resistant",
                              fill = "farm_type", position = position_dodge(0.7),
                              subtitle = "North America, Salmonella = 3,111",
                              xlab = "Antimicrobial", ylab = "Percentage resistance",
                              legend.title = "Farm type", font.x = "bold", font.y = "bold",
                              font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

N.A.salmonella.plot

##North America, Staphylococcus bar plot

N.A.staphy <- data3 %>%
  filter(continent == "North America", pathogen == "Staphylococcus")

N.A.Staphylococcus.plot <- ggbarplot(N.A.staphy, "antimicrobial_compound", "percent_resistant",
                                 fill = "farm_type", position = position_dodge(0.7),
                                 subtitle = "North America, Staphylococcus = 405",
                                 xlab = "Antimicrobial", ylab = "Percentage resistance",
                                 legend.title = "Farm type", font.x = "bold", font.y = "bold",
                                 font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

N.A.Staphylococcus.plot

##Oceania, E.coli bar plot

oceania.ecoli <- data3 %>%
  filter(continent == "Oceania", pathogen == "E.coli")

oceania.ecoli.plot <- ggbarplot(oceania.ecoli, "antimicrobial_compound", "percent_resistant",
                                     fill = "farm_type", position = position_dodge(0.7),
                                     subtitle = "Oceania, E.coli = 1,189",
                                     xlab = "Antimicrobial", ylab = "Percentage resistance",
                                     legend.title = "Farm type", font.x = "bold", font.y = "bold",
                                     font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

oceania.ecoli.plot

##Oceania, Enterococcus bar plot

oceania.entero <- data3 %>%
  filter(continent == "Oceania", pathogen == "Enterococcus")

oceania.enterococcus.plot <- ggbarplot(oceania.entero, "antimicrobial_compound", "percent_resistant",
                                fill = "farm_type", position = position_dodge(0.7),
                                subtitle = "Oceania, Enterococcus = 353",
                                xlab = "Antimicrobial", ylab = "Percentage resistance",
                                legend.title = "Farm type", font.x = "bold", font.y = "bold",
                                font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

oceania.enterococcus.plot

##South America, E.coli bar plot

S.A.ecoli <- data3 %>%
  filter(continent == "South America", pathogen == "E.coli")

S.A.ecoli.plot <- ggbarplot(S.A.ecoli, "antimicrobial_compound", "percent_resistant",
                                       fill = "farm_type", position = position_dodge(0.7),
                                       subtitle = "South America, E.coli = 156",
                                       xlab = "Antimicrobial", ylab = "Percentage resistance",
                                       legend.title = "Farm type", font.x = "bold", font.y = "bold",
                                       font.legend = "bold", font.subtitle = "italic")+
  rotate_x_text(90)

S.A.ecoli.plot


library(tidyverse)
library(haven)

setwd("/Users/rich/Dropbox/HILDA/shit-happens-paper")

#### Helper functions ####
source('src/GetRaws.R')
source('src/GetMCS.R')
# source('src/GetEventTimes.R')

GetEventTimes <- function(eventcodes, datalist) {

  df.list <- list()

  for (eventcode in eventcodes) {
    #### Recode data so event = 1, no event = 0, missing = NA ####
    #
    codeq <- paste0(eventcode, 'q', seq(4)) # get the quarterly codes
    #
    # Creating the event data frame...
    GetRaws(datalist, c(eventcode, codeq)) %>%
      spread(key = code, value = val) %>%
      # missing values replaced with NA
      mutate_at(eventcode, funs(case_when(. < 0 ~ NA_real_,
                                          TRUE ~ as.numeric(.)))) %>%
      mutate_at(eventcode, funs(. - 1)) %>%
      mutate_at(codeq, funs(case_when(. < 0 ~ NA_real_,
                                      TRUE ~ as.numeric(.)))) -> df

    # rename our column variables to make selection easier
    colnames(df) <- c("xwaveid", "wave", "annual", "post03",
                      "post06", "post09", "post12")

    # set the column order to allow column indexing below
    colorder <- c('xwaveid', 'wave', 'pre36', 'pre24', 'pre12', 'post03',
                  'post06', 'post09', 'post12', 'post24', 'post36', 'post48')

    # Add lead and lag variables based on annual event record
    # pre36 = 2-3 years before event
    # pre24 = 1-2 years before event
    # pre12 = 0-1 years before event
    # post03 = 0-3 months after event
    # post06 = 3-6 months after event
    # post09 = 6-9 months after event
    # post12 = 9-12 months after event
    # post24 = 1-2 years after event
    # post36 = 2-3 years after event
    # post48 = 3-4 years after event

    df %>%
      group_by(xwaveid) %>%
      # The annual event record is used to create yearly leads and lags (pre12
      # to post36). If the annual event record is missing (even if quarterly
      # event records are present), then leads and lags will be missing
      mutate(
        pre12  = dplyr::lead(annual, n = 1, order_by = wave),
        pre24  = dplyr::lead(annual, n = 2, order_by = wave),
        pre36  = dplyr::lead(annual, n = 3, order_by = wave),
        post24 = dplyr::lag(annual, n = 1, order_by = wave),
        post36 = dplyr::lag(annual, n = 2, order_by = wave),
        post48 = dplyr::lag(annual, n = 3, order_by = wave)
      ) %>%
      ungroup() %>%
      select(-annual) %>%
      select(one_of(colorder)) %>%
      mutate(rowsums = rowSums(.[3:12], na.rm = TRUE)) %>%
      filter(rowsums > 0) %>%
      select(-rowsums) -> df

    df.list[eventcode] <- list(df)

  }

  return(df.list)
}

#### Load data ####
filepaths <- list.files(
  path = '~/Dropbox/HILDA/data',
  pattern = '^Combined.*.dta$',
  full.names = TRUE
)

hilda <- list()
for (pathtofile in filepaths) {
  df <- read_dta(pathtofile)
  hilda <- append(hilda, list(df))
  cat('.')
}

#### Get Variables ####
# Get the life events
lifevents <- c('lefnw', 'lefni', 'lefrd', 'lejob', 'leprm', 'lertr', 'lemar',
               'leprg', 'lebth', 'ledsc', 'lesep', 'lemvd', 'leins', 'lepcm',
               'lejls', 'lejlf', 'ledfr', 'ledhm', 'ledrl', 'leinf', 'lercl', 'levio')

events_by_time <- GetEventTimes(lifevents, hilda)
write_rds(events_by_time, 'data/events_by_time.rds')

for (df in events_by_time) {
  print(dim(df))
}
# Store the events to use as covariates
# To be done

# Get outcome variables
mcs <- GetMCS(hilda)

GetRaws(hilda, c(
  'gh9a', # Vitality: feel full of life (lower is better)*
  'gh9b', # Mental H: Been a nervous person (higher is better)
  'gh9c', # Mental H: Felt so down in the dumps (higher is better)
  'gh9d', # Mental H: Felt calm and peaceful (lower is better)*
  'gh9e', # Vitality: Have a lot of energy (lower is better)*
  'gh9f', # Mental H: Felt down (higher is better)
  'gh9g', # Vitality: Felt worn out (higher is better)
  'gh9h', # Mental H: Been happy (lower is better)*
  'gh9i'  # Vitality: Felt tired (higher is better)
  )
) -> gh9

reversed_items <- c('gh9a', 'gh9d', 'gh9e', 'gh9h')

gh9 %>%
  # Recode missing to NA
  spread(code, val) %>%
  mutate_if(is.double, ~ ifelse(. < 0, NA_real_, .)) %>%
  # Reverse score
  mutate_at(reversed_items, ~ 7 - .) -> gh9_items

write_rds(gh9_items, 'data/gh9_items.rds')

gh9_items %>%
  gather(code, val, -xwaveid, -wave) %>%
  # Impute average if less than half missing (see ghmh data dictionary)
  group_by(xwaveid, wave) %>%
  mutate(
    sum_na = sum(is.na(val)),
    mean_na = mean(val, na.rm = TRUE),
    imputed = ifelse(is.na(val) & sum_na < 5, mean_na, val),
    sum_imputed = sum(imputed),
    code = "gh9_sum"
  ) %>%
  select(xwaveid, wave, code, val = sum_imputed) %>%
  distinct() %>%
  ungroup() -> gh9_imputed

GetRaws(hilda, c('losat', 'ghmh')) %>%
  bind_rows(mcs) %>%
  bind_rows(gh9_imputed) -> outcomes

write_rds(outcomes, 'data/outcomes.rds')

#### Get demographic covariates ####
GetRaws(hilda, c('hgage', 'hhda10', 'edhigh1')) -> covariates

GetRaws(hilda, 'hgsex') %>%
  group_by(xwaveid) %>%
  summarise(sex = round(mean(val))) %>%
  mutate(val = sex - 1,
         code = 'female') %>%
  select(xwaveid, code, val) %>%
  bind_rows(covariates) %>%
  arrange(xwaveid, code, wave) -> demographics

write_rds(demographics, 'data/demographics.rds')


#!/usr/bin/env Rscript

#======================
# script to sort the input locus pairs according to their genomic distance (ascending order)
# required for spline fitting
## if the input reference genome is circular genome
## the distance calculation is also adjusted
#======================
args <- commandArgs(TRUE)

InpFile <- as.character(args[1])
OutFile <- as.character(args[2])
CircularGenome <- as.integer(args[3])
ChrSizeFile <- as.character(args[4])
cccol <- as.integer(args[5])

## temporary file to store the genomic distances for individual locus pairs
temp_Dist_LocusPairFile <- paste0(dirname(OutFile), '/temp_Dist_LocusPair.bed')
if (file.exists(temp_Dist_LocusPairFile)) {
	system(paste("rm", temp_Dist_LocusPairFile))
}

## copy the first line (header) in the output file
## also append one field: genomic distance
system(paste("head ", InpFile, " | awk \'{if (NR==1) {print $0\"\tDist\"}}\' - > ", OutFile))

## get the number of fields in the input file
nfield <- as.integer(system(paste("awk \'{if (NR==1) {print NF}}\' ", OutFile), intern = TRUE))
cat(sprintf("\n Number of columns in the output file : %s ", nfield))

if (CircularGenome == 0) {
	## traditional reference genome
	## sort by the genomic distance and then by the contact count
	system(paste0("awk -F\'[\t]\' \'function abs(v) {return v < 0 ? -v : v} {if (NR>1) {print $0\"\t\"abs($5-$2)}}\' ", InpFile, " | sort -k", nfield, ",", nfield, "n -k", cccol, ",", cccol, "nr - >> ", OutFile))
} else {
	## circular genome
	## construct locus pairs with genomic distance for individual chromosomes
	ChrSizeData <- read.table(ChrSizeFile, header=F, sep="\t", stringsAsFactors=F)
	ChrList <- unique(ChrSizeData[,1])
	for (j in 1:length(ChrList)) {
		currchr <- ChrList[j]
		cat(sprintf("\n ==>> circular genome - creating adjusted genomic distance - processing chromosome : %s ", currchr))
		## chromosome size for this chromosome
		max_coord <- ChrSizeData[which(ChrSizeData[,1] == currchr), 2]
		cat(sprintf(" -->> max_coord (from ChrSizeFile) for this chromosome : %s ", max_coord))
		system(paste0("awk -F\'[\t]\' -v R=", max_coord, " -v c=\"", currchr, "\" \'function abs(v) {return v < 0 ? -v : v}; function min(x,y) {return x < y ? x : y} {if ((NR>1) && ($1==c)) {print $0\"\t\"min(min(abs($5-$2),abs((R-$5)+$2)),abs((R-$2)+$5))}}\' ", InpFile, " >> ", temp_Dist_LocusPairFile))
	}
	## now sort by the genomic distance and then by the contact count
	system(paste0("sort -k", nfield, ",", nfield, "n -k", cccol, ",", cccol, "nr ", temp_Dist_LocusPairFile, " >> ", OutFile))
}

if (file.exists(temp_Dist_LocusPairFile)) {
	system(paste("rm", temp_Dist_LocusPairFile))
}


#' slide
#'
#' TODO
#'
#' @param trainfile,testfile
#' TODO
#' @param logfile
#' TODO
#' @param batchsize
#' TODO
#' @param rehash
#' TODO
#' @param rebuild
#' TODO
#' @param input_dim
#' TODO
#' @param Lr
#' TODO
#' @param epochs
#' TODO
#' @param stepsize
#' TODO
#' @param layers
#' TODO
#'
#' @importFrom filesampler wc_l
#' @useDynLib slider R_slide
#' @export
slide = function(trainfile, testfile, logfile="/tmp/log.txt", batchsize=1000,
  rehash=1000, rebuild=1000, input_dim=784, Lr=0.0001, epochs=5, stepsize=20,
  layers=3)
{
  check.is.posint(batchsize)
  check.is.posint(rehash)
  check.is.posint(rebuild)
  check.is.posint(input_dim)
  # TODO Lr
  check.is.posint(epochs)
  check.is.posint(stepsize)
  check.is.posint(layers)

  trainfile = check_file(trainfile)
  testfile = check_file(testfile)

  wc_train = filesampler::wc_l(trainfile) - 1
  wc_test = filesampler::wc_l(testfile) - 1

  addparam = function(name, val) paste0(name, "=", val, "\n")
  config = paste0(
    addparam("trainData", trainfile),
    addparam("testData", testfile),
    addparam("totRecords", wc_train),
    addparam("totRecordsTest", wc_test),
    addparam("logFile", logfile),

    addparam("Batchsize", batchsize),
    addparam("Rehash", rehash),
    addparam("Rebuild", rebuild),
    addparam("InputDim", input_dim),
    addparam("Lr", Lr),
    addparam("Epoch", epochs),
    addparam("Stepsize", stepsize),
    addparam("numLayer", layers),

    addparam("sizesOfLayers", "128,670091"),
    addparam("K", "2,6"),
    addparam("L", "20,50"),
    addparam("RangePow", "6,18"),
    addparam("Sparsity", "1,0.005,1,1")
  )

  config_file = tempfile()
  cat(config, file=config_file)

  .Call(R_slide, c("./runme", config_file))

  unlink(config_file)
}


code 'lower_dim'
name '动态次级维度演示'
dimensions {
	accbook {
		appendLowerHeadCallback { thisHead,lowerHead->
			def term=lowerHead.model?.id
			term.toInteger() % 2 == 0
		}
		lowerDimensionExpandParams { thisHead->
			def accitem=thisHead.model
			[termSetId: accitem.termSetId as Integer]
		}
	}
	term null
	monthEnd name:'cfDate'
}
layout {
	rows (['accbook','term'])
	columns 'cfDate'
}
dataRequest {
	table 'mcfd',allDimensions: ['organ','accbook','currency','cfDate',
		'accitemTerm']
	fields 'sum(endingBalance) value'
	groupFields 'accbook,cfDate,accitemTerm'
	contextParams (['date','organ','currency','staticModel'])
}
heads {
	accbook {
		pager {
			perPage 10
			page 1
		}
	}
	cfDate {
		pager {
			perPage 3
			page 2
		}
	}
}


#CRAFTYOutput analysis - creates vector maps

#Outputs can be a combination of:
#1. figures vector maps of land use and Captials (.png files); years indicated by fig_yrs
#2. movies of 1. (.mp4); if video_output is TRUE

#8 vector maps for munis (in two different plots:
#First plot
#1. Observed LC - only for vector (mode for muni)
#2. Modelled LC (mode for muni)
#Second plot
#3. Agri Capital (mean for muni)
#4. Nature Capital (mean for muni)
#5. Infrastructure Capital (mean for muni)
#6. LandPrice
#7. LandProtection
#8. GrowingSeason

#muni cata from CRAFTYmunisLC.csv and CRAFTYmunisServCap.csv

rm(list=ls())

library(tidyverse)
library(gridExtra)
library(animation)
library(sf)
library(viridisLite)
library(RColorBrewer)  #for plotting

sim_yrs <- seq(2001, 2015, 1)   #movie made for all these years
fig_yrs <- c(2005, 2010, 2015) #figures output for only these years

#set for the run in CRAFTY (althrough runID difficult to control)
scenario <- "Testing_2019-02-21"
runID <- "0-0"
cl <- "PastureB"  #classification for observed LU map

#specify states to plot (for all states provide empty list)
#states <- c()  #all states
states <- c(51) #MT

#outputs to create
video_output <- FALSE

#Next, vector maps
#different approach - create figures first, then videos (as cannot save sf plot objects to a list)
cDat <- readr::read_csv(paste0("Data/",scenario,"/",runID,"/",scenario,"_CRAFTYmunisLC.csv"),
  col_types = cols(Year = col_integer(), diffcProp3 = col_double()))  #needed to ensure correct import (many zeros in diffcProp3 at top of file)

scDat <- readr::read_csv(paste0("Data/",scenario,"/",runID,"/",scenario,"_CRAFTYmunisServCap.csv"),
  col_types = cols(meanAgriC = col_double(), meanNatureC = col_double(), meanInfraC = col_double(),meanLandPriceC = col_double(),meanSoyProteC = col_double(),meanGSeasonC = col_double()))  #needed to ensure correct import

#note following shp was created using simplyfying_shapefiles.r
BRmunis <- st_read("Data/Vector/BRmunis_sim10_simple2.shp")

#yr <- 2005   #for testing

#create default land cover palette
lc_pal <- c("forestgreen", "darkcyan", "wheat2", "black", "orange2")
lc_labs <- c("Nature", "Other Agri", "Agriculture", "Other", "Pasture")

#funciton to get correct LC pallete colours (e.g. if a given LC is missing)
lc_pal_function <- function(dat){

  pal <- c()

  if(is.element(1,unlist(dat))) pal <- c(pal, "forestgreen")
  if(is.element(2,unlist(dat))) pal <- c(pal, "darkcyan")
  if(is.element(3,unlist(dat))) pal <- c(pal, "wheat2")
  if(is.element(4,unlist(dat))) pal <- c(pal, "black")
  if(is.element(5,unlist(dat))) pal <- c(pal, "orange2")

  return(pal)
}

#create capitals palette
cap_pal <- viridis(100)
brks <- seq(from=0,to=1,by=0.01)  #101 values

#create proportions palette
cell_pal <- brewer.pal(6, "YlGn")

#create figures
for(yr in sim_yrs){

  print(paste0("vector: ", yr))

  #if we want this year saved as an image
  if(yr %in% fig_yrs) {

    #land cover map first
    cDat_map <- left_join(BRmunis, filter(cDat, Year == yr), by = c("CD_GEOCMUn" ="muniID"))

    #filter to specified states (if needed)
    if(!is.null(states)){
      cDat_map <- filter(cDat_map, State %in% states)
    }

    #open png device
    png(paste0("Data/",scenario,"/",runID,"/",scenario,"_MuniOutput_LandUse_",yr,".png"), width=1000, height=1000, res=100)

    #create layout (including legend at bottom)
    m <- matrix(c(1,2,3,3),nrow = 2,ncol = 2,byrow = TRUE)
    layout(mat = m,heights = c(0.8,0.2))

    #add plots
    for(nm in c("ObsMode", "ModMode")){
      lc_pal_temp <- lc_pal_function(cDat_map[nm])
      plot(cDat_map[nm], pal = lc_pal_temp, graticule = st_crs(cDat_map), axes = TRUE, lty = 0, key.pos=NULL, reset=F)
    }

    #add legend
    par(mar=c(0,0,0,0))
    plot(1, type = "n", axes=FALSE, xlab="", ylab="")
    legend(x = "center",inset = 0, lc_labs, fill = lc_pal, title=paste0(yr), horiz = TRUE)

    #close png device
    dev.off()

    #######
    #now create capital maps
    scDat_map <- left_join(BRmunis, filter(scDat, Year == yr), by = c("CD_GEOCMUn" ="muniID"))

    #filter to specified states (if needed)
    if(!is.null(states)){
      scDat_map <- filter(scDat_map, State %in% states)
    }

    #select only Capitals we want
    ps <- scDat_map %>% dplyr::select(meanAgriC, meanNatureC, meanInfraC,meanLandPriceC,meanSoyProteC,meanGSeasonC)

    #open png device
    png(paste0("Data/",scenario,"/",runID,"/",scenario,"_MuniOutput_Capitals_",yr,".png"), width=1200, height=1200, res=100)

    #create layout
    m <- matrix(c(1,2,3,4,5,6,7,7,7),nrow = 3,ncol = 3,byrow = TRUE)
    layout(mat = m,heights = c(0.45,0.45,0.1))

    for(psi in 1:6)
    {
      par(mar = c(2,2,1,1))
      plot(ps[psi], pal = cap_pal, breaks = brks, graticule = st_crs(cDat_map), axes = T, lty = 0, key.pos=NULL, reset=F)
    }

    #the legend is its own plot https://stackoverflow.com/a/10391001
    par(mar=c(0,0,0,0))
    plot(1, type = "n", axes=FALSE, xlab="", ylab="")
    legend(x = "center",inset = 0,
      legend=seq(1,0,-0.1), fill=rev(viridis(11)), title=paste0(yr), horiz = TRUE)

    dev.off()

    #####
    #comparison maps of obs and mod proportions
    png(paste0("Data/",scenario,"/",runID,"/",scenario,"_MuniOutput_LUprops_",yr,".png"), width=1000, height=1000, res=100)

    #create layout
    m <- matrix(c(1,2,3,4,5,6,7,7),nrow = 4,ncol = 2,byrow = TRUE)
    layout(mat = m,heights = c(0.3,0.3,0.3,0.1))

    #names columns to map
    propmaps <- c("Obs1","Mod1","Obs3","Mod3","Obs5","Mod5")
    #labels to use on map titles
    proptitles <- c("Obs Nature","Mod Nature","Obs Agri","Mod Agri","Obs Pasture","Mod Pasture")

    #plot maps
    for(m in 1:length(propmaps)){
      plot(cDat_map[propmaps[m]], pal = cell_pal, breaks = seq(0,1,0.2), graticule = st_crs(cDat_map), axes = TRUE, lty = 0, key.pos=NULL, reset=F, main=proptitles[m])
    }

    #plot legend
    par(mar=c(0,0,0,0))
    plot(1, type = "n", axes=FALSE, xlab="", ylab="")
    legend(x = "center",inset = 0, legend=seq(0,1,0.2), fill=cell_pal, title=paste0(yr), horiz = TRUE)

    dev.off()

  }

}

#Now create LC video
if(video_output)
{
  saveVideo(
    for(yr in sim_yrs){

      cDat_map <- left_join(BRmunis, filter(cDat, Year == yr), by = c("CD_GEOCMUn" ="muniID"))

      #filter to specified states (if needed)
      if(!is.null(states)){
        cDat_map <- filter(cDat_map, State %in% states)
      }

      #create layout (including legend at bottom)
      m <- matrix(c(1,2,3,3),nrow = 2,ncol = 2,byrow = TRUE)
      layout(mat = m,heights = c(0.8,0.2))

      #add plots
      for(nm in c("ObsMode", "ModMode")){
        lc_pal_temp <- lc_pal_function(cDat_map[nm])
        plot(cDat_map[nm], pal = lc_pal_temp, graticule = st_crs(cDat_map), axes = TRUE, lty = 0, key.pos=NULL, reset=F)
      }

      #add legend
      par(mar=c(0,0,0,0))
      plot(1, type = "n", axes=FALSE, xlab="", ylab="")
      legend(x = "center",inset = 0, lc_labs, fill = lc_pal, title=paste0(yr), horiz = TRUE)

    },
    video.name = paste0("Data/",scenario,"/",runID,"/",scenario,"_MuniOutput_LandUse_",scenario,".mp4"))

  #capitals video
  saveVideo(
    for(yr in sim_yrs){

      #create capital maps
      scDat_map <- left_join(BRmunis, filter(scDat, Year == yr), by = c("CD_GEOCMUn" ="muniID"))

      #filter to specified states (if needed)
      if(!is.null(states)){
        scDat_map <- filter(scDat_map, State %in% states)
      }

      ps <- scDat_map %>% dplyr::select(meanAgriC, meanNatureC, meanInfraC,meanLandPriceC,meanSoyProteC,meanGSeasonC)

      #create layout
      m <- matrix(c(1,2,3,4,5,6,7,7,7),nrow = 3,ncol = 3,byrow = TRUE)
      layout(mat = m,heights = c(0.45,0.45,0.1))

      for(psi in 1:6)
      {
        par(mar = c(2,2,1,1))
        plot(ps[psi], pal = cap_pal, breaks = brks, graticule = st_crs(cDat_map), axes = T, lty = 0, key.pos=NULL, reset=F)
      }

      #the legend is its own plot https://stackoverflow.com/a/10391001
      par(mar=c(0,0,0,0))
      plot(1, type = "n", axes=FALSE, xlab="", ylab="")
      legend(x = "center",inset = 0,
        legend=seq(1,0,-0.1), fill=rev(viridis(11)), title=paste0(yr), horiz = TRUE)

    },
    video.name = paste0("Data/",scenario,"/",runID,"/",scenario,"_MuniOutput_Capitals_",scenario,".mp4"))
}

#following is how we would do it with ggplot but rendering is tool slow (keep for publications plotting later)
#
# library(ggpubr)
#
# #lc maps
# om <- ggplot(cDat_map) +
#   geom_sf(aes(fill=as.factor(ObsMode)), color = NA) +
#   scale_fill_manual(values=lc_pal, labels=lc_labs, name="Land Cover") +
#   theme(legend.position = c(0.825, 0.2)) +
#   ggtitle(paste0(yr," Observed Mode LC"))
#
# mm <- ggplot(cDat_map) +
#   geom_sf(aes(fill=as.factor(ModMode)), color = NA) +
#   scale_fill_manual(values=lc_pal, labels=lc_labs, name="Land Cover") +
#   theme(legend.position = c(0.825, 0.2)) +
#   ggtitle(paste0(yr," Modelled Mode LC"))
#
# ggarrange(om, mm, nrow = 1, ncol = 2, common.legend=T, legend="bottom")
#
# ggarrange(om, mm, nrow = 1, ncol = 2, common.legend=T, legend="bottom") %>%
#   ggsave(filename="tesing2.png")
#
#
# #capitals maps
# acm <- ggplot(scDat_map) +
#   geom_sf(aes(fill=meanAgriC), color = NA) +
#   scale_fill_distiller(palette = "YlOrBr", direction = 1, name="Capital") +
#   theme(legend.position = "none") +
#   ggtitle(paste0(yr," Agriculture C"))
#
# ncm <- ggplot(scDat_map) +
#   geom_sf(aes(fill=meanNatureC), color = NA) +
#   scale_fill_distiller(palette = "YlOrBr", direction = 1, name="Capital") +
#   theme(legend.position = "none") +
#   ggtitle(paste0(yr," Nature C"))
#
# icm <- ggplot(scDat_map) +
#   geom_sf(aes(fill=meanInfraC), color = NA) +
#   scale_fill_distiller(palette = "YlOrBr", direction = 1, name="Capital") +
#   theme(legend.position = "none") +
#   ggtitle(paste0(yr," Infrastructure C"))
#
# oacm <- ggplot(scDat_map) +
#   geom_sf(aes(fill=meanOtherAgriC), color = NA) +
#   scale_fill_distiller(palette = "YlOrBr", direction = 1, name="Capital") +
#   theme(legend.position = "none") +
#   ggtitle(paste0(yr," Other Agri C"))
#
# system.time(ggarrange(acm, ncm, icm, oacm, nrow = 2, ncol = 3))


suppressMessages(usePackage(ggplot2))
suppressMessages(usePackage(dplyr))
suppressMessages(usePackage(tidyr))
suppressMessages(usePackage(reshape2))
suppressMessages(usePackage(RColorBrewer))
suppressMessages(usePackage(MASS))
suppressMessages(usePackage(speedglm))
suppressMessages(usePackage(boot))
suppressMessages(usePackage(devtools))
suppressMessages(usePackage(psych))

source("./R/get_functions.r")

# Function counts the total observed number of de novo mutations 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
runTest <- function(cov, dir){
  covtmp <- covdat %>% filter(Cov==cov)
  if(dir=="Up"){
    covdir <- covtmp %>% filter(Est>0)
  } else {
    covdir <- covtmp %>% filter(Est<0)
  }

  dnmstmp <- chrpfdnm[paste0(chrpfdnm$Category.x, "_", substr(chrpfdnm$SEQ, 0, 7)) %in%
    paste0(covdir$Category, "_", covdir$Sequence),]
  if(nrow(dnmstmp)>=5){
    if(cov=="GC"){
      covbase <- "/net/bipolar/jedidiah/mutation/reference_data/high_gc"
      dnmstmp$GC <- gcCol(dnmstmp,
        "/net/bipolar/jedidiah/mutation/output/3bp_10k/full_bin.txt")
      dnmstmp$inside <- ifelse(dnmstmp$GC>=0.55, 1, 0)
    } else if(cov=="TIME"){
      dnmstmp$TIME <- repCol(dnmstmp,
        "/net/bipolar/jedidiah/mutation/reference_data/lymph_rep_time.txt")
      if(dir=="Down"){
        covbase <- "/net/bipolar/jedidiah/mutation/reference_data/late_rt"
        dnmstmp$inside <- ifelse(dnmstmp$TIME<=-1.25, 1, 0)
      } else if(dir=="Up"){
        covbase <- "/net/bipolar/jedidiah/mutation/reference_data/early_rt"
        dnmstmp$inside <- ifelse(dnmstmp$TIME>=1.25, 1, 0)
      }
    } else if(cov=="RR"){
      covbase <- "/net/bipolar/jedidiah/mutation/reference_data/high_rr"
      dnmstmp$RR <- rcrCol(dnmstmp,
        "/net/bipolar/jedidiah/mutation/reference_data/recomb_rate.bed")
      dnmstmp$inside <- ifelse(dnmstmp$RR>=2, 1, 0)
    } else if(cov=="DHS"){
      covbase <- "/net/bipolar/jedidiah/mutation/reference_data/DHS"
      covbed <- paste0(covbase, ".bed")
      dnmstmp$inside <- binaryCol(dnmstmp, covbed)
    } else if(cov=="CpGI"){
      covbase <- "/net/bipolar/jedidiah/mutation/reference_data/cpg_islands_sorted"
      covbed <- paste0(covbase, ".bed")
      dnmstmp$inside <- binaryCol(dnmstmp, covbed)
    } else if(cov=="LAMIN"){
      covbase <- "/net/bipolar/jedidiah/mutation/reference_data/lamin_B1_LADS2"
      covbed <- paste0(covbase, ".bed")
      dnmstmp$inside <- binaryCol(dnmstmp, covbed)
    } else {
      covbase <- paste0("/net/bipolar/jedidiah/mutation/reference_data/histone_marks/broad/sort.E062-", cov)
      covbed <- paste0(covbase, ".bed")
      dnmstmp$inside <- binaryCol(dnmstmp, covbed)
    }

    obs <- sum(dnmstmp$inside)

    seqs <- unlist(c(covdir$Sequence, lapply(covdir$Sequence, revcomp)))
    write.table(seqs, "/net/bipolar/jedidiah/mutation/seqs.txt", col.names=F, row.names=F, quote=F, sep="\t")

    grepcmd <- paste0("grep -o -Ff /net/bipolar/jedidiah/mutation/seqs.txt ", covbase, ".fa | sort | uniq -c > /net/bipolar/jedidiah/mutation/testcounts.txt")
    system(grepcmd)

    motifcts <- read.table("/net/bipolar/jedidiah/mutation/testcounts.txt", header=F, stringsAsFactors=F)

    names(motifcts) <- c("Count", "SEQ")
    motifcts$REVSEQ <- unlist(lapply(motifcts$SEQ, revcomp))
    motifcts$Sequence <- ifelse(substr(motifcts$SEQ,4,4) %in% c("A", "C"),
      motifcts$SEQ, motifcts$REVSEQ)
      # paste0(motifcts$SEQ, "(", motifcts$REVSEQ, ")"),
      # paste0(motifcts$REVSEQ, "(", motifcts$SEQ, ")"))
    motifcts2 <- motifcts %>%
      group_by(Sequence) %>%
      summarise(Count=sum(Count))
    covdir2 <- merge(covdir, motifcts2, by=c("Sequence"))

    covdir3 <- merge(covdir2, motifdat, by=c("Category", "Sequence"))
    covdir3$exp <- covdir3$Count*covdir3$rel_prop*1.67e-06*1074
    exp <- sum(covdir3$exp)

    total <- nrow(dnmstmp)
    if(dir=="Up"){
      test <- prop.test(c(obs, exp), c(total, total), alternative="greater")
    } else {
      test <- prop.test(c(obs, exp), c(total, total), alternative="less")
    }
    newrow <- data.frame(cov, dir=dir, obs=obs, exp=exp, n=total,
      propobs=test$estimate[1], propexp=test$estimate[2], pval=test$p.value)
    # testdat <- rbind(testdat, newrow)
    newrow
  }
}

# motiffile <- "/net/bipolar/jedidiah/mutation/output/7bp_1000k_rates.txt"
# motifdat <- read.table(motiffile, header=T, stringsAsFactors=F)
# motifdat <- motifdat %>%
#   mutate(Category=gsub("cpg_", "", Category2)) %>%
#   mutate(Sequence=substr(Sequence, 0, 7)) %>%
#   dplyr::select(Category, Sequence, rel_prop)

covdat <- read.table("/net/bipolar/jedidiah/mutation/fa_motifs.txt", header=T, stringsAsFactors=F)
covdat$Category <- gsub("cpg_", "", covdat$Category)
covs <- unique(covdat$Cov)
# covs <- covs[grepl("H3", covs)]
testdat <- 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)
    testdat <- rbind(testdat, 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=row$value, n=row$n, p=row$propexp, alternative="greater")$p.value
  } else {
    binom.pval <- binom.test(x=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("/net/bipolar/jedidiah/mutation/images/covbars_full.png", width=12, height=8)

# testdat2 <- testdat %>%
#   filter(cov != "CpGI" & cov != "GC") %>%
#   gather("gp", "val", obs:exp) %>%
#   mutate(gp=ifelse(gp=="exp", "Expected", "Observed"),
#     dir=ifelse(dir=="Up", "Predicted enrichment", "Predicted depletion"),
#     sigalpha=ifelse(pval<0.1, ifelse(pval<0.05, 1, 0.75), 0.6))
#
# ggplot(testdat2, aes(x=gp, y=val, fill=gp, group=dir, alpha=factor(sigalpha)))+
#   geom_bar(stat="identity", position="dodge")+
#   facet_grid(dir~cov, space="free", drop=TRUE)+
#   scale_fill_brewer("Number of mutations in feature-associated subtypes", palette="Dark2")+
#   scale_alpha_discrete("p-value", labels=c("n.s.", "<0.1", "<0.05"))+
#   theme_bw()+
#   theme(axis.title.x=element_blank(),
#     axis.text.x=element_blank(),
#     axis.ticks.x=element_blank(),
#     axis.title.y=element_blank(),
#     # legend.title=element_text(),
#     legend.position="bottom")
# ggsave("/net/bipolar/jedidiah/mutation/images/covdat.png", width=10, height=5)


# get_autospill_param_minimal.r
#
# Copyright (c) 2020 VIB (Belgium) & Babraham Institute (United Kingdom)
#
# Software written by Carlos P. Roca, as research funded by the European Union.
#
# This software may be modified and distributed under the terms of the MIT
# license. See the LICENSE file for details.

# Returns parameters for running a calculation of compensation with autospill,
# without creating any figures or tables.

get.autospill.param.minimal <- function()
{
    color.pal <- brewer.pal( 9, "Set1" )

    list(
        # general parameters

        verbose = TRUE,

        worker.process.n = 0,

        default.scatter.parameter = c( "FSC-A", "SSC-A" ),

        antigen.autof = "AutoF",

        marker.forbidden.char = " !\"#$%&'()*,/:;?@[\\]^{|}~",
        marker.substitution.char = "-",

        # algorithm parameters

        default.transformation.param = list(
            length = 256,
            max.range = 262144,
            pos = 4.418539922,
            neg = 0,
            width = -100
        ),

        default.gate.param = list(
            density.threshold = 0.33,
            region.auto = TRUE,
            region.factor.x.low = 0.05,
            region.factor.x.high = 0.80,
            region.factor.y.low = 0.05,
            region.factor.y.high = 0.80
        ),

        gate.data.trim.factor.x.min = 0.01,
        gate.data.trim.factor.x.max = 0.99,
        gate.data.trim.factor.y.min = 0.01,
        gate.data.trim.factor.y.max = 0.99,

        gate.bound.density.bw.factor = 3.0,
        gate.bound.density.grid.n = 100,
        gate.bound.density.neigh.size = 3,

        gate.bound.density.max.target = 1,
        gate.bound.density.max.exclusion.corner = 0.05,
        gate.bound.density.max.mad.factor = 3.0,

        gate.region.density.bw.factor = 2.0,
        gate.region.density.grid.n = 100,
        gate.region.density.neigh.size = 2,

        gate.region.max.density.bw.factor = 1.0,
        gate.region.max.density.grid.n = 100,

        rlm.iter.max = 100,
        rlm.trim.factor = 0.01,

        rs.iter.max = 100,

        rs.lambda.coarse = 1.0,
        rs.lambda.fine = 0.1,

        rs.delta.history.n = 10,

        rs.delta.threshold.untr = 1e-2,
        rs.delta.threshold.tran = 1e-4,
        rs.delta.threshold.change = 1e-6,

        # directory parameters

        figure.scatter.dir.base = NULL,

        figure.gate.dir = NULL,

        figure.compensation.dir = NULL,
        figure.convergence.dir = NULL,
        figure.spillover.dir = NULL,
        figure.slope.error.dir = NULL,
        figure.skewness.dir = NULL,

        table.compensation.dir = NULL,
        table.convergence.dir = NULL,
        table.spillover.dir = NULL,
        table.slope.error.dir = NULL,
        table.skewness.dir = NULL,

        # filename parameters

        marker.file.name = NULL,

        gate.parameter.file.name = "fcs_gate_parameter.csv",
        scatter.parameter.file.name = "fcs_scatter_parameter.csv",
        transformation.parameter.file.name =
            "fcs_transformation_parameter.csv",

        convergence.file.name = "autospill_convergence",

        compensation.file.name = "autospill_compensation",
        spillover.file.name = "autospill_spillover",
        slope.error.file.name = "autospill_slope_error",
        skewness.file.name = "autospill_skewness",

        compensation.popnegpop.file.name = "posnegpop_compensation",
        spillover.popnegpop.file.name = "posnegpop_spillover",
        slope.error.posnegpop.file.name = "posnegpop_slope_error",
        skewness.posnegpop.file.name = "posnegpop_skewness",

        posnegpop.file.label = "posnegpop",

        # table parameters

        rs.save.table.initial = FALSE,
        rs.save.table.every = 0,

        # graphics parameters

        rs.plot.figure.initial = FALSE,
        rs.plot.figure.every = 0,

        data.step = 50e3,

        convergence.color.delta = color.pal[ 7 ],    # brown
        convergence.color.delta.max = color.pal[ 5 ],    # orange
        convergence.color.delta.change = color.pal[ 8 ],    # pink
        convergence.shape.linear = "triangle",
        convergence.shape.biexp = "circle",
        convergence.shape.posnegpop = "triangle open",

        density.color.single = "blue3",
        density.color.initial = color.pal[ 3 ],    # green
        density.color.final = color.pal[ 2 ],    # blue
        density.color.posnegpop = color.pal[ 1 ],    # red
        density.palette.n = 1000,
        density.palette.base.n = 1000000,
        density.palette.base.color = c( "blue", "cyan", "green", "yellow",
            "red" ),

        gate.plot.stage = FALSE,
        gate.tesselation.color = "blue3",

        matrix.marker.color = "blue3",
        matrix.marker.proper.color = "red3",
        matrix.wavelength.min = 300,
        matrix.wavelength.max = 900,

        scatter.plot.scale.other = FALSE,
        scatter.expr.color.unco = "blue",
        scatter.expr.color.comp = "black",
        scatter.scale.breaks.coef = 2.0,
        scatter.ref.line.unco = FALSE,
        scatter.ref.line.color = "green3",
        scatter.ref.line.size.factor = 1.8,

        # parameters for main figures

        figure.width = 8.0,
        figure.height = 6.0,
        figure.margin = 4.0,

        figure.panel.line.size = 0.5,

        figure.axis.text.size = 12.0,
        figure.axis.title.size = 12.0,

        figure.convergence.point.size = 2.0,
        figure.convergence.line.size = 0.8,

        figure.density.line.size = 0.2,

        figure.gate.scale.expand = 0.01,
        figure.gate.point.size = 0.8,
        figure.gate.line.size = 0.5,
        figure.gate.bar.width = 1.0,
        figure.gate.bar.height = 25.0,
        figure.gate.bar.margin = 2.0,

        figure.matrix.point.size = 2.5,
        figure.matrix.line.size = 0.8,

        figure.scatter.alpha.gate.in = 0.8,
        figure.scatter.alpha.gate.out = 0.1,
        figure.scatter.point.size = 0.8,
        figure.scatter.line.size = 0.6,
        figure.scatter.error.label.size = 4.0,
        figure.scatter.error.label.pos.x = 0.90,
        figure.scatter.error.label.pos.y = 0.05,
        figure.scatter.axis.text.size = 12.0,
        figure.scatter.axis.title.size = 12.0,

        # thumbnail parameters

        make.thumbnail = FALSE,

        thumbnail.width = 2.0,
        thumbnail.height = 1.5,
        thumbnail.margin = 2.0,

        thumbnail.panel.line.size = 0.2,

        thumbnail.axis.text.size = 5.0,
        thumbnail.axis.title.size = 5.0,

        thumbnail.convergence.point.size = 0.8,
        thumbnail.convergence.line.size = 0.3,

        thumbnail.density.line.size = 0.4,

        thumbnail.gate.scale.expand = 0.01,
        thumbnail.gate.point.size = 0.3,
        thumbnail.gate.line.size = 0.2,
        thumbnail.gate.bar.width = 0.4,
        thumbnail.gate.bar.height = 6.0,
        thumbnail.gate.bar.margin = 0.0,

        thumbnail.matrix.point.size = 1.0,
        thumbnail.matrix.line.size = 0.3,

        thumbnail.scatter.alpha.gate.in = 0.8,
        thumbnail.scatter.alpha.gate.out = 0.1,
        thumbnail.scatter.point.size = 0.3,
        thumbnail.scatter.line.size = 0.2,
        thumbnail.scatter.error.label.size = 1.8,
        thumbnail.scatter.error.label.pos.x = 0.85,
        thumbnail.scatter.error.label.pos.y = 0.05,
        thumbnail.scatter.axis.text.size = 5.0,
        thumbnail.scatter.axis.title.size = 5.0
    )
}


output_fn="results-macro.pdf"

values1 <- array(dim=c(2,2,5),dimnames=list(c("nokiek","kieker"),c("mean","ci95%"),c(1:5)))
values1["kieker",,] <- c(
c(0.043,0.0012),
c(0.031,0.0031),
c(0.020,0.0012),
c(0.016,0.0005),
c(0.041,0.0023))
values1["nokiek",,] <- c(
c(0.042,0.0012),
c(0.026,0.0012),
c(0.015,0.0012),
c(0.012,0.0005),
c(0.031,0.0023))

values2 <- array(dim=c(2,2,5),dimnames=list(c("nokiek","kieker"),c("mean","ci95%"),c(1:5)))
values2["kieker",,] <- c(
c(0.036,0.0006),
c(0.018,0.0012),
c(0.012,0.0012),
c(0.009,0.0003),
c(0.026,0.0012))
values2["nokiek",,] <- c(
c(0.036,0.0006),
c(0.016,0.0003),
c(0.010,0.0003),
c(0.008,0.0003),
c(0.023,0.0002))

values3 <- array(dim=c(2,2,5),dimnames=list(c("nokiek","kieker"),c("mean","ci95%"),c(1:5)))
values3["kieker",,] <- c(
c(0.036,0.0005),
c(0.017,0.0004),
c(0.011,0.0012),
c(0.009,0.0012),
c(0.024,0.0002))
values3["nokiek",,] <- c(
c(0.035,0.0004),
c(0.016,0.0003),
c(0.009,0.0002),
c(0.008,0.0002),
c(0.022,0.0001))

pdf(output_fn,width=8,height=5,paper="special")
plot.new()
plot.window(xlim=c(0.55,3.45),ylim=c(0,0.06))
title(xlab="Active Cores",ylab="Response time (s)")
legend.labels=c("CreateVehicleEJB","CreateVehicleWS","","Purchase","Manage","Browse")
legend("topright",inset=c(0.0,0.05),legend=legend.labels,fill=TRUE,angle=c(45),density=c(5,10,0,15,20,25),title="Mean response times (with 95% confidence intervals)",ncol=2)
axis(1, at=c(0:4))
axis(2)

##singlecore
for (ce in c(1:5)) {
  rect(0.36+ce*0.18+0.02, 0, 0.36+ce*0.18+0.1, values1["nokiek","mean",ce],angle=45,density=ce*5)
    ciu=values1["nokiek","mean",ce]+values1["nokiek","ci95%",ce]
    cil=values1["nokiek","mean",ce]-values1["nokiek","ci95%",ce]
    lines(c(0.36+ce*0.18+0.04,0.36+ce*0.18+0.08),c(ciu,ciu))
    lines(c(0.36+ce*0.18+0.06,0.36+ce*0.18+0.06),c(ciu,cil))
    lines(c(0.36+ce*0.18+0.04,0.36+ce*0.18+0.08),c(cil,cil))
  rect(0.36+ce*0.18+0.1, 0, 0.36+ce*0.18+0.18, values1["kieker","mean",ce],angle=135,density=ce*5)
    ciu=values1["kieker","mean",ce]+values1["kieker","ci95%",ce]
    cil=values1["kieker","mean",ce]-values1["kieker","ci95%",ce]
    lines(c(0.36+ce*0.18+0.12,0.36+ce*0.18+0.16),c(ciu,ciu))
    lines(c(0.36+ce*0.18+0.14,0.36+ce*0.18+0.14),c(ciu,cil))
    lines(c(0.36+ce*0.18+0.12,0.36+ce*0.18+0.16),c(cil,cil))
}

##dualcore
for (ce in c(1:5)) {
  rect(1.36+ce*0.18+0.02, 0, 1.36+ce*0.18+0.1, values2["nokiek","mean",ce],angle=45,density=ce*5)
    ciu=values2["nokiek","mean",ce]+values2["nokiek","ci95%",ce]
    cil=values2["nokiek","mean",ce]-values2["nokiek","ci95%",ce]
    lines(c(1.36+ce*0.18+0.04,1.36+ce*0.18+0.08),c(ciu,ciu))
    lines(c(1.36+ce*0.18+0.06,1.36+ce*0.18+0.06),c(ciu,cil))
    lines(c(1.36+ce*0.18+0.04,1.36+ce*0.18+0.08),c(cil,cil))
  rect(1.36+ce*0.18+0.1, 0, 1.36+ce*0.18+0.18, values2["kieker","mean",ce],angle=135,density=ce*5)
    ciu=values2["kieker","mean",ce]+values2["kieker","ci95%",ce]
    cil=values2["kieker","mean",ce]-values2["kieker","ci95%",ce]
    lines(c(1.36+ce*0.18+0.12,1.36+ce*0.18+0.16),c(ciu,ciu))
    lines(c(1.36+ce*0.18+0.14,1.36+ce*0.18+0.14),c(ciu,cil))
    lines(c(1.36+ce*0.18+0.12,1.36+ce*0.18+0.16),c(cil,cil))
}

##triplecore
for (ce in c(1:5)) {
  rect(2.36+ce*0.18+0.02, 0, 2.36+ce*0.18+0.1, values3["nokiek","mean",ce],angle=45,density=ce*5)
    ciu=values3["nokiek","mean",ce]+values3["nokiek","ci95%",ce]
    cil=values3["nokiek","mean",ce]-values3["nokiek","ci95%",ce]
    lines(c(2.36+ce*0.18+0.04,2.36+ce*0.18+0.08),c(ciu,ciu))
    lines(c(2.36+ce*0.18+0.06,2.36+ce*0.18+0.06),c(ciu,cil))
    lines(c(2.36+ce*0.18+0.04,2.36+ce*0.18+0.08),c(cil,cil))
  rect(2.36+ce*0.18+0.1, 0, 2.36+ce*0.18+0.18, values3["kieker","mean",ce],angle=135,density=ce*5)
    ciu=values3["kieker","mean",ce]+values3["kieker","ci95%",ce]
    cil=values3["kieker","mean",ce]-values3["kieker","ci95%",ce]
    lines(c(2.36+ce*0.18+0.12,2.36+ce*0.18+0.16),c(ciu,ciu))
    lines(c(2.36+ce*0.18+0.14,2.36+ce*0.18+0.14),c(ciu,cil))
    lines(c(2.36+ce*0.18+0.12,2.36+ce*0.18+0.16),c(cil,cil))
}

invisible(dev.off())


plot.width = {img_width}
plot.height = {img_height}
plot.range = {date_range}
plot.locationid = {locationid}
plot.title = '{plot_title}'
plot.path = '{plot_path}'

date.min <- Sys.Date() - plot.range
type_list <- c(16274, 17887, 17888, 17889)
plot.typeids.str <- paste(type_list, collapse=',')
## Event List ##
event.query <- paste0(
    'SELECT datetime, eventName ',
    'FROM event_list ',
    'WHERE eventGroup in (\'patch\') ',
    'AND datetime > \'', date.min, '\' '
)
event <- sqlQuery(emd, event.query)
event$datetime <- as.POSIXlt(event$datetime, tz='GMT')
do_lines <- TRUE
if(nrow(event)==0){{
    do_lines <- FALSE
}}

## Get Data ##
ec.query <- paste0(
    'SELECT price_date AS `date`, price_time AS `hour`, locationid, typeid, ',
    'SUM(IF(buy_sell=1, price_best, NULL)) AS `SellOrder` ',
    'FROM snapshot_evecentral ',
    'WHERE locationid=', plot.locationid, ' ',
    'AND typeid IN (', plot.typeids.str, ') ',
    'AND price_date > \'', date.min, '\' ',
    'GROUP BY price_date, price_time, typeid'
)
ec <- sqlQuery(emd, ec.query)

odbcClose(emd)
ec$date <- as.Date(ec$date)
ec$typeid <- as.factor(ec$typeid)
ec <- subset(ec, SellOrder > 0)
ec$datetime <- paste(ec$date, ec$hour, sep=' ')
ec$datetime <- as.POSIXlt(ec$datetime, tz='GMT')

## CREST Lookups ##
CREST_BASE = 'https://crest-tq.eveonline.com/'
solarsystem.addr <- paste0(CREST_BASE, 'solarsystems/', plot.locationid, '/')
solarsystem.json <- fromJSON(readLines(solarsystem.addr))
solarsystem.name <- solarsystem.json$name

ec$locationName <- solarsystem.name

type_list <- unique(ec$typeid)
ec$typeName <- NA
for(type.index in 1:length(type_list)){{
    type.name <- ''
    type.id <- type_list[type.index]
    type.addr <- paste0(CREST_BASE, 'inventory/types/', type.id, '/')
    type.json <- fromJSON(readLines(type.addr))
    type.name <- type.json$name
    ec$typeName[ec$typeid==type.id] <- type.name
}}

## Plot Theme ##
theme_dark <- function( ... ) {{
  theme(
    text = element_text(color="gray90"),
    title = element_text(size=rel(2.5),hjust=0.05,vjust=3.5),
    axis.title.x = element_text(size=rel(0.75),hjust=0.5, vjust=0),
    axis.title.y = element_text(size=rel(0.75),hjust=0.5, vjust=1.5),
    plot.margin = unit(c(2,1,1,1), "cm"),
    plot.background=element_rect(fill="gray8",color="gray8"),
    panel.background=element_rect(fill="gray10",color="gray10"),
    panel.grid.major = element_line(colour="gray17"),
    panel.grid.minor = element_line(colour="gray12"),
    axis.line = element_line(color = "gray50"),
    plot.title = element_text(color="gray80"),
    axis.title = element_text(color="gray70"),
    axis.text = element_text(color="gray50",size=rel(1.1)),
    legend.key = element_rect(fill="gray8",color="gray8"),
    legend.background = element_rect(fill="gray8"),
    legend.title = element_text(size=rel(0.6)),
    legend.text = element_text(size=rel(1.1)),
    strip.background = element_rect(fill="#252525"),
    strip.text = element_text(size=rel(1.2))
  ) + theme(...)
}}

uniqueID <- unique(ec$typeid)
ec$SellOrder.smooth <- NA
for(id in uniqueID){{
  prices <- ec$SellOrder[ec$typeid==id]
  smooth <- rollmean(prices, k=24, align='right', fill=NA)
  ec$SellOrder.smooth[ec$typeid==id] <- smooth
}}
plot.data <- ec

## Plot Data ##
plot <- ggplot(
  plot.data,
  aes(
    x=datetime,
    y=SellOrder.smooth,
    color=typeName)
)
plot <- plot +geom_line(
  size=1.5
)
plot <- plot + theme_dark()
plot <- plot + labs(
  title=plot.title,
  fill='Item Name',
  x='date',
  y='price'
)
if(do_lines){{
  plot <- plot + geom_vline(
    xintercept=as.numeric(event$datetime),
    linetype=2,
    color='white'
  )
  plot <- plot + geom_text(
    aes(
      x=datetime,
      y=Inf,
      label=eventName),
    color='white',
    angle=-90,
    vjust=1.2,
    hjust=0,
    data=event,
    inherit.aes=FALSE
  )
}}
plot <- plot + scale_y_continuous(
  position='right'
)
plot <- plot + scale_color_manual(
  values=c(
    "Oxygen Isotopes"="#097686",
    "Hydrogen Isotopes"="#B7090D",
    "Nitrogen Isotopes"="#2169E0",
    "Helium Isotopes"="#EA8B25")
)

## Print Plot To File ##
png(
    plot.path,
    width=plot.width,
    height=plot.height
)
print(plot)
dev.off()


### SET PATHS ----------------------------------------------------------------------------------------------
dir.wrk <- file.path("/Data/Raunak/projects/MESO_peritoneal/task/03_enrichment_analysis")
dir.data <- file.path(dir.wrk, "data")
dir.plot <- file.path(dir.wrk, "plot")
dir.enrichment <- file.path(dir.wrk, "enrichment")

### LOAD LIBRARIES -----------------------------------------------------------------------------------------
library("gplots")
library("RColorBrewer")
library("stringr")

### DEFINE FILE --------------------------------------------------------------------------------------------
file.name <- "enrichment_h.all.v5.0.symbols.txt"

### DEFINE ENVIRONMENT -------------------------------------------------------------------------------------
batch <- "MESO_OUTLIERS_p01"
dir.batch <- file.path(dir.enrichment, batch)
dir.patients <- list.dirs(path=dir.batch, full.names=T, recursive=F)
ids.patients <- list.dirs(path=dir.batch, full.names=F, recursive=F)

### PROCESS EACH PATIENT DATA ------------------------------------------------------------------------------
list.dat <- list()
for(i in 1:length(ids.patients)){
	file.dat <- file.path(dir.patients[i], file.name)
	dat <- read.delim(file.dat, header=T, stringsAsFactors=F)
	dat$ngenes <- unlist(lapply(str_split(dat$overlap.genes, ","), function(x) length(x)))
	dat <- subset(dat, dat$ngenes >= 2)

	if(nrow(dat) != 0){
		list.dat[[i]] <- data.frame(SampleID=ids.patients[i],
									Category=dat$Category,
									pvalue=dat$pvalue,
									fdr=dat$fdr,
									EnrichmentScore=-log10(dat$fdr),
									genes=dat$overlap.genes)
	} else{
		list.dat[[i]] <- data.frame(NULL)
	}
}
df <- do.call(rbind.data.frame, list.dat)
df$SampleID <- as.character(df$SampleID)
df$Category <- as.character(df$Category)
df$genes <- as.character(df$genes)

### CONSTRUCT PATHWAY MATRIX ----------------------------------------------------------------------------------
pathways <- unique(df$Category)
patients <- unique(df$SampleID)
mat <- matrix(0, nrow=length(pathways), ncol=length(patients), dimnames=list(pathways, patients))

for(i in 1:nrow(df)){
	x <- df$Category[i]
	y <- df$SampleID[i]
	mat[x,y] <- df$EnrichmentScore[i]
}

### PLOT PATHWAYS HEATMAP ----------------------------------------------------------------------------------
jColFun <- colorRampPalette(brewer.pal(n = 9, "Blues"))

file.plot <- file.path(dir.plot, "MESO_OUTLIERS_p01_pathway_heatmap_HALLMARKS.pdf")
pdf(file.plot, height=10, width=8)
	heatmap.2(mat,
          col = jColFun(256),
          Colv=TRUE, Rowv=TRUE,
          dendrogram ="both", trace="none",  scale="none",
          cexCol=1, cexRow=0.5, margins = c(5,20),
          hclustfun = function(x) hclust(x, method = "ward.D2"),
          distfun = function(x) dist(x, method = "euclidean"),
          colsep=c(1:200), rowsep=c(1:200),
          sepcolor="black", sepwidth=c(0.0005,0.0005),
          key="FALSE", keysize=0.8, density.info="none", symkey=0)
dev.off()


library(dplyr)
library(data.table)
library(stringr)
library(glue)
library(Matrix)
# home_dir = '/d0-bayes/home/tenggao'
home_dir = '/home/tenggao'
devtools::load_all(glue('{home_dir}/numbat'))

con_washu = readRDS(glue("{home_dir}/paper_data/conos_objects/conos_WASHU.rds"))

cell_annot = fread(glue('{home_dir}/paper_data/cell_annotations/cell_annot_WASHU_march.tsv'), sep = '\t') %>%
    split(.$sample)

count_mat = c()
df = c()

samples = c('47491_Primary', '27522_Relapse_2', '59114_Relapse_1', '37692_Primary', '58408_Primary')

for (sample in samples) {
    count_mat[[sample]] = t(con_washu$samples[[sample]]$misc$rawCounts)
    cells = intersect(cell_annot[[sample]]$cell, colnames(count_mat[[sample]]))
    cell_annot[[sample]] = cell_annot[[sample]] %>% filter(cell %in% cells)
    count_mat[[sample]] = count_mat[[sample]][,cells]
}

load('~/numbat/data/ref_hca_counts.rda')

ref_types = c('NK', 'Macrophage', 'CD4+T', 'CD8+T', 'Myeloid', 'Monocyte', 'B', 'Plasma', 'Dendritic')

ref_counts = rowSums(ref_hca_counts) %>%
    as.matrix %>%
    magrittr::set_colnames('Plasma')

##### InferCNV #####

ref_types = c('Plasma')

ref_counts = ref_counts[,rep(ref_types,2),drop=F]
colnames(ref_counts) = c(paste0(ref_types, '_', 1), paste0(ref_types, '_', 2))

for (sample in samples) {

    for (frac in c(0.1, 0.3, 0.5, 0.7, 0.9)) {

        for (seed in c(0)) {

            set.seed(seed)

            tumor_cells = cell_annot[[sample]] %>% filter(annot == 'T') %>% pull(cell)

            n_cells = length(tumor_cells)

            cells_tumor = cell_annot[[sample]] %>%
                filter(annot == 'T') %>%
                pull(cell) %>% sample(n_cells * frac)

            cells_normal = cell_annot[[sample]] %>%
                filter(annot == 'N') %>%
                pull(cell) %>% sample(n_cells * (1-frac))

            cells = c(cells_normal, cells_tumor)

            # preparing input
            out_dir = glue('{home_dir}/paper_data/infercnv_out/{sample}_{frac}_{seed}')
            dir.create(out_dir, showWarnings = FALSE, recursive = TRUE)
            annot_file = glue('{out_dir}/{sample}_annot.tsv')

            ref_groups = paste0(str_remove(colnames(ref_counts), '_1|_2'), '_ref')

            cell_annot[[sample]] %>%
            filter(cell %in% cells) %>%
            mutate(group = 'Plasma') %>%
            bind_rows(
                data.frame(
                    cell = colnames(ref_counts),
                    group = ref_groups
                )
            ) %>%
            select(cell, group) %>%
            fwrite(annot_file, sep = '\t', col.names = F)

            genes_common = rownames(count_mat[[sample]]) %>% intersect(rownames(ref_counts))

            # run
            infercnv_obj = infercnv::CreateInfercnvObject(
                raw_counts_matrix = cbind(
                        ref_counts[genes_common,,drop=F],
                        count_mat[[sample]][genes_common,cells]
                ),
                annotations_file = annot_file,
                delim="\t",
                gene_order_file="/home/tenggao/inferCNV/hg38_gene_order.txt",
                ref_group_names = unique(ref_groups)
            )

            infercnv_obj = infercnv::run(
                infercnv_obj,
                num_threads = 30,
                cutoff=0.1,
                window_length = 101,
                out_dir=out_dir,
                cluster_by_groups=F,
                denoise=TRUE,
                HMM=TRUE,
                HMM_report_by = "consensus",
                resume_mode=FALSE
            )

        }
    }
}


REBOL [
    Title: "Premultiply"
    Date: 17-Feb-2012/10:51:29+1:00
    Name: none
    Version: none
    File: none
    Home: none
    Author: "David Oliva (commercial)"
    Owner: none
    Rights: none
    Needs: none
    Tabs: none
    Usage: [
		;rs/run/usage 'premultiply
		system/options/binary-base: 32
		print ((probe demultiply #{5522ffaa}) = (probe demultiply2 #{5522ffaa}))
		print ((probe demultiply #{000000005522ffaa}) = (probe demultiply2 #{000000005522ffaa}))
		ARGB: #{
		00000000000000000000000000000000238A9292D7232724ED000000AD171914
		A3999E9E9AD6DBD881DADADC77BDBDC5765F5F637783837E79CFCFCF80ACB4B8
		96332C33A92A2727B15E6262A25D6565C7383C40FF0305069E515451156D6D6D}
		ARGB-ok: #{
		0000000000000000000000000000000023121414D71D201EED000000AD0F100D
		A36164649A818482816E6E6F7758585B762B2B2D773D3D3A7962626280565A5C
		961E191EA91B1919B1414444A23B4040C72B2E31FF0305069E32343215080808}

		print ARGB-ok = premultiply  copy ARGB
		print ARGB-ok = premultiply2 copy ARGB
	]
    Purpose: none
    Comment: none
    History: none
    Language: none
    Type: none
    Content: none
    Email: none
	Require: [
		rs-project 'memory-tools
	]
]

ctx-premultiply: context [
	*lib: load/library dir_lib/premultiply.dll
	r_premultiply: make routine! [*data [integer!] bytes [integer!]] *lib "premultiply"
	r_demultiply:  make routine! [*data [integer!] bytes [integer!]] *lib "demultiply"
	set 'premultiply func[ARGB [binary!] /local bytes][
		bytes: length? ARGB
		if 0 <> (bytes // 4) [make error! "invalid data size to premultiply"]
		r_premultiply address? ARGB bytes
		ARGB
	]
	set 'premultiply2 func[ARGB /local a bytes][
		bytes: length? ARGB
		if 0 <> (bytes // 4) [make error! "invalid data size to premultiply"]
		while [not tail? ARGB][
			a: ARGB/1 / 255
			ARGB: next ARGB
			ARGB: change ARGB to char! (a * ARGB/1)
			ARGB: change ARGB to char! (a * ARGB/1)
			ARGB: change ARGB to char! (a * ARGB/1)
		]
		ARGB: head ARGB
	]

	set 'demultiply func[ARGB [binary!] /local bytes][
		bytes: length? ARGB
		if 0 <> (bytes // 4) [make error! "invalid data size to demultiply"]
		r_demultiply address? ARGB bytes
		ARGB
	]
	set 'demultiply2 func[ARGB [binary!] /local bytes a][
		bytes: length? ARGB
		if 0 <> (bytes // 4) [make error! "invalid data size to demultiply"]
		loop bytes / 4 [
			either 0 = a: first ARGB [
				ARGB: skip ARGB 4
			][
				if error? try [
					a: a * 256
					ARGB: next ARGB
					ARGB: change ARGB to char! min 255 to integer! (shift/left first ARGB 16) / a
					ARGB: change ARGB to char! min 255 to integer! (shift/left first ARGB 16) / a
					ARGB: change ARGB to char! min 255 to integer! (shift/left first ARGB 16) / a
				][
					print ["ERR:" a mold copy/part ARGB 4]
					halt
				]
			]
		]
		ARGB: head ARGB
	]
]


rm(list=ls(all=T));cat("\014");dev.off()

#Libraries
library(AnalystHelper);#devtools::install_github("SwampThingPaul/AnalystHelper")
library(plyr)
library(reshape)
library(zoo);
library(shiny)

library(tmap)
library(rgdal)

#Paths
wd="D:/_GitHub/FCE-BGChemWG/Trends"

GIS.path=paste0(wd,"/GIS")

#Helper variables
N.mw=14.0067
P.mw=30.973762
C.mw=12.0107
utm17=CRS("+proj=utm +zone=17 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs")

# custom functions
read.lter=function(data.package,PASTA,DOI){
  prefix="http://pasta.lternet.edu/package/data/eml/"

  infile1=paste0(prefix,data.package,PASTA,DOI)
  dt1=read.csv(infile1,na.strings=c("-9999","-9999.00","-9999.000"))
  return(dt1)
}

## GIS data
tmap_mode("view")
FCE.LTER.sites=spTransform(readOGR(GIS.path,"ltersites_utm"),utm17)
region.sites=data.frame(SITE=c("SRS-1a","SRS-1b", "SRS-1c", "SRS-1d", "SRS-2", "SRS-3", "SRS-4", "SRS-5", "SRS-6",  "TS/Ph-1a", "TS/Ph-1b", "TS/Ph-2a","TS/Ph-2b", "TS/Ph-3", "TS/Ph-6a", "TS/Ph-6b","TS/Ph-7a", "TS/Ph-7b","TS/Ph-4", "TS/Ph-5", "TS/Ph-8", "TS/Ph-9","TS/Ph-10", "TS/Ph-11"),
                        Region=c(rep("Shark River Slough",9),rep("Taylor Slough",9),rep("Panhandle",3),rep("Florida Bay",3)))
FCE.LTER.sites=merge(FCE.LTER.sites,region.sites,"SITE")

ENP=spTransform(readOGR(GIS.path,"ENP_boundary"),utm17)

## Data Import
dat.sources=data.frame(Dataset=c("LT_ND_Losada_002","LT_ND_Grahl_002","LT_ND_Rubio_002","LT_ND_Rondeau_002"),
                       PASTA=c("1075/8/","1073/12/","1080/8/","1077/3/"),
                       DOI=c("ac7159e66cbad75abb61bd1992f8d2c0","15e6ff92f875a272ba6d98db3f738026","3a84ab2009eda6b73e375aa3ad56da1a","832e5493edf5a5d79d8a60535e26a012"))

fce.losada=with(dat.sources[1,],read.lter("knb-lter-fce/",PASTA,DOI))
fce.losada$Dataset.ID=dat.sources$Dataset[1]
fce.grahl=with(dat.sources[2,],read.lter("knb-lter-fce/",PASTA,DOI))
fce.grahl$Dataset.ID=dat.sources$Dataset[2]
fce.rubio=with(dat.sources[3,],read.lter("knb-lter-fce/",PASTA,DOI))
fce.rubio$Dataset.ID=dat.sources$Dataset[3]
fce.rondeau=with(dat.sources[4,],read.lter("knb-lter-fce/",PASTA,DOI))
fce.rondeau$Dataset.ID=dat.sources$Dataset[4]

fce.grahl=rename(fce.grahl,c("NandN"="N.N"));#renaming NOx column to be consistent with other datasets

fce.wq=rbind(fce.grahl,fce.losada,fce.rondeau,fce.rubio)
fce.wq$Date.EST=date.fun(as.character(fce.wq$DATE),form="%Y-%m-%d")
fce.wq$WY=WY(fce.wq$Date.EST)
fce.wq$dec.year=decimal_date(fce.wq$Date.EST)
fce.wq$hydro.season=FL.Hydroseason(fce.wq$Date.EST)
fce.wq$SITENAME=with(fce.wq,ifelse(substring(fce.wq$SITENAME,1,2)=="TS",paste0("TS/PH",substring(fce.wq$SITENAME,6,7)),as.character(fce.wq$SITENAME)))

fce.wq.sites=data.frame(SITENAME=c(paste0("SRS",c("1a","1c","1d",2,3,4,5,6)),paste0("TS/PH",c("1a","1b",2,3,"6b","6a","7a","7b")),paste0("TS/PH",c(4,5,8)),paste0("TS/PH",c(9,10,11))),
                        Region=c(rep("SRS",8),rep("TS",8),rep("Ph",3),rep("FB","3")))
fce.wq=merge(fce.wq,fce.wq.sites,all.x=T)
fce.wq=subset(fce.wq,Date.EST<date.fun("2018-05-01"))

## Parameter reversals
fce.wq$TPReversal.abs=with(fce.wq,ifelse(is.na(SRP)==T|is.na(TP)==T,0,ifelse(SRP>TP,1,0)))
fce.wq$TPReversal=with(fce.wq,ifelse(is.na(SRP)==T|is.na(TP)==T,0,ifelse(SRP>(TP*1.3),1,0)));# Reversals identified as 1 reversals consistent with TP rule evaluation
fce.wq$OCReversal=with(fce.wq,ifelse(is.na(DOC)==T|is.na(TOC)==T,0,ifelse(DOC>(TOC*1.3),1,0)));
fce.wq$TNReversal=with(fce.wq,ifelse(is.na(N.N+NH4)==T|is.na(TN)==T,0,ifelse((N.N+NH4)>(TN*1.3),1,0)));

##Convert uM concentrations to ug/L (P-species) or mg/L (N and C species)
fce.wq$TP=round((fce.wq$TP*P.mw),4);#convert uM concentration to ug/L
fce.wq$TN=round((fce.wq$TN*N.mw)*0.001,2);#convert uM concentration to mg/L
fce.wq$TOC=round((fce.wq$TOC*C.mw)*0.001,2);#convert uM concentration to mg/L
fce.wq$DOC=round((fce.wq$DOC*C.mw)*0.001,2);#convert uM concentration to mg/L
fce.wq$SRP=with(fce.wq,ifelse(SRP<0.01,0.01,SRP))
fce.wq$SRP=round((fce.wq$SRP*P.mw),4);#convert uM concentration to ug/L
fce.wq$N.N=with(fce.wq,ifelse(N.N<=0,0.01,N.N))
fce.wq$DIN=with(fce.wq,N.N+NH4)
fce.wq$DIN=with(fce.wq,round((DIN*N.mw)*0.001,4));#convert uM concentration to mg/L

names(fce.wq)
id.vars.val=c("SITENAME","Region","Dataset.ID","Date.EST","WY","hydro.season","dec.year")
param.vars.val=c("TP","SRP","TN","DIN","DOC")

fce.wq.stack=melt(fce.wq[,c(id.vars.val,param.vars.val)],id.vars=id.vars.val,variable_name = "parameter")

rev.list=list(fce.wq[,c("SITENAME","Date.EST","TPReversal")],fce.wq[,c("SITENAME","Date.EST","TNReversal")],fce.wq[,c("SITENAME","Date.EST","OCReversal")])
for(i in 1:3){
colnames(rev.list[[i]])=c("SITENAME","Date.EST","Reversal")
}
names(rev.list)=c("TP","TN","OC")

param.list=c("TP","SRP","TN","DIN","DOC")
rev.param.list=c("TP","TP","TN","TN","OC")

fce.wq.stack.qa=data.frame()
for(i in 1:length(param.list)){
  tmp=subset(fce.wq.stack,parameter==param.list[i])
  tmp=merge(tmp,rev.list[[rev.param.list[i]]],c("SITENAME","Date.EST"))
  fce.wq.stack.qa=rbind(fce.wq.stack.qa,tmp)
}
fce.wq.stack.qa=subset(fce.wq.stack.qa,is.na(value)==F)

WQ.WY=ddply(subset(fce.wq.stack.qa,Reversal==0),c("SITENAME","WY","Region","parameter"),summarise,mean.val=mean(value,na.rm=T),GM.val=exp(mean(log(value),na.rm=T)),N.val=N(value))
WQ.WY$dec.yr=with(WQ.WY,WY+0.328);#decimal date for Apirl 30th

## for the shiny
param="TP"
site.val="SRS2"
WY.val=2007

tmp.da.dat=subset(fce.wq.stack.qa,parameter==param&SITENAME==site.val&WY==WY.val)

xlim.val=c(date.fun(c(paste0(WY.val-1,"-05-01"),paste0(WY.val,"-05-01"))))


# install packages
library(tidyverse)
#install.packages("fuzzyjoin")
library(fuzzyjoin)
# if (!requireNamespace("BiocManager", quietly = TRUE))
#   install.packages("BiocManager")
# BiocManager::install("pcaMethods")
library(pcaMethods)
# library(imputeLCMD)
#if (!requireNamespace("BiocManager", quietly = TRUE))
#  install.packages("BiocManager")
#BiocManager::install("biomaRt")
library(biomaRt)
# install.packages("imputeLCMD")
library(imputeLCMD)

# define pipeline
# pg_df: input dataframe
# removeContaminant, removeReverse: whether rows with possible contaminants or reverse sequences, respectively, are kept (if set to false) or removed (if set to true).
# type: type of intensity to extract (possible values: "MS2", "LFQ", "Raw")
# log2t: whether intensities are transformed using log2.
# one_protein_per_row: if set to true, N proteins identified in the same row are split into N different rows.
runMQ <- function(pg_df, removeContaminant = TRUE, removeReverse = TRUE, type = "Raw", log2t = FALSE, one_protein_per_row = FALSE, contaminant_list = NULL) {
  print("Running Part 1 of 6...")
  # create copy of input dataframe
  print("Attempting to create copy of input tibble...")
  out_df <- tibble(pg_df)
  print("Successfully created copy of input tibble.")

  if (removeContaminant & is.null(contaminant_list)) {
    stop("removeContaminant selected, contaminant_list must contain an argument!")
  }

  # create id column
  print("Attempting to detect if id column exists...")
  if ("id" %in% colnames(out_df)) {
    print("id column exists.")
  }
  else {
    print("id column does not exist, attempting to create id column...")
    out_df <- out_df %>%
      mutate(id = row_number())
  }

  # convert "." in columns to " "
  print("Attemtping to convert periods in column names to spaces...")
  names(out_df) <- sub("Protein.IDs", "Protein IDs", names(out_df))
  names(out_df) <- sub("Intensity.", "Intensity ", names(out_df))
  names(out_df) <- sub("LFQ.intensity.", "LFQ intensity ", names(out_df))
  names(out_df) <- sub("MS.MS.count.", "MS/MS count ", names(out_df))
  names(out_df) <- sub("Potential.contaminant", "Potential contaminant", names(out_df))
  names(out_df) <- sub("Gene.names", "Gene names", names(out_df))
  print("Successfully changed column names.")

  # remove unnecessary columns
  print("Attempting to remove unnecessary columns from input tibble...")
  print(paste("Number of columns:", ncol(out_df)))
  if ("MS/MS count" %in% colnames(out_df)) {
    out_df <- out_df %>%
      dplyr::select(-`MS/MS count`)
  }
  out_df <- out_df %>%
    dplyr::select(`Protein IDs`, starts_with("Intensity"), starts_with("LFQ intensity"), starts_with("MS/MS count"), Reverse, `Potential contaminant`, id, -Intensity, -`Gene names`)
  print(paste("Number of columns after removal:", ncol(out_df)))
  print("Successfully removed unnecessary columns from input tibble.")

  # perform log2 transformation, if specified
  # 0 is transformed to -Inf
  if (log2t) {
    print("Attempting to perform log2 transformation on input tibble...")
    out_df <- out_df %>%
      mutate(across(matches("Intensity") | matches("LFQ intensity") | matches("MS/MS count"), log2))
    print("Successfully performed log2 transformation on input tibble.")

    # change -Inf to NA
    print("Attempting to change -Inf values to NA values...")
    is.na(out_df) <- sapply(out_df, is.infinite)
    print("Successfully changed -Inf values to NA values.")
  }
  else {
    # change 0 to NA
    print("Attempting to change 0 values to NA values...")
    is.na(out_df) <- sapply(out_df, is.zero)
    print("Successfully changed 0 values to NA values.")
  }

  # remove columns of other types of intensities
  if (type == "Raw") {
    print("Raw intensity selected, attempting to remove LFQ intensity and MS/MS count columns...")
    print(paste("Number of columns:", ncol(out_df)))
    out_df <- out_df %>%
      dplyr::select(-starts_with("LFQ intensity"), -starts_with("MS/MS count"))
    print(paste("Number of columns after removal:", ncol(out_df)))
    print("Successfully removed LFQ intensity and MS/MS count columns.")
  } else if (type == "LFQ") {
    print("LFQ intensity selected, attempting to remove raw intensity and MS/MS count columns...")
    print(paste("Number of columns:", ncol(out_df)))
    out_df <- out_df %>%
      dplyr::select(-starts_with("Intensity"), -starts_with("MS/MS count"))
    print(paste("Number of columns after removal:", ncol(out_df)))
    print("Successfully removed raw intensity and MS/MS count columns.")
  } else if (type == "MS2") {
    print("MS/MS count selected, attempting to remove raw intensity and LFQ intensity columns...")
    print(paste("Number of columns:", ncol(out_df)))
    out_df <- out_df %>%
      dplyr::select(-starts_with("Intensity"), -starts_with("LFQ intensity"))
    print(paste("Number of columns after removal:", ncol(out_df)))
    print("Successfully removed raw intensity and LFQ intensity columns.")
  } else {
    warning("type should be specified as 'Raw', 'LFQ', or 'MS2'.")
  }

  # remove rows with contaminants and reverses, if specified
  if (removeContaminant) {
    #out_df <- out_df %>%
    #  mutate(temp = c(unlist(str_split(`Protein IDs`, ";")) %in% contaminant_list$`Entry (UniProtAC)`))
    contaminant_col = contaminant_list$`Entry (UniProtAC)`
    out_df_2 <- out_df %>%
      group_by(id) %>%
      separate_rows(`Protein IDs`, sep=";") %>%
      filter(!any(`Protein IDs` %in% contaminant_list$`Entry (UniProtAC)`))
    out_df <- out_df_2 %>%
      summarize(id=unique(id)) %>%
      left_join(out_df)
  }

  if (removeReverse) {
    print("Remove reverses selected, attempting to rows that were potentially reversed...")
    print(paste("Number of rows:", nrow(out_df)))
    out_df <- out_df %>%
      filter(is.na(Reverse))
    print(paste("Number of rows after removal:", nrow(out_df)))
    print("Successfully removed rows that were potentially reversed.")
  }

  out_df <- out_df %>%
    dplyr::select(-`Potential contaminant`, -Reverse)

  # split each row into more rows depending on amount of identified proteins, if one_protein_per_row = TRUE
  if (one_protein_per_row) {
    print("One protein per row selected, attempting to separate each row corresponding to individual proteins...")
    print(paste("Number of rows:", nrow(out_df)))
    out_df <- out_df %>%
      separate_rows(`Protein IDs`, sep = ';')
    print(paste("Number of rows after separations:", nrow(out_df)))
    print("Successfully separated each row corresponding to individual proteins.")
  }

  # output a dataframe
  print("Part 1 of 6 complete, returning tibble...")
  return(out_df)
}

# pg_df: tibble containing protein groups
# mf_df: tibble representing sample manifest
# sample.id.col: name of the column containing sample IDs
# intensity_type: "Raw", "LFQ", or "MS2" (REMOVED)
combine_matrix <- function (pg_df, mf_df, sample.id.col='Sample.ID') {
  print("Running part 2 of 6...")
  print("Attempting to create copy of input tibble...")
  proteingroups <- tibble(pg_df)
  print("Succesfully created copy of input tible.")

  print("Attempting to convert protein groups tibble to long format...")
  print(paste("Number of rows:", nrow(pg_df)))
  print(paste("Number of columns:", ncol(pg_df)))
  # convert protein groups tibble to long format
  proteingroups <- proteingroups %>%
    gather("Sample", "Intensity", starts_with("Intensity"), starts_with("LFQ intensity"), starts_with("MS/MS count"))
  # if (intensity_type == "Raw") {
  #   proteingroups <- proteingroups %>%
  #     gather("Sample", "Intensity", starts_with("Intensity"), starts_with("LFQ intensity"), starts_with("MS/MS count"))
  # } else if (intensity_type == "LFQ") {
  #   proteingroups <- proteingroups %>%
  #     gather("Sample", "LFQ intensity", starts_with("Intensity"), starts_with("LFQ intensity"), starts_with("MS/MS count"))
  # } else if (intensity_type == "MS2") {
  #   proteingroups <- proteingroups %>%
  #     gather("Sample", "MS/MS count", starts_with("Intensity"), starts_with("LFQ intensity"), starts_with("MS/MS count"))
  # } else {
  #   warning("type should be specified as 'Raw', 'LFQ', or 'MS2'.")
  # }
  print(paste("Number of rows after conversion:", nrow(pg_df)))
  print(paste("Number of columns after conversion:", ncol(pg_df)))
  print("Successfully converted protein groups tibble to long format.")

  # add regex column to manifest
  print("Attempting to add regex column to sample manifest tibble...")
  manifest_local <- mf_df %>%
    mutate(Sample.ID.regex = paste("(Intensity|LFQ intensity|MS/MS count)\\s", !!sym(sample.id.col), "\\b", sep=""))

  gsub(".", "[.]", manifest_local$Sample.ID.regex)

  print("Successfully added regex column to the sample manifest tibble.")

  # use left join to add patient diagnosis to sample ID
  print("Attempting to join protein groups and sample manifest tibbles...")
  print(paste("Number of columns:", ncol(pg_df)))
  combined_df <- regex_left_join(proteingroups, manifest_local, by=c(Sample = "Sample.ID.regex"))[-ncol(proteingroups) - ncol(manifest_local)] %>%
    dplyr::select(-!!sym(sample.id.col)) %>%
    distinct()
  print(paste("Number of columns after join:", ncol(pg_df)))
  print("Successfully joined protein groups and sample manifest tibbles.")

  print("Part 2 of 6 complete, returning combined tibble...")
  return(combined_df)
}

# pg_df: tibble containing protein groups
# method: used to determine whether to filter NA values per group by percentage ("percentage") or raw amount ("raw")
# filterGroup: column used to create groups for filtering
# percentageNA: minimum percentage of non-NA entries needed within a filter group in order to keep the protein group
# maxNA: maximum amount of NA values allowed within a filter group that is kept
# log2t: Boolean that specifies whether the data was log2 transformed or not
filter_intensities <- function(pg_df, method='percentage', filterGroup='DIAGNOSIS',percentageNA = 0.5, maxNA=0) {
  print("Running part 3 of 6...")

  # throw error if percentageNA < 0 or > 1
  if (percentageNA < 0 || percentageNA > 1) {
    stop("percentageNA must be between 0 and 1")
  }

  # create NARate column names for every unique diagnosis
  print("Attempting to retrieve unique filter group names...")
  diagnoses <- unique(pull(pg_df, !!sym(filterGroup)))
  print(paste("Number of unique filter groups detected:", length(diagnoses)))
  print("Successfully retrieved unique filter group names.")

  # filter values that do not meet conditions
  # first, create columns of NA counts and total diagnoses for each protein group and diagnosis
  print("Attempting to add MinNARate and MaxNAcount columns...")
  filtered_df <- pg_df %>%
    mutate(MinNARate = 1, MaxNAcount = 0)
  print("Successfully added MinNARate and MaxNAcount columns.")

  print("Attempting to create NARate/NACount columns for every unique diagnosis...")
  print(paste("Number of columns:", ncol(filtered_df)))

  for (i in diagnoses) {
    filtered_df <- filtered_df %>%
      group_by(`Protein IDs`) %>%
      mutate("NACount.{{i}}" := sum((is.na(Intensity) | Intensity == 0) & !!sym(filterGroup) == i), "NARate.{{i}}" := sum((is.na(Intensity) | Intensity == 0) & !!sym(filterGroup) == i)/sum(!!sym(filterGroup) == i))
    filtered_df <- filtered_df %>%
      group_by(`Protein IDs`) %>%
      mutate(MinNARate = min(MinNARate, !!sym(paste0('NARate."', i, '"'))), MaxNAcount = max(MaxNAcount, !!sym(paste0('NACount."', i, '"'))))
  }

  # if (log2t) {
  #   for (i in diagnoses) {
  #     pg_df <- pg_df %>%
  #       group_by(`Protein IDs`) %>%
  #       mutate("NACount.{{i}}" := sum(is.na(Intensity) & !!sym(filterGroup) == i), "NARate.{{i}}" := sum(is.na(Intensity) & !!sym(filterGroup) == i)/sum(!!sym(filterGroup) == i), MinNARate = min(MinNARate, sum(is.na(Intensity) & !!sym(filterGroup) == i)/sum(!!sym(filterGroup) == i)), MaxNAcount = max(MaxNAcount, sum(is.na(Intensity) & !!sym(filterGroup) == i)))
  #   }
  # } else {
  #   for (i in diagnoses) {
  #     pg_df <- pg_df %>%
  #       group_by(`Protein IDs`) %>%
  #       mutate("NACount.{{i}}" := sum(Intensity == 0 & !!sym(filterGroup) == i), "NARate.{{i}}" := sum(is.na(Intensity) & !!sym(filterGroup) == i)/sum(!!sym(filterGroup) == i), MinNARate = min(MinNARate, sum(is.na(Intensity) & !!sym(filterGroup) == i)/sum(!!sym(filterGroup) == i)), MaxNAcount = max(MaxNAcount, sum(is.na(Intensity) & !!sym(filterGroup) == i)))
  #   }
  # }

  print(paste("Number of columns after adding NARate/NAcount columns:", ncol(filtered_df)))
  print("Successfully created NARate/NACount columns for every unique diagnosis.")

  # then, filter based on percentage or raw amount
  if (method == "percentage") {
    print("Filter by percentage selected, attempting to remove rows with all filter groups whose NA rates are lower than specified...")
    print(paste("Number of rows:", nrow(filtered_df)))
    filtered_df <- filtered_df %>%
      filter(MinNARate <= percentageNA)
    print(paste("Number of rows after filtering:", nrow(filtered_df)))
    print("Successfully removed rows with all filter groups whose NA rates are lower than specified.")
  } else if (method == "raw") {
    print("Filter by raw amount selected, attempting to remove rows with all filter groups whose NA counts are lower than specified...")
    print(paste("Number of rows:", nrow(filtered_df)))
    filtered_df <- filtered_df %>%
      group_by(`Protein IDs`, !!sym(filterGroup)) %>%
      filter(MaxNAcount <= maxNA)
    print(paste("Number of rows after filtering:", nrow(filtered_df)))
    print("Successfully removed rows with all filter groups whose NA counts are lower than specified.")
  } else {
    warning("Matrix was not filtered; method was not specified as 'percentage' or 'raw'")
  }

  print("Part 3 of 6 complete, returning filtered tibble...")
  return(filtered_df)
}

# pg_df: tibble containing protein groups
# method: "ppca", "bpca", or "mindet"
# nPcs: number of principal components
# imputeGroup: variable that is used to separate groups for imputation
# intensity_type: raw intensity, LFQ intensity, or MS/MS count
impute <- function(pg_df, method = "ppca", nPcs=3, imputeGroup = "DIAGNOSIS") {
  print("Running part 4 of 6...")

  # split into groups
  print("Attempting to retrieve unique filter group names...")
  diagnoses <- unique(pull(pg_df, !!sym(imputeGroup)))
  print("Successfully retrieved unique filter group names.")

  print("Attempting to create tibbles for imputation...")
  groupdata_df <- pg_df %>%
    dplyr::select(`Protein IDs`, id, Sample, Intensity, !!sym(imputeGroup))
  impute_df <- tibble(groupdata_df) %>%
    ungroup() %>%
    dplyr::select(-!!sym(imputeGroup)) %>%
    spread(Sample, Intensity) %>%
    dplyr::select(-starts_with("Intensity"), -starts_with("LFQ intensity"), -starts_with("MS/MS count"))
  print("Successfully created tibbles for imputation.")
  # impute each group, combine with impute_df
  print("Attempting to perform imputations...")
  if (method == "mindet") {
    groupdata_df <- groupdata_df %>%
      ungroup() %>%
      dplyr::select(-!!sym(imputeGroup)) %>%
      spread(Sample, Intensity) %>%
      dplyr::select(id, starts_with("Intensity"), starts_with("LFQ intensity"), starts_with("MS/MS count"))
    groupdata_df <- groupdata_df %>%
      impute.MinDet()
    impute_df <- impute_df %>%
      inner_join(groupdata_df)
  }
  else {
    for (i in diagnoses) {
      cur_grp <- groupdata_df %>%
        ungroup() %>%
        filter(!!sym(imputeGroup) == i) %>%
        spread(Sample, Intensity) %>%
        dplyr::select(`Protein IDs`, starts_with("Intensity"), starts_with("LFQ intensity"), starts_with("MS/MS count"), id)
      pc <- pca(cur_grp, method=method, nPcs=nPcs)
      impute_df <- impute_df %>%
        inner_join(completeObs(pc), copy=TRUE)
    }
  }

  impute_df <- impute_df %>%
    distinct(id, .keep_all = TRUE)

  print("Successfully performed imputations.")

  # convert to long format
  # print("Attempting to convert tibble with imputations to long format...")
  # print(paste("Number of rows:", nrow(pg_df)))
  # print(paste("Number of columns:", ncol(pg_df)))
  # if (intensity_type == "Raw") {
  #   impute_df <- impute_df %>%
  #     gather("Sample", "Intensity", starts_with("Intensity"), starts_with("LFQ intensity"), starts_with("MS/MS count"))
  # } else if (intensity_type == "LFQ") {
  #   impute_df <- impute_df %>%
  #     gather("Sample", "LFQ intensity", starts_with("Intensity"), starts_with("LFQ intensity"), starts_with("MS/MS count"))
  # } else if (intensity_type == "MS2") {
  #   impute_df <- impute_df %>%
  #     gather("Sample", "MS/MS count", starts_with("Intensity"), starts_with("LFQ intensity"), starts_with("MS/MS count"))
  # } else {
  #   warning("type should be specified as 'Raw', 'LFQ', or 'MS2'.")
  # }
  # print(paste("Number of rows after conversion:", nrow(impute_df)))
  # print(paste("Number of columns after conversion:", ncol(impute_df)))
  # print("Successfully converted tibble with imputations to long format.")

  print("Part 4 of 6 complete, returning imputed tibble...")
  return (impute_df)
}

# pg_df: tibble containing protein groups
# pg_col: column containing name of protein IDs
# server: biomaRt server
# dataset: ensembl dataset
add_bm <- function (pg_df, pg_col = "Protein IDs", server = "useast.ensembl.org", dataset = "hsapiens_gene_ensembl") {
  print("Running part 5 of 6...")

  print("Attempting to initialize biomaRt...")
  mart <- useMart("ensembl")
  mart = useDataset(dataset, mart=mart)
  print("Successfully initialized biomaRt.")

  print("Attempting to retrieve information from biomaRt...")

  # getBM_df <- getBM(attributes=c("hgnc_symbol","description","uniprotswissprot"),filters = "uniprotswissprot",values=pull(pg_df, !!sym(pg_col)),mart=mart)

  pg_df_2 <- pg_df %>%
    separate_rows(`Protein IDs`, sep = ';')

  getBM_df <- getBM(attributes=c("hgnc_symbol","description","uniprotswissprot"),filters = "uniprotswissprot",values=pull(pg_df_2, !!sym(pg_col)),mart=mart)

  getBM_df <- getBM_df %>%
    group_by(uniprotswissprot) %>%
    summarize(hgnc_symbol = paste0(hgnc_symbol, collapse=';'), description = paste0(description, collapse=';'), uniprotswissprot = unique(uniprotswissprot))

  new_df <- pg_df_2 %>%
    left_join(getBM_df, by=c("Protein IDs" = "uniprotswissprot"))

  new_df <- new_df %>%
    dplyr::select(hgnc_symbol, description, `Protein IDs`, id) %>%
    group_by(id) %>%
    summarize(hgnc_symbol = paste0(hgnc_symbol, collapse=';'), description = paste0(description, collapse=';'), `Protein IDs` = paste0(`Protein IDs`, collapse=';'), id = unique(id)) %>%
    right_join(pg_df)

  print("Successfully retrieved information from biomaRt.")

  print("Part 5 of 6 complete, returning updated tibble...")

  return (new_df)
}

# pg_df: tibble with protein groups
# df_type: specified as "metadata" or "matrixx"
output_dfs <- function (pg_df, df_type) {
  print("Running part 6 of 6...")

  out_df <- data.frame(pg_df)

  if (df_type == "matrixx") {
    print("matrixx selected, attempting to create data matrix...")
    row.names(out_df) <- out_df$id
    out_df <- out_df %>%
      dplyr::select(starts_with("Intensity"), starts_with("LFQ.intensity"), starts_with("MS.MS.count"))
    colnames(out_df) <- gsub("\\bIntensity.", "", colnames(out_df))
    colnames(out_df) <- gsub("\\bLFQ.intensity.", "", colnames(out_df))
    colnames(out_df) <- gsub("\\bMS.MS.count.", "", colnames(out_df))
    print("Data matrix successfully created.")
  } else if (df_type == "metadata") {
    print("metadata selected, attempting to create metadata...")
    row.names(out_df) <- out_df$id
    out_df <- out_df %>%
      dplyr::select(!starts_with("Intensity") & !starts_with("LFQ.intensity") & !starts_with("MS.MS.count"))
    print("Metadata successfully created.")
  } else {
    warning("Parameter 'df_type' should be specified as 'metadata' or 'matrixx'!")
  }

  print("Part 6 of 6 complete, returning requested tibble...")
  return(out_df)
}

# read protein group files
print("Attempting to open pgdata.tsv and manifest.tsv...")
pgdata <- read_tsv("ad_m_f_data.tsv")
manifest <- read_tsv("manifest2.tsv")
contaminants <- read_tsv("Contaminants.tsv")
print("Successfully opened pgdata.tsv, manifest.tsv, and Contaminants.tsv.")
pgdata_1 <- runMQ(pgdata, log2t = TRUE, one_protein_per_row = FALSE, removeContaminant = FALSE, removeReverse = TRUE, type="Raw", contaminant_list = contaminants)
pgdata_2 <- combine_matrix(pgdata_1, manifest, sample.id.col='Sample.ID2')
# pgdata_3 <- filter_intensities(pgdata_2, method="raw", maxNA = 5, filterGroup = 'DIAGNOSIS')
pgdata_3 <- filter_intensities(pgdata_2, method = "percentage", percentageNA = 0.5, filterGroup = 'DIAGNOSIS')
pgdata_4 <- impute(pgdata_3, nPcs = 3, method = "bpca", imputeGroup = "DIAGNOSIS")
pgdata_5 <- add_bm(pgdata_4, pg_col = "Protein IDs", server = "useast.ensembl.org", dataset = "hsapiens_gene_ensembl")
matrixx <- output_dfs(pgdata_5, "matrixx")
metadata <- output_dfs(pgdata_5, "metadata")
print("Attempting to write final data to pgdata_processed_2.tsv...")
write_tsv(pgdata_5, "pgdata_processed_2.tsv")
print("Successfully wrote final data to pgdata_processed_2.tsv.")
print("Attempting to write final data matrix to pgdata_matrix_2.rds...")
saveRDS(matrixx, "pgdata_matrix_2.rds")
print("Successfully wrote final data matrix to pgdata_matrix_2.rds.")
print("Attempting to write final metadata to pgdata_metadata_2.rds...")
saveRDS(metadata, "pgdata_metadata_2.rds")
print("Successfully wrote final metadata to pgdata_metadata_2.rds.")