rm(list = ls())
setwd(dirname(parent.frame(2)$ofile))

library(ggplot2)
library(plyr)
library(dplyr)
library(tidyr)
library(readr)
source('./_function_task_expand_name.r')
source('./_compute_summary.r')
source('./_plot_parameter.r')

best.range = 5000

best.model.step.fn = function (errors) {
  best.step = max(length(errors) - best.range, 0) + which.min(tail(errors, best.range))
  if (length(best.step) == 0) {
    return(length(errors))
  } else {
    return(best.step)
  }
}

first.solved.step = function (steps, errors, threshold) {
  index = first(which(errors < threshold))
  if (is.na(index)) {
    return(NA)
  } else {
    return(steps[index])
  }
}

name.output = '../paper/results/simple_function_static_mul_parameter.pdf'
name.output.one.row = '../paper/results/simple_function_static_mul_parameter_onerow.pdf'

data.extracts = rbind(
  c(name.parameter = 'input.size',
    name.reference = 'input.size',
    plot.label='Input Size',
    name.input='../results/function_task_static_mul_input_size.csv'),
  c(name.parameter = 'hidden.size',
    name.reference = 'default',
    plot.label='Hidden Size',
    name.input='../results/function_task_static_mul_hidden_size.csv'),
  c(name.parameter = 'subset.ratio',
    name.reference = 'subset.ratio',
    plot.label='Subset Ratio',
    name.input='../results/function_task_static_mul_subset.csv'),
  c(name.parameter = 'overlap.ratio',
    name.reference = 'overlap.ratio',
    plot.label='Overlap Ratio',
    name.input='../results/function_task_static_mul_overlap.csv')
)

dat.all.rate = NA

for (row in 1:nrow(data.extracts)) {
  eps = read_csv('../results/function_task_static_mse_expectation.csv') %>%
    filter(simple == FALSE & parameter == data.extracts[row, 'name.reference']) %>%
    mutate(
      operation = revalue(operation, operation.full.to.short)
    ) %>%
    select(operation, input.size, overlap.ratio, subset.ratio, extrapolation.range, threshold)

  dat = expand.name(read_csv(data.extracts[row, 'name.input'])) %>%
    filter(model %in% c('NALU', '$\\mathrm{NAC}_{\\bullet}$')) %>%
    mutate(
      model = droplevels(model)
    ) %>%
    merge(eps) %>%
    mutate(
      parameter = !!as.name(data.extracts[row, 'name.parameter'])
    )

  dat.last = dat %>%
    group_by(name, parameter) %>%
    summarise(
      threshold = last(threshold),
      best.model.step = best.model.step.fn(metric.valid.interpolation),
      interpolation.last = metric.valid.interpolation[best.model.step],
      extrapolation.last = metric.test.extrapolation[best.model.step],
      interpolation.step.solved = first.solved.step(step, metric.valid.interpolation, threshold),
      extrapolation.step.solved = first.solved.step(step, metric.test.extrapolation, threshold),
      sparse.error.max = sparse.error.max[best.model.step],
      solved = replace_na(metric.test.extrapolation[best.model.step] < threshold, FALSE),
      model = last(model),
      operation = last(operation),
      seed = last(seed),
      size = n()
    )

  dat.last.rate = dat.last %>%
    group_by(model, operation, parameter) %>%
    group_modify(compute.summary) %>%
    ungroup() %>%
    mutate(
      plot.label = data.extracts[row, 'plot.label'],
      width = max(parameter) / 30
    )

  if (is.na(dat.all.rate)) {
    dat.all.rate = dat.last.rate;
  } else {
    dat.all.rate = rbind(dat.all.rate, dat.last.rate);
  }
}

p = ggplot(dat.all.rate, aes(x = parameter, colour=model)) +
  geom_errorbar(aes(ymin = success.rate.lower, ymax = success.rate.upper, width=width), alpha=0.5) +
  geom_point(aes(y = success.rate.mean)) +
  geom_line(aes(y = success.rate.mean)) +
  scale_color_discrete(labels = model.to.exp(levels(dat.all.rate$model))) +
  scale_y_continuous(name = "Success Rate", limits=c(0,1)) +
  scale_x_continuous(name = element_blank(), limits=c(0,NA)) +
  facet_wrap(~ plot.label, scales='free_x') +
  theme(legend.position="bottom") +
  theme(plot.margin=unit(c(5.5, 10.5, 5.5, 5.5), "points"))
print(p)
ggsave(name.output, p, device="pdf", width = 13.968, height = 9, scale=1.4, units = "cm")

p = ggplot(dat.all.rate, aes(x = parameter, colour=model)) +
  geom_errorbar(aes(ymin = success.rate.lower, ymax = success.rate.upper, width=width), alpha=0.5) +
  geom_point(aes(y = success.rate.mean)) +
  geom_line(aes(y = success.rate.mean)) +
  scale_color_discrete(labels = model.to.exp(levels(dat.all.rate$model))) +
  scale_y_continuous(name = "Success Rate", limits=c(0,1)) +
  scale_x_continuous(name = element_blank(), limits=c(0,NA)) +
  facet_wrap(~ plot.label, scales='free_x', nrow=1) +
  theme(legend.position="bottom") +
  theme(plot.margin=unit(c(5.5, 10.5, 5.5, 5.5), "points"))
print(p)
ggsave(name.output.one.row, p, device="pdf", width = 13.968, height = 5.7, scale=1.4, units = "cm")


#use Rscript --vanilla /datacit/Development/RNAseq_YR/SMAP_fusion/fusionAnalysis_forpaper.r $STAR_FUSION_DIR $SAMPLE
#exemple /datacit/Development/RNAseq_YR/SMAP_fusion/fusionAnalysis_forpaper.r /datacit/Development/RNAseq_YR/SMAP_fusion/ Sample_3

#STAR_FUSION_DIR=commandArgs(trailingOnly=TRUE)[1]
#SAMPLE=commandArgs(trailingOnly=TRUE)[2]

.fuzprocess=function(f,sample){

    y=utils::read.delim(f,sep="\t",header=F,as.is=T,comment.char="",skip=1)
    colnames(y)=gsub("^#","",unlist(strsplit(scan(f,sep='\n',what="character",nlines=1,quiet = T)[1],"\t")))

    suppressWarnings({
        y[,2]=as.integer(	y[,2])
        y[,3]=as.integer(	y[,3])
    })

    y=y[which(!is.na(y[,2])&!is.na(y[,3])),]
    y[,1]=gsub("^#","" 	,y[,1])

    y=y[,which(colSums(is.na(y))<nrow(y) )]
    genes=do.call(rbind,strsplit(y[,1],"--"))
    y = data.frame("LeftGene"=genes[,1],   "RightGene"=genes[,2] ,y,stringsAsFactors=F)

    y$OrgLeftGene = stringr::str_extract(y$LeftBreakpoint,"mmu|hs")
    y$OrgRightGene = stringr::str_extract(y$RightBreakpoint,"mmu|hs")

    y$sample = rep(sample,nrow(y))
    y=unique(y)
    y[order(y[,2],decreasing=T),]
}

.fishersMethod = function(x) stats::pchisq(-2 * sum(log(x)),df=2*length(x),lower=FALSE)
# Function to filter dupplicated fusion (selmaxreads)
.dupFUZ=function(expdat){
    expdat$orderfuz =apply(expdat,1,function(x) paste(as.character(sort(x[c("LeftGene","RightGene")])),collapse="--"))
    expdat$sum=apply(expdat[,c("JunctionReads", "SpanningFrags")],1,sum)
    sym=expdat$orderfuz
    i=order(expdat$sum,decreasing=T)
    oki=i[which(!duplicated(sym[i]))]
    newexpdat=data.frame(expdat[oki,])
    rownames(newexpdat)=sym[oki]
    newexpdat
}

#  utils
.getlast=function(x){return(x[length(x)])}
.cmess=function(...,sep=" "){message(paste(...,sep=sep))}
.cstop=function(...,sep=" "){stop(paste(...,sep=sep))}

#' Title
#'  SMAPfuz
#'
#'
#'
#' @param STAR_FUSION_DIR defines the path to the STAR fusion output directory.
#' @param specieOfInterestPattern defines for which specie the fusion are analysed.
#' usually human for Paitent Derived Xenograft
#'
#' @description This function aims at defining the best thresholds for cimeric transcripts detection.
#' It is based on an estimation of an H0 distribution of parameters of eahc of the detected fusion transcritps by
#' taking into account the impossibility of observing cross-species fusions and therefore using them
#' to define the parameters of H0.
#' As of now, only the number of spanning fragments and of junction reads are used.
#'
#'
#' @return A data frame containing one fusion per line.
#' In addition to the information given by STAR fusion, 4 colums are added :
#' JunctionReads_Pvalue : the p-value of the junction read
#' SpanningFrags_Pvalue : the p-value of the spanning fragments
#' Combined_pvalue : The combined p-value using fishers method
#' Combined_adj.pvalue : The FDR correction of the combined p-value
#'
#' @examples
#' d=system.file( "extdata","Example_StarFusion_OUTPUT", package = "SMAP")
#'
#' fusions=SMAPfuz(STAR_FUSION_DIR=d,"hs")
#' fusions_filtered=fusions[which(fusions$Combined_adj.pvalue < 0.01),]
#' fusions_filtered=fusions[which(fusions$Combined_adj.pvalue < 0.001),]
#'

SMAPfuz = function(STAR_FUSION_DIR,specieOfInterestPattern="hs"){

    finalfusionFiles="fusion.fusion_candidates.final.abridged"
    unfiltfusionFiles="fusion.fusion_candidates.preliminary.filt_info.abridged"

    sample =  .getlast(strsplit(STAR_FUSION_DIR,"/")[[1]])
    finaldatafile=grep(finalfusionFiles,list.files(STAR_FUSION_DIR),value=T)
    unfiltdatafile=grep(unfiltfusionFiles,list.files(STAR_FUSION_DIR),value=T)

    if(length(finaldatafile)==0 | length(unfiltdatafile)==0 ){
        .cstop("No STAR FUSION files found in the given directory: ",STAR_FUSION_DIR)
    }

    FilteredFuz=.dupFUZ(.fuzprocess(file.path(STAR_FUSION_DIR,finaldatafile),sample))
    UnfiltFuz=.dupFUZ(.fuzprocess(file.path(STAR_FUSION_DIR,unfiltdatafile),sample))

    # HO distribution
    valuecols=c("JunctionReads", "SpanningFrags")
    leftgeneOrgCol="OrgLeftGene"
    rightgeneOrgCol="OrgRightGene"

    humanfuze=FilteredFuz[which(FilteredFuz[,rightgeneOrgCol]==specieOfInterestPattern & FilteredFuz[,leftgeneOrgCol]==specieOfInterestPattern),]

    reads_junc = UnfiltFuz[which(UnfiltFuz[,rightgeneOrgCol] != UnfiltFuz[,leftgeneOrgCol]),valuecols[1]]
    frag_span = UnfiltFuz[which(UnfiltFuz[,rightgeneOrgCol] != UnfiltFuz[,leftgeneOrgCol]),valuecols[2]]
    nb0junc = sum(reads_junc>0)
    nb0span = sum(frag_span>0)
    #print(nb0junc)
    #print(nb0span)

    if(nb0junc<4 & nb0span<4) .cstop("Too few reads support the interspecies-Fusion for H0 calculation")

    if(nb0junc> 2 & nb0span<4){
        print("H0 on junction reads only")
        nulld1=MASS::fitdistr(UnfiltFuz[which(UnfiltFuz[,rightgeneOrgCol] != UnfiltFuz[,leftgeneOrgCol]),valuecols[1]],"negative binomial")$estimate
        humanfuze[[paste(valuecols[1],"_","Pvalue",sep="")]] = 1-stats::pnbinom(humanfuze[[valuecols[1]]],size=nulld1["size"],mu=nulld1["mu"])
        humanfuze[[paste(valuecols[1],"_","adj.pvalue",sep="")]]=stats::p.adjust( humanfuze[[paste(valuecols[1],"_","Pvalue",sep="")]],method="fdr")
        return(humanfuze)
    }
    if(nb0junc>2 & nb0span>2){
        print("H0 on junction reads and Spanning Fragments")
        nulld1=MASS::fitdistr (UnfiltFuz[which(UnfiltFuz[,rightgeneOrgCol] != UnfiltFuz[,leftgeneOrgCol]),valuecols[1]],"negative binomial")$estimate
        nulld2=MASS::fitdistr (UnfiltFuz[which(UnfiltFuz[,rightgeneOrgCol] != UnfiltFuz[,leftgeneOrgCol]),valuecols[2]],"negative binomial")$estimate
        logx=unique(floor(2^(seq(0,10,by=0.1))))
        x=log2(logx+1)
        xd1 <- stats::dnbinom(logx, mu =nulld1["mu"], size = nulld1["size"])
        xd2 <- stats::dnbinom(logx, mu = nulld2["mu"], size = nulld2["size"])
        humanfuze[[paste(valuecols[1],"_","Pvalue",sep="")]] = 1-stats::pnbinom(humanfuze[[valuecols[1]]],size=nulld1["size"],mu=nulld1["mu"])
        humanfuze[[paste(valuecols[2],"_","Pvalue",sep="")]]=1-stats::pnbinom(humanfuze[[valuecols[2]]],size=nulld2["size"],mu=nulld2["mu"])
        humanfuze$Combined_pvalue=apply(humanfuze[,c(paste(valuecols[1],"_","Pvalue",sep=""),paste(valuecols[2],"_","Pvalue",sep=""))],1,.fishersMethod)
        humanfuze$Combined_adj.pvalue=stats::p.adjust(humanfuze$Combined_pvalue,method="fdr")
        X=humanfuze
        X$decisionPvals=cut(X$Combined_adj.pvalue,breaks=c(0,0.001,0.01,0.05,0.1,1),include.lowest=T)
        FPvals=cbind(UnfiltFuz[which(UnfiltFuz[,rightgeneOrgCol] != UnfiltFuz[,leftgeneOrgCol]),valuecols[1]],
        UnfiltFuz[which(UnfiltFuz[,rightgeneOrgCol] != UnfiltFuz[,leftgeneOrgCol]),valuecols[2]])
        colnames(FPvals)=valuecols
        xmax=ceiling(log2(1+max(UnfiltFuz[,valuecols[1]])))
        logx=unique(floor(2^(seq(0,xmax,by=0.1))))
        xd1 <- stats::dnbinom(logx, mu =nulld1["mu"], size = nulld1["size"])
        xx=log2(logx+1)
        ymax=ceiling(log2(1+max(UnfiltFuz[,valuecols[2]])))
        logy=unique(floor(2^(seq(0,ymax,by=0.1))))
        xd2 <- stats::dnbinom(logy, mu = nulld2["mu"], size = nulld2["size"])
        xy=log2(logy+1)
        #pdf(paste(STAR_FUSION_DIR,"/", SAMPLE,"/SMAPFusions_fusionsAnalysis_filternDecisionThreshPval.pdf", sep=""))

        par(fig=c(0,0.8,0,0.75),mar=c(5.1,4.1,1,1))
        smoothScatter(log2(FPvals+1),transformation = function(x) x^.2,xlim=c(0,ymax),ylim=c(0,xmax) )
        points(log2(X[,valuecols]+1),col=rev(c("black","purple","red","orange","green"))[as.integer(X$decisionPvals)],pch=16)
        legend("topright",paste(c(">0.1","<0.1","<0.05","<0.01","<0.001"),"(fdr)"),col=c("black","purple","red","orange","green"),pch=16, cex=0.9)
        par(fig=c(0.8,1,0,0.75),new=T,mar=c(5.1,1,4.1,1))
        barplot(xd1,xx,type="l",axes=T,bty="l",horiz=T,xlab="Prob. distribution")
        par(fig=c(0,0.8,0.75,1),new=T,mar=c(1,4.1,3,1))
        barplot(xd2,xy,type="l",axes=T,bty="l",main="Parametric p-values (negative binomial)",ylab="Prob. distribution")
        #dev.off()

    }

    # isfilt=unlist(lapply(1:nrow(humanfuze),function(i){
    #  thisfuz=humanfuze[i,]
    #  js=which(filtfuz$X.fusion_name == thisfuz$X.fusion_name &
    #             filtfuz$sample == thisfuz$sample &filtfuz$LeftBreakpoint == thisfuz$LeftBreakpoint
    #           &filtfuz$RightBreakpoint == thisfuz$RightBreakpoint&filtfuz$Splice_type == thisfuz$Splice_type )
    #  length(js)
    #}))
    # humanfuze$PassStarFusion =isfilt>0
    return(humanfuze)

}


# Copyright 2019 Observational Health Data Sciences and Informatics
#
# This file is part of LcmmOhdsi
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

#' set arguments for lcmm
#' @param fixedArg          should be one integer
#' @param mixtureArg        should be vector of integer
#' @param randomArg         should be vector of integer
#' @param classNum          should be vector of integer. Default is 2 to 7 (2:7)
#' @param randomSeed        should be one integer
#' @export
#'
setLcmm <- function(fixedArg= c(2),
                                       mixtureArg= c(1,2),
                                       randomArg= c(1,2),
                                       classNum= 2:7,
                                       randomSeed = 1234){
    if(sum(mixtureArg>fixedArg)) stop ('Every element in mixtureArg should be equal to or less than the fixedArg')
    if(sum(randomArg>fixedArg)) stop ('Every element in mixtureArg should be equal to or less than the fixedArg')
    if(length(randomSeed)>1)
        stop ('random seed must be one')
    result <-split(expand.grid(
        fixedArg = fixedArg,
        mixtureArg = mixtureArg,
        randomArg = randomArg,
        classNum=classNum,
        randomSeed=randomSeed
    ),1:(length(fixedArg)*length(mixtureArg)*length(randomArg)*length(classNum)))

    class(result) <- "lcmmModelSettings"
    return(result)
}

#' run lcmm
#' @param modelSettings          resultant list from the setLcmm function
#' @param data        should be vector of integer
#' @param randomArg         should be vector of integer
#' @param classNum          should be vector of integer. Default is 2 to 7 (2:7)
#' @param randomSeed        should be one integer
#' @export
#'
runLcmm<- function(modelSettings,data){
    #if(class(modelSettings)!="lcmmModelSettings") stop ('modelSettings should be a resultant list from the setLcmm function')

    switch(modelSettings$fixedArg,
           {fixedFormula = "covariateValue ~ timeId"},
           {fixedFormula = "covariateValue ~ timeId + I(timeId^2)"},
           {fixedFormula = "covariateValue ~ timeId + I(timeId^2) + I(timeId^3)"})

    switch(modelSettings$mixtureArg,
           {mixtureFormula = "~ timeId"},
           {mixtureFormula = "~ timeId + I(timeId^2)"},
           {mixtureFormula = "~ timeId + I(timeId^2) + I(timeId^3)"})

    switch(modelSettings$randomArg,
           {randomFormula = "~ timeId"},
           {randomFormula = "~ timeId + I(timeId^2)"},
           {randomFormula = "~ timeId + I(timeId^2) + I(timeId^3)"})

    classNum = modelSettings$classNum
    set.seed(modelSettings$randomSeed)
    result<-lcmm::hlme(fixed = as.formula(fixedFormula),
                       mixture =as.formula(mixtureFormula),
                       random = as.formula(randomFormula),
                       subject = "rowId",
                       ng = classNum,
                       data = data)

    return (list (fixedFormula = fixedFormula,
                  mixtureFormula = mixtureFormula,
                  randomFormula = randomFormula,
                  classNum = classNum,
                  result = result)
    )
}


library(data.table)

source('../../functions.r')

load('../generated/model/mcmc-results.rdata', v=F)

spp <- fread('../acap-species-list.csv')[base_species == T]
setkeyv(spplist, 'code.sra')

c('wasg', 'DIX', 'South Georgia'),
c('wasg', 'DIX', 'South Georgia'),

mc_attributes[vartype=='apf_t' & role=='quarter0_spatial2' & species_code=='DIX', .N, .(species_code, site)]
mcsel <- mcmc[variable %in% mc_attributes[role == 'flag_quarter0_spatial0' & vartype == 'apf_t', variable]]
mcsel <- merge(mcsel, mc_attributes, by = 'variable', all.x=T, all.y=F)
apf_samples <- mcsel[, .(apf = sum(value)), .(species_code, sample)]

apf_samples[spplist,
            `:=`(cname = upper1st(i.cname),
                 sname = i.Taxa),
            on = c('species_code' = 'code.sra')]

saveRDS(apf_samples, '../generated/apf-samples.rds')

apf_sp_summ <- apf_samples[
  , .(mean     = mean(apf),
      median   = median(apf),
      sd       = sd(apf),
      lcl      = quantile(apf, 0.025, names=F),
      ucl      = quantile(apf, 0.975, names=F),
      nsamples = .N), .(species_code)]

apf_sp_summ[spplist,
            `:=`(common_name = upper1st(i.cname),
                 sname = i.Taxa),
            on = c('species_code' = 'code.sra')]
setorder(apf_sp_summ, -mean)

fwrite(apf_sp_summ, '../generated/apf-summary.csv')

## * Aggregated spatial APF
#TBC
mcsel <- mcmc[variable %in% mc_attributes[role == 'flag_quarter0_spatial1' & vartype == 'apf_t', variable]]
mcsel <- merge(mcsel, mc_attributes, by = 'variable', all.x=T, all.y=F)
apf_samples <- mcsel[, .(apf = sum(value)), .(grid_id)]

## ** Risk

risk_ratio <- merge(pst_samples, apf_samples, by = c('species_code', 'sample'))
risk_ratio[, riskratio := apf / pst]

## ** Summarise
risk_summ <- risk_ratio[, .(pst_mean = mean(pst),
                            pst_lcl  = quantile(pst, 0.025, names = F),
                            pst_ucl  = quantile(pst, 0.975, names = F),
                            apf_mean = mean(apf),
                            apf_lcl  = quantile(apf, 0.025, names = F),
                            apf_ucl  = quantile(apf, 0.975, names = F),
                            rr_med  = median(riskratio),
                            rr_lcl   = quantile(riskratio, 0.025, names = F),
                            rr_ucl   = quantile(riskratio, 0.975, names = F),
                            rr_p_ov_1 = mean(riskratio > 1)), species_code]
risk_summ[, `:=`(pst_ci = sprintf('%s--%s',
                                  format(round(pst_lcl,1), big.mark=' ', trim=T),
                                  format(round(pst_ucl,1), big.mark=' ', trim=T)),
                 apf_ci = sprintf('%s--%s',
                                  format(round(apf_lcl), big.mark=' ', trim=T),
                                  format(round(apf_ucl), big.mark=' ', trim=T)),
                 rr_ci = sprintf('%s--%s',
                                 format(round(rr_lcl,2), big.mark=' ', trim=T),
                                 format(round(rr_ucl,2), big.mark=' ', trim=T)))]

risk_summ <- merge(spplist[, .(species_code=code.sra, sname=Taxa, cname)], risk_summ, by = 'species_code')

saveRDS(risk_ratio, '../generated/risk-ratios.rds')
fwrite(risk_summ, '../generated/risk-ratios-summary.csv')


###plot pysim5g lookup tables
# install.packages("tidyverse")
library(tidyverse)
library(plyr)
library(ggpubr)
#####################

#get folder directory
folder <- dirname(rstudioapi::getSourceEditorContext()$path)

#get path to full tables via the data folder
full_tables <- file.path(folder, '..', 'data', 'raw', 'pysim5g', 'full_tables')

#get a list of all files in the folder ending in .csv
myfiles = list.files(path=full_tables, pattern="*.csv", full.names=TRUE)

#import data for all files in file list
data = ldply(myfiles, read_csv)

#select the ISD of 10000m to plot
data = data[data$inter_site_distance_m == 10000,]

data = data[data$frequency_GHz != 1.8 & data$frequency_GHz != 3.7 ,]

#drop results over 5km distance
data = data[data$r_distance <= 5000,]

#turn env into factor and relabel
data$environment = factor(data$environment, levels=c("urban",
                                                     "suburban",
                                                     "rural"),
                                            labels=c("Urban",
                                                     "Suburban",
                                                     "Rural"))

#subset the data for plotting
data = select(data, environment, frequency_GHz, ant_type, r_distance, spectral_efficiency_bps_hz, capacity_mbps, capacity_mbps_km2)

#plot data
#locally estimated scatterplot smoothing
#https://ggplot2.tidyverse.org/reference/geom_smooth.html
pysim5g_plot_se = ggplot(data, aes(x=r_distance/1000, y=spectral_efficiency_bps_hz, colour=factor(frequency_GHz))) +
  geom_point() +
  geom_smooth() +
  scale_x_continuous(expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0)) +
  theme(legend.position="bottom") + guides(colour=guide_legend(ncol=7)) +
  labs(title = 'Spectral Efficiency vs User Distance', x = NULL, y='Spectral Efficiency (Bps/Hz)', colour='Frequency (GHz)\n(10MHz BW)') +
  facet_wrap(~environment)

#plot data
#locally estimated scatterplot smoothing
#https://ggplot2.tidyverse.org/reference/geom_smooth.html
pysim5g_plot_capacity = ggplot(data, aes(x=r_distance/1000, y=capacity_mbps, colour=factor(frequency_GHz))) +
  geom_point() +
  geom_smooth() +
  scale_x_continuous(expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0)) +
  theme(legend.position="bottom") + guides(colour=guide_legend(ncol=7)) +
  labs(title = 'Channel Capacity vs User Distance', x = NULL, y='Capacity (Mbps)', colour='Frequency (GHz)\n(10MHz BW)') +
  facet_wrap(~environment)

#plot data
#locally estimated scatterplot smoothing
#https://ggplot2.tidyverse.org/reference/geom_smooth.html
pysim5g_plot_capacity_km2 = ggplot(data, aes(x=r_distance/1000, y=capacity_mbps_km2, colour=factor(frequency_GHz))) +
  geom_point() +
  geom_smooth() +
  scale_x_continuous(expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0)) +
  theme(legend.position="bottom") + guides(colour=guide_legend(ncol=7)) +
  labs(title = 'Area Capacity vs User Distance', x = "Distance (km)", y='Capacity (Mbps/km^2)', colour='Frequency (GHz)\n(10MHz BW)') +
  facet_wrap(~environment)

panel = ggarrange(pysim5g_plot_se, pysim5g_plot_capacity, pysim5g_plot_capacity_km2,
                  common.legend = TRUE, legend = 'bottom', ncol = 1, nrow = 3)

path = file.path(folder, 'figures', 'pysim5g_panel.png')
ggsave(path, units="in", width=8, height=10, dpi=300)
print(panel)
dev.off()


# This defines the global environment for the shiny app
libs = c("data.table","igraph","visNetwork")
lapply(libs, library, character.only=T)
# Load the dynamic library
if (!is.loaded("ProcessNYPhilJSON")) {
  dyn.load("nyphilLibrary.so")
}

yvec = read.csv("philyears.csv", stringsAsFactors=F, header=F)[,1]

BaseDir = getwd()
HomeDir = getwd()

ColorList = list(rp=rgb(0.8,0.6,0.7), vm=rgb(0.8,0.4,0), bg=rgb(0,0.6,0.5), yl=rgb(0.95,0.9,0.25), bl=rgb(0,0.45,0.7),
               or=rgb(0.9,0.6,0), sb=rgb(0.35,0.7,0.9)
)

# MakeNetwork creates a network plot based on the Go output
MakeNetwork <- function(goOutput) {
  composerNames = goOutput[[2]]
  networkFrom = goOutput[[3]][[1]]
  networkTo = goOutput[[3]][[2]]
  connectionStrength = goOutput[[3]][[3]]
  composerCount = goOutput[[3]][[4]]

  composerNodes = data.table(id=composerNames, value=composerCount, title=composerNames)
  composerEdges = data.table(from=networkFrom, to=networkTo, width=connectionStrength*2, color.opacity=connectionStrength, color="black")

  #Make an Igraph object for clustering
  CompIgraph = graph_from_data_frame(d=composerEdges, vertices=composerNodes, directed=F)
  CompClust = cluster_fast_greedy(CompIgraph, weights=connectionStrength)
  #Extract the clusters
  ClustSum = communities(CompClust)

  #Set the colors of the clusters to each composers
  if (length(ClustSum) <= 7) { #we can set the colors
    composerNodes$color = rep(0, length(composerNames))
    for (i in 1:length(ClustSum)) {
      composerNodes$color[which(composerNodes$id %in% ClustSum[[i]])] = ColorList[[i]]
    }
  }

  cnet = visNetwork(composerNodes, composerEdges, main="Composer Coperformance Network") %>%
    visIgraphLayout(layout="layout_with_lgl") %>%
    visOptions(highlightNearest=T, selectedBy="id")
  return(cnet)
}


# This code creates the summary statistics tables
# for COVID-19 pandemic in Saint Petersburg, Russia
# paper
library(data.table)
library(lubridate)
library(stringi)
library(stringr)
library(stargazer)
library(fastDummies)

# Declare working directory beforehand in an environment variable
# SPB_COVID_STUDY_PATH = "path_to_your_folder"
# with the aid of usethis::edit_r_environ()
# Restart R session for the changes to make effect
setwd(Sys.getenv('SPB_COVID_STUDY_PATH'))

#######
# Load and prepare the serosurvey data
# (see the estimation code in analysis/wave*/create_serosurvey_data_for_model_fit.r)

waves <- c(1, 1.5, 2, 3)

# Init an object to store the seroprevalence data
serosurvey_data_bywave_list <- list()

# Load the per-wave data and store them in one object
for(w in waves) {

	source(paste0("code/analysis/wave", w , "/create_serosurvey_data_for_model_fit.r"))

	# Make variables conformable across the waves
	if( w %in% c(1, 1.5) ) {

		serosurvey_data[, education_level := factor(education_level, ordered = F)]
		serosurvey_data[ education_level %in% c("Complete secondary education", "Primary education"), education_level := "Primary / secondary education"]
		serosurvey_data[, education_level := droplevels(education_level)]

	}

	setnames(serosurvey_data, "offered_taxi", "encouragement", skip_absent = T)
	setnames(serosurvey_data, "lenta_card", "encouragement", skip_absent = T)
	serosurvey_data[ , wave := NULL ]

	serosurvey_data_bywave_list[[ as.character(w) ]] <- serosurvey_data

	rm(serosurvey_data)

}

# Aggregate the results
serosurvey_data_bywave <- rbindlist(serosurvey_data_bywave_list, idcol = "wave", fill = T)
serosurvey_data_bywave[, wave := as.numeric(wave)]

# Full encouragement in wave 1.5
serosurvey_data_bywave[ wave %in% c(1.5), encouragement := 1]
# No encouragement in wave 3
serosurvey_data_bywave[ wave %in% c(3), encouragement := 0]

# Load paper survey data from wave 1 to get data on smoking
load("data/wave1/paper_survey/paper_survey_data_matched_to_phone_survey_ids.rdata")
serosurvey_data_bywave <- merge(serosurvey_data_bywave, unique(paper_survey_data_matched_to_phone_survey_ids[, c("ID", "smoking_now")]), by = "ID", all.x = T, all.y = F)
serosurvey_data_bywave[ is.na(smoking) & !is.na(smoking_now) & wave %in% c(1, 1.5, 3), smoking := smoking_now ]
serosurvey_data_bywave[, smoking_now := NULL]

# Define regressors to include in the table
summary_stat_regressors <- "agegroup + male + highereduc + higherincome + lives_alone + washing_hands_more + was_sick + selftested_covid + smoking + encouragement + was_vaccinated + IgG_testB + IgA_or_G_or_M_testC + IgG_or_M_testD"
summary_stat_regressors_list <- str_trim(unlist(strsplit(summary_stat_regressors, "+", fixed = T)))

# Create a new object with selected variabes
# and expand their dummies for each wave
## Wave 1: overall
wave1_overall <- serosurvey_data_bywave[wave == 1, summary_stat_regressors_list, with = F]
wave1_overall <- dummy_cols(wave1_overall, remove_first_dummy = F, remove_most_frequent_dummy = F, ignore_na = T, remove_selected_columns = T)

## Wave 1: tested
wave1_tested <- serosurvey_data_bywave[wave == 1 & agreed_and_tested == 1, summary_stat_regressors_list, with = F]
wave1_tested <- dummy_cols(wave1_tested, remove_first_dummy = F, remove_most_frequent_dummy = F, ignore_na = T, remove_selected_columns = T)

## Wave 1.5: tested
wave1.5_tested <- serosurvey_data_bywave[wave == 1.5 & agreed_and_tested == 1, summary_stat_regressors_list, with = F]
wave1.5_tested <- dummy_cols(wave1.5_tested, remove_first_dummy = F, remove_most_frequent_dummy = F, ignore_na = T, remove_selected_columns = T)

## Wave 2: overall
wave2_overall <- serosurvey_data_bywave[wave == 2, summary_stat_regressors_list, with = F]
wave2_overall <- dummy_cols(wave2_overall, remove_first_dummy = F, remove_most_frequent_dummy = F, ignore_na = T, remove_selected_columns = T)

## Wave 2: tested
wave2_tested <- serosurvey_data_bywave[wave == 2 & agreed_and_tested == 1, summary_stat_regressors_list, with = F]
wave2_tested <- dummy_cols(wave2_tested, remove_first_dummy = F, remove_most_frequent_dummy = F, ignore_na = T, remove_selected_columns = T)

## Wave 3: tested
wave3_tested <- serosurvey_data_bywave[wave == 3 & agreed_and_tested == 1, summary_stat_regressors_list, with = F]
wave3_tested <- dummy_cols(wave3_tested, remove_first_dummy = F, remove_most_frequent_dummy = F, ignore_na = T, remove_selected_columns = T)

# Produce a set of tables with summary statistics
waves <- c("wave1_overall", "wave1_tested", "wave1.5_tested", "wave2_overall", "wave2_tested", "wave3_tested")

# Export the results to designated .tex files
for( w in waves ) {

	#stargazer(get(w), type = "latex", summary = T, out = paste0("temp/summary_statistics_", w, ".tex"), summary.stat = c("n", "mean"), float = T, multicolumn = F)

}


library(tidyverse)
library(cowplot)
library (brms)
options (mc.cores=parallel::detectCores ()) # Run on multiple cores
# library(nnet)
# devtools::install_github('michael-franke/bayes_mixed_regression_tutorial/faintr', build_vignettes = TRUE)
library(faintr)

d = read_csv("../../data/06_sentence_select_with_training/data_raw_final.csv")

# check comments
d$comments %>% unique

# participants (gender, age...)
d %>% select(submission_id, gender) %>% unique() %>% group_by(gender) %>% summarize(count = n())
mean(d$age)
sd(d$age)

##########################################
# allocation to conditions
##########################################

message("Nr. of submissions for each co-player type:")
show(table(d$coplayer_type)/122)

##########################################
## color blindness
##########################################

color_blindness = filter(d, trial_type == "color_blindness_test") %>%
  select(submission_id, correct, response) %>%
  mutate(correct = ifelse(correct == response,1,0)) %>%
  group_by(submission_id) %>%
  summarize(color_blind = mean(correct) < 1)
color_blindness_failures = filter(color_blindness, color_blind == TRUE) %>% pull(submission_id)
message("Number of failures on color blindness test: ", length(color_blindness_failures))

# add info to full data set
d = full_join(d, color_blindness, by = "submission_id")

# inspect colorblind failures for gravity:

filter(d, color_blind == TRUE, trial_type == "color_blindness_test") %>%
  select(submission_id, correct, response)

## we do not exlcude anybody for a severe color-blindness

##########################################
# inspect data from training with feedback
##########################################

success_threshold = 0.5

d_training = filter(d, trial_type == "sentence_completion_training")

d_training_summary = d_training %>%
  mutate(winning_move = ifelse(coplayer_type == "unstrategic", "red", "green"),
         winning_move_chosen = ifelse(winning_move == response, 1, 0),
         loosing_move = ifelse(coplayer_type == "unstrategic", "green", "red"),
         loosing_move_chosen = ifelse(loosing_move == response, 1, 0),
         distractor_move_chosen = ifelse(response == "false", 1, 0)) %>%
  group_by(submission_id, coplayer_type, condition) %>%
  summarize(win = mean(winning_move_chosen),
            loose = mean(loosing_move_chosen),
            dstrct = mean(distractor_move_chosen)) %>%
  ungroup() %>%
  gather(key = response, value = proportion, win, loose, dstrct) %>%
  mutate(new_col_names = paste0("train_", condition, "_", response)) %>%
  select(submission_id, coplayer_type, new_col_names, proportion) %>%
  spread(key = new_col_names, value = proportion) %>%
  group_by(submission_id) %>%
  mutate(
    training_score = mean(c(train_all_win, train_none_win)),
    training_successful = ifelse(training_score > success_threshold, 1, 0)
    ) %>%
  ungroup()

# show distribution of training scores (average sucess)
d_training_summary %>% ggplot(aes(x = training_score)) + geom_histogram() + facet_grid( ~coplayer_type)

d_training_summary %>%
  group_by(coplayer_type) %>%
  summarize(mean_score = mean(training_score))

d = full_join(d, select(d_training_summary, - coplayer_type), by = "submission_id")

message("Nr learned from training?")
d %>% select(submission_id, coplayer_type, training_successful) %>%
  unique() %>%
  group_by(coplayer_type, training_successful) %>%
  summarize(count = n()) %>% show()

##########################################
# inspect data from TVJ task
##########################################

control_threshold = 0.7
semprag_threshold = 0.5

d_tvj = filter(d, trial_type == "truth_value_judgements") %>%
  mutate(response = ifelse(response == "true", 1, 0))

d_tvj_summary = d_tvj %>%
  group_by(submission_id, trigger, condition) %>%
  summarize(mean_true = mean(response)) %>%
  arrange(submission_id) %>%
  ungroup() %>%
  mutate(new_col_names = paste0("tvj_", trigger, "_", condition)) %>%
  select(submission_id, new_col_names, mean_true) %>%
  spread(key = "new_col_names", value = mean_true)

d_tvj_controls = d_tvj %>%
  filter( condition != "implicature" ) %>%
  group_by(submission_id, trigger, condition) %>%
  summarize(mean_true = mean(response)) %>%
  arrange(submission_id) %>%
  ungroup() %>%
  mutate(control_score = ifelse(condition == "true", mean_true, 1-mean_true)) %>%
  group_by(submission_id) %>%
  summarize(tvj_control_mean = mean(control_score),
            tvj_control_fail = ifelse(tvj_control_mean < control_threshold, 1, 0))

message("Number of people who performed really badly in the TVJ: ",
        d_tvj_controls$tvj_control_fail %>% sum())

d_tvj_implicatures = d_tvj %>%
  filter( condition == "implicature", trigger != "number" ) %>%
  group_by(submission_id, trigger, condition) %>%
  summarize(mean_true = mean(response)) %>%
  group_by(submission_id) %>%
  summarize(tvj_implicature_mean = mean(mean_true),
            tvj_semprag_type = ifelse(tvj_implicature_mean <= semprag_threshold,
                                      "pragmatic", "semantic"))

message("Number of participants who expected co-player to interpret pragmatically in TVJ: ",
        sum(d_tvj_implicatures$tvj_semprag_type == "pragmatic"))

d = full_join(d, d_tvj_summary, by = "submission_id")
d = full_join(d, d_tvj_controls, by = "submission_id")
d = full_join(d, d_tvj_implicatures, by = "submission_id")

# exclude bad performers
d = filter(d, tvj_control_fail == 0)

##########################################
# looking at how many combinations we got
##########################################

d %>% filter(tvj_control_fail == 0) %>%
  select(submission_id,
         coplayer_type,
         training_successful,
         tvj_semprag_type,
         tvj_control_fail) %>%
  unique() %>%
  group_by(coplayer_type, training_successful, tvj_semprag_type) %>%
  summarize(count = n()) %>% show()

# e = d %>% filter(tvj_control_fail == 0) %>%
#   select(submission_id,
#          coplayer_type,
#          training_successful,
#          tvj_semprag_type,
#          tvj_control_fail) %>%
#   unique()
# View(e)

##########################################
# plot main data as a function of
# behavioral types in other parts
##########################################

get_group_plot = function(sp_type = "pragmatic", success = 1) {
  group_data = filter(d,
                      trial_type == "sentence_completion",
                      # coplayer_type != "cooperative",
                      # color_blind == FALSE,
                      tvj_semprag_type == sp_type,
                      training_successful == success) %>%
    mutate(condition = factor(condition, ordered = T,
                              levels = c("all", "none", "number", "ad_hoc", "some")))
  N = group_data$submission_id %>% unique() %>% length()
  group_data %>% ggplot(aes(x = response)) +
    geom_bar(aes( y = ..prop.., group = 1)) +
    coord_flip() +
    facet_grid(coplayer_type ~ condition, scales = "free") +
    ggtitle(paste0(sp_type, " responders with ",
                   ifelse(success, "successful", "unsuccessful"),
                   " training (N=", N, ")"))
}

prag_success = get_group_plot("pragmatic", 1)
prag_fail = get_group_plot("pragmatic", 0)
sem_success = get_group_plot("semantic", 1)
sem_fail = get_group_plot("semantic", 0)

plot_grid(
  prag_success,
  prag_fail,
  sem_success,
  sem_fail,
  labels = c("A", "B", "C", "D"),
  ncol = 2) %>% show()

stop()

######################################################
## logistic regression on "win-move player" proportion
######################################################

## for each triple of player, co-player type and sentence
## determine whether the majority choice (> 50%) was the
## winning move (for that condition)
## --> analyze the proportion of "win-move" players
## as a function of co-player type and sentence

# filter and select the relevant bits for analysis
# code the responses as win/lose/opt_out
d_analysis = filter(d, trial_type == "sentence_completion") %>%
  filter(training_successful == 1) %>%
  mutate(
    rsp = relevel(factor(
      ifelse(coplayer_type == "unstrategic",
             case_when(response == "red" ~ "win",
                       response == "green" ~ "lose",
                       TRUE ~ "opt_out"),
             case_when(response == "green" ~ "win",
                       response == "red" ~ "lose",
                       TRUE ~ "opt_out"))),
      ref = "win"),
    condition = relevel(factor(condition), ref = "all"),
    item = number,
    win_move = ifelse(rsp == "win", 1, 0)
  ) %>%
  select(submission_id, item, coplayer_type, condition, tvj_semprag_type, rsp, win_move)

# threshold of minimal proportion of win-moves a player-condition typle
# needs to be counted as "majority-win-move" choice
winning_threshold = 0.7

# get the "win-move" proportions
d_win_prop = d_analysis %>%
  group_by(submission_id, coplayer_type, condition, tvj_semprag_type) %>%
  summarize(win_move_prop = mean(win_move),
            winner = win_move_prop > winning_threshold)

prior <- c(prior_string("normal(0,10)", class = "b"))
model_win_prop = brm(
  formula = winner ~ coplayer_type * condition * tvj_semprag_type,
  family = "bernoulli",
  data = d_win_prop,
  prior = prior
)

post_samples = posterior_samples(model_win_prop) %>%
  as_tibble() %>%
  select( - lp__)
newcolnames = str_replace(names(post_samples), "b_", "") %>%
  str_replace("condition", "") %>%
  str_replace("coplayer_type", "") %>%
  str_replace("tvj_semprag_type", "")
names(post_samples) = newcolnames

bayesplot::mcmc_intervals(post_samples)

# interpretation
# credibly positive intercept -> majority of win-choices overal
# credibly less win choices in competitive condition (coefs 'strategic' and 'unstrategic')
# credibly less win choices for 'ad hoc' -> seems more complicated
# NO credible difference for 'semantic vs pragmatic' but tendency for 'semantic' to be better
# credibly positive interaction between 'strategic' and 'ad hoc' suggesting (not particularly interesting)
# NO credible difference between 'all' and any other sentence condition (except 'ad hoc') so: 'number' and 'some' were
#   equally successful as the semantic conditions (also no further interactions), at this level of analysis

model_binomial = brm(
  formula = win_move ~ coplayer_type + condition + tvj_semprag_type,
  family = "bernoulli",
  data = d_analysis,
  prior = c(prior_string("normal(0,30)", class = "b"))
)

post_samples_binomial = posterior_samples(model_binomial) %>%
  as_tibble() %>%
  select( - lp__)
newcolnames = str_replace(names(post_samples_binomial), "b_", "") %>%
  str_replace("condition", "") %>%
  str_replace("coplayer_type", "") %>%
  str_replace("tvj_semprag_type", "")
names(post_samples_binomial) = newcolnames

bayesplot::mcmc_intervals(post_samples_binomial)

# prior <- c(prior_string("normal(0,10)", class = "b"))
# model_multinom = brm(
#   formula = rsp ~ coplayer_type + condition + tvj_semprag_type,
#   family = "categorical",
#   data = d_analysis,
#   prior = prior
# )

stop()

##########################################
## multinomial regression
##########################################

d_main = filter(d, trial_type == "sentence_completion") %>%
  mutate(
    rsp = relevel(factor(
      ifelse(coplayer_type == "unstrategic",
             case_when(response == "red" ~ "win",
                       response == "green" ~ "lose",
                       TRUE ~ "opt_out"),
             case_when(response == "green" ~ "win",
                       response == "red" ~ "lose",
                       TRUE ~ "opt_out"))),
      ref = "win"),
    training = relevel(factor(ifelse(training_successful == 1, "success", "failure")), ref = "success"),
    condition = relevel(factor(condition), ref = "all")
  ) %>%
  select(rsp, coplayer_type, training, condition, tvj_semprag_type)

## frequentist model w/o random effects

model_freq = multinom(
  rsp ~ coplayer_type + condition + tvj_semprag_type,
  data = d_main %>% filter(training != "failure") %>% mutate(rsp = ifelse(rsp == "win", "win", "other"))
)

# model_freq = step(model_freq)

z = summary(model_freq)$coefficients / summary(model_freq)$standard.errors
p = (1- pnorm(abs(z), 0, 1)) * 2

c_df = t(summary(model_freq)$coefficients) %>% as.data.frame() %>%
  mutate(coefficient = rownames(t(summary(model_freq)$coefficients))) %>%
  # gather(key = "choice_option", value = "estimate", other) %>%
  gather(key = "coefficient", value = "estimate")

p_df = t(p) %>% as.data.frame() %>%
  mutate(coefficient = rownames(t(p))) %>%
  # gather(key = "choice_option", value = "p_value", lose, opt_out)
  gather(key = "coefficient", value = "p_value")

# model_freq_summary = full_join(c_df, p_df, by = c("coefficient", "choice_option")) %>%
  model_freq_summary = full_join(c_df, p_df, by = c("coefficient")) %>%
  mutate(
    p_value = signif(p_value, 4),
    signif = case_when(p_value < 0.001 ~ "***",
                            p_value < 0.01 ~ "**",
                            p_value < 0.05 ~ "*",
                            TRUE ~ ""))
show(model_freq_summary)

###################################################
## try a logistic regression (win moves vs others)
## where the explanatory factors 'training', 'TVJ'
## are metric
###################################################

d = d %>% mutate(
  rsp = relevel(factor(
    ifelse(coplayer_type == "unstrategic",
           case_when(response == "red" ~ "win",
                     response == "green" ~ "lose",
                     TRUE ~ "opt_out"),
           case_when(response == "green" ~ "win",
                     response == "red" ~ "lose",
                     TRUE ~ "opt_out"))),
    ref = "win"),
  condition = relevel(factor(condition), ref = "all"))

m_exp = glm(family = "binomial",
    formula = rsp ~ training_score + tvj_implicature_mean + condition + coplayer_type,
    data = filter(d, trial_type == "sentence_completion") %>% mutate(rsp = ifelse(rsp == "win", 1, 0 )))

# model_bayes = brm(
#   formula = rsp ~ coplayer_type + training + condition,
#   data = d_main,
#   family = "categorical",
#   prior = c(set_prior ("normal (0, 8)"))
# )


# RGL-Demo: environment mapping
# Author: Daniel Adler

rgl.demo.envmap <- function()
{
  open3d()
  # Clear scene:
  clear3d("all")
  light3d()
  bg3d(sphere=T, color="white", back="filled"
  , texture=system.file("textures/refmap.png",package="rgl")
  )
  data(volcano)

  surface3d( 10*1:nrow(volcano),10*1:ncol(volcano),5*volcano
  , texture=system.file("textures/refmap.png",package="rgl")
  , texenvmap=TRUE
  , color = "white"
  )
}
rgl.demo.envmap()


setwd('/home/jovyan/work/microbial/GO_term_analysis/16_DEC_2020_dmm_troubleshooting_Lee')

library(tidyverse)
library(phyloseq)
<<<<<<< Updated upstream
setwd("./")

raw<-as_tibble(read.table("../Combined_BALF_GO_Terms_parent_propagated.tsv", sep = "\t", row.names = NULL, header = T, quote = "", comment.char = ""))
=======
setwd("C:/Users/jochum/OneDrive - Baylor College of Medicine/Documents/github/microbial/GO_Terms_scripts/")

raw<-as_tibble(read.table("./datasets/Combined_BALF_GO_Terms_parent_propagated_03292021.tsv", sep = "\t", row.names = NULL, header = T, quote = "", comment.char = ""))
>>>>>>> Stashed changes
colnames(raw)<-gsub("NA_tax","unclass", colnames(raw))%>%str_replace_all("NC1_SRR7796663", "NC1.SRR7796663")

df<-raw %>%
  select(GO_term,namespace,depth,name,ends_with("_counts"))%>%
  pivot_longer(cols = -c(GO_term,namespace,depth,name),
               names_to =  c("sample","type","abund"),
               names_pattern = "(.*)_(.*)_(.*)")%>%
  select(-abund)%>%
  filter(value>1)%>%
  pivot_wider(names_from = sample, values_from=value, values_fill=0)

df$depth<-as.character(df$depth)

term<-df%>%filter(type!="NA")%>%filter(type%in%c("bac","arc","vir"))%>%group_by(GO_term,namespace,depth,name)%>%
  summarise(across(.cols = where(is.numeric), sum))

term_tax<-term%>%select(GO_term,namespace,depth,name)
term_tax<-data.frame(term_tax, row.names=1)
term_counts<-data.frame(term[5:172], row.names = term$GO_term)

term_counts_phy <- otu_table(term_counts, taxa_are_rows=TRUE)
term_tax_phy <- tax_table(as.matrix(term_tax), errorIfNULL=TRUE)

<<<<<<< Updated upstream
term_sam<-as.data.frame(read.table("../Combined_BALF_GO_Terms_metadata3.txt",header = T, sep = "\t",row.names = 1))
=======
term_sam<-as.data.frame(read.table("./datasets/Combined_BALF_GO_Terms_metadata_03292021.tsv",header = T, sep = "\t",row.names = 1))
>>>>>>> Stashed changes
rownames(term_sam)<-rownames(term_sam)%>%str_replace_all("NC1_SRR7796663", "NC1.SRR7796663")
term_sam$accession<-rownames(term_sam)

term_pseq

term_sam$outcome<-term_sam$outcome%>%
  str_replace_all("recovered", "Recovered")%>%
  str_replace_all("deceased","Deceased")%>%
  str_replace_all('stabilized',"Stabilized")
term_sam$sex<-term_sam$sex%>%
  str_replace_all("M", "male")%>%
  str_replace_all("F", "female")%>%
  str_replace_all("na", "<NA>") # this is mixing the string "<NA>" with actual NAs, probably not related to our problem, but def not a good idea in general

term_pseq <- phyloseq(term_counts_phy, term_tax_phy, sample_data(term_sam))
term_pseq# [ 14581 taxa and 167 samples ] [ 27077 taxa and 167 samples ]

filtme<-c("GO:0003674")
term_pseq <- prune_taxa(taxa=taxa_names(term_pseq)!=filtme, term_pseq)
filtme<-c("GO:0008150")
term_pseq <- prune_taxa(taxa=taxa_names(term_pseq)!=filtme, term_pseq)
term_pseq #[ 14579 taxa and 167 samples ]

term_pseq_no_neg<-term_pseq
term_pseq_no_neg<-subset_samples(term_pseq, sample_type!="neg_control")
term_pseq_no_neg# [ 14579 taxa and 162 samples ]:
term_pseq_no_neg<-subset_samples(term_pseq_no_neg, sample_type!="Unknown")
term_pseq_no_neg#  [ 14579 taxa and 141 samples ]:
term_pseq_no_neg<-subset_samples(term_pseq_no_neg, case!="Control_Sick")
term_pseq_no_neg# [ 14597 taxa and 105 samples ]
term_pseq_no_neg<-subset_samples(term_pseq_no_neg,publication!="Michalovich")
term_pseq_no_neg# [ 14597 taxa and 102 samples ]
term_pseq_no_neg<-subset_samples(term_pseq_no_neg, bioproject!="PRJNA605907")
term_pseq_no_neg# [ 14597 taxa and 86 samples ]
term_pseq_no_neg<-prune_taxa(taxa = taxa_sums(term_pseq_no_neg)>0,x = term_pseq_no_neg)
term_pseq_no_neg# [ 13534 taxa and 86 samples ]
term_pseq_no_neg<-prune_samples(samples = sample_sums(term_pseq_no_neg)>0,x = term_pseq_no_neg)
term_pseq_no_neg# [ 13534 taxa and 86 samples ] # [ 25426 taxa and 86 samples ]
term_pseq_no_neg_gonames<-term_pseq_no_neg

meta<-meta(term_pseq_no_neg)%>%filter(case=="COVID19")
colnames(meta)

tally(sample_name~isolate_name,meta)

tax<-data.frame(tax_table(term_pseq_no_neg))
names<-paste(rownames(tax),tax$name,sep="-")
taxa_names(term_pseq_no_neg)<-names

save.image(file = "./images/0_preprocessing.RDA")

taxa_names(term_pseq_no_neg)

load(file = "./images/0_preprocessing.RDA")

library(mosaic)
library(microbiome)

meta<-as_tibble(meta(term_pseq))

tally(outcome~case=="COVID19",meta)

tally(case~publication=="Zhou",meta)

tally(publication~sample_name,meta)


symbol_size_data <- function(a,symsize=0.2,colour=4) {
  if(dim(a)[1]>0) {
    a <- aggregate(a$setwt,list(a$centlat,a$centlong),sum)
#    a <- a[a$x>0,]
    symbols(a[,2],a[,1],circles=sqrt(a[,3]),add=T,inches=symsize,bg=colour)
  }
}

clean_logbook_data <- function(dat) {
  dat <- dat[,c("trip_id","set_id","flag_id","logdate","lat_long","lon_long","ez_id",
                "in_arch","spc","sch_id","days_sch","set_start","set_end","skj_c","yft_c","bet_c",
                "skj_w","yft_w","bet_w","yft_c_adj","bet_c_adj")]
  return(dat)
}

prepare_logbook_data <- function(dat) {
  dat$latd <- as.numeric(substring(dat$lat, 1, 4))/100
  dat$latd <- floor(dat$latd) + (dat$latd-floor(dat$latd))/0.6
  dat$latd <- ifelse(substring(dat$lat, 5, 5) == "S", -1 * dat$latd, dat$latd)
  dat <- dat[dat$latd <= 0,]

  dat$lond <- as.numeric(substring(dat$lon, 1, 5))/100
  dat$lond <- floor(dat$lond) + (dat$lond-floor(dat$lond))/0.6
  dat$lond <- ifelse(substring(dat$lon, 6, 6) == "W", 360-dat$lond, dat$lond)
  dat <- dat[dat$lond>=140 & dat$lond<250,]

  dat$lat5 <- 5*floor((dat$latd+5)/5)-5
  dat$lon5 <- 5*floor(dat$lond/5)
  dat$latlong <- as.factor(paste(dat$lat5,dat$lon5))
  dat$centlat <- dat$lat5 + 2.5
  dat$centlong <- dat$lon5 + 2.5
  dat <- dat[dat$centlat > -50,]
  dat <- dat[dat$centlat < 50,]
  dat <- dat[dat$centlong > 100,]
  dat <- dat[dat$centlong < 310,]

  dat$reg <- rep(0, length(dat$centlat))
  dat$reg <- ifelse(dat$centlat >= -25 & dat$centlat <   0 & dat$centlong >= 140 & dat$centlong < 180, 1, dat$reg)
  dat$reg <- ifelse(dat$centlat >= -25 & dat$centlat <   0 & dat$centlong >= 180 & dat$centlong < 250, 2, dat$reg)
  dat$reg <- ifelse(dat$centlat >= -40 & dat$centlat < -25 & dat$centlong >= 140 & dat$centlong < 180, 3, dat$reg)
  dat$reg <- ifelse(dat$centlat >= -40 & dat$centlat < -25 & dat$centlong >= 180 & dat$centlong < 250, 4, dat$reg)
  dat$reg <- ifelse(dat$centlat >= -25 & dat$centlat <   0 & dat$centlong >= 250 & dat$centlong < 330, 5, dat$reg)
  dat$reg <- ifelse(dat$centlat >= -40 & dat$centlat < -25 & dat$centlong >= 250 & dat$centlong < 330, 6, dat$reg)

  dat <- dat[dat$reg %in% 1:4,]

  return(dat)
}

prepare_logbook_data_2 <- function(a) {
  a$trip_date <- as.Date(a$trip_date,format="%d/%m/%Y")
  a$trip_yr <- as.numeric(format(a$trip_date,"%Y"))
  a$trip_mon <- as.numeric(format(a$trip_date,"%m"))
  a$set_date <- as.Date(a$logdate,format="%d/%m/%Y")
  a$set_yr <- as.numeric(format(a$set_date,"%Y"))
  a$set_mon <- as.numeric(format(a$set_date,"%m"))
  a$set_qtr <- floor((a$set_mon+2)/3)
  a$set_yrqtr <- a$set_yr + a$set_qtr/4 - 0.125
  return(a)
  }

spatial_overlap_index <- function(samp,catch){
  latlevs <- seq(-12.5,12.5,5);lonlevs <- seq(127.5,207.5,5);
  t1 <- with(samp,tapply(setwt,list(factor(centlat,levels=latlevs),factor(centlong,levels=lonlevs)),sum))
  t2 <- with(catch,tapply(setwt,list(factor(centlat,levels=latlevs),factor(centlong,levels=lonlevs)),sum))
  t1[is.na(t1)] <- 0
  t2[is.na(t2)] <- 0
  r1 <- t1 / sum(t1)
  r2 <- t2 / sum(t2)
  d1 <- sum(abs(r1-r2))
  d2 <- sum(log(((r1[r2>0]-r2[r2>0])^2)/r2[r2>0]))
  d3 <- (sum(t2)/sum(t1))/(sum(t2[t1>0]/(t1[t1>0]))/sum(t1>0))
  return(data.frame(absdiff=d1,propLik=d2,Gulland=d3))
}

symbol_catch_data <- function(a,symsize=0.2,colour=4) {
  if(dim(a)[1]>0) {
    a <- aggregate(a$setwt,list(a$centlat,a$centlong),sum)
    symbols(a[,2],a[,1],circles=sqrt(a[,3]),add=T,inches=symsize,bg=colour)
  }
}


rm(list=ls())
setwd("/Users/davidbeauchesne/Dropbox/PhD/PhD_obj2/Structure_Comm_EGSL/Predict_network/")

# Libraries
    library(reshape2)
    library(tidyr)
    library(dplyr)
    library(sp)
    library(rgdal)

# Add fonts
    #install.packages('showtext', dependencies = TRUE)
    library(showtext)
    showtext.auto()
    xx <- font.files()
    font.add(family = 'Triforce', regular = 'Triforce.ttf')
    font.add(family = 'regText', regular = 'Alegreya-Regular.otf')
    # font.add(family = 'Hylia', regular = 'HyliaSerifBeta-Regular.otf')
    # font.add(family = 'HylianSymbols', regular = 'HylianSymbols.ttf')

# Functions
    source('../../../PhD_RawData/script/function/colorBar.r')
    source('../../../PhD_RawData/script/function/plotEGSL.r')

# Load files
    # Species occurrence probabilities for the St. Lawrence
        predEGSL <- readRDS('../EGSL_species_distribution/RData/predEGSL.rds')

    # EGSL species list from JSDM analysis
        sp <- readRDS('./RData/spEGSL.rds')
        nSp <- nrow(sp) # number of taxa

    # Complete list of EGSL species
        load("../Interaction_catalog/RData/sp_egsl.RData")

    # Network predictions with interactions per cell
        networkPredict <- readRDS('./RData/networkPredict.rds')
        networkFoodWeb <- readRDS('./RData/networkFoodWeb.rds')

    # Load grid
        egsl_grid <- readOGR(dsn = "../../../PhD_obj0/Study_Area/RData/", layer = "egsl_grid") # Load grid

    # Measure link density
        linkDensity <- numeric(length(networkFoodWeb))
        for(i in 1:length(networkFoodWeb)){
            if(is.null(networkFoodWeb[[i]])) {
                next
            } else {
                linkDensity[i] <- sum(networkFoodWeb[[i]]) / nrow(networkFoodWeb[[i]])
            }
        }

# EGSL contour
egsl <- readOGR(dsn = "/Users/davidbeauchesne/Dropbox/PhD/PhD_RawData/data/EGSL", layer = "egsl")
# egsl <- rgeos::gSimplify(egsl, 100, topologyPreserve=TRUE)
# clip <- rgeos::gIntersection(egsl_grid, egsl, byid = TRUE, drop_lower_td = TRUE)

    # Plot
    # Color palette
        rbPal <- colorRampPalette(c('#B8CEED','#0E1B32')) # color palette
        cols <- rbPal(50)[as.numeric(cut(linkDensity, breaks = 50))]
        textCol <- '#21120A'

        # pdf('/users/davidbeauchesne/dropbox/phd/phd_obj2/Structure_Comm_EGSL/Predict_network/communication/linkDensity.pdf', width = 13, height = 13, pointsize = 25) # , units = 'in', res = 300
        png('/users/davidbeauchesne/dropbox/phd/phd_obj2/Structure_Comm_EGSL/Predict_network/communication/linkDensity_CHONeII.png', width = 13, height = 13, pointsize = 25, units = 'in', res = 300)
            layout(matrix(c(1,1,1,0,2,0),ncol=2), width = c(9,1), height = c(3,3,3))
            # layout(matrix(c(1,1,0,1,1,2,1,1,0),ncol=3), width = c(3,3,3), height = c(9,1))
            par(mar = c(0,0,0,0), bg = 'transparent', family = 'regText', col.lab = textCol, col.axis = textCol, col = textCol)
            plot(egsl_grid, col = cols, border = cols)
            # text(x = 527500, y = 950000, labels = 'Link density (l/s)', cex = 1.5, family = 'Triforce', adj = 0.5)
            # text(x = 527500, y = 925000, labels = 'Link density (l/s)', cex = 2, family = 'Triforce', adj = 1)
            plot(egsl, border = 'black', col = 'transparent', add = TRUE) # plot EGSL contour
            # colorBar(rbPal(50), min = round(min(linkDensity, na.rm = T),1), max = round(max(linkDensity, na.rm = T),1), align = 'horizontal')
            colorBar(rbPal(50), min = round(min(linkDensity, na.rm = T),1), max = round(max(linkDensity, na.rm = T),1), align = 'vertical')
        dev.off()


count = 1024000
bound = 4000000
x <- sample(0:(bound-1), count, replace=T)
for( i in 1:count)
        cat(x[i],"\n")


# cat rf-predict | R --slave --vanilla --args TYPE MODEL TE

library(randomForest)
set.seed(0)

type <- commandArgs(TRUE)[1]
load(commandArgs(TRUE)[2])
csv <- read.csv( commandArgs(TRUE)[3], header=FALSE ); te.x <- csv[,2:ncol(csv)]

if ( 'classify' == type ) {
	response <- predict( rf, te.x, type='response' )
	prob <- predict( rf, te.x, type='prob' )
	write.table( cbind( matrix(response), prob ), col.names=FALSE, row.names=FALSE )
} else {
	response <- predict( rf, te.x, type='response' )
	write.table( response, col.names=FALSE, row.names=FALSE )
}

# vi:nowrap:sw=4:ts=4


# R script
#
# author: Xavier Devroey

library(ggplot2)
library(dplyr)

source('dataclean.r')

colorpalette="Spectral" # Use photocopy friendly colors (http://colorbrewer2.org/)

# ------------------------------
# Functions definition
# ------------------------------

plotFramesPerException <- function(benchmark){
  # Consider only distinct cases
  df <- benchmark %>%
    distinct(application, case, exception_factor, frame_count)
  p <- 	ggplot(df, aes(x=exception_factor, y=frame_count, fill=factor(exception_factor))) +
    geom_boxplot(outlier.shape = NA) +
    xlab("Exception class") +
    ylab("Number of frames") +
    scale_y_log10() +
    guides(fill=FALSE) +
    scale_fill_brewer(palette=colorpalette)
  return(p)
}

plotExceptionsPerApp <- function(benchmark){
  # Consider only distinct cases
  df <- benchmark %>%
    distinct(application, application_name, case, exception_factor) #%>%
    #mutate(application_name = ifelse(application %in% c('math', 'time', 'chart', 'mockito', 'lang'), 'Defects4J', application_name))
  p <- ggplot(df, aes(x=application_name, fill=exception_factor)) +
    #geom_bar(stat="count") +
    geom_bar(position = position_dodge(preserve = 'single')) +
    xlab("") +
    ylab("Number of exceptions") +
    labs(fill="Exception") +
    #scale_y_log10() +
    scale_fill_brewer(palette=colorpalette)
  return (p)
}

plotCCNPerApp <- function(benchmark){
  # Consider only distinct cases
  df <- benchmark %>%
    distinct(application, application_name, application_factor, version, avg_ccn) %>%
    arrange(application_factor, version)
  p <- ggplot(df, aes(x=version, y=avg_ccn, fill=factor(application_factor))) +
    geom_bar(stat = "identity") +
    theme(axis.text.x=element_blank(),
          axis.ticks.x=element_blank()) +
    xlab("Application version") +
    ylab("Average CCN") +
    guides(fill=FALSE) +
    scale_fill_brewer(palette=colorpalette) +
    facet_grid(. ~ application_factor, scales="free_x")
  return (p)
}

plotAvgCCNPerApp <- function(benchmark){
  # Consider only distinct cases
  df <- benchmark %>%
    distinct(application, application_name, application_factor, version, avg_ccn) #%>%
    #mutate(application_name = ifelse(application %in% c('math', 'time', 'chart', 'mockito', 'lang'), 'Defects4J', application_name))
  p <- ggplot(df, aes(x=application_factor, y=avg_ccn, fill=factor(application_factor))) +
    geom_bar(position = "dodge", stat = "summary", fun.y = "mean") +
    geom_point() +
    xlab("") +
    ylab("Average CCN") +
    #scale_y_log10() +
    guides(fill=FALSE) +
    scale_fill_brewer(palette=colorpalette)
  return (p)
}

plotNCSSPerApp <- function(benchmark){
  # Consider only distinct cases
  df <- benchmark %>%
    distinct(application, application_name, application_factor, version, application_ncss=application_ncss/1000 ) %>%
    arrange(application_factor, version)
  p <- ggplot(df, aes(x=version, y=application_ncss, fill=factor(application_factor))) +
    geom_bar(stat = "identity") +
    theme(axis.text.x=element_blank(),
          axis.ticks.x=element_blank()) +
    xlab("Application version") +
    ylab("KNCSS") +
    guides(fill=FALSE) +
    scale_fill_brewer(palette=colorpalette) +
    facet_grid(. ~ application_factor, scales="free_x")
  return (p)
}

plotAvgNCSSPerApp <- function(benchmark){
  # Consider only distinct cases
  df <- benchmark %>%
    distinct(application, application_name, application_factor, case, application_ncss) #%>%
    #mutate(application_name = ifelse(application %in% c('math', 'time', 'chart', 'mockito', 'lang'), 'Defects4J', application_name))
  p <- ggplot(df, aes(x=application_factor, y=application_ncss, fill=factor(application_factor))) +
    geom_bar(position = "dodge", stat = "summary", fun.y = "mean") +
    geom_point() +
    xlab("") +
    ylab("Average NCSS") +
    #scale_y_log10() +
    guides(fill=FALSE) +
    scale_fill_brewer(palette=colorpalette)
  return (p)
}

# ------------------------------
# Main function definition
# ------------------------------

main <- function(){
	benchmark <- getCleanBenchmarkDf('../csv/benchmark.csv')

  # Number of frames per exception boxplot
	p <- plotFramesPerException(benchmark)
	ggsave(plot = p, filename = '../plots/benchmark-frames-per-exception-boxplot.pdf', width=110, height=50, units = "mm" )

	# Number of exceptions per application stacked bar graph
	p <- plotExceptionsPerApp(benchmark)
	ggsave(plot = p, filename = '../plots/benchmark-exceptions-per-app-barchart.pdf', width=110, height=50, units = "mm" )

	# CCN distribution per project
	p <- plotCCNPerApp(benchmark)
	ggsave(plot = p, filename = '../plots/benchmark-ccn-per-app-histogram.pdf', width=200, height=50, units = "mm" )

	# CCN distribution per project
	p <- plotAvgCCNPerApp(benchmark)
	ggsave(plot = p, filename = '../plots/benchmark-ccn-per-app-boxplot.pdf', width=200, height=70, units = "mm" )

	# CCN distribution per project
	p <- plotNCSSPerApp(benchmark)
	ggsave(plot = p, filename = '../plots/benchmark-ncss-per-app-histogram.pdf', width=200, height=50, units = "mm" )

	# CCN distribution per project
	p <- plotAvgNCSSPerApp(benchmark)
	ggsave(plot = p, filename = '../plots/benchmark-ncss-per-app-boxplot.pdf', width=200, height=70, units = "mm" )

}

# ------------------------------
# Program
# ------------------------------

main()


#' Get ADIOS! data and prepare for Plan B smooth
#'
#' Reads in ADIOS! csv file (ADIOS_SV_speciesitis_stock_sex_strat_mean.csv), standardizes series if desired, computes mean of all or user selected surveys, outputs csv file with Year and Mean Index.
#' @param data.dir directory with csv file
#' @param adios.file.name name of ADIOS! csv file (without the .csv extension)
#' @param od directory for output (default=working directory)
#' @param standardize true/false flag to divide by mean of time series (default=FALSE)
#' @param usesurvey vector of true/false to select surveys to average (default=NA which means use all)
#' @param shiftfallflag true/falsee flag for shifting fall survey by one year (default=TRUE)
#' @param narmavgflag true/false flag for na.rm setting in average across multiple surveys (default=FALSE)
#' @param saveplots true/false flag to save output to od (default=FALSE)
#' @param nameplots added to start of saved files (default=""), spaces not recommended
#' @export

ReadADIOS <- function(data.dir,
                      adios.file.name,
                      od                = ".",
                      standardize       = FALSE,
                      usesurvey         = NA,
                      shiftfallflag     = TRUE,
                      narmavgflag       = FALSE,
                      saveplots         = FALSE,
                      nameplots         = ""){

  adios.dat <- read.csv(file.path(data.dir, paste0(adios.file.name,".csv")))

  # check to make sure ADIOS! file
  if(colnames(adios.dat)[1] != "COMMON_NAME"){
    return("This does not appear to be an ADIOS! file, please check to ensure correct file defined")
  }

  # convert adios.dat to format that could be read by ReadRaw
  adios.r <- filter(adios.dat, INDEX_TYPE=="Biomass (kg/tow)") %>%   # select biomass data only
    mutate(Year = ifelse(shiftfallflag == TRUE & SEASON=="FALL",YEAR+1,YEAR),                # shift Fall data ahead 1 year
           PurposeSurvey = paste(PURPOSE_CODE,SURVEY)) %>%           # create survey+season variable
    select(Year, PurposeSurvey, INDEX) %>%                           # keep only needed variables
    spread(key=PurposeSurvey, value=INDEX)                           # convert long to wide format

  # print to screen the survey names in order to facilitate usesurvey variable
  cnames <- colnames(adios.r)
  ncols <- length(cnames)
  print(cbind(1:(ncols-1), cnames[2:ncols]))

  # save the ReadRaw formatted file
  if(saveplots) write.csv(adios.r,
                          file=file.path(od, paste0(nameplots,
                                      "adios_converted_data_",
                                      adios.dat$SPECIES_ITIS[1],"_",
                                      adios.dat$STOCK_ABBREV[1],".csv")),
                          row.names=FALSE)

  # standardize each column, other than year of course, if desired
  adios.s <- adios.r

  if(standardize == TRUE){
    for (i in 2:ncols){
      adios.s[,i] <- adios.r[,i] / mean(adios.r[,i], na.rm=T)
    }
  }

  # calculate row averages of selected columns
  if(is.na(sum(usesurvey))) usesurvey <- rep(TRUE, (ncols - 1))
  colvals <- 2:ncols
  adios.a <- adios.s[, (colvals * usesurvey)] # tricky way to pick the surveys
  if(sum(usesurvey) == 0) return("No surveys selected, change usesurvey option and try again.")
  if(sum(usesurvey) == 1) adios.avg <- data.frame(Year = adios.r[,1],
                                                  avg = adios.a)
  if(sum(usesurvey) >= 2) adios.avg <- data.frame(Year = adios.r[,1],
                                                  avg = apply(adios.a, 1, mean, na.rm = narmavgflag))

  # save csv file of averaged values
  if(saveplots) write.csv(adios.avg,
                          file=file.path(od, paste0(nameplots,
                            "adios_converted_average_",adios.file.name,".csv")),
                          row.names = FALSE)

  return(adios.avg)
#testing
}


# By Yea-Hung Chen

# function for adjustment variables
aa<-function(adj,adj.name=NULL,dd=ii){
  # estimates
  aa<-tapply(dd[,adj],dd$com,function(vv){prop.table(table(vv))['1']})
  aa[is.na(aa)]<-0 # applies if no values are equal to 1
  aa<-data.frame(com=as.numeric(names(aa)),adj=as.numeric(aa))
  if(is.null(adj.name)){adj.name<-adj}
  names(aa)<-gsub('adj',adj.name,names(aa))
  # merge estimates into cc
  cc<-merge(cc,aa,by='com',all.x=TRUE,all.y=FALSE)
  # output estimates
  assign('cc',cc,envir=.GlobalEnv)
}

# function for outcome variables
oo<-function(outcome,method='survival',dd=ii){
  nIndv<-paste('nIndv',outcome,sep='_')
  if(method=='survival'){
    cc[,outcome]<-sapply(cc$com,ss,dd=dd)
    cc[,nIndv]<-sapply(cc$com,function(cc){sum(dd$com==cc)})
  }
  if(method=='rate'){
    cc[,outcome]<-sapply(cc$com,rr,dd=dd)
    cc[,nIndv]<-tapply(dd$rend,dd$com,sum)
  }
  if(method=='annual'){
    cc<-merge(cc,do.call(rbind,lapply(cc$com,yy,cc.var='com',
                                      dd=dd,nn=outcome)),by='com')
  }
  assign('cc',cc,envir=.GlobalEnv)
}

# function for survival
ss<-function(cc,dd,time=TIME){
  dd<-subset(dd,com==cc)
  ss<-with(dd,Surv(time=rend,event=o))
  ee<-survfit(ss~1)
  summary(ee,min(time,max(dd$rend)))$surv
}

# function for rates
rr<-function(cc,dd){
  dd<-subset(dd,com==cc)
  sum(dd$oend<=dd$rend,na.rm=TRUE)/sum(dd$rend,na.rm=TRUE)
}

# function for annual rates
yy<-function(cc,cc.var='com',dd,nn){
  # subset data
  dd<-dd[dd[,cc.var]==cc,]
  # convert survival end dates back to dates
  dd$oend<-dd$start+dd$oend*365.25
  dd$rend<-dd$start+dd$rend*365.25
  # function for incidence
  incidence<-function(start,end){
    # redefine annual risk period
    is.na(dd$rend)<-!is.na(start)&(dd$rend<start)
    end<-pmin(dd$rend,end,na.rm=TRUE)
    # outcome
    oo<-!is.na(dd$oend)&!is.na(start)&!is.na(end)&
      (start<=dd$oend)&(dd$oend<=end)
    # person-time
    tt<-as.numeric(end-start)/365.25
    tt<-ifelse(is.na(tt),0,tt)
    # marker for ending risk within annual risk period
    ee<-(start<=dd$rend)&(dd$rend<=end)
    # output results
    list(oo,tt,ee)
  }
  # year-1 incidence rate
  rr1<-incidence(dd$y1start,dd$y1end)
  oo1<-rr1[[1]]
  tt1<-rr1[[2]]
  ee1<-rr1[[3]]
  is.na(dd$y2start)<-ee1
  is.na(dd$y3start)<-ee1
  is.na(dd$y2end)<-ee1
  is.na(dd$y3end)<-ee1
  # year-2 incidence rate
  rr2<-incidence(dd$y2start,dd$y2end)
  oo2<-rr2[[1]]
  tt2<-rr2[[2]]
  ee2<-rr2[[3]]
  is.na(dd$y3start)<-ee2
  is.na(dd$y3end)<-ee2
  # year-3 incidence rate
  rr3<-incidence(dd$y3start,dd$y3end)
  oo3<-rr3[[1]]
  tt3<-rr3[[2]]
  # entire risk period
  dd$start.min<-pmin(dd$y1start,dd$y2start,dd$y3start,na.rm=TRUE)
  dd$end.max<-pmax(dd$y1end,dd$y2end,dd$y3end,na.rm=TRUE)
  rra<-incidence(dd$start.min,dd$end.max)
  ooa<-rra[[1]]
  tta<-rra[[2]]
  # incidence
  rr1<-sum(oo1)/sum(tt1)
  rr2<-sum(oo2)/sum(tt2)
  rr3<-sum(oo3)/sum(tt3)
  # output incidence rates
  sumoo<-sum(oo1)+sum(oo2)+sum(oo3)
  sumtt<-sum(tt1)+sum(tt2)+sum(tt3)
  if((sum(ooa)==sumoo)&(floor(sum(tta))==floor(sumtt))){
    cc<-data.frame(var=cc)
    names(cc)<-gsub('var',cc.var,names(cc))
    cc[,paste(nn,1,sep='')]<-sum(rr1)
    cc[,paste(nn,2,sep='')]<-sum(rr2)
    cc[,paste(nn,3,sep='')]<-sum(rr3)
    cc[,paste('nIndv_',nn,1,sep='')]<-sum(tt1)
    cc[,paste('nIndv_',nn,2,sep='')]<-sum(tt2)
    cc[,paste('nIndv_',nn,3,sep='')]<-sum(tt3)
    cc
  }
}


# Constructor error message
mu_error <- function() stop("Badly formed 'memuse' object", call.=FALSE)

check_type <- function(type, intsize)
{
  if (type == "double")
    bytes <- 8
  else if (type == "float")
    bytes = 4
  else if (type == "integer")
    bytes <- intsize

  return( bytes )
}

# Function to grab the printable units from the convoluted .units data structure
get_units <- function(x)
{
  return( .units[[x@unit.names]][[x@unit.prefix]][["print"]] )
}

# Get the correct power for the factor that determines which unit is to be used
get_power <- function(x)
{
  units <- get_units(x)

  power <- which(units == x@unit)

  if (length(power) > 0)
    return( power - 1L )
  else
    mu_error()
}

# Convert a memuse object to one stored in bytes
convert_to_bytes <- function(x)
{
  size <- x@size

  n <- which(x@unit == .units[[x@unit.names]][[x@unit.prefix]][["print"]]) - 1

  if (x@unit.prefix == "IEC")
    f <- 1024
  else if (x@unit.prefix == "SI")
    f <- 1e3
  else
    mu_error()

#  size <- size * f^n
  size <- abc(size, f, n)

  x@size <- size
  x@unit <- .units[[x@unit.names]][[x@unit.prefix]][["print"]][1L]

  return( x )
}

# Find the best unit representation for an object
best.unit <- function(x)
{
  if (x@unit.prefix == "IEC"){
    f <- 1024
    fun <- function(x) log2(abs(x))
    dgts <- 10
  } else if (x@unit.prefix == "SI"){
    f <- 1e3
    fun <- function(x) log10(abs(x))
    dgts <- 3
  } else {
    mu_error()
  }

  size <- convert_to_bytes(x)@size

  if (size == 0){
    x@unit.names <- .units[[x@unit.names]][[x@unit.prefix]][["print"]][1L]
    return( x )
  }

  num.digits <-fun(size)

  for (i in seq.int(9)){
    if (num.digits < dgts*i){
      unit <- .units[i]
      break
    }
  }

  size <- size/(f^(i-1))

  x@size <- size
  x@unit <- .units[[x@unit.names]][[x@unit.prefix]][["print"]][i]

  return( x )
}

# stable a*b^c with c an integer
abc <- function(a, b, c)
{
  if (c==0)
    return(a)
  p <- a
  for (i in seq.int(c)){
    p <- p*b
  }

  return( p )
}

# whole number checker
is.int <- function(x)
{
  # IEEE arithmetic gives 52 bit mantissa, so instead of doing that
  # weird shit R suggests in help('is.integer'), we will just use
  # machine epsilon for the tolerance.  Deal with it, nerd.
  # With this tolerance, this is probably equivalent to just doing
  # x==floor(x), but for some reason this makes me less nervous.
  tol <- 2^(-53)

  if (!is.numeric(x))
    return( FALSE )
  else
    return( abs(x - floor(x)) < tol )
}

# return the value or 0 if NULL
val_or_zero <- function(x)
{
  if (is.null(x))
    return(0)
  else
    return(x)
}

# Zero's digits of a string after the first 15 digits
digits2zero <- function(str)
{
  if (nchar(str) <= 15)
    return( str )

  split <- simplify2array(strsplit(x=str, split=""))

  n <- length(split) - 15L
  ret <- paste(paste(split[1L:15L], collapse=""), paste(rep(0, n), collapse=""), collapse="", sep="")

  return( ret )
}


mxstg <- read.table(paste(jaw, "FVBDUHiCD1scores20.txt", sep=""))

mxstg$nid <- as.factor(paste(mxstg$Weight, mxstg$Clutch, sep=""))

mxstg <- subset(mxstg, mxstg$Strain != "CD1")

lf <- Sys.glob("predic*")

combdat <- data.frame(matrix(nrow=0,ncol=20))

for (i in lf){
  lht <- read.table(i)
  lht$sd <- substr(i,(nchar(i)-6), (nchar(i)-4))
  combdat <-rbind(combdat, lht)
}

ndat <- subset(combdat, combdat$sd == "001")
ndat05 <- subset(combdat, combdat$sd == "005")
ndat15 <- subset(combdat, combdat$sd == "015")

ndat$dev05 <- ndat05$dev
ndat$dev15 <- ndat15$dev

names(ndat)[names(ndat) == 'dev'] <- 'dev01'
ndat$ident <- seq(1, nrow(ndat))

ndat$nid <- as.factor(paste(ndat$Weight, ndat$Litter, sep=""))

mxstgp <- left_join(mxstg, ndat, by="nid")

write.csv(ndat, file="ndat.csv")

write.csv(mxstgp, file=paste(jaw, "dat.csv", sep=""))

combdat$correction <- combdat$sd
combdat$correction[combdat$sd == "001"] <- 10
combdat$correction <- as.numeric(combdat$correction)/ 100

combdat$devlev <- case_when(
  combdat$sd == "001" ~ "sd.litter.preg = 0.1",
  combdat$sd == "005" ~ "sd.litter.preg = 0.05",
  combdat$sd == "015" ~ "sd.litter.preg = 0.15")

(p=ggplot(combdat, aes(y=Weight, x=dev, colour=Strain))+
    geom_point() +
    facet_wrap(devlev~Strain, ncol=2)+
    scale_colour_manual(values=c("red3",  "cornflowerblue")) +
    xlab("Computed developmental age (cdpc)")+
    ylab("Embryo Weight (mg)") +
    theme_bw()
)

ggsave(plot=p,height=8, width=8,device="png", file="wtvscdpc.png" )

ggsave(plot=p,height=7, width=5,device="pdf", file=paste(jaw,"allstatedev05.pdf" ,sep="") )


library(challengeR)

##### Sample

data=read.csv("sample_ranking.csv")
challenge=as.challenge(data,by="task",
                        algorithm="alg_name", case="case", value="value",smallBetter = FALSE
                        )
ranking=challenge%>%aggregateThenRank(FUN = mean,
                                      na.treat=0,
                                      ties.method = "min"
)
meanRanks=ranking%>%consensus(method = "euclidean")
ranking%>%report(consensus=meanRanks,
         title="MOOD 2020 - Sample",
         file = "sample_report",
         format = "PDF", # format can be "PDF", "HTML" or "Word"
         latex_engine="pdflatex"#LaTeX engine for producing PDF output. Options are "pdflatex", "lualatex", and "xelatex"
         )

##### Pixel

data=read.csv("pixel_ranking.csv")
challenge=as.challenge(data,by="task",
                        algorithm="alg_name", case="case", value="value",smallBetter = FALSE
                        )
ranking=challenge%>%aggregateThenRank(FUN = mean,
                                      na.treat=0,
                                      ties.method = "min"
)
meanRanks=ranking%>%consensus(method = "euclidean")
ranking%>%report(consensus=meanRanks,
         title="MOOD 2020 - Pixel",
         file = "pixel_report",
         format = "PDF", # format can be "PDF", "HTML" or "Word"
         latex_engine="pdflatex"#LaTeX engine for producing PDF output. Options are "pdflatex", "lualatex", and "xelatex"
         )


suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(broom))
suppressPackageStartupMessages(library(ggplot2))
suppressPackageStartupMessages(library(ggrepel))

source(file.path("utils", "signature_utils.R"))

set.seed(123)

dataset <- "bortezomib"
input_data_dir <- "data"
data_file <- file.path(input_data_dir, "bortezomib_signature_analytical_set.tsv.gz")
feat_file <- file.path(input_data_dir, "dataset_features_selected.tsv")

output_fig_dir = file.path("figures", "anova")
output_results_dir = file.path("results", "signatures")

alpha = 0.05

# Load profiles
bulk_col_types <- readr::cols(
    .default = readr::col_double(),
    Metadata_Plate = readr::col_character(),
    Metadata_Well = readr::col_character(),
    Metadata_cell_count = readr::col_integer(),
    Metadata_batch = readr::col_character(),
    Metadata_clone_number = readr::col_character(),
    Metadata_plate_map_name = readr::col_character(),
    Metadata_treatment = readr::col_character(),
    Metadata_dataset = readr::col_character(),
    Metadata_clone_type = readr::col_character(),
    Metadata_clone_type_indicator = readr::col_character(),
    Metadata_model_split = readr::col_character(),
    Metadata_cell_density = readr::col_character(),
    Metadata_treatment_time = readr::col_character(),
    Metadata_unique_sample_name = readr::col_character(),
    Metadata_time_to_adhere = readr::col_character()
)

data_df <- readr::read_tsv(data_file, col_types = bulk_col_types)

print(dim(data_df))
head(data_df, 4)

# Load feature selected features
all_selected_features_df <- readr::read_tsv(feat_file, col_types = readr::cols())
head(all_selected_features_df, 3)

# Subset dataset
bulk_subset_df <- data_df %>%
    dplyr::filter(
        Metadata_dataset == !!dataset,
        Metadata_model_split == "training",
    )

# Apply feature selection performed in 0.compile-bulk-datasets
selected_features <- all_selected_features_df %>%
    dplyr::filter(dataset == !!dataset) %>%
    dplyr::pull(features)

bulk_subset_df <- bulk_subset_df %>%
    dplyr::select(starts_with("Metadata"), all_of(selected_features))

# Populate the list for signature building
bulk_subset_df$Metadata_clone_type_indicator <- factor(
    bulk_subset_df$Metadata_clone_type_indicator, levels = c("0", "1")
)

# Print dataset description
print(paste("Training dataset:", dataset))
print(table(
    bulk_subset_df$Metadata_clone_number,
    bulk_subset_df$Metadata_batch
))

formula_terms <- paste(
    "~",
    "Metadata_clone_type_indicator", "+",
    "Metadata_treatment_time", "+",
    "Metadata_batch", "+",
    "Metadata_clone_number"
)

cell_count_formula <- paste(
    "~",
    "Metadata_clone_type_indicator", "+",
    "scale(Metadata_cell_count)"
)

# Fit ANOVA to determine sources of variation and process results
lm_results <- perform_anova(bulk_subset_df, formula_terms)

# Order the full results data frame by significance and extract feature names
full_results_df <- lm_results[["full_results_df"]] %>%
    dplyr::arrange(desc(neg_log_p))

features <- unique(full_results_df$feature)

# Perform TukeyHSD posthoc test
tukey_results <- process_tukey(
    aov_list = lm_results[["aovs"]],
    features = features
)

# Fit a linear model on cell counts
cell_count_results <- perform_linear_model(bulk_subset_df, cell_count_formula) %>%
    dplyr::arrange(desc(neg_log_p)) %>%
    dplyr::mutate(dataset = dataset)

# Isolate features that represent significant differences between resistant and senstive clones
anova_results_df <- lm_results[["full_results_df"]] %>%
    dplyr::mutate(dataset = dataset)

tukey_results_df <- tukey_results %>%
    dplyr::mutate(dataset = dataset)

features <- unique(anova_results_df$feature)

num_cp_features <- length(features)
signif_line <- -log10(alpha / num_cp_features)

signif_line

# Derive signature by systematically removing features influenced by technical artifacts
signature_features <- tukey_results_df %>%
    dplyr::filter(term == "Metadata_clone_type_indicator", neg_log_adj_p > !!signif_line) %>%
    dplyr::pull(feature)

# Determine if the clone number comparison is between like-clones
wt_clone_count <- stringr::str_count(
    tukey_results_df %>%
    dplyr::filter(term == "Metadata_clone_number") %>%
    dplyr::pull("comparison"), "WT"
)

# Exclude features with consistent within sensitivity-type clones
feature_exclude_nonspecific_variation <- tukey_results_df %>%
    dplyr::filter(term == "Metadata_clone_number") %>%
    dplyr::mutate(wt_clone_count = wt_clone_count) %>%
    dplyr::filter(neg_log_adj_p > !!signif_line, wt_clone_count != 1) %>%
    dplyr::count(feature) %>%
    dplyr::arrange(desc(n)) %>%
    dplyr::filter(n > 1) %>%
    dplyr::pull(feature)

# Exclude features that are significantly different as explained by batch
feature_exclude_batch <- tukey_results_df %>%
    dplyr::filter(term == "Metadata_batch", neg_log_adj_p > !!signif_line) %>%
    dplyr::pull(feature)

# Exclude features that are significantly impacted by cell count
feature_exclude_cell_count <- cell_count_results %>%
    dplyr::filter(term == "scale(Metadata_cell_count)", neg_log_p > !!signif_line) %>%
    dplyr::pull(feature)

# Exclude features that are significantly impacted by treatment time
feature_exclude_time <- tukey_results_df %>%
    dplyr::filter(term == "Metadata_treatment_time", neg_log_adj_p > !!signif_line) %>%
    dplyr::pull(feature)

# Restrict signature
final_signature_features <- setdiff(
    signature_features, unique(feature_exclude_cell_count)
)
final_signature_features <- setdiff(
    final_signature_features, unique(feature_exclude_nonspecific_variation)
)
final_signature_features <- setdiff(
    final_signature_features, unique(feature_exclude_batch)
)
final_signature_features <- setdiff(
    final_signature_features, unique(feature_exclude_cell_count)
)
final_signature_features <- setdiff(
    final_signature_features, unique(feature_exclude_time)
)
# Create a summary of the signatures
signature_summary_df <- tibble(features)

signature_summary_df <- signature_summary_df %>%
    dplyr::mutate(
        non_status_significant_exclude = !(signature_summary_df$features %in% signature_features),
        batch_exclude = signature_summary_df$features %in% feature_exclude_batch,
        cell_count_exclude = signature_summary_df$features %in% feature_exclude_cell_count,
        non_specific_exclude = signature_summary_df$features %in% feature_exclude_nonspecific_variation,
        treatment_time_exclude = signature_summary_df$features %in% feature_exclude_time,
        final_signature = signature_summary_df$features %in% final_signature_features,
        dataset = dataset
    )

print(paste("For the dataset:", dataset))
print(paste("the number of features in the core signature:", sum(signature_summary_df$final_signature)))

# Determine feature direction
final_signature <- signature_summary_df %>% dplyr::filter(final_signature)

tukey_subset_results_df <- tukey_results_df %>%
    dplyr::filter(
        dataset == !!dataset,
        term == "Metadata_clone_type_indicator",
        feature %in% final_signature$features
    )

up_features <- tukey_subset_results_df %>% dplyr::filter(estimate > 0) %>% dplyr::pull(feature)
down_features <- tukey_subset_results_df %>% dplyr::filter(estimate < 0) %>% dplyr::pull(feature)

# Store signature for downstream analyses
signature_features <- list("up" = up_features, "down" = down_features)

signature_features

anova_output_file <- file.path(output_results_dir, paste0("anova_results_", dataset, "_signature.tsv.gz"))
tukey_output_file <- file.path(output_results_dir, paste0("tukey_results_", dataset, "_signature.tsv.gz"))
cell_count_output_file <- file.path(output_results_dir, paste0("lm_cell_count_results_", dataset, "_signature.tsv.gz"))
signature_output_file <- file.path(output_results_dir, paste0("signature_summary_", dataset, "_signature.tsv.gz"))

anova_results_df %>% readr::write_tsv(anova_output_file)
tukey_results_df %>% readr::write_tsv(tukey_output_file)
cell_count_results %>% readr::write_tsv(cell_count_output_file)
signature_summary_df %>% readr::write_tsv(signature_output_file)


#!/usr/bin/Rscript

## csplot.r -- generates a chromosome "manhattan" plot for a genome-wide statistic

## Author: David Eccles (gringer), 2009 <programming@gringer.org>

usage <- function(){
  cat("usage: ./csplot.r <file> [options]\n");
  cat("\nOther Options:\n");
  cat("-help              : Only display this help message\n");
  cat("-threshold <value> : Only display data greater than <value>\n");
  cat("-pointsize <value> : Multiplier for size of points in graph\n");
  cat("-invert            : Invert values (lowest value at top of graph)\n");
  cat("-normlimit         : Limit value display to a reasonable normal distribution\n");
  cat("-limit <value>     : Trim values greater than <limit>\n");
  cat("-keep <value>      : Keep a proportion of values below the cutoff value\n");
  cat("-label <string>    : Label for Y axis\n");
  cat("\n");
}

dataFile <- FALSE; # marker chromosome location <other fields> value
valThreshold <- 0;
useNormDistForMax <- FALSE;
invertAxis <- FALSE;
trimLimit <- FALSE;
sizeMul <- 2;
filterKeepProp <- 0; # keep this proportion of markers below threshold cutoff
filterRandom <- (filterKeepProp > 0); # keep a random sampling of markers below threshold cutoff
valueText <- expression(chi^2~Value);

argLoc <- 1;
while(!is.na(commandArgs(TRUE)[argLoc])){
  if(file.exists(commandArgs(TRUE)[argLoc])){ # file existence check
    if(dataFile == FALSE){
      dataFile <- commandArgs(TRUE)[argLoc];
    } else{
      cat("Error: More than one input file specified\n");
      usage();
      quit(save = "no", status=1);
    }
  } else {
    parsed <- FALSE;
    if(commandArgs(TRUE)[argLoc] == "-help"){
      usage();
      parsed <- TRUE;
      quit(save = "no", status=0);
    }
    if(commandArgs(TRUE)[argLoc] == "-threshold"){
      valThreshold <- as.numeric(commandArgs(TRUE)[argLoc+1]);
      argLoc <- argLoc + 1;
      cat("Setting value threshold to ",valThreshold,"\n",sep="");
      parsed <- TRUE;
    }
    if(commandArgs(TRUE)[argLoc] == "-pointsize"){
      sizeMul <- as.numeric(commandArgs(TRUE)[argLoc+1]);
      argLoc <- argLoc + 1;
      cat("Setting point size multiplier to ",sizeMul,"\n",sep="");
      parsed <- TRUE;
    }
    if(commandArgs(TRUE)[argLoc] == "-invert"){
      invertAxis <- TRUE;
      cat("Using normal distribution to set upper graph limit\n");
      parsed <- TRUE;
    }
    if(commandArgs(TRUE)[argLoc] == "-normlimit"){
      useNormDistForMax <- TRUE;
      cat("Using normal distribution to set upper graph limit\n");
      parsed <- TRUE;
    }
    if(commandArgs(TRUE)[argLoc] == "-limit"){
      trimLimit <- as.numeric(commandArgs(TRUE)[argLoc+1]);
      argLoc <- argLoc + 1;
      cat("Values greater than ",trimLimit," will be marked at graph extent\n",sep="");
      parsed <- TRUE;
    }
    if(commandArgs(TRUE)[argLoc] == "-keep"){
      filterKeepProp <- as.numeric(commandArgs(TRUE)[argLoc+1]);
      argLoc <- argLoc + 1;
      filterRandom <- (filterKeepProp > 0);
      cat("Including ",filterKeepProp,"x markers below threshold value\n",sep="");
      parsed <- TRUE;
    }
    if(commandArgs(TRUE)[argLoc] == "-label"){
      valueText <- commandArgs(TRUE)[argLoc+1];
      argLoc <- argLoc + 1;
      cat("Setting value text to ",valueText,"\n",sep="");
      parsed <- TRUE;
    }
    if(!parsed){
      cat("Error: unknown argument '",commandArgs(TRUE)[argLoc],"'\n",sep="");
    }
  }
  argLoc <- argLoc + 1;
}

if(dataFile == FALSE){
  cat("Error: No valid file given\n\n");
  usage();
  quit(save = "no", status=1);
}

## Chromosome Statistics -- from http://genome.ucsc.edu/goldenPath/stats.html#hg18
cs.stats <-
  c(1,247249719,224999719,
    2,242951149,237712649,
    3,199501827,194704827,
    4,191273063,187297063,
    5,180857866,177702766,
    6,170899992,167273992,
    7,158821424,154952424,
    8,146274826,142612826,
    9,140273252,120143252,
    10,135374737,131624737,
    11,134452384,131130853,
    12,132349534,130303534,
    13,114142980,95559980,
    14,106368585,88290585,
    15,100338915,81341915,
    16,88827254,78884754,
    17,78774742,77800220,
    18,76117153,74656155,
    19,63811651,55785651,
    20,62435964,59505253,
    21,46944323,34171998,
    22,49691432,34851332,
    23,154913754,151058754, # X
    24,57772954,25652954,   # Y
    25,16571,16571);        # MT
dim(cs.stats) <- c(3,25);
cs.stats <- as.data.frame(t(cs.stats));
colnames(cs.stats) <- c("Chromosome","Assembled","Sequenced");
rownames(cs.stats) <- cs.stats$Chromosome;
cs.stats$startPoint <- c(0,cumsum(as.numeric(cs.stats$Assembled)))[-length(cs.stats$Assembled)];

cat("Reading data file...", file = stderr());
retVal = grep(pattern = "marker", x = readLines(gzfile(dataFile), n = 1), ignore.case = TRUE);
marker.statistics <- NULL;
if(length(retVal) > 0){
  markers.statistics <- read.table(gzfile(dataFile), header = TRUE);
} else {
  markers.statistics <- read.table(gzfile(dataFile), header = FALSE);
}
colnames(markers.statistics)[1] <- "Marker";
if(length(grep("/",markers.statistics[1,2])) > 0){
  colnames(markers.statistics)[2] <- "Mutation";
  colnames(markers.statistics)[3] <- "Chromosome";
  colnames(markers.statistics)[4] <- "Location";
} else {
  colnames(markers.statistics)[2] <- "Chromosome";
  colnames(markers.statistics)[3] <- "Location";
}
rownames(markers.statistics) <- markers.statistics$Marker;
colnames(markers.statistics)[length(colnames(markers.statistics))] <- "Value";
markers.statistics$Chromosome <- sub("chr","",markers.statistics$Chromosome,
                                     ignore.case = TRUE);
markers.statistics$Chromosome <- sub("X","23",markers.statistics$Chromosome,
                                     ignore.case = TRUE);
markers.statistics$Chromosome <- sub("Y","24",markers.statistics$Chromosome,
                                     ignore.case = TRUE);
markers.statistics$Chromosome <- sub("MT?","25",markers.statistics$Chromosome,
                                     ignore.case = TRUE);
markers.statistics$Chromosome <- as.numeric(markers.statistics$Chromosome);
markers.statistics$Colour <- rep(c("#0000FF","#00A0FF"),13)[markers.statistics$Chromosome];
markers.statistics$startPoint <- cs.stats[markers.statistics$Chromosome,]$startPoint;
cat("done!\n", file = stderr());

cat("Calculating limits...", file = stderr());
maxVal <- Inf;
if(useNormDistForMax){ # Filters out abnormally large spikes, redrawn as triangles in graph
  maxVal <- 4*qnorm(p = 1 - 1/dim(markers.statistics)[1], mean = mean(markers.statistics$Value), sd = sd(markers.statistics$Value));
}

if(!(trimLimit == FALSE)){
  maxVal <- trimLimit;
}
## valRange <- c(min(markers.statistics$Value, na.rm = TRUE),
##               min(maxVal, max(markers.statistics$Value, na.rm = TRUE)));
valRange <- c(min(markers.statistics$Value, na.rm = TRUE),
              min(maxVal, max(markers.statistics$Value, na.rm = TRUE)));
markers.statistics$randVal <- runif(dim(markers.statistics)[1]);
markers.filtered <- subset(markers.statistics, (Value >= valThreshold) | (filterRandom & (randVal < filterKeepProp)));
markers.filtered$Colour[markers.filtered$Value > valRange[2]] <-
  rep(c("#800000","#A04040"),13)[markers.filtered$Chromosome[markers.filtered$Value > valRange[2]]];
markers.filtered$Value[markers.filtered$Value > valRange[2]] <- valRange[2]+0.01;
cat("done!\n", file = stderr());

cat("Generating PDF...", file = stderr());
pdf("chromosome_plot.pdf", paper = "a4r", width = 11, height = 8);
#svg("chromosome_plot.svg", width = 11, height = 8);
#Cairo_png("chromosome_plot.png", width = 11, height = 8);
if(!(is.expression(valueText)) && (valueText == FALSE)){
  par(mfrow = c(3,1), mar = c(4,5,1,1));
} else {
  par(mfrow = c(3,1), mar = c(4,7,1,1));
}
assembled.third <- cs.stats$startPoint[23]/3;
drawMarkers <- subset(markers.filtered,
                      ((startPoint + Location) >= assembled.third * 0) &
                      ((startPoint + Location) <= assembled.third * 1));
pchStyle <- (drawMarkers$Value > valRange[2]) + 16; # circles within range, triangles outside
plot(drawMarkers$startPoint+drawMarkers$Location,
     drawMarkers$Value, col = drawMarkers$Colour,
     pch = pchStyle, cex = 0.5 * sizeMul, xaxt = "n", frame.plot = FALSE,
     ylab = "", ylim = valRange, xlim = c(0, assembled.third * 1),
     cex.axis = 2, lwd = 2, cex.lab = 2, xaxs = "i",
     xlab = "", las = 1);
## print tick marks
axis(side = 1, at=cs.stats$startPoint[c(-24,-25)], labels = FALSE, lwd = 2);
## print labels
axis(side = 1, at=(cs.stats$startPoint[c(-23,-24,-25)] +
       cs.stats$startPoint[c(-1,-24,-25)]) / 2, srt = 2,
     labels = seq(1,22), las = 1, tick = FALSE, lwd = 2, cex.axis = 2);
drawMarkers <- subset(markers.filtered,
                      ((startPoint + Location) >= assembled.third * 1) &
                      ((startPoint + Location) <= assembled.third * 2));
pchStyle <- (drawMarkers$Value > valRange[2]) + 16; # circles within range, triangles outside
plot(drawMarkers$startPoint+drawMarkers$Location,
     drawMarkers$Value, col = drawMarkers$Colour,
     pch = pchStyle, cex = 0.5 * sizeMul, xaxt = "n", frame.plot = FALSE,
     ylab = valueText, ylim = valRange, xlim = c(assembled.third * 1, assembled.third * 2),
     cex.axis = 2, lwd = 5, cex.lab = 2, xaxs = "i",
     xlab = "", las = 1, mgp = c(5,1,0));
## print tick marks
axis(side = 1, at=cs.stats$startPoint[c(-24,-25)], labels = FALSE, lwd = 2,
     cex.axis = 2);
## print labels
axis(side = 1, at=(cs.stats$startPoint[c(-23,-24,-25)] +
       cs.stats$startPoint[c(-1,-24,-25)]) / 2,
     labels = seq(1,22), las = 1, tick = FALSE, lwd = 2, cex.axis = 2);
drawMarkers <- subset(markers.filtered,
                      ((startPoint + Location) >= assembled.third * 2) &
                      ((startPoint + Location) <= assembled.third * 3));
pchStyle <- (drawMarkers$Value > valRange[2]) + 16; # circles within range, triangles outside
plot(drawMarkers$startPoint+drawMarkers$Location,
     drawMarkers$Value, col = drawMarkers$Colour,
     pch = pchStyle, cex = 0.5 * sizeMul, xaxt = "n", frame.plot = FALSE,
     ylab = "", ylim = valRange, xlim = c(assembled.third * 2, assembled.third * 3),
     cex.axis = 2, cex.lab = 2, xaxs = "i",
     xlab = paste("Chromosome location",
       if((valThreshold > 0) && (!filterRandom)){paste(", Value >", valThreshold)}, sep = ""), las = 1);
## print tick marks
axis(side = 1, at=cs.stats$startPoint[c(-24,-25)], labels = FALSE, lwd = 2,
     cex.axis = 2);
## print labels
axis(side = 1, at=(cs.stats$startPoint[c(-23,-24,-25)] +
       cs.stats$startPoint[c(-1,-24,-25)]) / 2,
     labels = seq(1,22), las = 1, tick = FALSE, lwd = 2, cex.axis = 2);
dummy <- dev.off();
cat("done!\n", file = stderr());


#' @title Category Plot Data
#' @description Transform rate data to rate plot data. Assumes all numeric columns are count data. Will group by id and timepoint.
#' Other columns are preserved and end up as facets.
#' @param input_data dataframe with "identifier", "timepoint" and category columns,
#' @return dataframe transformed for plotting with category_plot
#' @import dplyr
#' @importFrom tidyr gather
#' @importFrom purrr map_lgl
#' @export
category_plot_data <- function(input_data){
  # Assume all numeric columns are category count columns
  cat_cols <- names(input_data)[purrr::map_lgl(input_data, is.numeric)]
  gathered <- gather(input_data, key="event", value="count", cat_cols)

  # Convert key column (title of former columns) to a factor with the specified order of values
  #   Specify in reverse order so that the geom_text and geom_col legends are in same order.
  rev_levels <- sort(unique(gathered$event), decreasing=TRUE)
  gathered$event <- factor(gathered$event, levels = rev_levels)

  # Calculate the max digit per ID that should be plotted to avoid overplotting when the height
  #   of the bar is less than that of the plotted numeral.
  non_cat_cols <- setdiff(colnames(input_data), cat_cols)
  group_cols <- setdiff(colnames(input_data), c(cat_cols, 'timepoint'))

  count_limits <- gathered %>%
    group_by_at(.vars=non_cat_cols) %>%
    summarize(t_lim=lower_print_lim(count) ) %>%
    group_by_at(.vars=group_cols) %>%
    summarize(limit=max(t_lim))

  # Create a column count_label with NA for counts that are less than the count limit for the id.
  gathered %>%
    left_join(count_limits, by=NULL)  %>%
    mutate(
      count_label = case_when(
        count > limit ~ count,
        count <= limit ~ as.numeric(NA)
      )
    )
}


retre_entity_kind <- function(doc, kind){

      doc_cont <- doc$content
      annotations <- NLP::annotations(doc)[[1]]
      if(hasArg(kind)){
            k <- sapply(annotations$features, '[[', "kind")
            doc_cont[annotations[k == kind]]
      }else{
            doc_cont[annotations[k == "entity"]]
      }

}

get_named_entity <- function(test_source, anno_list = c("person", "location", "organization")){

      merged_text_source_str <- str_replace_all(stringi::stri_enc_toutf8(paste0(test_source,collapse = " ")), "\\s+", " ") %>% as.String()
      sent_token <- Maxent_Sent_Token_Annotator()
      word_token <- Maxent_Word_Token_Annotator()
      pipline <- vector(mode = "list", length = length(anno_list)+2)
      pipline[[1]] <- sent_token
      pipline[[2]] <- word_token
      for(i in 3:(length(anno_list)+2)){
            pipline[[i]] <- openNLP::Maxent_Entity_Annotator(kind = anno_list[i-2])
      }
      text_anot <- NLP::annotate(s = merged_text_source_str, f = pipline)
      text_anot_plain <- NLP::AnnotatedPlainTextDocument(s = merged_text_source_str, annotations=text_anot)
      queue <- NULL
      list <- vector(mode = "list", length = length(anno_list))
      for(i in 1:length(anno_list)){
            queue <- retre_entity_kind(text_anot_plain,anno_list[i])
            queue <- data.frame(KeyWords = queue)
            queue$KeyWords <- queue$KeyWords %>% str_replace_all(pattern = "[^A-Za-z0-9_-|^\\s]",replacement = " ")
            list[[i]] <- queue
            names(list[[i]]) <- anno_list[i]
      }
      return(list)
}

cluster_word_hclust <- function(corpus, sparse = 0.9, method_dist = "euclidean", method_hclust = "average"){

      TermDocumentMatrix(x = corpus) %>% # generate term doc matrix
      removeSparseTerms(sparse=sparse) %>% # remove highly sparse terms
      scale() %>% # scale the matrix
      dist(method = method_dist) %>% # calculate the distances among terms based on "euclidean distance"
      hclust(method = method_hclust)

}

draw_dendrogram <- function(hclust, num_cluster = 4, main_title = "Word Clusters", border_type = 8, border_lin_type = 5, border_line_width = 2){

      hclust %>% as.dendrogram() %>% dendextend::set("branches_k_color", k = num_cluster) %>% plot(main = main_title, col.main = "salmon")
      hclust %>% as.dendrogram() %>% dendextend::set("branches_k_color", k = num_cluster)  %>% rect.dendrogram(k = num_cluster, border = border_type,  lty = border_lin_type, lwd = border_line_width)

}

calclulate_score <- function( sentences, pos, neg){

      pos.score <- sapply(sentences, function(x){
            tm_term_score(x,pos)
      }) %>% as.numeric()

      neg.score <- sapply(sentences, function(x){
            tm_term_score(x,neg)
      }) %>% as.numeric()

      dt <- data.table(pos.score,neg.score)

      return(dt)
}