# Runs panelcn over the datasets cofigured at [datasets_params_file]
#USAGE: Rscript runpanelcn.R [panelcn_params_file] [datasets_params_file]
print(paste("Starting at", startTime <- Sys.time()))
suppressPackageStartupMessages(library(yaml))
source(if (basename(getwd()) == "optimizers") "../utils/utils.r" else "utils/utils.r") # Load utils functions
suppressPackageStartupMessages(library(panelcn.mops))
suppressPackageStartupMessages(library(plyr))
suppressPackageStartupMessages(library(GenomicRanges))

# translates DEL/DUP into a common format
auxCNname <- function(x) {
  if (x %in% c("CN0", "CN1")) return("deletion")
  else if (x %in% c("CN3", "CN4")) return("duplication")
}

# Read args
args <- commandArgs(TRUE)
print(args)
if(length(args)>0) {
    panelcnParamsFile <- args[1]
    datasetsParamsFile <- args[2]
} else {
    panelcnParamsFile <- "algorithms/panelcnmops/panelcnmopsParams.yaml"
    datasetsParamsFile <- "datasets.yaml"
}

#Load the parameters file
params <- yaml.load_file(panelcnParamsFile)
datasets <- yaml.load_file(datasetsParamsFile)

print(paste("Params for this execution:", list(params)))

# go over datasets and run panelcn for those which are active
for (name in names(datasets)) {
    dataset <- datasets[[name]]
    if (dataset$include){
        print(paste("Starting panelcn.mops for", name, "dataset", sep=" "))

        # extract fields
        bamsDir <- file.path(dataset$bams_dir)
        bedFile <- file.path(dataset$bed_file)
        fastaFile <- file.path(dataset$fasta_file)
        validatedResultsFile <- file.path(dataset$validated_results_file)

        # set readlength from algorithm params if defined
        if (!is.null(params$readLength)){
          readLength <- params$readLength
        } else
          readLength <- dataset$read_length

        # Create output folder
        if (!is.null(params$outputFolder)) {
          outputFolder <- params$outputFolder
        } else
          outputFolder <- file.path(getwd(), "output", paste0("panelcn-", name))
        if (is.null(params$execution) || params$execution != "skipPrecalcPhase") {
          unlink(outputFolder, recursive = TRUE);
          dir.create(outputFolder)
        }
        outputFile <- file.path(outputFolder, "cnvFounds.txt")

        # Do pre-calc part of the algorithm
        if (is.null(params$execution) || params$execution != "skipPrecalcPhase") {
          # Get count windows
          countWindows <- getWindows(bedFile)

          # Get read counts from BAM file
          allbams <- list.files(path=bamsDir, pattern="*.bam$", full.names = TRUE)
          counts <- countBamListInGRanges(countWindows = countWindows, bam.files = allbams, read.width = readLength)
          names(mcols(counts)) <- unlist(lapply(names(mcols(counts)), getSampleName)) # remove .bam from samples names

          if (!is.null(params$execution) && params$execution == "onlyPrecalcPhase") {
            # save results to be used by other executions
            dir.create(params$precalcFolder)
            saveRDS(countWindows, file.path(params$precalcFolder, "countWindows.rds"))
            saveRDS(counts, file.path(params$precalcFolder, "counts.rds"))

            print(paste("panelcn.mops (Only pre-calc phase) for", name, "dataset finished", sep=" "))
            cat("\n\n\n")
            quit()
          }
        } else { # skipPrecalcPhase mode: read previous results
          print(paste("panelcn.mops Skipping pre-calc phase for", name, "dataset finished", sep=" "))
          countWindows <- readRDS(file.path(params$precalcFolder, "countWindows.rds"))
          counts <- readRDS(file.path(params$precalcFolder, "counts.rds"))
        }

        # extract params
        classes <- c(params$CN0, params$CN1, 1, params$CN3, params$CN4)
        normType <- params$normType
        sizeFactor <- params$sizeFactor
        qu <- params$qu
        quSizeFactor <- params$quSizeFactor
        norm <- params$norm
        priorImpact <- params$priorImpact
        minMedianRC <- params$minMedianRC
        maxControls <- params$maxControls

        # Test samples depending on sample indications compatibility
        allResults <- data.frame()
        allSampleNames <- names(mcols(counts))
        if (dataset$validated_results_file_format == "panelcn" && dataset$validated_results_file != ""
            && params$defineControlsByIndication == TRUE) {
          sample_indications <- readIndicationsForSamples(dataset$validated_results_file)
          indicationsComp <- readCompatibleIndications(dataset$validated_results_file) # get compatible indications for each indication

          for (indication in names(indicationsComp)) {
            print(paste("Processing indication:", indication))

            # samples to test: samples matching this indication
            testSamplesNames <- sample_indications[sample_indications$Genes == indication,][["SampleID"]]
            if (length(testSamplesNames > 0)){
              testSamples <- counts  # copy calculated counts
              mcols(testSamples) <- NULL # remove metadata columns
              mcols(testSamples)[, testSamplesNames] <- mcols(counts)[, testSamplesNames] # add only test samples

              # control samples: samples with compatible indications
              compatibles <- indicationsComp[[indication]]
              samplesToExclude <- sample_indications[!sample_indications$Genes %in% compatibles,][["SampleID"]]
              controlSamplesNames <- allSampleNames[!(allSampleNames %in% samplesToExclude)]
              controlSamples <- counts  # copy calculated counts
              mcols(controlSamples) <- NULL # remove metadata columns
              mcols(controlSamples)[, controlSamplesNames] <- mcols(counts)[, controlSamplesNames] # add only control samples

              # Run the algorithm
              XandCB <- testSamples
              elementMetadata(XandCB) <- cbind(elementMetadata(XandCB), elementMetadata(controlSamples))
              resultList <- runPanelcnMops(XandCB, 1:ncol(elementMetadata(testSamples)),countWindows = countWindows, I = classes, sizeFactor = sizeFactor, norm = norm,
                                           normType = normType, qu = qu, quSizeFactor = quSizeFactor, priorImpact = priorImpact, minMedianRC = minMedianRC, maxControls = maxControls)

              # Build results table
              sNames <- colnames(elementMetadata(testSamples))
              resultsTable <- createResultTable(resultlist = resultList, XandCB = XandCB, countWindows = countWindows,
                                                sampleNames = sNames)
              concatResults <- ldply(resultsTable, data.frame) # concat output from all samples

              # join with final table
              allResults <- rbind(allResults, concatResults)
            }
          }
        } else {
          message("Clinical indication not found, using all samples potentially as controls")

          # Run the algorithm
          XandCB <- counts
          elementMetadata(XandCB) <- cbind(elementMetadata(XandCB), elementMetadata(XandCB))
          resultList <- runPanelcnMops(XandCB, 1:ncol(elementMetadata(counts)),countWindows = countWindows, I = classes, sizeFactor = sizeFactor, norm = norm,
                                       normType = normType, qu = qu, quSizeFactor = quSizeFactor, priorImpact = priorImpact, minMedianRC = minMedianRC, maxControls = maxControls)

          # Build results table
          sampleNames <- colnames(elementMetadata(counts))
          finalResultsTable <- createResultTable(resultlist = resultList, XandCB = XandCB, countWindows = countWindows,
                                            sampleNames = sampleNames)
          allResults <- ldply(finalResultsTable, data.frame) # concat output from all samples
        }

        # Build output file
        colNames <- c("Sample", "Gene", "Chr", "Start", "End", "lowQual", "CN")
        filteredResults <- allResults[(allResults$CN != "CN2") & (allResults$lowQual != "lowQual"),colNames] # only deletions/duplications (CN2 means normal), and high quality
        filteredResults$CNV.type <- lapply(filteredResults$CN, function(x) sapply(x, auxCNname)) # Add CNV.type column before storing file
        filteredResults$CNV.type <- as.factor(unlist(filteredResults$CNV.type))  # R things...
        write.table(filteredResults, outputFile, sep="\t", row.names=FALSE, quote = FALSE)  # write output file

        # Save failed ROIs in a common format
        failedROIs <- allResults[allResults$lowQual == "lowQual", colNames] # get all low qual
        names(failedROIs)[1]<- "SampleID" # rename Sample column
        failedROIs <- failedROIs[,c(1,3,4,5,2)] # reorder and filter columns
        failedROIs[,1] <- unlist(strsplit(data.frame(lapply(failedROIs, as.character), stringsAsFactors=FALSE)[,1],"\\.bam"))  # remove .bam from sample names
        write.table(failedROIs, file.path(outputFolder, "failedROIs.csv"), sep="\t", row.names=FALSE, quote = FALSE) # save

        # Save results in GRanges format
        message("Saving GenomicRanges results")
        saveResultsFileToGR(outputFolder, "cnvFounds.txt")

        print(paste("panelcn.mops for", name, "dataset finished", sep=" "))
        cat("\n\n\n")
    }
}

print(paste("Finishing at", endTime <- Sys.time()))
cat("\nElapsed time:")
print(endTime - startTime)


# PAWS preprocessing - human activity
# Lily Xu
# December 2018

# libraries needed
library(rgdal)
library(sp)
library(raster)
library(adehabitatHR)
library(maptools)
library(rgeos)

# specify input files
dataFilename         <- paste(path, outputPath, "patrolObservationClean.csv", sep="")
trajectoryFilename   <- paste(path, outputPath, "effort/trajectory.Rdata", sep="")

outFilepath   <- paste(path, outputPath, "human_activity/", sep="")

# create 'human_activity' folder if it does not exist
if (!dir.exists(outFilepath)) {
  dir.create(outFilepath)
}

load(trajectoryFilename)

saveCoordinates <- function(rast, boundary, outFilepath) {
  # save XY coordinate values
  rast <- setValues(rast, 1:ncell(rast))
  rast <- mask(rast, boundary)
  XYvalues <- rasterToPoints(rast)
  # round values to prevent, for example, 10 from being written as 9.999999
  XYvalues <- round(XYvalues, digits=0)
  # prevent values from appearing in scientific notation
  XYvalues <- format(XYvalues, scientific=FALSE)
  XYfilename <- paste(outFilepath, "XY.csv", sep="")
  write.csv(XYvalues, file=XYfilename, quote=FALSE)
}

# note: the only difference here is we purge data that don't have at least 3 points in a row
# other ones return dataGridPixels, this returns data
readData <- function(dataFilename, crs_in, crs_use) {
  data <- read.csv(dataFilename)

  # grid as used previously:
  coordinates(data) <- data[,c("X", "Y")] # convert to a spatialpoints* object
  proj4string(data) <- CRS(crs_in)
  data <- spTransform(data, CRS(crs_use))

  return(data)
}

findObservations <- function(data, trajectory) {
  # select data from data where the IDs in trajectory == ID_New
  dataNew <- list()
  for (i in 1:length(trajectory)) {
    dataNew[[i]] <- data[as.character(data$ID_New) %in% (levels(ld(trajectory[[i]])$id)),]
  }
  data <- do.call("rbind", dataNew)

  # TODO: check manually for order
  # Either add in alphabetical order or check manually for order when retrieving from stack
  data <- findHumanPoachingActivity(data)

  # select only the rows with an illegal activity in poach
  data <- data[!is.na(data$poach),]

  return(data)
}

# set everything outside boundary to NA
# TODO: data should already be in proper CRS, right?
maskIllegalActivities <- function(data, rast, boundary, crs_use) {
  illegalActivityAll <- rasterize(data, rast, field=1, fun="count", na.rm=T)
  values(illegalActivityAll)[is.na(values(illegalActivityAll))] <- 0
  proj4string(illegalActivityAll) <- CRS(crs_use)
  crs(illegalActivityAll) <- crs_use
  illegalActivityAllMasked <- mask(illegalActivityAll, boundary)

  return(illegalActivityAllMasked)
}

###############################################
# Extract data per year and month for each illegal activity class
# combine the above and below (i.e. year and poaching classification)

divideClasses <- function(rast, data, illegalActivityAllMasked) {
  class_arr <- array(0,
                     dim = c(length(rast), 12, NROW(unique(data$Year)), NROW(unique(data$poach))),
                     dimnames = list(NULL,
                                     c("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12"),
                                     as.character(sort(unique(data$Year))),
                                     as.character(unique(data$poach))))

  #sg: #data.expanded <- data[rep(row.names(data), data$poach),]

  # divide up by classes
  system.time(
    for (class in levels(as.factor(data$poach))) {
      for (year in levels(as.factor(data$Year))) {
        for (month in levels(as.factor(data$Month))) {
          if (sum(data$Year == year & data$Month == month & data$poach == class) > 0) {
            illegalActivity <- rasterize(
              data[data$Year == year & data$Month == month & data$poach == class,],
              rast, 1, fun="count", na.rm=T)
            values(illegalActivity)[is.na(values(illegalActivity))] <- 0
            class_arr[,as.numeric(month), year, class] <-
              class_arr[,as.numeric(month), year, class] + values(illegalActivity)
          }
        }
      }
    }
  )

  # crop to boundary
  illegalActivityDataFrame <- as.data.frame(illegalActivityAllMasked, xy=TRUE)
  illegalActivityDataFrame$layer[!is.na(illegalActivityDataFrame$layer)]
  class_arr <- class_arr[!is.na(illegalActivityDataFrame$layer),,,]

  # save data as Rdata and CSV files
  monthFilename <- paste(outFilepath, "human_activity_month.csv", sep="")
  write.csv(class_arr, file=monthFilename)

  # # annual counts of all illegal activities
  # annualSum <- apply(class_arr, c(1, 3, 4), sum, na.rm=TRUE)
  # yearFilename1 <- paste(outFilepath, "human_activity_year.Rdata", sep="")
  # yearFilename2 <- paste(outFilepath, "human_activity_year.csv", sep="")
  # save(annualSum, file=yearFilename1)
  # write.csv(annualSum, file=yearFilename2)
}

# create visualization of all classes of illegal activities
visualizeClasses <- function(outFilepath, data, boundary) {
  illegalActivityClasses <- list()
  numCols <- ceiling(length(unique(data$poach)) / 3)

  png(file=paste(outFilepath, "plot_activities.png", sep=""), width=numCols*450, height=1350)
  par(mfrow=c(3, numCols))

  # create plot of all illegal activities
  for (class in unique(data$poach)) {
    illegalActivityClasses[[class]] <- rasterize(data[data$poach==class,], rast, field="poach", fun="count", na.rm=T)
    values(illegalActivityClasses[[class]])[is.na(values(illegalActivityClasses[[class]]))] <- 0

    # mask to park boundary
    illegalActivityClasses[[class]] <- mask(illegalActivityClasses[[class]], boundary)
    plot(illegalActivityClasses[[class]], main=class, cex.main=2)
    lines(boundary)
  }
  dev.off()

  return(illegalActivityClasses)
}

# create combined visualization of all activities
visualizeCombinedActivities <- function(outFilepath, illegalActivityAllMasked, boundary) {
  png(file=paste(outFilepath, "plot_all_activity.png", sep=""),
      width=800, height=600)
  plot(illegalActivityAllMasked, main="All illegal activity", cex.main=2)
  lines(boundary)
  dev.off()
}

rast <- loadGridRast(gridFilename, crs_use)
saveCoordinates(rast, boundary, outFilepath)
data <- readData(dataFilename, crs_in, crs_use)
data <- findObservations(data, trajectory)
illegalActivityAllMasked <- maskIllegalActivities(data, rast, boundary, crs_use)
divideClasses(rast, data, illegalActivityAllMasked)
illegalActivityClasses <- visualizeClasses(outFilepath, data, boundary)
visualizeCombinedActivities(outFilepath, illegalActivityAllMasked, boundary)


REBOL [
	System: "REBOL [R3] Language Interpreter and Run-time Environment"
	Title: "REBOL Internal Dialect: Draw Commands (SVG)"
	Rights: {
		Copyright 2012 REBOL Technologies
		REBOL is a trademark of REBOL Technologies
	}
	License: {
		Licensed under the Apache License, Version 2.0
		See: http://www.apache.org/licenses/LICENSE-2.0
	}
	Note: "Modification requires recompiling affected source files."
]

system/dialects/draw: context [

	type-spec:		[block!]

	;-- DRAW Commands:

	anti-alias:		[logic!]
	arc:			[;shared with SHAPE command
						pair! pair! decimal! decimal! word!
						decimal! word!
					]
	arrow:			[tuple! pair!]
	box:			[pair! pair! decimal!]
	circle:			[pair! decimal! decimal!]
	clip:			[pair! pair! logic!]
	curve:			[* pair!] ;shared with SHAPE command
	effect:			[pair! pair! block!]
	ellipse:		[pair! pair!]
	fill-pen:		[tuple! image! logic!]
	fill-rule:		[word!]
	gamma:			[decimal!]
	grad-pen:		[word! word! pair! logic! decimal! decimal! decimal! decimal! decimal! block!]
	invert-matrix:	[]
	image:			[image! tuple! word! word! integer! integer! integer! integer! * pair!]
	image-filter:	[word! word! decimal!]
	line:			[* pair!] ;shared with SHAPE command
	line-cap:		[word!]
	line-join:		[word!]
	line-pattern:	[logic! tuple! * decimal!]
	line-width:		[decimal! word!]
	matrix:			[block!]
	pen:			[tuple! image! logic!]
	polygon:		[* pair!]
	push:			[block!]
	reset-matrix:	[]
	rotate:			[decimal!]
	scale:			[decimal! decimal!]
	shape:			[block!]
	skew:			[decimal!]
	spline:			[integer! word! * pair!]
	text:			[word! pair! pair! block!]
	transform:		[decimal! pair! decimal! decimal! pair!]
	translate:		[pair!]
	triangle:		[pair! pair! pair! tuple! tuple! tuple! decimal!]

	;-- SHAPE Commands
	;arc is shared
	close: []
	curv: [* pair!]
	;curve is shared
	hline: [decimal!]
	;line is shared
	move: [* pair!]
	qcurv: [pair!]
	qcurve: [* pair!]
	vline:	[decimal!]

	;-- DRAW Options:

	; FILL-PEN
	radial:
	conic:
	diamond:
	linear:
	diagonal:
	cubic:

	; FILL-RULE
	non-zero:
	even-odd:

	; IMAGE
	border:

	; IMAGE-FILTER
	nearest:
	bilinear:
	bicubic:
	gaussian:
	resample:

	; LINE-CAP
	butt:
	square:
	rounded:

	; LINE-JOIN
	miter:
	miter-bevel:
	round:
	bevel:

	;LINE-WIDTH
	fixed:

	; SPLINE & ARC & TEXT
	closed:

	; GRADIENT
	normal:
	repeat:
	reflect:

	;SHAPE ARC
	large:
	sweep:

	;TEXT
	vectorial:
		none
]


#!/usr/bin/env Rscript

################################################
################################################
## REQUIREMENTS                               ##
################################################
################################################

## DIFFERENTIAL ANALYSIS, SCATTERPLOTS AND PCA FOR SAMPLES IN FEATURECOUNTS FILE
    ## - FIRST SIX COLUMNS OF FEATURECOUNTS_FILE SHOULD BE INTERVAL INFO. REMAINDER OF COLUMNS SHOULD BE SAMPLES-SPECIFIC COUNTS.
    ## - SAMPLE NAMES HAVE TO END IN "_R1" REPRESENTING REPLICATE ID. LAST 3 CHARACTERS OF SAMPLE NAME WILL BE TRIMMED TO OBTAIN GROUP ID FOR DESEQ2 COMPARISONS.
    ## - BAM_SUFFIX IS PORTION OF FILENAME AFTER SAMPLE NAME IN FEATURECOUNTS COLUMN SAMPLE NAMES E.G. ".rmDup.bam" if "DRUG_R1.rmDup.bam"
    ## - PACKAGES BELOW NEED TO BE AVAILABLE TO LOAD WHEN RUNNING R

################################################
################################################
## LOAD LIBRARIES                             ##
################################################
################################################
c("optparse", "DESeq2", "vsn",
         "ggplot2", "RColorBrewer", "pheatmap",
         "lattice", "BiocParallel")

library(optparse)
library(DESeq2)
library(vsn)
library(ggplot2)
library(RColorBrewer)
library(pheatmap)
library(lattice)
library(BiocParallel)

################################################
################################################
## PARSE COMMAND-LINE PARAMETERS              ##
################################################
################################################

option_list <- list(make_option(c("-i", "--featurecount_file"), type="character", default=NULL, help="Feature count file generated by the SubRead featureCounts command.", metavar="path"),
                    make_option(c("-o", "--outdir"), type="character", default='./', help="Output directory", metavar="path"),
                    make_option(c("-p", "--outprefix"), type="character", default='differential', help="Output prefix", metavar="string"),
                    make_option(c("-s", "--outsuffix"), type="character", default='', help="Output suffix for comparison-level results", metavar="string"),
                    make_option(c("-v", "--vst"), type="logical", default=FALSE, help="Run vst transform instead of rlog", metavar="boolean"),
                    make_option(c("-c", "--cores"), type="integer", default=1, help="Number of cores", metavar="integer"))

opt_parser <- OptionParser(option_list=option_list)
opt <- parse_args(opt_parser)

if (is.null(opt$featurecount_file)){
    print_help(opt_parser)
    stop("Please provide featurecount file.", call.=FALSE)
}

################################################
################################################
## READ IN COUNTS FILE                        ##
################################################
################################################
opt$featurecount_file <- strsplit(opt$featurecount_file, " ")[[1]]
featurecount_file <- lapply(opt$featurecount_file, read.delim, header=TRUE, skip=1)
count.table <- do.call(cbind, lapply(featurecount_file, function(.ele) .ele[, -seq.int(6)]))
colnames(count.table) <- gsub(".featureCounts.txt","",basename(opt$featurecount_file))
rownames(count.table) <- featurecount_file[[1]][,"Geneid"]
interval.table <- featurecount_file[[1]][,1:6]

################################################
################################################
## RUN DESEQ2                                 ##
################################################
################################################

if (file.exists(opt$outdir) == FALSE) {
    dir.create(opt$outdir,recursive=TRUE)
}
setwd(opt$outdir)

samples.vec <- sort(colnames(count.table))
groups <- sub("_[^_]+$", "", samples.vec)
print(unique(groups))
if (length(unique(groups)) == 1) {
    quit(save = "no", status = 0, runLast = FALSE)
}

DDSFile <- paste(opt$outprefix,".dds.rld.RData",sep="")
if (file.exists(DDSFile) == FALSE) {
    counts <- count.table[,samples.vec,drop=FALSE]
    coldata <- data.frame(row.names=colnames(counts),condition=groups)
    dds <- DESeqDataSetFromMatrix(countData = round(counts), colData = coldata, design = ~ condition)
    dds <- DESeq(dds, parallel=TRUE, BPPARAM=MulticoreParam(opt$cores))
    if (!opt$vst) {
        rld <- rlog(dds)
    } else {
        rld <- vst(dds)
    }
    save(dds,rld,file=DDSFile)
}

################################################
################################################
## PLOT QC                                    ##
################################################
################################################

PlotFile <- paste(opt$outprefix,".plots.pdf",sep="")
if (file.exists(PlotFile) == FALSE) {
    pdf(file=PlotFile,onefile=TRUE,width=7,height=7)

    ## PCA
    pca.data <- DESeq2::plotPCA(rld,intgroup=c("condition"),returnData=TRUE)
    percentVar <- round(100 * attr(pca.data, "percentVar"))
    plot <- ggplot(pca.data, aes(PC1, PC2, color=condition)) +
            geom_point(size=3) +
            xlab(paste0("PC1: ",percentVar[1],"% variance")) +
            ylab(paste0("PC2: ",percentVar[2],"% variance")) +
            theme(panel.grid.major = element_blank(),
                  panel.grid.minor = element_blank(),
                  panel.background = element_blank(),
                  panel.border = element_rect(colour = "black", fill=NA, size=1))
    print(plot)

    ## WRITE PC1 vs PC2 VALUES TO FILE
    pca.vals <- pca.data[,1:2]
    colnames(pca.vals) <- paste(colnames(pca.vals),paste(percentVar,'% variance',sep=""), sep=": ")
    pca.vals <- cbind(sample = rownames(pca.vals), pca.vals)
    write.table(pca.vals,file=paste(opt$outprefix,".pca.vals.txt",sep=""),row.names=FALSE,col.names=TRUE,sep="\t",quote=TRUE)

    ## SAMPLE CORRELATION HEATMAP
    sampleDists <- dist(t(assay(rld)))
    sampleDistMatrix <- as.matrix(sampleDists)
    colors <- colorRampPalette( rev(brewer.pal(9, "Blues")) )(255)
    pheatmap(sampleDistMatrix,clustering_distance_rows=sampleDists,clustering_distance_cols=sampleDists,col=colors)

    ## WRITE SAMPLE DISTANCES TO FILE
    write.table(cbind(sample = rownames(sampleDistMatrix), sampleDistMatrix),file=paste(opt$outprefix,".sample.dists.txt",sep=""),row.names=FALSE,col.names=TRUE,sep="\t",quote=FALSE)

    dev.off()
}

################################################
################################################
## SAVE SIZE FACTORS                          ##
################################################
################################################

SizeFactorsDir <- "sizeFactors/"
if (file.exists(SizeFactorsDir) == FALSE) {
    dir.create(SizeFactorsDir,recursive=TRUE)
}

NormFactorsFile <- paste(SizeFactorsDir,opt$outprefix,".sizeFactors.RData",sep="")
if (file.exists(NormFactorsFile) == FALSE) {
    normFactors <- sizeFactors(dds)
    save(normFactors,file=NormFactorsFile)

    for (name in names(sizeFactors(dds))) {
        sizeFactorFile <- paste(SizeFactorsDir,name,opt$outsuffix,".sizeFactor.txt",sep="")
        if (file.exists(sizeFactorFile) == FALSE) {
            write(as.numeric(sizeFactors(dds)[name]),file=sizeFactorFile)
        }
    }
}

################################################
################################################
## WRITE LOG FILE                             ##
################################################
################################################

LogFile <- paste(opt$outprefix,".log",sep="")
if (file.exists(LogFile) == FALSE) {
    cat("\nSamples =",samples.vec,"\n\n",file=LogFile,append=TRUE,sep=', ')
    cat("Groups =",groups,"\n\n",file=LogFile,append=TRUE,sep=', ')
    cat("Dimensions of count matrix =",dim(counts),"\n\n",file=LogFile,append=FALSE,sep=' ')
    cat("\n",file=LogFile,append=TRUE,sep='')
}

################################################
################################################
## LOOP THROUGH COMPARISONS                   ##
################################################
################################################

ResultsFile <- paste(opt$outprefix,".results.txt",sep="")
if (file.exists(ResultsFile) == FALSE) {

    raw.counts <- counts(dds,normalized=FALSE)
    colnames(raw.counts) <- paste(colnames(raw.counts),'raw',sep='.')
    pseudo.counts <- counts(dds,normalized=TRUE)
    colnames(pseudo.counts) <- paste(colnames(pseudo.counts),'pseudo',sep='.')

    deseq2_results_list <- list()
    comparisons <- combn(unique(groups),2)
    for (idx in 1:ncol(comparisons)) {

        control.group <- comparisons[1,idx]
        treat.group <- comparisons[2,idx]
        CompPrefix <- paste(control.group,treat.group,sep="vs")
        cat("Saving results for ",CompPrefix," ...\n",sep="")

        CompOutDir <- paste(CompPrefix,'/',sep="")
        if (file.exists(CompOutDir) == FALSE) {
            dir.create(CompOutDir,recursive=TRUE)
        }

        control.samples <- samples.vec[which(groups == control.group)]
        treat.samples <- samples.vec[which(groups == treat.group)]
        comp.samples <- c(control.samples,treat.samples)

        comp.results <- results(dds,contrast=c("condition",c(control.group,treat.group)))
        comp.df <- as.data.frame(comp.results)
        comp.table <- cbind(interval.table, as.data.frame(comp.df), raw.counts[,paste(comp.samples,'raw',sep='.')], pseudo.counts[,paste(comp.samples,'pseudo',sep='.')])

        ## WRITE RESULTS FILE
        CompResultsFile <- paste(CompOutDir,CompPrefix,opt$outsuffix,".deseq2.results.txt",sep="")
        write.table(comp.table, file=CompResultsFile, col.names=TRUE, row.names=FALSE, sep='\t', quote=FALSE)

        ## FILTER RESULTS BY FDR & LOGFC AND WRITE RESULTS FILE
        pdf(file=paste(CompOutDir,CompPrefix,opt$outsuffix,".deseq2.plots.pdf",sep=""),width=10,height=8)
        if (length(comp.samples) > 2) {
            for (MIN_FDR in c(0.01,0.05)) {

                ## SUBSET RESULTS BY FDR
                pass.fdr.table <- subset(comp.table, padj < MIN_FDR)
                pass.fdr.up.table <- subset(comp.table, padj < MIN_FDR & log2FoldChange > 0)
                pass.fdr.down.table <- subset(comp.table, padj < MIN_FDR & log2FoldChange < 0)

                ## SUBSET RESULTS BY FDR AND LOGFC
                pass.fdr.logFC.table <- subset(comp.table, padj < MIN_FDR & abs(log2FoldChange) >= 1)
                pass.fdr.logFC.up.table <- subset(comp.table, padj < MIN_FDR & abs(log2FoldChange) >= 1 & log2FoldChange > 0)
                pass.fdr.logFC.down.table <- subset(comp.table, padj < MIN_FDR & abs(log2FoldChange) >= 1 & log2FoldChange < 0)

                ## WRITE RESULTS FILE
                CompResultsFile <- paste(CompOutDir,CompPrefix,opt$outsuffix,".deseq2.FDR",MIN_FDR,".results.txt",sep="")
                CompBEDFile <- paste(CompOutDir,CompPrefix,opt$outsuffix,".deseq2.FDR",MIN_FDR,".results.bed",sep="")
                write.table(pass.fdr.table, file=CompResultsFile, col.names=TRUE, row.names=FALSE, sep='\t', quote=FALSE)
                write.table(pass.fdr.table[,c("Chr","Start","End","Geneid","log2FoldChange","Strand")], file=CompBEDFile, col.names=FALSE, row.names=FALSE, sep='\t', quote=FALSE)

                ## MA PLOT & VOLCANO PLOT
                DESeq2::plotMA(comp.results, main=paste("MA plot FDR <= ",MIN_FDR,sep=""), ylim=c(-2,2),alpha=MIN_FDR)
                plot(comp.table$log2FoldChange, -1*log10(comp.table$padj), col=ifelse(comp.table$padj<=MIN_FDR, "red", "black"), xlab="logFC", ylab="-1*log10(FDR)", main=paste("Volcano plot FDR <=",MIN_FDR,sep=" "), pch=20)

                ## ADD COUNTS TO LOGFILE
                cat(CompPrefix," genes with FDR <= ",MIN_FDR,": ",nrow(pass.fdr.table)," (up=",nrow(pass.fdr.up.table),", down=",nrow(pass.fdr.down.table),")","\n",file=LogFile,append=TRUE,sep="")
                cat(CompPrefix," genes with FDR <= ",MIN_FDR," & FC > 2: ",nrow(pass.fdr.logFC.table)," (up=",nrow(pass.fdr.logFC.up.table),", down=",nrow(pass.fdr.logFC.down.table),")","\n",file=LogFile,append=TRUE,sep="")

            }
            cat("\n",file=LogFile,append=TRUE,sep="")
        }

        ## SAMPLE CORRELATION HEATMAP
        rld.subset <- assay(rld)[,comp.samples]
        sampleDists <- dist(t(rld.subset))
        sampleDistMatrix <- as.matrix(sampleDists)
        colors <- colorRampPalette( rev(brewer.pal(9, "Blues")) )(255)
        pheatmap(sampleDistMatrix,clustering_distance_rows=sampleDists,clustering_distance_cols=sampleDists,col=colors)

        ## SCATTER PLOT FOR RLOG COUNTS
        combs <- combn(comp.samples,2,simplify=FALSE)
        clabels <- sapply(combs,function(x){paste(x,collapse=' & ')})
        plotdat <- data.frame(x=unlist(lapply(combs, function(x){rld.subset[, x[1] ]})),y=unlist(lapply(combs, function(y){rld.subset[, y[2] ]})),comp=rep(clabels, each=nrow(rld.subset)))
        plot <- xyplot(y~x|comp,plotdat,
                       panel=function(...){
                           panel.xyplot(...)
                           panel.abline(0,1,col="red")
                       },
                       par.strip.text=list(cex=0.5))
        print(plot)
        dev.off()

        colnames(comp.df) <- paste(CompPrefix,".",colnames(comp.df),sep="")
        deseq2_results_list[[idx]] <- comp.df

    }

    ## WRITE RESULTS FROM ALL COMPARISONS TO FILE
    deseq2_results_table <- cbind(interval.table,do.call(cbind, deseq2_results_list),raw.counts,pseudo.counts)
    write.table(deseq2_results_table, file=ResultsFile, col.names=TRUE, row.names=FALSE, sep='\t', quote=FALSE)

}

################################################
################################################
## R SESSION INFO                             ##
################################################
################################################

RLogFile <- "R_sessionInfo.log"
if (file.exists(RLogFile) == FALSE) {
    sink(RLogFile)
    a <- sessionInfo()
    print(a)
    sink()
}

################################################
################################################
################################################
################################################


  logbook.prorate = function(lgbk) {

    # manual pro-rate:

    # fix problems with slip weights
      new.slip.sums = tapply2( x=lgbk, indices=c("doc_id"), var="slip_weight_lbs", newvars=c("new.slip.wgt"),
                       func=function(x){ sum(unique(x)) } )

      lgbk = merge( x=lgbk, y=new.slip.sums, by="doc_id", sort=F, all.x=T, all.y=F)
      i = which(( lgbk$new.slip.wgt - lgbk$slip_weight_lbs) != 0 )
      j = which( duplicated( lgbk$log_efrt_std_info_id,  ))
      bad.data = intersect ( i, j )
      if (length(bad.data) > 0 ) lgbk = lgbk[-bad.data ,]

      lgbk$slip_weight_lbs = lgbk$new.slip.wgt
      lgbk$new.slip.wgt = NULL

      # compute rescaling factors that ensure sums are still correct after rescaling
      # counts
      pr.count = tapply2( x=lgbk, indices=c("doc_id"), var="log_efrt_std_info_id", newvars=c("pr.count"),
                       func=function(x){ length(unique(x)) } )
      # sums
      pr.sum = tapply2( x=lgbk, indices=c("doc_id"), var="est_weight_log_lbs", newvars=c("pr.sum"),
                       func=function(x){ sum(x, na.rm=F) } )

      # merge and rescale
      pr = merge(x=pr.count, y=pr.sum, by="doc_id", sort=F, all=F)
      pr$doc_id = as.character(pr$doc_id )

      lgbk = merge(x=lgbk, y=pr, by="doc_id", all.x=T, all.y=F, sort=F)
      lgbk$pr.fraction = lgbk$est_weight_log_lbs / lgbk$pr.sum
      lgbk$pro_rated_slip_wt_lbs = lgbk$pr.fraction * lgbk$slip_weight_lbs

      # second pro-rating of data with missing values/nulls, etc
      na.logs = which (!is.finite ( lgbk$pr.sum ) )
      if (length( na.logs) > 0 ) {
        lgbk$pro_rated_slip_wt_lbs[ na.logs ] = lgbk$slip_weight_lbs[na.logs ] / lgbk$pr.count [  na.logs]
      }

      bad.usage.codes = which ( lgbk$catch_usage_code!=10 )
      if (length(bad.usage.codes) > 0 ) lgbk = lgbk[-bad.usage.codes, ]

    return( lgbk )
  }


library(data.table)

options(max.print = 3600)

composition <- fread("~/Dropbox/liverpool/retail_typology/data/composition/composition_input.csv")
diversity <- fread("~/Dropbox/liverpool/retail_typology/analysis/indicators/national_diversity.csv")
local_diversity <- fread("~/Dropbox/liverpool/retail_typology/analysis/indicators/local_diversity.csv")
setnames(local_diversity, "indie_pct", "local_indie_pct")
retail_function <- fread("~/Dropbox/liverpool/retail_typology/analysis/indicators/retail_function.csv")
morphology <- fread("~/Dropbox/liverpool/retail_typology/analysis/indicators/morphology.csv")[,.(cluster_id, roek)]
size <- fread("~/Dropbox/liverpool/retail_typology/analysis/indicators/size.csv")
pop <- fread("~/Dropbox/liverpool/retail_typology/analysis/indicators/pop_catchments_weighted.csv")
income <- fread("~/Dropbox/liverpool/retail_typology/analysis/indicators/mean_income.csv")
unemployment <- fread("~/Dropbox/liverpool/retail_typology/analysis/indicators/mean_weighted_jsa.csv")
vacancy <- fread("~/Dropbox/liverpool/retail_typology/analysis/indicators/vacancy.csv")[,.(cluster_id, vac_pct_16, vac_change_pos)]
working_pop <- fread("~/Dropbox/liverpool/retail_typology/data/wz/working_pop_weighted.csv")
competitors_count <- fread("~/Dropbox/liverpool/retail_typology/data/competitors_count.csv")
retail_change <- fread("~/Dropbox/liverpool/retail_typology/data/retail_change.csv")[,.(cluster_id, service_change_pos)]
crime <- fread("~/Dropbox/liverpool/retail_typology/data/crime/count_crime.csv")[,.(id, crime_density)]
setnames(crime, "id", "cluster_id")

all_data <- composition[diversity, on = "cluster_id"]
all_data <- size[all_data, on = "cluster_id", nomatch = 0] # we should produce an output with as many entries as cluster catchments (i.e. 3110)
all_data <- local_diversity[all_data, on = "cluster_id"]
all_data <- retail_function[all_data, on = "cluster_id"]
all_data <- morphology[all_data, on = "cluster_id"]
all_data <- pop[all_data, on = "cluster_id"]
all_data <- income[all_data, on = "cluster_id"]
all_data <- unemployment[all_data, on = "cluster_id"]
all_data <- vacancy[all_data, on = "cluster_id"]
all_data <- working_pop[all_data, on = "cluster_id"]
all_data <- competitors_count[all_data, on = "cluster_id"]
all_data <- crime[all_data, on = "cluster_id"]
all_data <- retail_change[all_data, on = "cluster_id"]

####################################################### Deal with NAs ###################################################################

##### 1. service_change_pos #############################################################################################################
# some clusters did not have a service unit neither in 2014 nor in 2016, so there is no change between years, replace NA with 0
all_data[is.na(service_change_pos), service_change_pos := 0]

##### 2. crime_density ##################################################################################################################
# some clusters did not crime occurrence, replace NA with 0
all_data[is.na(crime_density), crime_density := 0]

##### 3. vac_pct_16 #####################################################################################################################
# some clusters did not have vacant units, replace NA with 0
all_data[is.na(vac_pct_16), vac_pct_16 := 0]

##### 4. vac_change_pos #################################################################################################################
# some clusters did not have vacant units, replace NA with 0
all_data[is.na(vac_change_pos), vac_change_pos := 0]

##### 5. local_services_diversity_pct ###################################################################################################
# some clusters did not have neighbours, replace NA values with 100 if the cluster has an occurrence, 0 if it doesn't
all_data[is.na(local_services_diversity_pct), local_services_diversity_pct := ifelse(services_diversity_pct != 0, 100, 0)]

##### 6. local_retail_diversity_pct #####################################################################################################
# some clusters did not have neighbours, replace NA values with 100 if the cluster has an occurrence, 0 if it doesn't
all_data[is.na(local_retail_diversity_pct), local_retail_diversity_pct := ifelse(retail_diversity_pct != 0, 100, 0)]

##### 7. local_small_multi_pct ##########################################################################################################
# some clusters did not have neighbours, replace NA values with 100 if the cluster has an occurrence, 0 if it doesn't
all_data[is.na(local_small_multi_pct), local_small_multi_pct := ifelse(small_multi_pct != 0, 100, 0)]

##### 8. local_large_multi_pct ##########################################################################################################
# some clusters did not have neighbours, replace NA values with 100 if the cluster has an occurrence, 0 if it doesn't
all_data[is.na(local_large_multi_pct), local_large_multi_pct := ifelse(large_multi_pct != 0, 100, 0)]

##### 9. local_indie_pct ################################################################################################################
# some clusters did not have neighbours, replace NA values with 100 if the cluster has an occurrence, 0 if it doesn't
all_data[is.na(local_indie_pct), local_indie_pct := ifelse(indie_pct != 0, 100, 0)]

##### 10. local_leisure_pct #############################################################################################################
# some clusters did not have neighbours, replace NA values with 100 if the cluster has an occurrence, 0 if it doesn't
all_data[is.na(local_leisure_pct), local_leisure_pct := ifelse(attractive_leisure_pct != 0, 100, 0)]

##### 11. local_convenience_pct #########################################################################################################
# some clusters did not have neighbours, replace NA values with 100 if the cluster has an occurrence, 0 if it doesn't
all_data[is.na(local_convenience_pct), local_convenience_pct := ifelse(attractive_convenience_pct != 0, 100, 0)]

##### 11. local_consumer_pct ############################################################################################################
# some clusters did not have neighbours, replace NA values with 100 if the cluster has an occurrence, 0 if it doesn't
all_data[is.na(local_consumer_pct), local_consumer_pct := ifelse(attractive_consumer_pct != 0, 100, 0)]

##### 12. local_departm_stores_pct ######################################################################################################
# some clusters did not have neighbours, replace NA values with 100 if the cluster has an occurrence, 0 if it doesn't
all_data[is.na(local_departm_stores_pct), local_departm_stores_pct := ifelse(department_stores_pct != 0, 100, 0)]

##### 13. local_comparison_pct ##########################################################################################################
# some clusters did not have neighbours, replace NA values with 100 if the cluster has an occurrence, 0 if it doesn't
all_data[is.na(local_comparison_pct), local_comparison_pct := ifelse(attractive_comparison_pct != 0, 100, 0)]

fwrite(all_data, "~/Dropbox/liverpool/retail_typology/analysis/indicators/all_data.csv")

# all_data_sele <- all_data[, .(cluster_id, crime_count, competitors, working_pop, vac_pct_15, vac_change_pos, mean_jsa, mean_income, resident_pop, catch_area, retail_area, roek, stores_nr, ethnic_pct,
#                          charity_pct, betting_pct, value_brand_pct, mass_brand_pct, anchor_pct, premium_brand_pct, local_services_diversity_pct, local_retail_diversity_pct,
#                          local_small_multi_pct, local_large_multi_pct, local_indie_pct, local_leisure_pct, local_convenience_pct, local_consumer_pct, local_departm_stores_pct,
#                          local_comparison_pct, clothing, house_goods, electrical, hobbies, food_retailers, ctn, off_license, chemists, restaurants, bars, caffes, entertainment,
#                          fitness, health_and_beauty, consumer_services, household_services, financial_services, recruitment_services, services_diversity_pct, retail_diversity_pct,
#                          small_multi_pct, large_multi_pct, indie_pct, attractive_leisure_pct, attractive_convenience_pct, attractive_consumer_pct, department_stores_pct, attractive_comparison_pct)]
#
# all_data_sele[, working_pop_density := working_pop / catch_area]
# all_data_sele[, resident_pop_density := resident_pop / catch_area]
# all_data_sele[, crime_density := crime_count / retail_area]
#
# cor(all_data_sele[,2:61])


parse.timeout = function(pbp, play) {
    play$timeout = FALSE
    play$timeout_team = NA

    timeout_regex = "Timeout (?<team>[-a-zA-Z\\. ']+).* (?<min>\\d{1,2})?:(?<sec>\\d\\d)"

    if (grepl(timeout_regex, pbp, perl=TRUE, fixed=FALSE, ignore.case=TRUE)) {
        play$timeout = TRUE

        match = regex(timeout_regex, pbp, perl=TRUE, fixed=FALSE, ignore.case=TRUE)

        if (!is.na(match[1,'team'])) {
            teams = c(play$poss, play$def)
            costs = list(insertions=2, deletions=0, substitutions=1)
            t1.unlike = adist(teams[1], match[1,'team'], costs=costs, ignore.case=TRUE)
            t2.unlike = adist(teams[2], match[1,'team'], costs=costs, ignore.case=TRUE)
            if (t1.unlike != t2.unlike) {
                play$timeout_team = teams[which.min(c(t1.unlike, t2.unlike))]
            } else {play$timeout_team = match[1,'team']}
        }
    }

    return(play)
}


# Ensemble gene noise for the CAP/Sepsis

library(parallel)

setwd("/media/yuri/Data/home1/GNI_data/infection/DataSciRep/")
# Read CORUM and KEGG gene ensembles annotations
load("org.Hs.core_paths.Rdat")
load("pr_cl.Rdat")
names(kegg_path) <- paste0("kegg:", names(kegg_path))
# redundant to Respiratory chain complex I (subcomplex I alpha), mitochondrial complex
corum_core$`mitochondrial respiratory chain complex I assembly` <- NULL
names(corum_core) <- paste0("complex:", names(corum_core))
core_paths <- c(corum_core, kegg_path, promSim_cl)
# promSim_cl - gene ensembles based on promoter similarity

setwd("/media/yuri/Data/home1/GNI_data/infection/ResultsSciRep/")
# Read CAP/Sepsis affymetrix data
load("GSE65682_series_all_mortality.Rdat")

# match genes between ensembles annotations and affymetrix data
core_paths_subset <- lapply(seq_along(core_paths), function(i) core_paths[[i]][ core_paths[[i]] %in% rownames(affyData_out) ] )
names(core_paths_subset) <- names(core_paths)
# select ensembles represented by more than 10 genes
core_paths_subset <- core_paths_subset[ sapply(core_paths_subset, length) >= 10 ]

# Calculate ensemble gene noise
affyDat_noise_paths <- lapply(seq_along(core_paths_subset), function(i) {
  cat(i, "\r")
  idx <- rownames(affyData_out) %in% core_paths_subset[[i]]
  dat <- affyData_out[idx,]
  res <- apply(dat, 2, var)
  res
})
names(affyDat_noise_paths) <- names(core_paths_subset)
affyDat_noise_paths <- do.call(cbind, affyDat_noise_paths)

affyDat_noise_paths <- affyDat_noise_paths[pheno$d != "ctl", ]
pheno <- pheno[pheno$d != "ctl", ]

# save ensemble gene noise for CAP
affyDat_noise_paths_CAP <- affyDat_noise_paths[pheno$d != "other", ]
pheno_CAP <- pheno[pheno$d != "other", ]

# save ensemble gene noise for Sepsis
affyDat_noise_paths_SPS <- affyDat_noise_paths[pheno$d != "cap", ]
pheno_SPS <- pheno[pheno$d != "cap", ]

rm(affyData, affyData_out, core_paths, corum_core, kegg_path, org.Hs, promSim_cl, samples, samples_pData, samples_pData_subset, trxL)

setwd("/media/yuri/Data/home1/GNI_data/infection/ResultsSciRep")
save.image("CAP_Sepsis_Ensemble_noise_model.RDat")


# this is important for running this package from scripts
#' @import methods
NULL

#' Single cell RNA-seq matrix
#'
#' a single cell RNA matrix interface. Does not do much beyond adding
#' specifically gene names, cell names and labels describing the type of data.
#' Methods for basic stat, gene selection, clustering are implemented separately
#'
#' @slot mat A sparse matrix containing the expression data
#' @slot genes list of all genes. By default the matrix row names are used
#' @slot cells list of all cells. By default the matrix col names are used
#' @slot stat_type Type of statistic. Currently only "umi" is supported
#' @slot cell_metadata dataframe with metadata on the cells. Rownames correspond to the cell names. By default a table consisting of only a "Batch" field is added with a trivial batch number. If the cell_metadata does not include a Batch field, it will be added with a trivial value. Additional standard fields spike_umis - the number of (filtered_) spike umis for the cell
#'
#' @examples
#' # we first initialize a tgScMat object
#' #TO ADD
#' @importClassesFrom Matrix Matrix dgCMatrix dgeMatrix
#' @import Matrix
#'
#' @export tgScMat
#' @exportClass tgScMat
tgScMat <- setClass(
   "tgScMat",
	slots = c(
	  mat = "dgCMatrix",
	  genes = "vector",
	  cells = "vector",
	  ncells = "numeric",
	  ngenes = "numeric",
	  stat_type = "character",
	  ignore_genes = "vector",
	  ignore_cells = "vector",
	  ignore_gmat = "dgCMatrix",
	  ignore_cmat = "dgCMatrix",
	  ignore_gcmat = "dgCMatrix",
	  cell_metadata = "data.frame")
)

setMethod(
  "initialize",
  signature = "tgScMat",
  definition =
    function(.Object, mat=NULL, stat_type = "umi", cell_metadata = NULL, ...) {
      .Object@stat_type=stat_type
      if(!is.null(mat)) {
      	if(!is.null(rownames(mat))) {
        		.Object@genes=rownames(mat)
      	} else {
        		.Object@genes=seq(1,nrow(mat),1)
      	}
      	if(!is.null(colnames(mat))) {
        		.Object@cells=colnames(mat)
      	} else {
      	  .Object@cells=seq(1,ncol(mat),1)
      	}
			.Object@ngenes = nrow(mat)
      	.Object@ncells = ncol(mat)

      	.Object@mat = as(mat, "dgCMatrix")

      	# cell metadata
      	.Object@cell_metadata = .scm_init_md(.Object, cell_metadata)
      }

      return(.Object)
    }
)

# Checks metadata
.scm_init_md = function(.Object, cell_metadata)
{
  if(is.null(cell_metadata)) {
		#by defulat the mat data indicate one single Batch
		md = data.frame(amp_batch_id = rep(1, nrow(.Object@mat)),
							 row.names=.Object@cells)
		return(md)
  }
  md_nms = rownames(cell_metadata)
  if(length(md_nms) != length(.Object@cells)
	  | length(md_nms) != length(intersect(.Object@cells, md_nms))) {
		stop("Metadata cells names are incompatible with matrix cells - aborting")
  }
  if(!"amp_batch_id" %in% colnames(cell_metadata)) {
		cell_metadata$amp_batch_id = 1
  }
  cell_metadata = cell_metadata[.Object@cells,]	#making sure it is reordered

  return(cell_metadata)
}

setValidity("tgScMat", function(object) {
  # TBA
  return(TRUE)
})

# PUBLIC CONSTRUCTORS

#' Constract a tgScMat
#'
#' Constract a tgScMat gene expression matrix object
#'
#'
#' @param mat A matrix containing the expression data (will be stored as a sparse matrix)
#' @param cell_metadata dataframe with metadata on the cells. Rownames correspond to the cell names.
#' @param stat_type Type of statistic. ("umi", "rpkm", "tpm" etc.). Default: "umi"

#'
#' @return A tgScMat gene expression matrix object
#'
#' @export
scm_new_matrix = function(mat,
									cell_metadata,
									stat_type = "umi")
{
	return(
		tgScMat(
			mat,
			stat_type = stat_type,
			cell_metadata = cell_metadata
		)
	)
}

#' ncell_merge_mats: Merge two matrix using their ids in scdb. See scm_merge_mats for details on batch management and policies on missing genes
#'
#' @param id1 - first matrix to merge
#' @param id2 - second matrix to merge
#' @param new_id - id of matrix to generate

mcell_merge_mats = function(id1, id2, new_id)
{
	if(!is.character(id1) | !is.character(id2) | !is.character(new_id)) {
		stop("mcell_merge_mats must be called ids into scdb, not other objects")
	}
	if(is.null(scdb_mat(id1)) | is.null(scdb_mat(id2))) {
		stop("mcell_merge_mats called with missing mat ids, ", id1, " ", id2)
	}
	scdb_add_mat(new_id,
					 scm_merge_mats(scdb_mat(id1), scdb_mat(id2)))
}

#' Merge multiple single cell matrix object.
#'
#' Merge multiple single cell matrix object.
#' Return the merged matrix, with merged meta data and issues an error if there are overlapping cell names between the two matrices.
#'
#' In case genes sets differs between the matrices, the union is used, with zeros (not NAs!) filling up the missing genes in the respective matrix.
#'
#' @param ... tgScMat objects to merge.
#'   Each parameter can be either a single tgScMat or a list of tgScMat (that will be merged)
#'
#' @export
#'
scm_merge_mats = function(...)
{
	scmats = list(...)
	scmats = do.call(c, scmats)

	if (length(scmats) == 0) {
		return(NULL)
	}

	if (!all(sapply(scmats, function(scmat) {"tgScMat" %in% class(scmat)}))) {
		stop("Trying to merge a non-tgScMat object using scm_merge_mats() - if you want to merge from the scdb, call mcell_merge_mats")
	}

	scmats = lapply(scmats, scm_ignore_cells, NULL)
	scmats = lapply(scmats, scm_ignore_genes, NULL)

	res = scmats[[1]]

	mds = lapply(scmats, function(scmat) {scmat@cell_metadata})
	md_cols = lapply(mds, colnames)
	md_cols_all = Reduce(function(a, b) {c(a, setdiff(b, a))}, md_cols)
	mds = lapply(mds, function(md) {
		missing = setdiff(md_cols_all, colnames(md))
		if (length(missing) > 0) {
			md[, missing] = NA
		}
		return(md[, md_cols_all])
	})
	res@cell_metadata = do.call(rbind, mds)

	mats = lapply(scmats, function(scmat) {scmat@mat})
	genes = lapply(scmats, function(scmat) {scmat@genes})
	genes_all = Reduce(function(a, b) {c(a, setdiff(b, a))}, genes)
	if (any(sapply(genes, length) != length(genes_all))) {
		warning("Merged tgScMats have different gene sets. Missing genes will be set to 0.")
	}
	mats = lapply(mats, function(mat) {
		missing <- setdiff(genes_all, rownames(mat))
		if (length(missing) > 0) {
			missing = Matrix::sparseMatrix(i = c(), j = c(), x = 0,
								           dims = c(length(missing), ncol(mat)),
								           dimnames = list(missing, colnames(mat)))
			mat = rbind(mat, missing)
		}
		return(mat[genes_all, ])
	})
	res@mat = do.call(cbind, mats)

	res@genes = rownames(res@mat)
	res@cells = colnames(res@mat)
	res@ncells = ncol(res@mat)
	res@ngenes = nrow(res@mat)
	res@ignore_genes = vector(l=0)
	res@ignore_cells = vector(l=0)
	res@ignore_cmat =  as(matrix(0, nrow=nrow(res@mat), ncol=0), 'dgCMatrix')
	res@ignore_gmat =  as(matrix(0, nrow=0, ncol=ncol(res@mat)), 'dgCMatrix')
	res@ignore_gcmat =  as(matrix(0, nrow=0, ncol=0), 'dgCMatrix')

	return(res)
}

#'
#' Extract sub-matrix. This return a matrix object on a subset of the genes and cells.
#'
#' @param scmat A tgScMat object.
#' @param genes Genes range. NULL implies the entire gene set
#' @param cells Cells range. NULL implies the entire cell set
#'
#' @export
scm_sub_mat = function(scmat, genes=NULL, cells=NULL)
{
	if (class(scmat)[1] != "tgScMat") {
		stop("invalid scmat in scm_sub_mat")
	}
	if (is.null(genes)) {
		genes = scmat@genes
	}
	if (is.null(cells)) {
		cells = scmat@cells
	}

	if(length(cells)<2) {
		stop("At least 2 cells must be selected")
	}
	if(length(genes)<2) {
		stop("At least 2 genes must be selected")
	}
	meta = scmat@cell_metadata[cells,]
	# remove unused levels
	meta[] <- lapply(meta, function(x) if(is.factor(x)) factor(x) else x)
	return(tgScMat(mat = scmat@mat[genes, cells,drop=F],
						stat_type= scmat@stat_type,
						cell_metadata= meta))
	#batch_map = scmat@batch_map[cells],

}

#' Generate a new matrix object after removing cells without enough umis
#'
#' The currently ignored cells are still going to be ignored, and small cells
#' are goign to be added to them
#'
#' @param new_mat_id id of matrix in scdb
#' @param mat_id existing matrix
#' @param min_umis minimum number of umi per cell
#'
#' @export

mcell_mat_ignore_small_cells = function(new_mat_id, mat_id, min_umis)
{
	if(is.null(scdb_mat(mat_id))) {
		stop("mcell_mat_ignore_small_cells called with missing mat id, ", mat_id)
	}
	mat = scdb_mat(mat_id)
	csize = colSums(mat@mat)
	small_c = names(which(csize < min_umis))
	mcell_mat_ignore_cells(new_mat_id, mat_id, union(mat@ignore_cells, small_c))
}

#' Generate a new matrix object with a given ignore cell list
#'
#' @param new_mat_id id of matrix in scdb
#' @param mat_id existing matrix
#' @param ig_cells cells names to ignore
#' @param reverse set this to true to focus on cells instead of ignore them. False by default
#'
#' @export

mcell_mat_ignore_cells = function(new_mat_id, mat_id, ig_cells, reverse=F)
{
	if(is.null(scdb_mat(mat_id))) {
		stop("mcell_mat_ignore_cells called with missing mat id, ", mat_id)
	}
	mat = scdb_mat(mat_id)

	new_mat = scm_ignore_cells(mat, ig_cells, reverse)
	scdb_add_mat(new_mat_id, new_mat)
}

#' Generate a new matrix object with a given ignore gene list
#'
#' @param new_mat_id id of matrix in scdb
#' @param mat_id existing matrix
#' @param ig_gene gene names to ignore
#' @param reverse set this to true to focus on genes instead of ignore them. False by default
#'
#' @export

mcell_mat_ignore_genes = function(new_mat_id, mat_id, ig_genes, reverse=F)
{
	if(is.null(scdb_mat(mat_id))) {
		stop("mcell_mat_ignore_genes called with missing mat id, ", mat_id)
	}
	mat = scdb_mat(mat_id)

	new_mat = scm_ignore_genes(mat, ig_genes, reverse)
	scdb_add_mat(new_mat_id, new_mat)
}

#' Set ignored (i.e. blacklisted) cells
#'
#' Given a list of cells to ignore, this will cancel any previous policy for blacklisting and remove the given cells to the ignore_mat. Downstream algorithm usually ignore these cells altogether, for any purpose including normalization. However, ignored cells can be accessed and analyzed seperately for validation/tests or when they represent some relevant biology (e.g. cell cycle)
#'
#' @param scmat the matrix object
#' @param ig_cell a list of cell names to ignore
#' @param reverse false by default, if this is true the set of cells to ingore is the complement of the given list
#'
#' @export

scm_ignore_cells = function(scmat, ig_cells, reverse=FALSE)
{
	if(is.null(ig_cells) | length(ig_cells) == 0) {
		ig_cells = vector(l=0)
	}
	if(length(scmat@ignore_cells) > 0) {
		scmat@mat = cbind(scmat@mat, scmat@ignore_cmat)
		if(length(scmat@ignore_genes) > 0) {
			scmat@ignore_gmat = cbind(scmat@ignore_gmat, scmat@ignore_gcmat)
		}
	}
	if(!reverse) {
		good_cells = setdiff(colnames(scmat@mat), ig_cells)
		scmat@ignore_cells = intersect(colnames(scmat@mat), ig_cells)
	} else {
		scmat@ignore_cells = setdiff(colnames(scmat@mat), ig_cells)
		good_cells = intersect(colnames(scmat@mat), ig_cells)
		if(length(good_cells) != length(ig_cells)) {
			stop("Some cells to focus on (ignore_cell, reverse=T), are missing from the current matrix, check your list. len(intersect) = ", length(good_cells), " len(ig_cells) = ", length(ig_cells))
		}
	}
	scmat@cells = good_cells
	scmat@ncells = length(good_cells)
	scmat@ignore_cmat = scmat@mat[,scmat@ignore_cells]
	if(length(scmat@ignore_genes) > 0) {
		scmat@ignore_gcmat = scmat@ignore_gmat[,scmat@ignore_cells]
		scmat@ignore_gmat = scmat@ignore_gmat[,good_cells]
	}
	scmat@mat = scmat@mat[,good_cells]
	return(scmat)
}

#' Set ignored (i.e. blacklisted) genes
#'
#' Given a list of genes to ignore, this will cancel any previous policy for blacklisting and remove the given genes to the ignore_mat. Downstream algorithm usually ignore these genes altogether, for any purpose including normalization. However, ignored genes can be accessed and analyzed seperately for validation/tests or when they represent some relevant biology (e.g. cell cycle)
#'
#' @param scmat the matrix object
#' @param ig_gene a list of gene names to ignore
#' @param reverse false by default, if this is true the set of genes to ingore is the complement of the given list
#'
#' @export

scm_ignore_genes = function(scmat, ig_genes, reverse=FALSE)
{
	if(is.null(ig_genes)) {
		ig_genes = vector(l=0)
	}
	if(length(scmat@ignore_genes) > 0) {
		scmat@mat = rbind(scmat@mat, scmat@ignore_gmat)
		if(length(scmat@ignore_cells) > 0) {
			scmat@ignore_cmat = rbind(scmat@ignore_cmat, scmat@ignore_gcmat)
		}
	}
	if(!reverse) {
		good_genes = setdiff(rownames(scmat@mat), ig_genes)
		scmat@ignore_genes = intersect(rownames(scmat@mat), ig_genes)
	} else {
		scmat@ignore_genes = setdiff(rownames(scmat@mat), ig_genes)
		good_genes = intersect(rownames(scmat@mat), ig_genes)
		if(length(good_genes) != length(ig_genes)) {
			stop("Some genes to focus on (ignore_cell, reverse=T), are missing from the current matrix, check your list. len(intersect) = ", length(good_genes), " len(ig_genes) = ", length(ig_genes))
		}
	}
	scmat@genes = good_genes
	scmat@ignore_gmat = scmat@mat[scmat@ignore_genes,]
	if(length(scmat@ignore_cells) > 0) {
		scmat@ignore_gcmat = scmat@ignore_cmat[scmat@ignore_genes,]
		scmat@ignore_cmat = scmat@ignore_cmat[good_genes,]
	}
	scmat@mat = scmat@mat[good_genes,]
	return(scmat)
}

#' Determine recommended downsampling depth.
#'
#' If the parameter scm_n_downsamp is set, it will be returned. If it is null, we return the 5th percentile of the umi count or 750, depending which is larger. However, if the median umi count is lower than this, we use it as the depth. In usch "bad" cases, it may be a good idea to tune the parameter after looking at the umi distribution and resolving possibilities for empty wells/barcodes
#'
#' @param mat_id
#'
#' @export
scm_which_downsamp_n = function(scmat)
{
	downsample_n = get_param("scm_n_downsamp_gstat")
	if(is.null(downsample_n)) {
   	downsample_n = min(round(quantile(colSums(scmat@mat), 0.5)),
                  max(750, round(quantile(colSums(scmat@mat), 0.05))))
  	}
	return(downsample_n)
}

setMethod(
	"show",
	signature = "tgScMat",
	definition =
		function(object) {
			cat("An object of class ", class(object), ",", sep = "")
			cat(" stat type ", object@stat_type, ".\n", sep = "")
			cat(length(object@cells), " cells by ", nrow(object@mat), " genes. median cell content ", median(Matrix::colSums(object@mat)), ".\n", sep = "")
			invisible(NULL)
		}
)

#' Export a mat object (umi matrix and metadata table) to a SingleCellExperiment object
#'
#' @param mat_id id of the mat object to export
#'
#' @return SingleCellExpriment instance
#' @export
#'
scm_export_mat_to_sce = function(mat_id, add_log_counts=F, scale_to=1e4)
{
    mat = scdb_mat(mat_id)
    if (is.null(mat)) {
        error(sprintf("In scm_export_mat_to_seurat, could not find metacell mat %s", mat_id))
    }

    # Adjusted from Seurat Convert functions
    sce <- SingleCellExperiment::SingleCellExperiment(assays = list(counts = mat@mat, logcounts = log(1+ scale_to * t(t(mat@mat) / colSums(mat@mat)))))

    SummarizedExperiment::colData(sce) <- S4Vectors::DataFrame(mat@cell_metadata[mat@cells, ])

    sce
}

#' Import a umi count matrix with metadata per cell from a SingleCellExperiment objectto a scmat object  to a SingleCellExperiment object
#'
#' @param sce Input SingleCellExperiment to export
#' @param counts_slot name of the umi matrix slot
#'
#' @return tgScMat
#' @export
#'
scm_import_sce_to_mat = function(sce, counts_slot = "counts")
{
    # Adjusted from Seurat Convert functions
    umis <- tryCatch(
        expr = SummarizedExperiment::assay(sce, counts_slot),
        error = function(e) {
            stop(paste0("No data in provided assay - ", counts_slot))
        }
    )

    md <- as.data.frame(SummarizedExperiment::colData(sce))

    scm_new_matrix(umis, md)
}


#!/usr/bin/Rscript

## snpchip2gtmap.r -- Creates a chromosome location diagram for a sequence of SNPs, with
## a genotype summary below

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

usage <- function(){
  cat("usage: ./snpchip2gtmap.r <genotype file> <SNP location file>\n");
}

argLoc <- 1;
gtFile <- FALSE;
locFile <- FALSE;
useLocation <- TRUE;
featureNames <- NULL;
featureLocs <- NULL;
popLimits <- NULL;
popNames <- NULL;

while(!is.na(commandArgs(TRUE)[argLoc])){
  if(file.exists(commandArgs(TRUE)[argLoc])){ # file existence check
    if(gtFile == FALSE){
      gtFile <- commandArgs(TRUE)[argLoc];
    } else {
      if(locFile == FALSE){
        locFile <- commandArgs(TRUE)[argLoc];
      } else{
        cat("Error: More than two input files specified\n");
        cat("usage: ./snpchip2gtmap.r <genotype file> <SNP location file>\n");
        quit(save="no", status=2);
      }
    }
  }
  else{ # other command line arguments
    if(commandArgs(TRUE)[argLoc] == "-feature"){
      featureNames <- append(featureNames,
                             commandArgs(TRUE)[argLoc+1]);
      featureLocs <- append(featureLocs,
                            as.numeric(commandArgs(TRUE)[argLoc+2]));
      argLoc <- argLoc + 2;
    }
    if(commandArgs(TRUE)[argLoc] == "-nolocation"){
      useLocation <- FALSE;
    }
    if(substr(commandArgs(TRUE)[argLoc],1,1) == "p"){
      popNames <- append(popNames, substring(commandArgs(TRUE)[argLoc],2));
      popLimits <- cbind(popLimits,c(as.numeric(commandArgs(TRUE)[argLoc+1]),
                                     as.numeric(commandArgs(TRUE)[argLoc+2])));
      argLoc <- argLoc + 2;
    }
  }
  argLoc <- argLoc + 1;
}

if(locFile == FALSE){
  cat("Error: Fewer than two [valid] input files specified\n");
  cat("usage: ./snpchip2gtmap.r <genotype file> <SNP location file>\n");
  quit(save="no", status=2);
}

gt.df <-
  read.table(gtFile, colClasses = "character");
numIndivs <- dim(gt.df)[2] - 1;
colnames(gt.df) <- c("Marker",1:numIndivs);
rownames(gt.df) <- gt.df[,"Marker"];

loc.df <- read.table(locFile, nrows = 1);
if(length(grep("^rs",loc.df[1,1])) == 0){
  loc.df <- read.table(locFile, header = TRUE);
} else {
  loc.df <- read.table(locFile);
}
colnames(loc.df) <- c("Marker","Mutation","Chromosome","Location");

gt.df <- merge(gt.df,loc.df);
rownames(gt.df) <- gt.df[,"Marker"];
gt.df <- gt.df[,-1]; # remove marker, now that it's added to rownames

for(x in 1:numIndivs){
  ## substitute complementary bases
  gt.df[,x] <- gsub("T","A",gt.df[,x]);
  gt.df[,x] <- gsub("G","C",gt.df[,x]);
  if(length(which(gt.df[,x] == "CA"))>0){
    ## not including this check complains gives the following error:
    ## In max(i) : no non-missing arguments to max; returning -Inf
    gt.df[which(gt.df[,x] == "CA"),x] <- "AC";
  }
  if(length(grep("[^AC]",gt.df[,x]))>0){
    ## not including this check complains gives the following error:
    ## In max(i) : no non-missing arguments to max; returning -Inf
    gt.df[grep("[^AC]",gt.df[,x]),x] <- NA;
  }
}
## replace text with "C-purity" value
gt.df[,1:numIndivs] <- (function(x){
  ifelse(is.na(x),NA,ifelse(x=="AA",0,ifelse(x=="CC",1,0.5)));
})(gt.df[,1:numIndivs])

##print(gt.df[1:5,c(1:5,(dim(gt.df)[2]-5):dim(gt.df)[2])]);

if(useLocation){
  gt.df[,"Location"] <- gt.df[,"Location"] / 1000000;
  gt.df <- gt.df[order(gt.df[,"Location"]),];
} else {
  gt.df[,"Location"] <- 1:length(gt.df[,"Location"]);
}

gt.numeric <- gt.df[,1:numIndivs];
gt.numeric[is.na(gt.numeric)] <- -2;
gt.df[,1:numIndivs] <- gt.numeric;

ref.means <- colMeans(gt.df[,1:numIndivs], na.rm = TRUE);
hcc <- hclust(dist(t(gt.df[,1:numIndivs])));
ddc <- reorder(as.dendrogram(hcc), ref.means);
hcc <- order.dendrogram(ddc);

gt.numeric <- gt.df[,hcc];
gt.numeric[gt.numeric == -2] <- NA;
colnames(gt.numeric) <- hcc;
gt.numeric[,numIndivs+1] <- NA;
colnames(gt.numeric)[numIndivs+1] <- "";
if(!is.null(popNames)){
  for(x in 1:length(popNames)){
    gt.numeric[,numIndivs+x+1] <-
      rowMeans(gt.numeric[,popLimits[1,x]:popLimits[2,x]]);
    colnames(gt.numeric)[numIndivs+x+1] <- popNames[x];
  }
}

pdf("output_gtmap.pdf",width=11,height=8,paper="a4r");
library(gtools);
library(gdata);
library(gplots, warn.conflicts = FALSE);
if(useLocation){
  xLabel <- "Location (Mbp)";
} else {
  xLabel <- "SNP Number";
}
image(gt.df[,"Location"], 1:(numIndivs + length(popNames)+1),
      as.matrix(gt.numeric),
      col = rgb(
        c(seq(1,1,length.out=5),seq(1,0,length.out=5)),
        c(seq(0,1,length.out=5),seq(1,1,length.out=5)),0),
       axes=FALSE, xlab = xLabel, ylab = "",cex.lab = 2);

axis(1, las = 2, line = 0.5, cex.axis = 1);

axis(4, at = 1:(numIndivs + length(popNames)+1), labels=colnames(gt.numeric),
     las = 2, line = -0.5, tick =
     0, cex.axis =  min(0.5, 30 / (numIndivs + length(popNames)+1)) );

if(!is.null(featureNames)){
  for(x in 1:length(featureNames)){
    segments(x0=featureLocs[x]/1000000, y0=0,
             x1=featureLocs[x]/1000000, y1=numIndivs + length(popNames)+2);
    rect(xleft=featureLocs[x]/1000000 - 0.125,
         ybottom=(numIndivs + length(popNames)+2)/2 - 10,
         xright=featureLocs[x]/1000000 + 0.125,
         ytop=(numIndivs + length(popNames)+2)/2 + 10,
         col="white", border = "black");
    text(srt=90, x=featureLocs[x]/1000000,
         y=(numIndivs + length(popNames)+2)/2, featureNames[x]);
  }
}
dummy <- dev.off();


########----- Network Gadus morhua ------########
####
library(magrittr)
library(webshot)
library(htmlwidgets)
library(DiagrammeR)
library(igraph)

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')

plot0 <- function(x = 1, y = 1, xmin = 0, xmax = 1, ymin = 0, ymax = 1) {
  plot(x = x,
       y = y,
       bty = "n",
       ann = FALSE,
       xaxt = "n",
       yaxt = "n",
       type = "n",
       bg = "grey",
       ylim = c(ymin,ymax),
       xlim = c(xmin,xmax))
}

####
get_connec <- function(x) sum(x)/prod(dim(x))
spFocus <- c('Hippoglossus hippoglossus', 'Gadus morhua', 'Pandalus borealis', 'Chionoecetes opilio')
spFocusName <- c('Atlantic halibut', 'Atlantic cod', 'Northern prawn', 'Snow crab')
metaweb <- readRDS("./RData/metaWeb.rds")
connec <- get_connec(metaweb) ## Curiosity
## Taxon
taxon <- readRDS("./RData/spEGSL.rds")
taxon_grp <- taxon[,3] %>%
  as.character %>%
  strsplit(split="[|]") %>%
  lapply(FUN = function(x) paste(x[2:3], collapse="-")) %>%
  unlist
##
taxon$grp <- gsub(taxon_grp, pat=" ", rep="")
taxon[which(taxon$grp=="Chordata-Actinopteri"),1:2]
taxon$grp[which(taxon$grp=="Chordata-Actinopteri")] <- "Chordata-Actinopterygii"

#### Crabe crevette Flétan
spsc <- c(1,3,4)
sp_nms <- spFocus[spsc]
id <- which(colnames(metaweb) %in% sp_nms)
idpro <- which(metaweb[id[1],] > 0)
prpr <- c()
for (i in id){
  prpr <- c(prpr, which(metaweb[i,] > 0), which(metaweb[, i] > 0))
}
subnet <- which(1:ncol(metaweb)%in%unique(prpr)) # Au lieu d'utiliser unique histoire que ce soit dans le bon ordre
grptax <- taxon$grp[subnet]
subweb <- metaweb[subnet,subnet]
id <- which(colnames(subweb) %in% sp_nms)
# Eliminer les autres liens
for (i in 1:nrow(subweb)) {
  for (j in 1:ncol(subweb)) {
    if (!(i%in%id | j%in%id)) subweb[i,j] = 0
  }
}
nsp <- ncol(subweb)
vec_names <- colnames(subweb)
vec_names[-id] <- 1:(nsp-3)
vec_names[id] <- c("PB", "CO", "HH")
vec_size <- rep(9, nsp)
vec_size[id] <- 18
# vec_colfont <- rep("white",nsp)
# vec_colfont[-id] <- "black"
# sp_nm <- "cracreflé"
netw <-  graph_from_adjacency_matrix(t(subweb))
##
pal <- c("#cc154b", "#f79809", "#11bdec",
  "#0c3179", "#680c88", "#f526f4", "#75da10", "#0b6b43",
  "#888a88", "#6b4308")
vec_col <-  pal[as.numeric(as.factor(grptax))]
##

lay <- layout_nicely(netw)
png(paste0("./fig/figure1.png"), width=7, height=9, units="in", res=300)
  layout(matrix(c(1,2), 2, 1), height=c(.8,.2))
  par(bg="transparent", mar=rep(0.4,4), fg="black", family = 'regText')
  plot(netw,
    vertex.color = vec_col,
    vertex.frame.color = "transparent",
    vertex.label.color = "black",
    vertex.label = vec_names,
    vertex.size = vec_size,
    # edge.width = 1+3*log(links$weight/min(links$weight)),
    layout = lay,
    edge.arrow.size = .5
    # edge.color = factor(links$from, levels=levels(as.factor(nodes$id)))
    )
  plot0()
  legend("center", bty="n", legend=sort(unique(grptax)), cex=1.2, pch=21, ncol=2,
  pt.bg=pal, col=pal, pt.cex=2.4)
    # layout = coords)
dev.off()

## Legend
nms <- colnames(subweb)[-id]
leg_txt <- ""
for (i in 1:length(nms)){
  leg_txt %<>% paste0(i, "-", nms[i], "; ")
}
nms <- colnames(subweb)[id]
for (i in 1:length(nms)){
  leg_txt %<>% paste0(c("PB", "CO", "HH")[i], "-", nms[i], "; ")
}

########## Figure 2

plotMean <- readRDS("../EGSL_species_distribution/RData/plotMean.rds")
subweb2 <- plotMean[subnet,subnet]
# # Eliminer associations < 0.4
# for (i in 1:nrow(subweb)) {
#   for (j in 1:ncol(subweb)) {
#     if (subweb2[i,j] > -.4 & subweb2[i,j] < .4) subweb2[i,j] = 0
#   }
# }
subweb2 <- subweb2[which(subweb > 0)] # sélectionner uniquement les liens relevés pour la figure 1
arrowWidth <- ((abs(subweb2)/min(abs(subweb2)))/50)+1
cols <- floor(subweb2)
cols[cols == 0 | cols == 1] <- '#3CADA2' # associations positives
cols[cols == -1] <- '#B62F34' # associations négatives

##

png(paste0("./fig/figure2.png"), width=7, height=9, units="in", res=300)
  layout(matrix(c(1,2), 2, 1), height=c(.8,.2))
  par(bg="transparent", mar=rep(0.4,4), fg="black", family = 'regText')
  plot(netw,
    vertex.color = vec_col,
    vertex.frame.color = "transparent",
    vertex.label.color = "black",
    vertex.label = vec_names,
    vertex.size = vec_size,
    edge.arrow.size = 0,
    edge.width = arrowWidth,
    edge.color = cols,
    layout = lay
    )
  plot0()
  legend("center", bty="n", legend=sort(unique(grptax)), cex=1.2, pch=21, ncol=2,
  pt.bg=pal, col=pal, pt.cex=2.4)
    # layout = coords)
dev.off()


library(randtoolbox)
library(dplyr)
library(tidyr)
library(rsm)
library(DiceKriging)
library(DiceOptim)
library(future.apply)

plan(multiprocess, workers = 256)

args = commandArgs(trailingOnly = TRUE)

quiet <- function(x) {
  sink(tempfile())
  on.exit(sink())
  invisible(force(x))
}

iterations <- 2

results <- NULL

# Resnet50
sobol_dim <- 54 * 1

# vgg19
# sobol_dim <- 19 * 2

starting_sobol_n <- (1 * sobol_dim) + 10
sobol_n <- starting_sobol_n

bit_min <- 1
bit_max <- 8
perturbation_range <- 3 * (bit_min / bit_max)

gpr_iterations <- 30
gpr_added_points <- 3

gpr_added_neighbours <- 3
gpr_neighbourhood_factor <- 1000

gpr_sample_size <- 60 * sobol_dim

total_measurements <- starting_sobol_n + (gpr_iterations * (gpr_added_points + gpr_added_neighbours))

network <- "resnet50"
network_sizes_data <- "network_sizes_data.csv"

preserve_ratio <- 0.1
batch_size <- 128
cuda_device <- as.integer(args[1])
resume_run_id <- as.integer(args[2])

size_weight <- 10.0
top1_weight <- 0.0
top5_weight <- 2.5

network_sizes <- read.csv(network_sizes_data)
network_specs <- network_sizes %>%
    filter(id == network)

design <- NULL
gpr_model <- NULL
df_design <- NULL
current_results <- NULL
size_df <- NULL
coded_size_df <- NULL
new_sample <- NULL
perturbation <- NULL
gpr_sample <- NULL
search_space <- NULL

for(i in 1:iterations){
    if(!(is.null(gpr_sample))){
        rm(gpr_sample)
        quiet(gc())
        gpr_sample <- NULL
    }
    if(!(is.null(search_space))){
        rm(search_space)
        quiet(gc())
        search_space <- NULL
    }

    start_time <- as.integer(format(Sys.time(), "%s"))

    temp_sobol <- sobol(n = sobol_n,
                        dim = sobol_dim,
                        scrambling = 2,
                        seed = as.integer((99999 - 10000) * runif(1) + 10000),
                        init = TRUE)

    rm(temp_sobol)
    quiet(gc())

    if(i == 1 && resume_run_id != -1){
        print(paste("Resuming run:", resume_run_id))
        run_id <- resume_run_id
    } else{
        run_id <- round(100000 * runif(1))

        if(!(is.null(design))){
            rm(design)
            quiet(gc())
            design <- NULL
        }

        design <- sobol(n = sobol_n,
                        dim = sobol_dim,
                        scrambling = 2,
                        seed = as.integer((99999 - 10000) * runif(1) + 10000),
                        init = FALSE)

        if(!(is.null(df_design))){
            rm(df_design)
            quiet(gc())
            df_design <- NULL
        }

        df_design <- data.frame(design)

        # names(df_design) <- c(rbind(paste("W",
        #                                   seq(1:(sobol_dim / 2)),
        #                                   sep = ""),
        #                             paste("A",
        #                                   seq(1:(sobol_dim / 2)),
        #                                   sep = "")))

        write.csv(df_design,
                  paste("current_design_",
                        run_id,
                        ".csv",
                        sep = ""),
                  row.names = FALSE)

        cmd <- paste("CUDA_VISIBLE_DEVICES=",
                     cuda_device,
                     " python3 -W ignore rl_quantize.py --arch ",
                     network,
                     " --dataset imagenet --dataset_root data",
                     " --suffix ratio010 --preserve_ratio ",
                     preserve_ratio,
                     " --n_worker 120 --warmup -1 --train_episode ",
                     sobol_n,
                     " --use_top5",
                     " --run_id ",
                     run_id,
                     " --data_bsize ",
                     batch_size,
                     " --optimizer RS --val_size 10000",
                     " --train_size 20000",
                     sep = "")

        print(cmd)
        system(cmd)

        system("rm -r ../../save")
    }

    if(!(is.null(current_results))){
        rm(current_results)
        quiet(gc())
        current_results <- NULL
    }

    current_results <- read.csv(paste("current_results_",
                                      run_id,
                                      ".csv",
                                      sep = ""),
                                header = TRUE)

    if(is.null(search_space)){
        search_space <- current_results
    } else{
        search_space <- bind_rows(search_space, current_results) %>%
            distinct()
    }

    write.csv(search_space,
              paste("gpr_",
                    total_measurements,
                    "_samples_",
                    i,
                    "_iteration_id_",
                    run_id,
                    "_search_space.csv",
                    sep = ""),
              row.names = FALSE)

    for(j in 1:gpr_iterations){
        print("Starting reg")

        if(!(is.null(size_df))){
            rm(size_df)
            quiet(gc())
            size_df <- NULL
        }

        # size_df <- select(search_space, -Top5, -Top1)
        # formulas <- character(length(names(size_df)))

        # for(k in 1:length(names(size_df))){
        #     formulas[k] <- paste(names(size_df)[k],
        #                          "e ~ trunc((8 * ",
        #                          names(size_df)[k],
        #                          ") + 1)",
        #                          sep = "")
        # }

        # if(!(is.null(coded_size_df))){
        #     rm(coded_size_df)
        #     quiet(gc())
        #     coded_size_df <- NULL
        # }

        # coded_size_df <- coded.data(size_df, formulas = lapply(formulas, formula))
        # coded_size_df <- round(data.frame(coded_size_df))
        # coded_size_df$id <- seq(1:length(coded_size_df$A1e))
        # coded_size_df <- gather(coded_size_df, "Layer", "Bitwidth", -id)

        # coded_size_df <- coded_size_df %>%
        #     group_by(id) %>%
        #     do(mutate(., weights_MB = sum((network_specs$parameters *
        #                                    (filter(., grepl("W", Layer))$Bitwidth / 8)) / 1e6))) %>%
        #     do(mutate(., activations_MB = sum((network_specs$activations *
        #                                        (filter(., grepl("A", Layer))$Bitwidth / 8)) / 1e6))) %>%
        #     summarize(total_size_MB = unique(weights_MB) + unique(activations_MB),
        #               network_size_MB = sum(network_specs$bits8_size_MB))

        print("Search space:")
        print(str(search_space))
        # print("Coded weight df:")
        # print(str(coded_size_df))

        if(!(is.null(gpr_model))){
            rm(gpr_model)
            quiet(gc())
            gpr_model <- NULL
        }

        #y <- ((size_weight * (coded_size_df$total_size_MB / coded_size_df$network_size_MB)) +
        y <- ((size_weight * (search_space$SizeRatio)) +
              (top1_weight * ((100.0 - search_space$Top1) / 100.0)) +
              (top5_weight * ((100.0 - search_space$Top5) / 100.0))) /
            (size_weight + top1_weight + top5_weight)

        gpr_model <- km(formula = ~ .,
                        design = select(search_space, -Top5, -Top1, -Size, -SizeRatio),
                        response = y,
                        nugget = 1e-8 * var(y),
                        control = list(pop.size = 400,
                                       BFGSburnin = 500))

        print("Generating Sample")

        if(!(is.null(new_sample))){
            rm(new_sample)
            quiet(gc())
            new_sample <- NULL
        }

        new_sample <- sobol(n = gpr_sample_size,
                            dim = sobol_dim,
                            scrambling = 2,
                            seed = as.integer((99999 - 10000) * runif(1) + 10000),
                            init = FALSE)

        new_sample <- data.frame(new_sample)

        # names(new_sample) <- c(rbind(paste("W",
        #                                    seq(1:(sobol_dim / 2)),
        #                                    sep = ""),
        #                              paste("A",
        #                                    seq(1:(sobol_dim / 2)),
        #                                    sep = "")))

        if(is.null(gpr_sample)){
            gpr_sample <- new_sample %>%
                distinct()
        } else{
            gpr_sample <- bind_rows(gpr_sample, new_sample) %>%
                distinct()
        }

        print("Computing EI")
        # Using the EI function from DiceOptim:
        # gpr_sample$expected_improvement <- future_apply(gpr_sample,
        #                                                 1,
        #                                                 EI,
        #                                                 gpr_model)
        # gpr_selected_points <- gpr_sample %>%
        #     arrange(desc(expected_improvement))

        pred <- predict(gpr_model, gpr_sample, "UK")
        gpr_sample$expected_improvement <- pred$mean - (1.96 * pred$sd)

        gpr_selected_points <- gpr_sample %>%
            arrange(expected_improvement)

        gpr_sample <- select(gpr_sample, -expected_improvement)

        gpr_selected_points <- select(gpr_selected_points[1:gpr_added_points, ],
                                      -expected_improvement)

        print("Generating perturbation sample")

        if(!(is.null(perturbation))){
            rm(perturbation)
            quiet(gc())
            perturbation <- NULL
        }

        perturbation <- sobol(n = gpr_added_points * gpr_neighbourhood_factor,
                              dim = sobol_dim,
                              scrambling = 2,
                              seed = as.integer((99999 - 10000) * runif(1) + 10000),
                              init = FALSE)

        perturbation <- data.frame(perturbation)

        # names(perturbation) <- c(rbind(paste("W",
        #                                     seq(1:(sobol_dim / 2)),
        #                                     sep = ""),
        #                               paste("A",
        #                                     seq(1:(sobol_dim / 2)),
        #                                     sep = "")))

        perturbation <- (2 * perturbation_range * perturbation) - perturbation_range

        gpr_selected_neighbourhood <- gpr_selected_points %>%
            slice(rep(row_number(), gpr_neighbourhood_factor))

        gpr_selected_neighbourhood <- gpr_selected_neighbourhood + perturbation

        gpr_selected_neighbourhood[gpr_selected_neighbourhood < 0.0] <- 0.1
        gpr_selected_neighbourhood[gpr_selected_neighbourhood > 1.0] <- 0.9

        gpr_sample <- bind_rows(gpr_sample, gpr_selected_neighbourhood) %>%
            distinct()

        gpr_selected_points <- bind_rows(gpr_selected_points,
                                         gpr_selected_neighbourhood)
        gpr_selected_points <- gpr_selected_points %>%
            distinct()

        print("Computing perturbed EI")

        # Using EI from DiceOptim:
        # gpr_selected_points$expected_improvement <- future_apply(gpr_selected_points,
        #                                                          1,
        #                                                          EI,
        #                                                          gpr_model)
        # gpr_selected_points <- gpr_selected_points %>%
        #     arrange(desc(expected_improvement))

        pred <- predict(gpr_model, gpr_selected_points, "UK")
        gpr_selected_points$expected_improvement <- pred$mean - (1.96 * pred$sd)

        gpr_selected_points <- gpr_selected_points %>%
            arrange(expected_improvement)

        gpr_selected_points <- select(gpr_selected_points[1:(gpr_added_points +
                                                             gpr_added_neighbours), ],
                                      -expected_improvement)

        df_design <- data.frame(gpr_selected_points)
        # names(df_design) <- c(rbind(paste("W",
        #                                   seq(1:(sobol_dim / 2)),
        #                                   sep = ""),
        #                             paste("A",
        #                                   seq(1:(sobol_dim / 2)),
        #                                   sep = "")))

        write.csv(df_design,
                  paste("current_design_",
                        run_id,
                        ".csv",
                        sep = ""),
                  row.names = FALSE)

        cmd <- paste("CUDA_VISIBLE_DEVICES=",
                     cuda_device,
                     " python3 -W ignore rl_quantize.py --arch ",
                     network,
                     " --dataset imagenet --dataset_root data",
                     " --suffix ratio010 --preserve_ratio ",
                     preserve_ratio,
                     " --n_worker 120 --warmup -1 --train_episode ",
                     gpr_added_points + gpr_added_neighbours,
                     " --use_top5",
                     " --run_id ",
                     run_id,
                     " --data_bsize ",
                     batch_size,
                     " --optimizer RS --val_size 10000",
                     " --train_size 20000",
                     sep = "")

        print(cmd)
        system(cmd)

        system("rm -r ../../save")

        if(!(is.null(current_results))){
            rm(current_results)
            quiet(gc())
            current_results <- NULL
        }

        current_results <- read.csv(paste("current_results_",
                                          run_id,
                                          ".csv",
                                          sep = ""),
                                    header = TRUE)

        if(is.null(search_space)){
            search_space <- current_results
        } else{
            search_space <- bind_rows(search_space, current_results) %>%
                distinct()
        }

        write.csv(search_space,
                  paste("gpr_",
                        total_measurements,
                        "_samples_",
                        i,
                        "_iteration_id_",
                        run_id,
                        "_search_space.csv",
                        sep = ""),
                  row.names = FALSE)
    }

    elapsed_time <- as.integer(format(Sys.time(), "%s")) - start_time

    # Optimizing for Top5 (Top1, Model Size, Latency... ?)

    # top5 only
    # best_points <- filter(search_space, Top5 == max(Top5))

    # size_df <- select(search_space, -Top5, -Top1)
    # formulas <- character(length(names(size_df)))

    # for(k in 1:length(names(size_df))){
    #     formulas[k] <- paste(names(size_df)[k],
    #                          "e ~ trunc((8 * ",
    #                          names(size_df)[k],
    #                          ") + 1)",
    #                          sep = "")
    # }

    # coded_size_df <- coded.data(size_df, formulas = lapply(formulas, formula))
    # coded_size_df <- round(data.frame(coded_size_df))
    # coded_size_df$id <- seq(1:length(coded_size_df$A1e))
    # coded_size_df <- gather(coded_size_df, "Layer", "Bitwidth", -id)

    # coded_size_df <- coded_size_df %>%
    #     group_by(id) %>%
    #     do(mutate(., weights_MB = sum((network_specs$parameters *
    #                                    (filter(., grepl("W", Layer))$Bitwidth / 8)) / 1e6))) %>%
    #     do(mutate(., activations_MB = sum((network_specs$activations *
    #                                        (filter(., grepl("A", Layer))$Bitwidth / 8)) / 1e6))) %>%
    #     summarize(total_size_MB = unique(weights_MB) + unique(activations_MB),
    #               network_size_MB = sum(network_specs$bits8_size_MB))

    response_data <- search_space %>%
        mutate(performance_metric = ((size_weight * (search_space$SizeRatio)) +
                                     (top1_weight * ((100.0 - search_space$Top1) / 100.0)) +
                                     (top5_weight * ((100.0 - search_space$Top5) / 100.0))) /
                   (size_weight + top1_weight + top5_weight))

    best_points <- search_space[response_data$performance_metric == min(response_data$performance_metric), ]

    best_points$id <- i
    best_points$elapsed_seconds <- elapsed_time
    best_points$points <- total_measurements

    best_points$gpr_iterations <- gpr_iterations
    best_points$gpr_added_points <- gpr_added_points
    best_points$perturbation_range <- perturbation_range
    best_points$gpr_neighbourhood <- gpr_neighbourhood_factor
    best_points$gpr_sample_size <- gpr_sample_size

    if(is.null(results)){
        results <- best_points
    } else{
        results <- bind_rows(results, best_points)
    }

    write.csv(results,
              paste("gpr_",
                    total_measurements,
                    "_samples_",
                    iterations,
                    "_iterations_id_",
                    run_id,
                    ".csv",
                    sep = ""),
              row.names = FALSE)
}


fragment_HL_pen <- function(probe, pen, pen_out, from, to, cores) {
  # I.Preparations: the dataframe is configured and some other variables are
  # assigned

  registerDoMC(cores)

  probe <- probe[with(probe, order(-xtfrm(probe$strand), probe$position)), ]

  probe[probe$strand == "-", ] <- probe[probe$strand == "-", ][
      order(probe[probe$strand == "-", ]$position, decreasing = TRUE), ]

  # In this special version we look at position_segments
  tmp_df <-
    data.frame(
      ID = probe$ID,
      val = probe$distance_HL,
      seg = probe$position_segment
    )

  tmp_df <- na.omit(tmp_df)

  unique_seg <- unlist(unique(tmp_df$seg))

  # II. Dynamic Programming: the scoring function is interpreted

  frags <- foreach(k = seq_along(unique_seg)) %dopar% {

    section <- tmp_df[which(tmp_df$seg == unique_seg[k]), ]

    best_frags <- c()
    best_names <- c()

    if (nrow(section) >= from &
      nrow(section) <= to) {
      # the sampling is between 10 and 100

      for (i in 2:nrow(section)) {
        #
        tmp_score <-
          score_fun_ave(section[seq_len(i), "val"],
                        section[seq_len(i), "ID"], pen_out)
        tmp_name <- names(tmp_score)
        if (i > 3) {
          # fragments of the size at lest 4 are allowed for half-life
          for (j in (i - 1):3) {
            tmp_val <- section[j:i, "val"]
            tmp_ID <- section[j:i, "ID"]
            tmp <-
              score_fun_ave(tmp_val, tmp_ID, pen_out) + pen + best_frags[j - 2]
            tmp_score <- c(tmp_score, tmp)
            tmp_n <- paste0(best_names[j - 2], "|", names(tmp))
            tmp_name <- c(tmp_name, tmp_n)
          }
        }
        pos <- which(tmp_score == min(tmp_score))[1]
        tmp_score <- tmp_score[pos]
        tmp_name <- tmp_name[pos]
        best_frags <- c(best_frags, tmp_score)
        best_names <- c(best_names, tmp_name)
      }
    }
    best_names[length(best_names)]
  }

  frags <- frags[!(vapply(frags, is.null, logical(1)))]

  if (length(frags) == 0) {
    res1 <- 0
    res2 <- 0
    res <- list(res1, res2)
    names(res) <- c("distance_HL", "distance_HL_out")
    return(res)
  }

  # III. Fill the dataframe

  comp <- foreach(k = seq_along(frags)) %dopar% {
    na <- strsplit(frags[[k]], "\\|")[[1]]

    parts <- vector("list", length = length(na))

    for (i in seq_along(na)) {
      tmp_trgt <- strsplit(na[i], "_")[[1]][1]
      trgt <- strsplit(tmp_trgt, ",")[[1]]
      if (length(strsplit(na[i], "_")[[1]]) == 3) {
        tmp_outl <- strsplit(na[i], "_")[[1]][3]
        outl <- strsplit(tmp_outl, ",")[[1]]
        trgt <- trgt[-which(trgt %in% outl)]
      }
      rows <- match(trgt, probe[, "ID"])

      parts[[i]] <- probe[rows, "distance_HL"]
    }
    parts
  }

  p <- c()
  all <- 0

  for (k in seq_along(comp)) {
    all <- all + (length(comp[[k]]) - 1)
    if (length(comp[[k]]) > 1) {
      for (i in seq_len(length(comp[[k]]) - 1)) {
        if (!identical(unique(comp[[k]][[i]]), unique(comp[[k]][[i + 1]]))) {
          tryCatch({
              p_val <- t.test(comp[[k]][[i]], comp[[k]][[i + 1]])$p.value
              p <- c(p, p_val)
            },
            error = function(e) {
            }
          )
        }
      }
    }
  }
  p <- p.adjust(p)
  count <- length(p[which(p < 0.01)])
  res1 <- count
  res2 <- all - count
  res <- list(res1, res2)
  names(res) <- c("distance_HL", "distance_HL_out")
  res
}


##Ukázka 2=name
##R workshop=group
##Vystup=output vector
library(RCzechia)
Vystup <- obce_polygony()


# This file is Wei Wu's code in participating
# Kaggle "American Epilepsy Society Seizure Prediction Challenge" Competition
#
# Copyright (c) 2014, Wei Wu
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in all
# copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.

require(plyr)

single_submissions=data.frame(subfile=c(
        "Official_XGBoost_median0.9_Split10_Freq200FFT2-0.2Log1_nround5000_eta0.05_depth6_lambda0.25_alpha0_child1_subsamp1_colsamp1_delflds1_sub.csv", # 0.80514 (Public LB)
        "Official_SVM_Individual_median0.9_Split10_Freq200FFT2-0.2Log1_cost100_gamma0.001_delflds0_sub.csv", # Old LB 0.79975,  New LB 0.79813
        "Official_SVM_median0.9_Split10_Freq200FFT2-0.2Log1_cost100_gamma0.001_delflds0_sub.csv", # Old LB 0.7879, New LB 0.78785
        "Official_glmnet_median0.75_Split10_Freq200FFT2-0.2Log1_alpha0_delflds0_sub.csv", # 0.70077
        "Official_glmnet_Individual_median0.9_Split10_Freq200FFT2-0.2Log1_alpha0_delflds0_sub.csv" #0.72466
	),
	subscore=c(0.80514, 0.79975, 0.78790, 0.70077, 0.72466),
	stringsAsFactors=FALSE)

### Setting do_holdout = 0 to get ensembled submission for test submission
### Setting do_holdout = 1 to get submission for post-competition holdout results
do_holdout=0

nmix=5
do_scale=2	# 0 no scaling, 1 - range scaling, 2 - rank scaling
weighted=5	# 0 - not weighted, 1 - score weighted, 2 - score^2, 3 - score^3
all_scores=NULL
weight_sum = 0
for (i in c(1:nmix)) {
	myfile=single_submissions$subfile[i]
        if (do_holdout == 1) {
            myfile=gsub("^Official_","Holdout_",myfile)
        }
	myscore=single_submissions$subscore[i]
	a=read.csv(myfile)
	if (do_scale == 1) {
		amax=max(a[,2])
		amin=min(a[,2])
		a[,2]=(a[,2]-amin)/(amax-amin)
	}
	if (do_scale == 2) {
#		a[order(a[,2]),2]=1:nrow(a)
		a[order(a[,2]),2]=(1:nrow(a))/nrow(a)
	}
	if (weighted == 1) {
		a[,2]=a[,2]*myscore
		weight_sum=weight_sum+myscore
	}
	if (weighted > 1) {
		a[,2]=a[,2]*myscore^weighted
		weight_sum=weight_sum+(myscore^weighted)
	}
	if (is.null(all_scores)) {
		all_scores=a
	} else {
		all_scores=join(all_scores, a, by="clip")
	}
}

if (weighted == 0) {
	sub_scores=data.frame(clip=all_scores$clip, preictal=rowMeans(all_scores[,2:ncol(all_scores)]))
} else {
	sub_scores=data.frame(clip=all_scores$clip, preictal=rowSums(all_scores[,2:ncol(all_scores)])/weight_sum)
}

if (do_holdout == 1) {
    fname=paste0("Holdoutmix_",nmix, "(xgb_svmInd_svm_glmnet_glmnetInd)", "_scale",do_scale,"_",
		ifelse(weighted,paste0("weighted",weighted),"equal"), "_sub.csv")
} else {
    fname=paste0("Officialmix_",nmix, "(xgb_svmInd_svm_glmnet_glmnetInd)", "_scale",do_scale,"_",
		ifelse(weighted,paste0("weighted",weighted),"equal"), "_sub.csv")
}
write.csv(sub_scores, row.names=F, quote=F, file=fname)