#!/usr/bin/env Rscript

##################################################################################################################################
############## FUNCTION TO CALCULATE AND PLOT EVOLUTION OF SPECIES POPULATION  function:main.glm    ##############################
##################################################################################################################################

#### Based on Romain Lorrillière R script
#### Modified by Alan Amosse and Benjamin Yguel for integrating within Galaxy-E

##### workes with the R version 3.5.1 (2018-07-02)
##### Package used with the version:
#suppressMessages(library(lme4))  version 1.1.18.1
#suppressMessages(library(ggplot2))  version 3.0.0
#suppressMessages(library(speedglm))  version 0.3.2
#suppressMessages(library(arm))  version 1.10.1
#suppressMessages(library(reshape))  version 0.8.8
#suppressMessages(library(data.table))  version 1.12.0
#suppressMessages(library(reshape2))   version 1.4.3

######################################### debut de la fonction makeTableAnalyse / stard of the function makeTableAnalyse
## mise en colonne des especes  et rajout de zero mais sur la base des carrés selectionné sans l'import  /  Species are placed in separated columns and addition of zero on plots where at least one selected species is present

makeTableAnalyse <- function(data) {
    tab <- reshape(data
                  ,v.names="abond"
                  ,idvar=c("carre","annee")
                  ,timevar="espece"
                  ,direction="wide")
    tab[is.na(tab)] <- 0               ###### remplace les na par des 0 / replace NAs by 0

    colnames(tab) <- sub("abond.","",colnames(tab))### remplace le premier pattern "abond." par le second "" / replace the column names "abond." by ""
    return(tab)
}

######################################### fin de la fonction makeTableAnalyse / end of the function makeTableAnalyse

############################################# les fonctions qui filtrent les données pas suffisantes pour analyses fiables / The filtering functions removing species with not enough data to perform accurate analyses

filter_absent_species<-function(tab){
##################### Filtre les espèces jamais présentes (abondance=0) / Filter of species with 0 abundance
#################################################################################  PARTIE POTENTIELLEMENT ISOLABLE ET INSERABLE AVANT LA BOUCLE = permet de gagner du temps sur la boucle car supprime sps pas vu, donc pas repris par la boucle

    ## Fait la somme des abondances totales par espèce / calculate the sum of all abundance per species
    if(ncol(tab)==3) {
	tabSum <- sum(tab[,3])## cas d'une seule especes (problème de format et manip un peu differente)  / when selecting only one species, use a different method
	names(tabSum) <- colnames(tab)[3]
    } else {  ## cas de plusieurs espèce/ when selecting more than one species
        tabSum <- colSums(tab[,-(1:2)])
    }
    ## colNull= espece(s) toujours absente /species with 0 total abundance
    colNull <- names(which(tabSum==0))
    ## colconserve= espece(s) au moins presente 1 fois/ species at least with 1 presence
    colConserve <- names(which(tabSum>0))
    ## Affichage des espèces rejetees  / show species eliminated for the analyses
    if(length(colNull)>0){
        cat("\n",length(colNull)," Species removed from the analysis, abundance is always 0.\n\n",sep="")  #Espèces enlevées de l'analyse car abondance toujours égale a 0\n\n",sep="")
        #tabNull <- data.frame(Code_espece = colNull, nom_espece = tabsp[colNull,"nom"])
        cat("Removed absent species : \n-",paste(colNull,collapse="\n-"),sep="")
        tab <- tab[,c("carre","annee",colConserve)]
    }
################################################################################ FIN DE LA PARTIE ISOLABLE
    return(tab)
}

###################### Filtre les especes trop rare pour avoir des analyses robustes i.e. espèce non presente la 1ère année, avec plus de 3 ans consecutif sans données et moins de 3 ans consécutif avec données
######################  Filter too rare species for accurate analysis i.e.  species absent the first year, with more than 3 consecutive years with 0 abundance, or with less than 3 consecutive years with presence

###
filter_rare_species<-function(tab){
    exclude_threshold <- NULL
    ## calcul et filtre pour chaque (colonne) espece / measure and filter for each species
    for(i in 3:ncol(tab)) {
        ## v =abondance par annee / v= abundance per year
        v <- tapply(tab[,i],tab$annee,sum)  ####################
        ## v0 =presence(1) abscence(0) per year
        v0 <- ifelse(v>0,1,0)  #####
        tx <- paste(v0,collapse="") #### colle les 0 et 1 / stick the 0 and 1

        p <- unlist(strsplit(tx,"0"))#### Enleve les 0, ce qui séparent les sequences de "1", les sequences de "1" = nbre d'années consécutives avec data / remove 0, splitting sequences of "1" which correspond to consecutve year with data (e.g. 111 = 3 years consecutive years with data)
        p <- p[p!=""] #### ne garde pas les partie sans 1 ou 0 dans les sequences
        ## gsSup0 = plus grande serie temporelle de presence =calcul du nbre de 1 consécutif max / calcul of the biggest temporal series which corresponds to the maximum number of consecutive "1"
        gsSup0 <- max(nchar(p))####
        ## gsInf0 plus grande serie temporelle d'absccence ou sans données = enlève les 1 séparant sequence de 0 qui correspondent au nbre d'année consecutive sans données / calcul of the biggest temporal series without data which corresponds to max numbzer fo consecutive "0"
        gsInf0 <- max(nchar(unlist(strsplit(tx,"1")))) ####
        ## y0is0 absence la premiere annee
        y0is0 <- v0[1]==0  #### True ou false pour presence de "0"(=pas de données) dans la 1ère année / look if the first year of the time sequence analyzed has no data
        ## seuil d'exclusion / exclusion threshold
        exclude_threshold <- c(exclude_threshold,as.vector(ifelse( y0is0 | gsInf0 > 3 | gsSup0 < 3 ,"exclu","bon")))  ############## exclu sps absente la 1ère année, avec plus de 3 ans consécutifs sans données, et avec moins de 3 années consécutives sans données / indicate if the max consecutive year with data and without data, as well as whether the first year of the time sequence analyzed has data
    }
    names(exclude_threshold) <- colnames(tab)[3:ncol(tab)]

    ## colonnes conservees avec assez de données / Column with enough data
    colConserve <- names(exclude_threshold)[exclude_threshold=="bon"]

    ## colonnes supprimees / Column that will conserved
    colSupr <- names(exclude_threshold)[exclude_threshold=="exclu"]
    tabCLEAN <- tab[,c("carre","annee",colConserve)] #### Garde les sps à conserver / select only species with enough data
    lfiltre <- list(tabCLEAN=tabCLEAN,colConserve=colConserve,colSupr=colSupr)

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

    ## colConserve espece conservees / extract species that will be kept to print them
    colConserve <- lfiltre$colConserve
    ## colsupr espece trop rare et donc supprimée de l'analyse / extract species that will be deleted to print them
    colSupr <- lfiltre$colSupr
    ## affichage des especes retirer de l'analyse / print species that will be deleted
    if(length(colSupr)>0){
        cat("\n",length(colSupr)," Rare species removed from the analysis.\n\n",sep="")
        #tabSupr <- subset(tabsp,espece %in% colSupr ,select=c("espece","nom"))
        #tabSupr <- tabSupr[order(tabSupr$espece),]
        cat("Removed rare species : \n-",paste(colSupr,collapse="\n-"),sep="")

    }
    if(length(colConserve)==0) {
        mess <- "No species available to calculate abundance variation in this dataset."
        stop(mess)
    }

    tabCLEAN <- lfiltre$tabCLEAN

                                        #### MARCHE PAS NE SAIT PAS PQUOI
    tabCLEAN <- melt(tabCLEAN, id.vars=c("carre", "annee"))  #### remet le format de base :le nom d'espèce et abondance dans des colonnes séparées / back to the first format of the file: species name and abundance in separated column

    colnames(tabCLEAN)[3:4] <- c("espece","abond")
    tabCLEAN$annee <- as.numeric(as.character(tabCLEAN$annee))
################################################################################
    return(tabCLEAN)
}

####################################################################################################################### fin des 2 fonctions de filtre des données / end of the two function to filter the data

############################################################################################ debut de la Function main.glm / start of the function main.glm

main.glm <- function(id="france",donneesAll=dataCLEAN,assessIC= TRUE,tabsp=tabsp,annees=annees,figure=TRUE,description=TRUE,tendanceSurFigure=TRUE, ###### declaration des arguments  listSp=sp était avant declaré avant la fonction mais il me semble que ca marche aussi comme cela
                     seuilOccu=14,seuilAbond=NA) {

    filesaveAn <-  paste("Output/",id,"/variationsAnnuellesEspece_",id,".tabular",  ##### Nom du dossier ET fichier de sortie des resultats par année / name of the output file with results for each years
                         sep = "")
    filesaveTrend <-  paste("Output/",id,"/tendanceGlobalEspece_",id,".tabular",   ##### Nom du dossier ET fichier de sortie des resultats pour la période "annee" complete / name of the output file with the results for the period
                            sep = "")
    fileSaveGLMs <-  paste("Output/",id,"/listGLM_",id,sep = "")  #####  Nom du dossier ET fichier de sortie des modèles lineaire generalisés / name of the output file of the generlized linear models

    seuilSignif <- 0.05  ## seuil de significativite / significancy threshold

   rownames(tabsp) <- tabsp$espece  ## change nom des lignes de tabsp (table de reference des especes)

    ##vpan vecteur des panels de la figure  ###### POUR FAIRE LES GRAPHIQUES
    vpan <- c("Variation abondance")
    if(description) vpan <- c(vpan,"Occurrences","Abondances brutes")

    ## specifications des variables temporelles necesaires pour les analyses / specification of temporal variable necessary for the analyses
    annee <- sort(unique(donneesAll$annee))
    nbans <- length(annee)
    pasdetemps <- nbans-1
    firstY <- min(annee)
    lastY <- max(annee)

    ## Ordre de traitement des especes ### order of species to be analyzed
    spOrdre <- aggregate(abond~espece,data=donneesAll,sum)  #### calcul les sommes des abondances pour ordonner / calculate the sum for the ordination
    spOrdre <- merge(spOrdre,tabsp,by="espece") #### rajoute la colonne avec les abondances totales par espece / add a new column with the sum

    spOrdre <- spOrdre[order(as.numeric(spOrdre$indicateur),spOrdre$abond,decreasing = TRUE),] #### mets les especes plus abondantes en premiers (plus long pour faire tourner le modèle) / order the species by abundance, the most abundant species being the less fast analysis

    listSp <- spOrdre$espece
    i <- 0
    nbSp <- length(listSp)
                                        #	browser()
    ## analyse par espece
### browser()
    ## affichage des especes conservees pour l'analyse  ### PAS SUR QUE CE SOIT ENCORE UTILE
    cat("\n",nbSp," Espèces conservées pour l'analyse\n\n",sep="")
    rownames(tabsp) <- tabsp$espece
    print(tabsp[,1:2])
    #tabCons <- data.frame(Code_espece = listSp, nom_espece = tabsp[as.character(listSp),"nom"])
    #print(tabCons)
    cat("\n\n",sep="")
    flush.console()

    ## initialisation de la liste de sauvegarde

##browser()

    for (sp in listSp) {  ######## Boucle pour analyse par espèce / loop for the analysis by species

        i <- i + 1

        d <- subset(donneesAll,espece==sp)  ## d data pour l'espece en court  / cut the data keeping only the i species

        #nomSp <- as.character(tabsp[sp,"nom"])  ## info sp
        nomSp <- tabsp$nom[which(tabsp$espece==sp)]  ## info sp
        cat("\n(",i,"/",nbSp,") ",sp," | ", nomSp,"\n",sep="")
        flush.console()

        #indic <- tabsp[sp,"indicateur"] ## indic :espece utilisee pour le calcul des indicateurs par groupe de specialisation / list the species used as species indicators by trophic specialization
        indic <- tabsp$indicateur[which(tabsp$espece==sp)] ## indic :espece utilisee pour le calcul des indicateurs par groupe de specialisation / list the species used as species indicators by trophic specialization
        nb_carre = tapply(rep(1,nrow(d)),d$annee,sum) ## nb_carre nombre de carre suivie par annee / number of plots per year

        nb_carre_presence = tapply(ifelse(d$abond>0,1,0),d$annee,sum) ## nb_carre_presence nombre de carre de presence par annee / number the plots where the species were observed

        tab2 <- data.frame(annee=rep(annee,2),val=c(nb_carre,nb_carre_presence),LL = NA,UL=NA, ## tab2 table de resultat d'analyse / data.frame of the analyses results
                           catPoint=NA,pval=NA,
                           courbe=rep(c("carre","presence"),each=length(annee)),panel=vpan[2])
        tab2$catPoint <- ifelse(tab2$val == 0,"0",ifelse(tab2$val < seuilOccu,"infSeuil",NA))

        abond <- tapply(d$abond,d$annee,sum) ## abond abondance par annee / abundance per year

        tab3 <- data.frame(annee=annee,val=abond,LL = NA,UL=NA,catPoint=NA,pval=NA,courbe=vpan[3],panel=vpan[3]) ## table pour la figure / data.frame made to realize the graphical outputs
        tab3$catPoint <- ifelse(tab3$val == 0,"0",ifelse(tab3$val < seuilAbond,"infSeuil",NA))

        ## GLM pour calcul des tendances annuelles de l'evolution des populations / GLM to measure annual tendency of population evolution
       formule <- as.formula("abond~as.factor(carre)+as.factor(annee)") #### specification du modèle = log lineaire / specifying the model = log linear
       if(assessIC) {##### OPTION A RENTRER AU DEBUT PEUT ËTRE A METTRE DANS LES ARGUMENTS SI LAISSE LE CHOIX SINON L ARG PAR DEFAUT LORS DE LA DECLARATION DE LA FONCTION
           glm1 <- glm(formule,data=d,family=quasipoisson)  ##### fit model lineaire general avec intervalle de confiance disponible / fit linear and generalized model with confidence intervalle available
       } else {
           glm1 <- try(speedglm(formule,data=d,family=quasipoisson())) ##### fit modele lineaire et generaux pour les gros jeux de données / fit of linear and generalized model for large-medium dataset
           if(class(glm1)[1]=="try-error")
               glm1 <- glm(formule,data=d,family=quasipoisson) ##### comprends pas mais je pense que c'est speedglm qui marche pas avec toutes les données
       }
       sglm1 <- summary(glm1)  #### sortie du modele / output of the model
       sglm1 <- coefficients(sglm1) ### coefficient regression de chaque variable avec les résultats des tests statistiques / regression coefficient of each predictive variables with results of the statistical tests
       sglm1 <- tail(sglm1,pasdetemps) #### recupére les derniers elements du modèle avec la taille de l'objet "pasdetemps" car le nombre de coef = nbre d'année et pas les coefficient de regression de la variable carre / retrieve only the coefficient regression of the variable year
       coefan <- as.numeric(as.character(sglm1[,1]))#### coefficient de regression de la variable année (1 pour chaque année)

        coefannee <- c(1,exp(coefan))## coefannee vecteur des variation d'abondance par annee avec transformation inverse du log :exp() / regression coefficient of the year back transformed from log(abundance) : exp()

		erreuran <- as.numeric(as.character(sglm1[,2])) #### erreur standard sur le coefficient de regression de la variable annee  / standard error on the regression coefficient of the year
        erreurannee1 <- c(0,erreuran*exp(coefan))## erreur standard par année / the standard error per year  ###### LA J AI UN DOUTE NORMALEMENT INTERVAL DE CONF C CI_lower <- coefficients(lin_mod)[2] - 1.96*summary(lin_mod)$coefficients[2,2]
                                                                                ####CI_upper <- coefficients(lin_mod)[2] + 1.96*summary(lin_mod)$coefficients[2,2]

        pval <- c(1,as.numeric(as.character(sglm1[,4])))###### p value

        ## calcul des intervalle de confiance avec methode de bootstrap pour simuler des coef de regress sur lequel intervalle de conf sont mesurés/ calcul of the confidence interval using bootstrap method to simulate set regression coefficients and s.e.with uncertainty   POURQUOI PAS UTILISE confint.glm() ou boot() ou ci.boot()

        if(assessIC) {
        glm1.sim <- sim(glm1)
        ic_inf_sim <- c(1,exp(tail(apply(coef(glm1.sim), 2, quantile,.025),pasdetemps)))
        ic_sup_sim <- c(1,exp(tail(apply(coef(glm1.sim), 2, quantile,.975),pasdetemps)))
        } else {
            ic_inf_sim <- NA
            ic_sup_sim <- NA

        }

        tab1 <- data.frame(annee,val=coefannee,  ## tab1 table pour la realisation des figures / table for the graphical outputs  ### 2EME POUR GRAPH ici ce sont le coef de regress annee en fonction des annéés alors que tab3 c'est les abondance en fct des années et tab2 nombre de carré total et avec presence
                           LL=ic_inf_sim,UL=ic_sup_sim,
                           catPoint=ifelse(pval<seuilSignif,"significatif",NA),pval,
                           courbe=vpan[1],
                           panel=vpan[1])
        ## netoyage des intervalle de confiance mal estimés et qd donnees pas suffisantes pour calcul d'IC /cleaning of wrong or biaised measures of the confidence interval
        if(assessIC) {
        tab1$UL <- ifelse( nb_carre_presence==0,NA,tab1$UL)
        tab1$UL <-  ifelse(tab1$UL == Inf, NA,tab1$UL)
        tab1$UL <-  ifelse(tab1$UL > 1.000000e+20, NA,tab1$UL)
        tab1$UL[1] <- 1
        tab1$val <-  ifelse(tab1$val > 1.000000e+20,1.000000e+20,tab1$val)
        }
        ## indice de surdispersion  / overdispersion index
       ## browser()
        if(assessIC) dispAn <- glm1$deviance/glm1$null.deviance else dispAn <- glm1$deviance/glm1$nulldev

        ## tabAn table de sauvegarde des resultats par année / table of the results per year ######  reprends bcp de tabl DIFFERENCE AVEC tab2  c les abondances relatives, alors que nb de carre, nb de carre presnce, p val sont aussi ds tab2
        tabAn <- data.frame(id,code_espece=sp, nom_espece = nomSp,indicateur = indic,annee = tab1$annee,
                            abondance_relative=round(tab1$val,3),
                            IC_inferieur = round(tab1$LL,3), IC_superieur = round(tab1$UL,3),
                            erreur_standard = round(erreurannee1,4),
                            p_value = round(tab1$pval,3),significatif = !is.na(tab1$catPoint),
                            nb_carre,nb_carre_presence,abondance=abond)

        ## GLM pour calcul des tendance generale sur la periode avec modele log lineaire / GLM to measure the tendency of population evolution on the studied period with log linear model
        formule <- as.formula(paste("abond~ as.factor(carre) + annee",sep="")) ###
          #  browser()

         if(assessIC) {
             md2 <- glm(formule,data=d,family=quasipoisson) }
        else {
                md2 <- try(speedglm(formule,data=d,family=quasipoisson()),silent=TRUE)

                if(class(md2)[1]=="try-error")
                    md2 <- glm(formule,data=d,family=quasipoisson)
            }

       smd2 <- summary(md2)       #### sortie du modele / output of the model
       smd2 <- coefficients(smd2) ### coefficient regression de chaque variable avec les résultats des tests statistiques / regression coefficient of each predictive variables with results of the statistical tests
       smd2 <- tail(smd2,1)       ### coefficient regression de variable annee avec les résultats des tests statistiques / regression coefficient of the variable year with results of the statistical tests

        coefan <- as.numeric(as.character(smd2[,1])) ## tendences sur la periode = coefficient regression de variable annee  / tendency of population evolution on the studied period = regression coefficient of the variable year
        trend <- round(exp(coefan),3)

        pourcentage <- round((exp(coefan*pasdetemps)-1)*100,2) ## pourcentage de variation sur la periode / percentage of population variation on the studied period
        pval <- as.numeric(as.character(smd2[,4]))

        erreuran <- as.numeric(as.character(smd2[,2])) #### récuperer l'erreur standard / retrieve the error
        ## erreur standard
        erreurannee2 <- erreuran*exp(coefan)

        ## calcul des intervalle de confiance avec methode de bootstrap pour simuler des coef de regress sur lequel intervalle de conf sont mesurés/ calculating the confidence interval based on bootstrap method to simulate set regression coefficients and s.e.with uncertainty
        LL <- NA
        UL <- NA
        if(assessIC) {
            md2.sim <- sim(md2)
            LL <- round(exp(tail(apply(coef(md2.sim), 2, quantile,.025),1)),3)
            UL <- round(exp(tail(apply(coef(md2.sim), 2, quantile,.975),1)),3)
        } else {
            LL <- NA
            UL <- NA
        }

        ## tab1t table utile pour la realisation des figures  / table used for the figures
        tab1t <- data.frame(Est=trend,
                            LL , UL,
                            pourcent=pourcentage,signif=pval<seuilSignif,pval)

        trendsignif <- tab1t$signif
        pourcent <- round((exp(coefan*pasdetemps)-1)*100,3)
        ## mesure de la surdispersion / overdispersion measurment

          if(assessIC) dispTrend <- md2$deviance/md2$null.deviance else dispTrend <- md2$deviance/md2$nulldev

        ## classement en categorie incertain /classifying wrong or not reliable results
       # browser()
        if(assessIC) {
        if(dispTrend > 2 | dispAn > 2 | median( nb_carre_presence)<seuilOccu) catIncert <- "Incertain" else catIncert <-"bon"  ##### en fonction de l'indice de surdispersion et presence < à seuil occurence / based on the overdispersion index and the presence on a minimum number of plots
        vecLib <-  NULL
        if(dispTrend > 2 | dispAn > 2 | median( nb_carre_presence)<seuilOccu) {
            if(median( nb_carre_presence)<seuilOccu) {
                vecLib <- c(vecLib,"espece trop rare")
            }
            if(dispTrend > 2 | dispAn > 2) {
                vecLib <- c(vecLib,"deviance")
            }
        }
        raisonIncert <-  paste(vecLib,collapse=" et ")
        } else {
            catIncert <- NA
            raisonIncert <- NA
        }

        ## affectation des tendence EBCC  / retrieve the trend of population evolution on the studied period
        catEBCC <- NA
        if(assessIC)  catEBCC <- affectCatEBCC(trend = as.vector(trend),pVal = pval,ICinf=as.vector(LL),ICsup=as.vector(UL)) else catEBCC <- NA
        ## table complete de resultats  pour la periode etudiée / complete table with results for the studied period
     #   browser()
        tabTrend <- data.frame(
            id,code_espece=sp,nom_espece = nomSp,indicateur = indic,
            nombre_annees = pasdetemps,premiere_annee = firstY,derniere_annee = lastY,
            tendance = as.vector(trend) ,  IC_inferieur=as.vector(LL) , IC_superieur = as.vector(UL),pourcentage_variation=as.vector(pourcent),
            erreur_standard = as.vector(round(erreurannee2,4)), p_value = round(pval,3),
            significatif = trendsignif,categorie_tendance_EBCC=catEBCC,mediane_occurrence=median( nb_carre_presence) ,
            valide = catIncert,raison_incertitude = raisonIncert)

        if(assessIC)  listGLMsp <- list(list(glm1,glm1.sim,md2,md2.sim)) else  listGLMsp <- list(list(glm1,md2))
        names(listGLMsp)[[1]] <-sp
        fileSaveGLMsp <- paste(fileSaveGLMs,"_",sp,".Rdata",sep="")

        save(listGLMsp,file=fileSaveGLMsp)
        cat("--->",fileSaveGLMsp,"\n")
        flush.console()

        if(sp==listSp[1]) {
            glmAn <- tabAn
            glmTrend <- tabTrend
        } else  {
            glmAn <- rbind(glmAn,tabAn)
            glmTrend <- rbind(glmTrend,tabTrend)
        }
	## les figures
        if(figure) {
            ## table complete pour la figure en panel par ggplot2
            ## table pour graphe en panel par ggplot2
            if(description)	dgg <- rbind(tab1,tab2,tab3) else dgg <- tab1
            ## les figures

            ggplot.espece(dgg,tab1t,id,serie=NULL,sp,valide=catIncert,nomSp,description,tendanceSurFigure,seuilOccu=14,vpan = vpan,assessIC=assessIC)

        }

    }

    write.table(glmAn,filesaveAn,row.names=FALSE,quote=FALSE,sep="\t",dec=".",fileEncoding="UTF-8")
    cat("--->",filesaveAn,"\n")
    write.table(glmTrend,filesaveTrend,row.names=FALSE,quote=FALSE,sep="\t",dec=".",fileEncoding="UTF-8")
    cat("--->",filesaveTrend,"\n")

    flush.console()

}
########################################################################################################## Fin de la fonction main.glm / end of the function main.glm

###########################################################################################################  fonction appelée par main.glm renvoyant la categorie European Bird Census Council en fonction des resultats des modèles  / function called by main.glm to classify results depending on the quality of the data and analyses
## renvoie la categorie EBCC de la tendance en fonction
## trend l'estimateur de la tendance / estimation of the trends
## pVal la p value
## ICinf ICsup l intervalle de confiance a 95 pourcent
affectCatEBCC <- function(trend,pVal,ICinf,ICsup){
  catEBCC <- ifelse(pVal>0.05,
                    ifelse(ICinf < 0.95 | ICsup > 1.05,"Incertain","Stable"),
                    ifelse(trend<1,
                           ifelse(ICsup<0.95,"Fort declin","Declin moderee"),
                           ifelse(ICinf>1.05,"Forte augmentation","Augmentation modere")))
  return(catEBCC)
}

############################################################################################################ fin de la fonction renvoyant la categorie EBCC / end of the function main.glm

############################################################################################################ fonction graphique appelée par main.glm / function called by main.glm for graphical output
ggplot.espece <- function(dgg,tab1t,id,serie=NULL,sp,valide,nomSp=NULL,description=TRUE,
                          tendanceSurFigure=TRUE,seuilOccu=14, vpan,assessIC=TRUE) {

  #  serie=NULL;nomSp=NULL;description=TRUE;valide=catIncert
  #  tendanceSurFigure=TRUE;seuilOccu=14
  require(ggplot2)

  figname<- paste("Output/",id,"/",ifelse(valide=="Incertain","Incertain/",""),
                  sp,"_",id,serie, ".png",
                  sep = "")
  ## coordonnee des ligne horizontal de seuil pour les abondances et les occurences
  hline.data1 <- data.frame(z = c(1), panel = c(vpan[1]),couleur = "variation abondance",type="variation abondance")
  hline.data2 <- data.frame(z = c(0,seuilOccu), panel = c(vpan[2],vpan[2]),couleur = "seuil",type="seuil")
  hline.data3 <- data.frame(z = 0, panel = vpan[3] ,couleur = "seuil",type="seuil")
  hline.data <- rbind(hline.data1,hline.data2,hline.data3)
  titre <- paste(nomSp)#,"\n",min(annee)," - ",max(annee),sep="")

  ## texte de la tendance / text for the population evolution trend
  tab1 <- subset(dgg,panel =="Variation abondance")
  pasdetemps <- max(dgg$annee) - min(dgg$annee) + 1
  if(assessIC){
      txtPente1 <- paste(tab1t$Est,
                     ifelse(tab1t$signif," *",""),"  [",tab1t$LL," , ",tab1t$UL,"]",
                     ifelse(tab1t$signif,paste("\n",ifelse(tab1t$pourcent>0,"+ ","- "),
                                               abs(tab1t$pourcent)," % en ",pasdetemps," ans",sep=""),""),sep="")
  }else{
       txtPente1 <- ifelse(tab1t$signif,paste("\n",ifelse(tab1t$pourcent>0,"+ ","- "),
                                               abs(tab1t$pourcent)," % en ",pasdetemps," ans",sep=""),"")

  }
  ## table du texte de la tendance / table of the text for the population evolution trend
  tabTextPent <- data.frame(y=c(max(c(tab1$val,tab1$UL),na.rm=TRUE)*.9),
                            x=median(tab1$annee),
                            txt=ifelse(tendanceSurFigure,c(txtPente1),""),
                            courbe=c(vpan[1]),panel=c(vpan[1]))
  ## les couleurs / the colors
  vecColPoint <- c("#ffffff","#eeb40f","#ee0f59")
  names(vecColPoint) <- c("significatif","infSeuil","0")
  vecColCourbe <- c("#3c47e0","#5b754d","#55bb1d","#973ce0")
  names(vecColCourbe) <- c(vpan[1],"carre","presence",vpan[3])
  vecColHline <- c("#ffffff","#e76060")
  names(vecColHline) <- c("variation abondance","seuil")

  col <- c(vecColPoint,vecColCourbe,vecColHline)
  names(col) <- c(names(vecColPoint),names(vecColCourbe),names(vecColHline))

  ## si description graphique en 3 panels
  if(description) {
    p <- ggplot(data = dgg, mapping = aes(x = annee, y = val))
    ## Titre, axes ...
    p <- p + facet_grid(panel ~ ., scale = "free") +
      theme(legend.position="none",
            panel.grid.minor=element_blank(),
            panel.grid.major.y=element_blank())  +
      ylab("") + xlab("Annee")+ ggtitle(titre) +
      scale_colour_manual(values=col, name = "" ,
                          breaks = names(col))+
      scale_x_continuous(breaks=min(dgg$annee):max(dgg$annee))
    p <- p + geom_hline(data =hline.data,mapping = aes(yintercept=z, colour = couleur,linetype=type ),
                        alpha=1,size=1.2)
   if(assessIC){ ############# ONLY FOR THE CONFIDENCE INTERVAL
    p <- p + geom_ribbon(mapping=aes(ymin=LL,ymax=UL),fill=col[vpan[1]],alpha=.2)
    p <- p + geom_pointrange(mapping= aes(y=val,ymin=LL,ymax=UL),fill=col[vpan[1]],alpha=.2)
	}
    p <- p + geom_line(mapping=aes(colour=courbe),size = 1.5)
    p <- p + geom_point(mapping=aes(colour=courbe),size = 3)
    p <- p + geom_point(mapping=aes(colour=catPoint,alpha=ifelse(!is.na(catPoint),1,0)),size = 2)
    p <-  p + geom_text(data=tabTextPent, mapping=aes(x,y,label=txt),parse=FALSE,color=col[vpan[1]],fontface=2, size=4)
    ggsave(figname, p,width=16,height=21, units="cm")
	print (figname)  ##### CAN BE REMOVED IF YOU DO NOT WANT THE GRAPH TO BE PLOTTED
  } else {

    p <- ggplot(data = subset(dgg,panel=="Variation abondance"), mapping = aes(x = annee, y = val))
    ## Titre, axes ...
    p <- p + facet_grid(panel ~ ., scale = "free") +
      theme(legend.position="none",
            panel.grid.minor=element_blank(),
            panel.grid.major.y=element_blank())  +
      ylab("") + xlab("Annee")+ ggtitle(titre) +
      scale_colour_manual(values=col, name = "" ,
                          breaks = names(col))+
      scale_x_continuous(breaks=min(dgg$annee):max(dgg$annee))
    p <- p + geom_hline(data =subset(hline.data,panel=="Variation abondance"),mapping = aes(yintercept=z, colour = couleur,linetype=type ),
                        alpha=1,size=1.2)

   if(assessIC){ ############# ONLY FOR THE CONFIDENCE INTERVAL
    p <- p + geom_ribbon(mapping=aes(ymin=LL,ymax=UL),fill=col[vpan[1]],alpha=.2)
    p <- p + geom_pointrange(mapping= aes(y=val,ymin=LL,ymax=UL),fill=col[vpan[1]],alpha=.2)
	}
    p <- p + geom_line(mapping=aes(colour=courbe),size = 1.5)
    p <- p + geom_point(mapping=aes(colour=courbe),size = 3)
    p <- p + geom_point(mapping=aes(colour=catPoint,alpha=ifelse(!is.na(catPoint),1,0)),size = 2)
    p <-  p + geom_text(data=tabTextPent, mapping=aes(x,y,label=txt),parse=FALSE,color=col[vpan[1]],fontface=2, size=4)
    ggsave(figname, p,width=15,height=9,units="cm")
  print (figname) ##### CAN BE REMOVED IF YOU DO NOT WANT THE GRAPH TO BE PLOTTED
  }
}
############################################################################################################ fin fonction graphique / end of function for graphical output

#################################################################################################################### debut de la fonction de moyenne geometrique pondere / start of the geometric weighted mean function
geometriqueWeighted <- function(x,w=1) exp(sum(w*log(x))/sum(w))
#################################################################################################################### fin de la fonction de moyenne geometrique pondere / end of the geometric weighted mean function

##################################################################################################################### debut de la fonction analyseGroupe / start of the function analyseGroupe
## Analyse par groupe de specialisation a partir des resulats de variation d'abondance par especes / analysis by specialization group based on results of the analysis of population evolution trend
#

analyseGroupe <- function(id="france",tabsp=tabsp,donnees=donnees,donneesTrend=donneesTrend,ICfigureGroupeSp=TRUE,powerWeight=2,
                          correctionAbondanceNull = 0.000001,
                          groupeNom = c("generaliste","milieux batis","milieux forestiers","milieux agricoles"),
                          groupeCouleur = c("black","firebrick3","chartreuse4","orange")) {

    ## donnees tendances globales / results of the global trends
    donneesTrend <- subset(donneesTrend, select = c(code_espece,valide,mediane_occurrence))

    ## table de reference espece  / reference table for species
    tabsp <- subset(tabsp, select= c(sp,nom,indicateur, specialisation))
    donnees <- merge(donnees,donneesTrend,by="code_espece")
    donnees <- merge(donnees,tabsp,by.x="code_espece",by.y="sp")
    ## table de correspondance de biais en fonction des medianes des occuerences

    nameFileSpe <-  paste("Output/",id,"/variationsAnnuellesGroupes_",id, ############# Declare le fichier de sortie des variations annuelles par groupe / declare the name of the outputfile for annual population evolution trend by group
                          ".tabular",sep="" )
    nameFileSpepng <-  paste("Output/",id,"/variationsAnnuellesGroupes_",id, ############# Declare le fichier de sortie graphique des variations annuelles par groupe / declare the name of the graphical output file for annual population evolution trend by group
                             ".png",sep="" )

    grpe <- donnees$specialisation

    ####### valeur seuil sont obtenues à partir de simulations / threshold values are obtained from simulations
    ff <- function(x,y) max(which(y<=x)) ## fonction pour recherche le poid associé à valeur max parmi valeur seuil d'occurence inferieur ou egale à occurence mediane obs / function to retrieve the weight associated with the max occurence threshold equal or smaller than the occurence mediane observed

    IncertW <- ifelse(donnees$valide=="Incertain",tBiais$biais[sapply(as.vector(donnees$mediane_occurrence),ff,y=tBiais$occurrenceMed)],1) ## pr verifier poids de l'espèce dans analyse, récupére seuil occurence minimum pour lequel tendance pas bonne, et compare avec mediane occurence des données  / to check the weight of species in the analysis, this retrieve occurence threshold with wich real occurence measured on data are compared in order to verify the accuracy of the trend measurment
    ## poids du a la qualite de l'estimation
                                        #   erreur_stW <- 1/((donnees$erreur_st+1)^powerWeight)
                                        #	erreur_stW <- ifelse( is.na(donnees$IC_superieur),0,erreur_stW)
    erreur_stW <- ifelse(is.na(donnees$IC_superieur),0,1)#####  si pas d'interval de confiance met 0 et donne un poid de 0 à l'esps (voir ci dessous) /  if no confidence interval calculated give a weight of 0 for the sps
    ## calcul du poids total de chaque espèce / calcul of the weight of each species
    W <- IncertW * erreur_stW

    ## variable de regroupement pour les calculs par groupe de specialisation et par an / variables gathered to identify group for the calculation (per specialization and per year)
    grAn <- paste(donnees$specialisation,donnees$annee,sep="_")
    ## data frame pour le calcul / dataframe made for the calcul
    dd <- data.frame(grAn,annee = donnees$annee, grpe,W,ab=donnees$abondance_relative,ICinf= donnees$IC_inferieur, ICsup= ifelse(is.na(donnees$IC_superieur),10000,donnees$IC_superieur))
    ## table resumer de tous les poids / table to sum up the weights of each species depending on the incertainty in the calcul of the poulation evolution trends
    ddd <- data.frame(code_espece = donnees$code_espece,nom_espece = donnees$nom_espece,annee = donnees$annee,
                      groupe_indicateur = grpe,
                      poids_erreur_standard = round(erreur_stW,3), poids_incertitude = round(IncertW,3),poids_final = round(W,3),
                      abondance_relative=donnees$abondance_relative,
                      IC_inferieur= donnees$IC_inferieur,
                      IC_superieur= ifelse(is.na(donnees$IC_superieur),10000,donnees$IC_superieur),
                      valide = donnees$valide, mediane_occurrence = donnees$mediane_occurrence)

    nomFileResum <- paste("Output/",id,"/donneesGroupes_",id, ###### declaration du nom du repertoire et des fichiers de sortie / declaring the name of the output folder and files
                          ".tabular",sep="" )
    write.table(ddd,nomFileResum,row.names=FALSE,sep="\t",dec=".",fileEncoding="UTF-8")
    cat("-->",nomFileResum,"\n")

    ## calcul des moyennes ponderees par groupe par an et pour les abondance et les IC	/ calcul of weighted means per specialization group and per year for the abundance and confidence interval
    for(j in 5:7) dd[,j] <- ifelse(dd[,j]==0,correctionAbondanceNull,dd[,j])
    ag <- apply(dd[,5:7], 2,  ######## sur les abondances relatives, les ICinf et ICsup
                function(x) {
                    sapply(split(data.frame(dd[,1:4], x), dd$grAn),  ###### fait les moyennes pondérés par groupe grAn / calculate the weighted mean by group grAn
                           function(y) round(geometriqueWeighted(y[,5], w = y$W),3))
                })
    ##	gg <- subset(dd,as.character(dd$grAn)=="milieux forestier_2014")  #############################################################

    ag <- ifelse(is.na(ag),1,ag)
    ag <- as.data.frame(ag)
    ag$grAn <-  rownames(ag)
    dbon <- subset(donnees,valide=="bon")
    dIncert <- subset(donnees,valide=="Incertain")
    ## calcul nombre d'espece "bonne" pour le calcul / calculating the number of species with low level of incertainty, "good" species
    bon <- tapply(dbon$nom,dbon$specialisation,FUN=function(X)length(unique(X)) )
    bon <- ifelse(is.na(bon),0,bon)
    tbon <- data.frame(groupe=names(bon),bon)
    ## calcul nombre d'especes "incertaines" pour le calcul / calculating the number of species with high level of incertainty, "bad" species
    Incert <- tapply(dIncert$nom,dIncert$specialisation,FUN=function(X)length(unique(X)) )
    Incert <- ifelse(is.na(Incert),0,Incert)
    tIncert <- data.frame(groupe=names(Incert),Incertain=Incert)

    tIncert <- merge(tIncert,tbon,by="groupe")

    ## table de données avec les moyennes ponderees par groupe / table of the data with the weighted mean by group
    da <- merge(unique(dd[,1:3]),ag,by="grAn")[,-1]
    colnames(da) <- c("annee","groupe","abondance_relative","IC_inferieur","IC_superieur")

    da$annee <- as.numeric(da$annee)
    da <-  merge(da,tIncert,by="groupe") #### ajoute le nombre d'espece "incertaines" et "bonne" aux resultats  / add the number of "good" and "bad" species to the overall resutls
    da <- subset(da, groupe != "non")
    colnames(da)[6:7] <-  c("nombre_especes_incertaines","nombre_espece_bonnes")
    a <- data.frame(id,da)
    write.table(da,file=nameFileSpe,row.names=FALSE,quote=FALSE,sep="\t",dec=".",fileEncoding="UTF-8")

    cat("-->",nameFileSpe,"\n")
    yearsrange <- c(min(da$annee),max(da$annee))

    ## figure par ggplot2  / plots with ggplot2
    titre <- paste("Variation de l'indicateur groupe de specialisation",sep="")

    vecCouleur <- setNames(groupeCouleur,groupeNom)
                                        #browser()
    p <- ggplot(data = da, mapping = aes(x = annee, y = abondance_relative, colour=groupe,fill=groupe))
    p <- p + geom_hline(aes(yintercept = 1), colour="white", alpha=1,size=1.2)
    if(ICfigureGroupeSp)
        p <- p + geom_ribbon(mapping=aes(ymin=IC_inferieur,ymax=IC_superieur),linetype=2,alpha=.1,size=0.1)
    p <- p + geom_line(size=1.5)
    p <- p +  ylab("") + xlab("Annee")+ ggtitle(titre)
    if(!is.null(groupeNom)) p <- p + scale_colour_manual(values=vecCouleur, name = "" )+
                                scale_x_continuous(breaks=unique(da$annee))
    if(!is.null(groupeNom)) p <- p +  scale_fill_manual(values=vecCouleur, name="")
    p <- p +  theme(panel.grid.minor=element_blank(), panel.grid.major.y=element_blank())
    ggsave(nameFileSpepng, p,width=17,height=10,units="cm")

                                        #   cat(" <==",nameFileSpepng,"\n")

    ## calul pour chaque groupe une pente de regression d'evolution des abondances sur la periode étudiée / calculating for each group the regression slope for the abundance evolution on the studied period
    vecSpe <- unique(da$groupe)
    datasum <- data.frame(groupe=NULL,tendance=NULL,pourcentage_variation=NULL)
    for(spe in 1:4){
        # print(spe)
        subtab <- subset(da,groupe==vecSpe[spe])
        if(nrow(subtab)>1) {
            sumlm <- summary(lm(abondance_relative~annee,data=subtab)) ##### recupère les resultats du modèle linéaire / retrieve the results of the linear model
            subdatasum <- data.frame(groupe=vecSpe[spe],
                                     tendance=round(sumlm$coefficients[2,1],3),
                                     pourcentage_variation=round(sumlm$coefficients[2,1]*(nrow(subtab)-1)*100,3)) #### assemble les resultats pour en faire une sortie  /  bring together the results for an output file
            datasum <- rbind(datasum,subdatasum)

        }

    }
    datasum <- merge(datasum,tIncert,by="groupe") ####
    datasum <- data.frame(id,datasum)
                                        #datasum$cat_tendance_EBCC <- affectCatEBCC(trend,pVal,ICinf,ICsup
    namefilesum <- paste("Output/",id,"/tendancesGlobalesGroupes_",id,
                         ".tabular",sep="" )
    write.table(datasum,file=namefilesum,row.names=FALSE,quote=FALSE,sep="\t",dec=".",fileEncoding="UTF-8")
    cat("-->",namefilesum,"\n")
}

################################################################################################################## fin de la fonction analyseGroupe / end of the function analyseGroupe

################################################################################################################### debut de la fonction check_file / start of the function check_file
# Fonction pour verifier les données d'entrée / General function to check integrity of input file. Will check numbers and contents of variables(colnames).
#return an error message and exit if mismatch detected
#Faut rentrer le nom du jeu de données, le nbre et le nom des variables / Enter dataset name,  expected number and names of variables. + an exit error message to guide user.

check_file<-function(dataset,err_msg,vars,nb_vars){
    if(ncol(dataset)!=nb_vars){ #Verifiction de la présence du bon nb de colonnes, si c'est pas le cas= message d'erreur / checking for right number of columns in the file if not = error message
        cat("\nerr nb var\n")
        stop(err_msg, call.=FALSE)
    }

    for(i in vars){
        if(!(i %in% names(dataset))){
            stop(err_msg,call.=FALSE)
        }
    }
}

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


library(keras)
library(tidyverse)
library(EBImage)
library(bioimagetools)

rdata_file <- "/scratch/network/ds65/ELE571/stress_outputs/ele571_3d_lowSNR_1.RData"
model_file <- "/scratch/network/ds65/ELE571/stress_outputs/ele571_3d_lowSNR_model_1.h5"

load(rdata_file)

model <- load_model_hdf5(model_file,
                         custom_objects = c("dice_coef" = dice_coef,
                                            "dice_coef_loss" = dice_coef_loss))

print("Get predictions on testing data...")
images_test <- list.files(paste(TEST_PATH,"image",sep = ""),
                         pattern = ".tif",
                         full.names = T)
masks_test <- list.files(paste(TEST_PATH,"mask",sep = ""),
                        pattern = ".tif",
                        full.names = T)

imageids <- gsub("^.*([0-9]{4}).*$","\\1",basename(images_test))

test_data <- data.frame("ImageId" = imageids,
                         "ImageFile" = images_test,
                         "MaskFile" = masks_test)
test_data <- test_data %>%
                mutate(ImageShape = map(ImageFile,
                                      .f = function(file) dim(readImage(as.character(file)))))
test_data$ImageFile <- as.character(test_data$ImageFile)
test_data$MaskFile <- as.character(test_data$MaskFile)
test_data %>% glimpse()

input_test <- sample_n(test_data[test_data$ImageId == "0001",], 1) %>%
            mutate(Y = map(MaskFile, preprocess_masks, new_shape = SHAPE),
                   X = map(ImageFile, preprocess_image, shape = SHAPE))

print(paste("Testing image ", input_test$ImageId[1],sep=""))

input_test <- input_test %>% select(X,Y)

W_test <- map(input_test$Y, function(x) {bw <- x > 0; 1*bw}) ##binarize

X_test <- list2tensor(input_test$X)
Y_test <- list2tensor(input_test$Y)
Ybw_test <- list2tensor(W_test)

Y_hat_test_1 <- predict(model, x = X_test)

model %>% evaluate(X_test, Y_test)

save.image(file = "3d_lowSNR_stress_test0001_1.RData")
writeTIF(Y_hat_test_1[1,,,,], file = "test0001_prediction_lowSNR_1.tif")


#Usage:
#Rscript cell_classified_pseudotime_genes.r FDR_value num_clusters
library("monocle")
library("reshape")
library('ggplot2')
args <- commandArgs(trailingOnly=TRUE)
if(length(args)==0)
{
	print("Usage: Rscript cell_classified_pseudotime_genes.r FDR_value num_clusters")
}
num_genes <- args[1]
num_clusters <- args[2]
#HSMM <- readRDS("classified_cells.rds")
HSMM <- readRDS("reduded_dimension.rds")
#HSMM_myo <- reduceDimension(HSMM, max_components=2)
#HSMM_myo <- orderCells(HSMM_myo, reverse=FALSE)

#diff_test_res <- differentialGeneTest(HSMM_myo, fullModelFormulaStr="~CellType")
#sig_genes <- subset(diff_test_res, qval < as.numeric(FDR_value))
#HSMM <- reduceDimension(HSMM, max_components=as.numeric(dimension_number))
#HSMM <- orderCells(HSMM, reverse=FALSE)
#print(plot_cell_trajectory(HSMM, color_by="CellType"))
#HSMM <- reduceDimension(HSMM, max_components=2)
#saveRDS(HSMM,'reduded_dimension.rds')
#print(head(pData(HSMM)))
#rpc_matrix <- relative2abs(HSMM, cores = detectCores())
#pd <- new("AnnotatedDataFrame", data = pData(HSMM))
#fd <- new("AnnotatedDataFrame", data = fData(HSMM))
#HSMM <- newCellDataSet(as(as.matrix(rpc_matrix), "sparseMatrix"),phenoData = pd,featureData = fd,lowerDetectionLimit=1,expressionFamily=negbinomial.size())
#HSMM <- estimateSizeFactors(HSMM)
#HSMM <- estimateDispersions(HSMM)
#HSMM <- reduceDimension(HSMM, max_components=2)
#HSMM <- orderCells(HSMM, reverse=FALSE)
#saveRDS(HSMM,'reduded_dimension.rds')

#print(head(pData(HSMM)))
#pData(HSMM)$Pseudotime = pData(HSMM_reduced)$Pseudotime
#print("second part")
#BEAM_res <- BEAM(HSMM, branch_point=1, cores = detectCores())
#BEAM_res <- BEAM_res[order(BEAM_res$qval),]
#BEAM_res <- BEAM_res[,c("gene_short_name", "pval", "qval")]
#print(plot_genes_branched_heatmap(HSMM[row.names(subset(BEAM_res, qval < as.numeric(FDR_value))),],branch_point = 1,num_clusters = as.numeric(num_clusters),cores = detectCores(),use_gene_short_name = T,show_rownames = T))
#print(plot_pseudotime_heatmap(HSMM_myo[sig_genes,],num_clusters = as.numeric(num_clusters),show_rownames = T))
HSMM <- orderCells(HSMM, reverse=FALSE)

#print("0")
library(pheatmap)
diff_test_res <- differentialGeneTest(HSMM,fullModelFormulaStr="~CellType",cores = detectCores())
new_diff <- diff_test_res[order(diff_test_res$qval),]
#new_diff[1:100,]
newHSMM <- HSMM[rownames(new_diff[1:100,]),]
expression_matrix <- exprs(newHSMM)
colnames(expression_matrix) <- pData(newHSMM)$CellType
sorted_matrix <- expression_matrix[,order(colnames(expression_matrix))]
Cell_Type <- colnames(sorted_matrix)
colnames(sorted_matrix) <- 1:length(colnames(sorted_matrix))
annotation_data <- data.frame(Cell_Type)
rownames(annotation_data) <-colnames(sorted_matrix)
log_matrix <- log(sorted_matrix)
log_matrix[log_matrix==-Inf] <- 0
png('heatmap5.png',width = 10, height = 10, units= 'in',res=600)
pheatmap(log(sorted_matrix), annotation=annotation_data,cluster_cols = FALSE,cluster_rows = FALSE,show_colnames = FALSE,scale='row')

png('cell_classified_heatmap_plot.png', width = 10, height = ceiling(as.numeric(num_genes)/10), units= 'in',res=600)

#saveRDS(diff_test_res,'diff_test_res.rds')
#print('1')
#print(diff_test_res$qval)
#sig_gene_names <- row.names(subset(diff_test_res, qval < .5))
#print(sig_gene_names)
#print("2")
#print(plot_pseudotime_heatmap(HSMM[sig_gene_names,],num_clusters = 2,cores = detectCores(),show_rownames = T))

ggsave("cell_classified_heatmap_plot.png")
ggsave("cell_classified_heatmap_plot.tiff", width = 7, height = 7,dpi=600)
dev.off()


  projected.exploitation.rate = function( target.landings=NULL, fm.reg, numbers.initial, sizes, yr, region, scenario="mature.only") {

    eps = 1e-5
    objective.threshold = 0.1  # tons
    CV.abundance = 0.1 # assume 10% coefficient of variation in numbers and biomass (minimal assumption)  ... this is really a dummy argument to allow biomass estimation, the error is recalculated at a later step

    fm.mean = apply(fm.reg, c(1), function(b) { mean( b[(b > 0) & (b< 1)], na.rm=T, trim=0.1 ) } )

    if (scenario=="same.as.last.year") {
        Constraint.ER = fm.mean
    } else if (scenario=="historic" ) {
        fm.binary = ifelse( fm.mean > eps, 1, 0 )
        n = fm.binary * fm.mean
        Constraint.ER = n / sum (n, na.rm=T)
    } else if (scenario=="mature.only" ) {
        fm.binary = fm.mean * 0
        fm.binary[ which( fm.mean >= eps ) ] = 1
        fm.binary[ grep("imm", names(fm.mean)) ] = 0
        fm.binary[ grep("CC1to2",  names(fm.mean)) ] = 0
        n = fm.binary * fm.mean
        Constraint.ER = n / sum (n, na.rm=T)
    } else {
        Constraint.ER = fm.mean
    }

    if (target.landings==0) Constraint.ER = fm.mean * 0

    Constraint.ER [ !is.finite(Constraint.ER)] = 0

    # NOTE for future reference: the optimization functions must live internal to the calling environment !!!
    optim.model.core = function(inits,  ...) {
      exploitation.rate.optim = inits * Constraint.ER
      exploitation.rate.optim [ which( exploitation.rate.optim > 1 ) ] = 1  # make sure solution does not exceed 100% exploitation
      exploitation.rate.optim [ which( exploitation.rate.optim < eps ) ] = eps  # make sure solution does not exceed 100% exploitation
      numbers.optim = numbers.initial * exploitation.rate.optim
      biomass.optim = estimate.biomass( numbers.optim, numbers.optim*CV.abundance, sizes, y=yr, r=region )
      biomass.optim.fishable = subset.biomass (biomass.optim$x, biomass.optim$x*CV.abundance, names(biomass.optim$x), type=scenario)[1]
      error = abs( target.landings - biomass.optim.fishable )
      V = list( error=error, exploitation.rate.optim=exploitation.rate.optim, numbers.optim=numbers.optim)
      return (V)
    }

    optim.model = function(inits, ... ) {
      res = optim.model.core(inits)
     return (res$error)
    }

   # optim.methods = c( "Nelder-Mead", "CG", "BFGS", "L-BFGS-B", "SANN", "PORT", "NLM-Newton" )
   optim.methods = c( "BFGS", "L-BFGS-B", "PORT" ) # PORT seems most robust

    inits = 0.5
    lower = 0
    upper = 10

    params = NULL

    for (om in optim.methods) {
      res = NULL
      if (om == "PORT" ) {
        res = nlminb( start=inits, objective=optim.model, lower=lower, upper=upper,
          control=list(eval.max=500, iter.max=500 ))
        res$value = res$objective
      } else if (om == "NLM-Newton" ) {
        res = nlm( p=inits, f=optim.model)
        res$convergence = ifelse (res$code %in% c(1,2), 0, 1)
        res$value = res$minimum
      } else {
        res = optim( par=inits, fn=optim.model, gr=NULL, method=om, Constraint.ER=Constraint.ER )
      }
      print(om)
      print(res)
      params = rbind ( params, list(
        optim.method=om, convergence=res$convergence, error=res$value, par=res$par  # convergence if == 0
      ) )
    }
    V = extract.solution (params, optim.model.core)
    return ( V )
  }


# This script finds the consensus category per clip and video for original, umbrella duiker, and umbrella designations.
# Umbrella duiker: all duikers together as duiker, all hogs together as hog, large ungulate and small antelope together as hoofed animal.
# Umbrella: duikers, large ungulate, and small antelope together as ungulate, all hogs together as hog.

# How to find the consensus category per clip:
# The consensus category is the single category with a proportion of the responses >=0.5.
# If there are 2 categories that are each 50% of the responses, or if there is one category that is most frequenet but at a proportion less than 0.5, then the clip doesn't reach consensus.

# The proportion agreement for each clip is the proportion of classifications that match the expert category, regardless of what the consensus category is.
# The consensus proportion is the proportion of responses that belong to the consensus category (range 0.5-1).
# If a clip has 1, 2, or 3 nonblank classifications and the rest are blank, then that clip is instead considered "presence undetermined".

# To find the video consensus:
# First remove any presence undetermined clips.
# A video with all blank clips is consensus blank. If not all clips are consensus blank, then consider only clips that are not consensus blank.
# If all remaining nonblank clips are nonconsensus, then the video is nonconsensus.
# Otherwise, consider only clip(s) that have the highest consensus proportion. If those remaining clips reach a consensus on different categories, the video does not reach consensus. If the remaining clips all reach consensus on the same category, then the video reaches consensus on that category.
# The proportion agreement for the video is the average proportion agreement of the clips that were considered for the consensus category determination.

# Replace "YourPathHere" with respective file path

# Note: "species" in this script is the same as a "category" mentioned in the paper

#############################################
#       Original category designation       #
#############################################

# Bring in expert data
# expert.data<-read.table("YourPathHere/expert_data_for_analysis_CandS_Species_ID_MS.txt", sep="\t", header=T)
expert.data<-read.table("YourPathHere/expert_data_for_analysis_CandS_Species_ID_MS.txt", sep="\t", header=T)
nrow(expert.data)
#11896

######################## Find consensus species per clip
# class.data<-read.table("YourPathHere/class_data_for_analysis_CandS_Species_ID_MS.txt", sep="\t", header=T)
class.data<-read.table("YourPathHere/class_data_for_analysis_CandS_Species_ID_MS.txt", sep="\t", header=T)
nrow(class.data)
#313505
class.data<-class.data[order(class.data$Clip.ID),]

#create summ.data to house summaries for each clip
summ.data<-data.frame(Clip.ID=sort(unique(class.data$Clip.ID)), Video.ID=NA, Expert.Species=NA, Consensus.Species=NA, Consensus.Prop=NA, Prop.Agreement=NA, Number.Blanks=NA, Number.Nonblanks=NA)
summ.data$Video.ID<-class.data$Video.ID[match(summ.data$Clip.ID, class.data$Clip.ID)]
summ.data$Expert.Species<-expert.data$Species[match(summ.data$Video.ID, expert.data$Video.ID)]
nrow(summ.data)
#47584

consensus.threshold<-0.5

# Summarize the consensus per clip and proportion agreement to expert.id
start.time<-Sys.time()
for(i in 1:nrow(summ.data)){
    cat(i, round(i/47584*100, 2), "% \n")
	flush.console()
	sub.class<-class.data[class.data$Clip.ID==summ.data$Clip.ID[i],]
	sub.Expert.Species<-expert.data$Species[expert.data$Video.ID==summ.data$Video.ID[i]]

	Number.Blanks<-sum(sub.class$Species=="blank")
	Number.Nonblanks<-sum(sub.class$Species!="blank")

	summ.data$Number.Blanks[i]<-Number.Blanks
	summ.data$Number.Nonblanks[i]<-Number.Nonblanks

	# if the clip is only blanks, then species is blank
	if(Number.Nonblanks==0){
		summ.data$Consensus.Species[i]<-"blank"
		summ.data$Consensus.Prop[i]<-1
		summ.data$Prop.Agreement[i]<-mean(sub.class$Species==sub.Expert.Species)

	# if there are enough nonblanks to find a consensus, find a consensus using nonblank classifications only
	} else if(Number.Nonblanks>=4){
		sub.class<-sub.class[sub.class$Species!="blank",]

		sp.table<-table(sub.class$Species)
		max.prop<-max(sp.table)/sum(sp.table)
		max.sp<-names(sp.table[sp.table==max(sp.table)])
		# if only one species has the maximum proportion of responses, and the prop is at least 0.5, then clip reaches consensus on that species
		if(length(max.sp)==1 & max.prop>=consensus.threshold){
			summ.data$Consensus.Species[i]<-max.sp
			summ.data$Consensus.Prop[i]<-max.prop
			summ.data$Prop.Agreement[i]<-mean(sub.class$Species==sub.Expert.Species)
		# otherwise doesn't reach consensus
		} else {
			summ.data$Consensus.Species[i]<-"no consensus"
		}

	# if there are too few nonblank clips, then it's presence undetermined
	} else if(Number.Nonblanks<=3){
			summ.data$Consensus.Species[i]<-"presence undetermined"
	}
}
end.time<-Sys.time()
end.time - start.time
#19 mins

sum(is.na(summ.data$Consensus.Species))
#0

table(summ.data$Consensus.Species)

#                  bird                 blank            chimpanzee
#                   288                 29360                   672
#           dark duiker              elephant      giant forest hog
#                    48                     6                    11
#          hippopotamus                 human      Jentink's duiker
#                    76                   881                   123
#        large ungulate               leopard          no consensus
#                     4                    89                  2028
#   other (non-primate)       other (primate)              pangolin
#                   142                  1994                    13
#             porcupine presence undetermined            red duiker
#                    26                  1763                  2632
#         red river hog                rodent        small antelope
#                   453                   165                    32
#             small cat     small grey duiker               warthog
#                    10                  6583                    10
#          zebra duiker
#                   175

# write.table(summ.data, "YourPathHere/consensus_per_clip_original_CandS_Species_ID_MS.txt", sep="\t", row.names=F, col.names=T)
write.table(summ.data, "YourPathHere/consensus_per_clip_original_CandS_Species_ID_MS.txt", sep="\t", row.names=F, col.names=T)

######################## Find consensus species per video
clip.cons.data<-read.table("YourPathHere/consensus_per_clip_original_CandS_Species_ID_MS.txt", sep="\t", header=T, stringsAsFactor=F)
nrow(clip.cons.data)
#47584
length(unique(clip.cons.data$Video.ID))
#11896

clip.cons.data<-clip.cons.data[order(clip.cons.data$Video.ID),]

video.cons<-data.frame(Video.ID=unique(clip.cons.data$Video.ID), Expert.Species=NA, Consensus.Species=NA, Consensus.Prop=NA, Prop.Agreement=NA, Consensus.Type=NA)
video.cons$Expert.Species<-clip.cons.data$Expert.Species[match(video.cons$Video.ID, clip.cons.data$Video.ID)]
nrow(video.cons)
#11896

start.time<-Sys.time()
for(i in 1:nrow(video.cons)){
    # cat(i, round(i/11896*100, 2), "% \n")
	sub.cons<-clip.cons.data[clip.cons.data$Video.ID==video.cons$Video.ID[i],]

	# First remove any clips that are presence undetermined
	sub.cons<-sub.cons[sub.cons$Consensus.Species!="presence undetermined",]

	# If there are any remaining clips, get consensus
	if(nrow(sub.cons)>0){
		# If there are only blanks, then video is blank
		if(sum(sub.cons$Consensus.Species=="blank")==nrow(sub.cons)){
			video.cons$Consensus.Type[i]<-"Consensus blank"
			video.cons$Consensus.Species[i]<-"blank"

		# If there are only nonblank nonconsensus clips, don't continue, video is non consensus
		} else if(sum(sub.cons$Consensus.Species=="no consensus")==sum(sub.cons$Consensus.Species!="blank")){
			video.cons$Consensus.Type[i]<-"All nonblank clips are nonconsensus"
			video.cons$Consensus.Species[i]<-"no consensus"

		} else {
			# Remove any nonconsensus species and blanks
			sub.cons<-sub.cons[!sub.cons$Consensus.Species %in% c("no consensus","blank"),]

			# Keep only rows that have the highest consensus prop
			sub.cons<-sub.cons[sub.cons$Consensus.Prop==max(sub.cons$Consensus.Prop),]

			# If there are multiple species present, then no consensus
			if(length(unique(sub.cons$Consensus.Species))>1){
				video.cons$Consensus.Type[i]<-"Conflicting consensus species"
				video.cons$Consensus.Species[i]<-"no consensus"

			# If there's just one species present, then video reaches consensus on that species, at that max proportion, with the average Prop.Agreement
			} else {
				video.cons$Consensus.Type[i]<-"Consensus reached"
				video.cons$Consensus.Species[i]<-sub.cons$Consensus.Species[1]
				video.cons$Consensus.Prop[i]<-sub.cons$Consensus.Prop[1]
				video.cons$Prop.Agreement[i]<-mean(sub.cons$Prop.Agreement)
			}
		}
	# Otherwise whole video is presence undetermined
	} else {
		video.cons$Consensus.Species[i]<-"presence undetermined"
		video.cons$Consensus.Type[i]<-"presence undetermined"
	}
}
end.time<-Sys.time()
end.time - start.time
#28 seconds

table(video.cons$Consensus.Type, useNA="always")
# All nonblank clips are nonconsensus       Conflicting consensus species
#                                 615                                  19
#                     Consensus blank                   Consensus reached
#                                3665                                7595
#               presence undetermined                                <NA>
#                                   2                                   0

table(video.cons$Consensus.Type, video.cons$Expert.Species=="blank")
#                                       FALSE TRUE
#   All nonblank clips are nonconsensus   608    7
#   Conflicting consensus species          19    0
#   Consensus blank                      1106 2559
#   Consensus reached                    7544   51
#   presence undetermined                   2    0

######## Remove presence undetermined videos
video.cons<-video.cons[video.cons$Consensus.Species!="presence undetermined",]
nrow(video.cons)
#11894

# write.table(video.cons, "YourPathHere/consensus_per_video_original_CandS_Species_ID_MS.txt", sep="\t", row.names=F, col.names=T)
write.table(video.cons, "YourPathHere/consensus_per_video_original_CandS_Species_ID_MS.txt", sep="\t", row.names=F, col.names=T)

#############################################
#        Umbrella duiker designation        #
#############################################

# Bring in expert data
expert.data<-read.table("YourPathHere/expert_data_for_analysis_CandS_Species_ID_MS.txt", sep="\t", header=T)
nrow(expert.data)
#11896

######################## Find consensus species per clip
class.data<-read.table("YourPathHere/class_data_for_analysis_CandS_Species_ID_MS.txt", sep="\t", header=T)
nrow(class.data)
#313505
class.data<-class.data[order(class.data$Clip.ID),]

# Create summ.data to house summaries for each clip
summ.data.umbrella.duiker<-data.frame(Clip.ID=sort(unique(class.data$Clip.ID)), Video.ID=NA, Expert.Species=NA, Consensus.Species=NA, Consensus.Prop=NA, Prop.Agreement=NA, Number.Blanks=NA, Number.Nonblanks=NA)
summ.data.umbrella.duiker$Video.ID<-class.data$Video.ID[match(summ.data.umbrella.duiker$Clip.ID, class.data$Clip.ID)]
summ.data.umbrella.duiker$Expert.Species<-expert.data$Umbrella.Duiker.Species[match(summ.data.umbrella.duiker$Video.ID, expert.data$Video.ID)]
nrow(summ.data.umbrella.duiker)
#47584

consensus.threshold<-0.5

# Summarize the consensus per clip and proportion agreement to expert.id
start.time<-Sys.time()
for(i in 1:nrow(summ.data.umbrella.duiker)){
    # cat(i, round(i/47584*100, 2), "% \n")
	sub.class<-class.data[class.data$Clip.ID==summ.data.umbrella.duiker$Clip.ID[i],]
	sub.Expert.Species<-expert.data$Umbrella.Duiker.Species[expert.data$Video.ID==summ.data.umbrella.duiker$Video.ID[i]]

	Number.Blanks<-sum(sub.class$Umbrella.Duiker.Species=="blank")
	Number.Nonblanks<-sum(sub.class$Umbrella.Duiker.Species!="blank")

	summ.data.umbrella.duiker$Number.Blanks[i]<-Number.Blanks
	summ.data.umbrella.duiker$Number.Nonblanks[i]<-Number.Nonblanks

	# If the clip is only blanks, then species is blank
	if(Number.Nonblanks==0){
		summ.data.umbrella.duiker$Consensus.Species[i]<-"blank"
		summ.data.umbrella.duiker$Consensus.Prop[i]<-1
		summ.data.umbrella.duiker$Prop.Agreement[i]<-mean(sub.class$Umbrella.Duiker.Species==sub.Expert.Species)

	# If there are enough nonblanks to find a consensus, find a consensus using nonblank classifications only
	} else if(Number.Nonblanks>=4){
		sub.class<-sub.class[sub.class$Umbrella.Duiker.Species!="blank",]

		sp.table<-table(sub.class$Umbrella.Duiker.Species)
		max.prop<-max(sp.table)/sum(sp.table)
		max.sp<-names(sp.table[sp.table==max(sp.table)])
		# If only one species has the maximum proportion of responses, and the prop is at least 0.5, then clip reaches consensus on that species
		if(length(max.sp)==1 & max.prop>=consensus.threshold){
			summ.data.umbrella.duiker$Consensus.Species[i]<-max.sp
			summ.data.umbrella.duiker$Consensus.Prop[i]<-max.prop
			summ.data.umbrella.duiker$Prop.Agreement[i]<-mean(sub.class$Umbrella.Duiker.Species==sub.Expert.Species)
		# Otherwise doesn't reach consensus
		} else {
			summ.data.umbrella.duiker$Consensus.Species[i]<-"no consensus"
		}

	# If there are too few nonblank clips, then it's presence undetermined
	} else if(Number.Nonblanks<=3){
			summ.data.umbrella.duiker$Consensus.Species[i]<-"presence undetermined"
	}
}
end.time<-Sys.time()
end.time - start.time
#21 mins

sum(is.na(summ.data.umbrella.duiker$Consensus.Species))
#0

table(summ.data.umbrella.duiker$Consensus.Species)
    #              bird                 blank            chimpanzee                duiker
    #               288                 29360                   672                 11221
    #          elephant          hippopotamus                   hog         hoofed.animal
    #                 6                    75                   558                    28
    #             human               leopard          no consensus   other (non-primate)
    #               881                    89                   295                   141
    #   other (primate)              pangolin             porcupine presence undetermined
    #              1994                    13                    26                  1763
    #            rodent             small cat
    #               164                    10

#
write.table(summ.data.umbrella.duiker, "YourPathHere/consensus_per_clip_umbrella_duiker_CandS_Species_ID_MS.txt", sep="\t", row.names=F, col.names=T)

write.table(summ.data.umbrella.duiker, "YourPathHere/consensus_per_clip_umbrella_duiker_CandS_Species_ID_MS.txt", sep="\t", row.names=F, col.names=T)

######################## Find consensus species per video
clip.cons.data.umbrella.duiker<-read.table("YourPathHere/consensus_per_clip_umbrella_duiker_CandS_Species_ID_MS.txt", sep="\t", header=T, stringsAsFactor=F)
nrow(clip.cons.data.umbrella.duiker)
#47584
length(unique(clip.cons.data.umbrella.duiker$Video.ID))
#11896

clip.cons.data.umbrella.duiker<-clip.cons.data.umbrella.duiker[order(clip.cons.data.umbrella.duiker$Video.ID),]

video.cons.umbrella.duiker<-data.frame(Video.ID=unique(clip.cons.data.umbrella.duiker$Video.ID), Expert.Species=NA, Consensus.Species=NA, Consensus.Prop=NA, Prop.Agreement=NA, Consensus.Type=NA)
video.cons.umbrella.duiker$Expert.Species<-clip.cons.data.umbrella.duiker$Expert.Species[match(video.cons.umbrella.duiker$Video.ID, clip.cons.data.umbrella.duiker$Video.ID)]
nrow(video.cons.umbrella.duiker)
#11896

start.time<-Sys.time()
for(i in 1:nrow(video.cons.umbrella.duiker)){
    # cat(i, round(i/11896*100, 2), "% \n")
	sub.cons<-clip.cons.data.umbrella.duiker[clip.cons.data.umbrella.duiker$Video.ID==video.cons.umbrella.duiker$Video.ID[i],]

	# First remove any clips that are presence undetermined
	sub.cons<-sub.cons[sub.cons$Consensus.Species!="presence undetermined",]

	# If there are any remaining clips, get consensus
	if(nrow(sub.cons)>0){
		# If there are only blanks, then video is blank
		if(sum(sub.cons$Consensus.Species=="blank")==nrow(sub.cons)){
			video.cons.umbrella.duiker$Consensus.Type[i]<-"Consensus blank"
			video.cons.umbrella.duiker$Consensus.Species[i]<-"blank"

		# If there are only nonblank nonconsensus clips, don't continue, video is non consensus
		} else if(sum(sub.cons$Consensus.Species=="no consensus")==sum(sub.cons$Consensus.Species!="blank")){
			video.cons.umbrella.duiker$Consensus.Type[i]<-"All nonblank clips are nonconsensus"
			video.cons.umbrella.duiker$Consensus.Species[i]<-"no consensus"

		} else {
			# Remove any nonconsensus species and blanks
			sub.cons<-sub.cons[!sub.cons$Consensus.Species %in% c("no consensus","blank"),]

			# Keep only rows that have the highest consensus prop
			sub.cons<-sub.cons[sub.cons$Consensus.Prop==max(sub.cons$Consensus.Prop),]

			# If there are multiple species present, then no consensus
			if(length(unique(sub.cons$Consensus.Species))>1){
				video.cons.umbrella.duiker$Consensus.Type[i]<-"Conflicting consensus species"
				video.cons.umbrella.duiker$Consensus.Species[i]<-"no consensus"

			# If there's just one species present, then video reaches consensus on that species, at that max proportion, with the average Prop.Agreement
			} else {
				video.cons.umbrella.duiker$Consensus.Type[i]<-"Consensus reached"
				video.cons.umbrella.duiker$Consensus.Species[i]<-sub.cons$Consensus.Species[1]
				video.cons.umbrella.duiker$Consensus.Prop[i]<-sub.cons$Consensus.Prop[1]
				video.cons.umbrella.duiker$Prop.Agreement[i]<-mean(sub.cons$Prop.Agreement)

			}
		}
	# Otherwise whole video is presence undetermined
	} else {
		video.cons.umbrella.duiker$Consensus.Species[i]<-"presence undetermined"
		video.cons.umbrella.duiker$Consensus.Type[i]<-"presence undetermined"

	}
}
end.time<-Sys.time()
end.time - start.time
#19 seconds

table(video.cons.umbrella.duiker$Consensus.Type, useNA="always")
# All nonblank clips are nonconsensus       Conflicting consensus species
#                                 107                                  15
#                     Consensus blank                   Consensus reached
#                                3665                                8107
#               presence undetermined                                <NA>
#                                   2                                   0

table(video.cons.umbrella.duiker$Consensus.Type, video.cons.umbrella.duiker$Expert.Species=="blank")
#                                       FALSE TRUE
#   All nonblank clips are nonconsensus   101    6
#   Conflicting consensus species          15    0
#   Consensus blank                      1106 2559
#   Consensus reached                    8055   52
#   presence undetermined                   2    0

######## Remove presence undetermined videos for now
video.cons.umbrella.duiker<-video.cons.umbrella.duiker[video.cons.umbrella.duiker$Consensus.Species!="presence undetermined",]
nrow(video.cons.umbrella.duiker)
#11894

# write.table(video.cons.umbrella.duiker, "YourPathHere/consensus_per_video_umbrella_duiker_CandS_Species_ID_MS.txt", sep="\t", row.names=F, col.names=T)
write.table(video.cons.umbrella.duiker, "YourPathHere/consensus_per_video_umbrella_duiker_CandS_Species_ID_MS.txt", sep="\t", row.names=F, col.names=T)

#############################################
#                  umbrella                 #
#############################################

# Bring in expert data
expert.data<-read.table("YourPathHere/expert_data_for_analysis_CandS_Species_ID_MS.txt", sep="\t", header=T)
nrow(expert.data)
#11896

######################## Find consensus species per clip
class.data<-read.table("YourPathHere/class_data_for_analysis_CandS_Species_ID_MS.txt", sep="\t", header=T)
nrow(class.data)
#313505
class.data<-class.data[order(class.data$Clip.ID),]

# Create summ.data to house summaries for each clip
summ.data.umbrella<-data.frame(Clip.ID=sort(unique(class.data$Clip.ID)), Video.ID=NA, Expert.Species=NA, Consensus.Species=NA, Consensus.Prop=NA, Prop.Agreement=NA, Number.Blanks=NA, Number.Nonblanks=NA)
summ.data.umbrella$Video.ID<-class.data$Video.ID[match(summ.data.umbrella$Clip.ID, class.data$Clip.ID)]
summ.data.umbrella$Expert.Species<-expert.data$Umbrella.Species[match(summ.data.umbrella$Video.ID, expert.data$Video.ID)]
nrow(summ.data.umbrella)
#47584

consensus.threshold<-0.5

# Summarize the consensus per clip and proportion agreement to expert.id
start.time<-Sys.time()
for(i in 1:nrow(summ.data.umbrella)){
    # cat(i, round(i/47584*100, 2), "% \n")
	sub.class<-class.data[class.data$Clip.ID==summ.data.umbrella$Clip.ID[i],]
	sub.Expert.Species<-expert.data$Umbrella.Species[expert.data$Video.ID==summ.data.umbrella$Video.ID[i]]

	Number.Blanks<-sum(sub.class$Umbrella.Species=="blank")
	Number.Nonblanks<-sum(sub.class$Umbrella.Species!="blank")

	summ.data.umbrella$Number.Blanks[i]<-Number.Blanks
	summ.data.umbrella$Number.Nonblanks[i]<-Number.Nonblanks

	# If the clip is only blanks, then species is blank
	if(Number.Nonblanks==0){
		summ.data.umbrella$Consensus.Species[i]<-"blank"
		summ.data.umbrella$Consensus.Prop[i]<-1
		summ.data.umbrella$Prop.Agreement[i]<-mean(sub.class$Umbrella.Species==sub.Expert.Species)

	# If there are enough nonblanks to find a consensus, find a consensus using nonblank classifications only
	} else if(Number.Nonblanks>=4){
		sub.class<-sub.class[sub.class$Umbrella.Species!="blank",]

		sp.table<-table(sub.class$Umbrella.Species)
		max.prop<-max(sp.table)/sum(sp.table)
		max.sp<-names(sp.table[sp.table==max(sp.table)])
		# If only one species has the maximum proportion of responses, and the prop is at least 0.5, then clip reaches consensus on that species
		if(length(max.sp)==1 & max.prop>=consensus.threshold){
			summ.data.umbrella$Consensus.Species[i]<-max.sp
			summ.data.umbrella$Consensus.Prop[i]<-max.prop
			summ.data.umbrella$Prop.Agreement[i]<-mean(sub.class$Umbrella.Species==sub.Expert.Species)
		# Otherwise doesn't reach consensus
		} else {
			summ.data.umbrella$Consensus.Species[i]<-"no consensus"
		}

	# If there are too few nonblank clips, then it's presence undetermined
	} else if(Number.Nonblanks<=3){
			summ.data.umbrella$Consensus.Species[i]<-"presence undetermined"
	}
}
end.time<-Sys.time()
end.time - start.time
#20 mins

sum(is.na(summ.data.umbrella$Consensus.Species))
#0

table(summ.data.umbrella$Consensus.Species)
        #          bird                 blank            chimpanzee              elephant
        #           288                 29360                   672                     6
        #  hippopotamus                   hog         hoofed.animal                 human
        #            75                   555                 11318                   881
        #       leopard          no consensus   other (non-primate)       other (primate)
        #            89                   230                   141                  1994
        #      pangolin             porcupine presence undetermined                rodent
        #            13                    26                  1763                   164
        #     small cat
        #             9
# write.table(summ.data.umbrella, "YourPathHere/consensus_per_clip_umbrella_CandS_Species_ID_MS.txt", sep="\t", row.names=F, col.names=T)

write.table(summ.data.umbrella, "YourPathHere/consensus_per_clip_umbrella_CandS_Species_ID_MS.txt", sep="\t", row.names=F, col.names=T)

######################## Find consensus species per video
clip.cons.data.umbrella<-read.table("YourPathHere/consensus_per_clip_umbrella_CandS_Species_ID_MS.txt", sep="\t", header=T, stringsAsFactor=F)
nrow(clip.cons.data.umbrella)
#47584
length(unique(clip.cons.data.umbrella$Video.ID))
#11896

clip.cons.data.umbrella<-clip.cons.data.umbrella[order(clip.cons.data.umbrella$Video.ID),]

video.cons.umbrella<-data.frame(Video.ID=unique(clip.cons.data.umbrella$Video.ID), Expert.Species=NA, Consensus.Species=NA, Consensus.Prop=NA, Prop.Agreement=NA, Consensus.Type=NA)
video.cons.umbrella$Expert.Species<-clip.cons.data.umbrella$Expert.Species[match(video.cons.umbrella$Video.ID, clip.cons.data.umbrella$Video.ID)]
nrow(video.cons.umbrella)
#12876

start.time<-Sys.time()
for(i in 1:nrow(video.cons.umbrella)){
    # cat(i, round(i/11896*100, 2), "% \n")
	sub.cons<-clip.cons.data.umbrella[clip.cons.data.umbrella$Video.ID==video.cons.umbrella$Video.ID[i],]

	# First remove any clips that are presence undetermined
	sub.cons<-sub.cons[sub.cons$Consensus.Species!="presence undetermined",]

	# If there are any remaining clips, get consensus
	if(nrow(sub.cons)>0){
		# If there are only blanks, then video is blank
		if(sum(sub.cons$Consensus.Species=="blank")==nrow(sub.cons)){
			video.cons.umbrella$Consensus.Type[i]<-"Consensus blank"
			video.cons.umbrella$Consensus.Species[i]<-"blank"

		# If there are only nonblank nonconsensus clips, don't continue, video is non consensus
		} else if(sum(sub.cons$Consensus.Species=="no consensus")==sum(sub.cons$Consensus.Species!="blank")){
			video.cons.umbrella$Consensus.Type[i]<-"All nonblank clips are nonconsensus"
			video.cons.umbrella$Consensus.Species[i]<-"no consensus"

		} else {
			# Remove any nonconsensus species and blanks
			sub.cons<-sub.cons[!sub.cons$Consensus.Species %in% c("no consensus","blank"),]

			# Keep only rows that have the highest consensus prop
			sub.cons<-sub.cons[sub.cons$Consensus.Prop==max(sub.cons$Consensus.Prop),]

			# If there are multiple species present, then no consensus
			if(length(unique(sub.cons$Consensus.Species))>1){
				video.cons.umbrella$Consensus.Type[i]<-"Conflicting consensus species"
				video.cons.umbrella$Consensus.Species[i]<-"no consensus"

			# If there's just one species present, then video reaches consensus on that species, at that max proportion, with the average Prop.Agreement
			} else {
				video.cons.umbrella$Consensus.Type[i]<-"Consensus reached"
				video.cons.umbrella$Consensus.Species[i]<-sub.cons$Consensus.Species[1]
				video.cons.umbrella$Consensus.Prop[i]<-sub.cons$Consensus.Prop[1]
				video.cons.umbrella$Prop.Agreement[i]<-mean(sub.cons$Prop.Agreement)

			}
		}
	# Otherwise whole video is presence undetermined
	} else {
		video.cons.umbrella$Consensus.Species[i]<-"presence undetermined"
		video.cons.umbrella$Consensus.Type[i]<-"presence undetermined"

	}
}
end.time<-Sys.time()
end.time - start.time
#20 seconds

table(video.cons.umbrella$Consensus.Type, useNA="always")
# All nonblank clips are nonconsensus       Conflicting consensus species
#                                  93                                  15
#                     Consensus blank                   Consensus reached
#                                3665                                8121
#               presence undetermined                                <NA>
#                                   2                                   0

table(video.cons.umbrella$Consensus.Type, video.cons.umbrella$Expert.Species=="blank")

#                                       FALSE TRUE
#   All nonblank clips are nonconsensus    89    4
#   Conflicting consensus species          15    0
#   Consensus blank                      1106 2559
#   Consensus reached                    8067   54
#   presence undetermined                   2    0

######## Remove presence undetermined videos for now
video.cons.umbrella<-video.cons.umbrella[video.cons.umbrella$Consensus.Species!="presence undetermined",]
nrow(video.cons.umbrella)
#11894

# write.table(video.cons.umbrella, "YourPathHere/consensus_per_video_umbrella_CandS_Species_ID_MS.txt", sep="\t", row.names=F, col.names=T)

write.table(video.cons.umbrella, "YourPathHere/consensus_per_video_umbrella_CandS_Species_ID_MS.txt", sep="\t", row.names=F, col.names=T)


# run r work
base_dir <- "/drone/src/github.com/COMBINE-lab/continuous_analysis_rnaseq"
sample_id <- dir(file.path(base_dir,"salmon_output"))
sample_id
kal_dirs <- sapply(sample_id, function(id) file.path(base_dir, "salmon_output", id))
kal_dirs

s2c <- read.table(file.path(base_dir, "samples.txt"), header = TRUE, stringsAsFactors=FALSE)
s2c <- dplyr::select(s2c, sample, condition)
s2c

s2c <- dplyr::mutate(s2c, path = kal_dirs)
print(s2c)

# this analysis is from: https://benchtobioinformatics.wordpress.com/2015/07/10/using-kallisto-for-gene-expression-analysis-of-published-rnaseq-data/
# perform PCA
source("https://bioconductor.org/biocLite.R")
library("edgeR")
library('biomaRt')
library("genefilter")

library("ggplot2")
library("stringr")
library("plyr")
library("RColorBrewer")
for (i in 1:length(kal_dirs)){
	print(kal_dirs[i])
	tmp = read.table(file = paste0(kal_dirs[i],"/quant.sf"), header = T)
	assign(kal_dirs[i], tmp)
}
sample_list = mget(kal_dirs)
ListNames <- Map(function(x, i) setNames(x, ifelse(names(x) %in% "Name", names(x), sprintf("%s.%d", names(x), i))), sample_list, seq_along(sample_list))
# merge full kalisto table
# have to use Reduce() function as merge() will only merge two data.frames
full_results <- Reduce(function(...) merge(..., by='Name', all = T), ListNames)

# subset estimate count values (correcting from TPM values)
count_vals <- full_results[, grep("NumReads", names(full_results))]

# now we have to assign column and row IDs to tpm table
row.names(count_vals) <- full_results$target_id

# setting column names is a little trickier as each file has "output_SRR..." as IDs
# we will use regrex with stringr and dplyr packages to get down to the SRR file IDs
splitNames <- str_split(string=kal_dirs, pattern = "_", n = 2)
df <- ldply(splitNames, data.frame)
FinalNames <- df[df$X..i.. != "output",]

FinalNames
# [1] SRR1654626 SRR1654628 SRR1654633 SRR1654636 SRR1654637 SRR1654639 SRR1654641 SRR1654643
# 9 Levels: output SRR1654626 SRR1654628 SRR1654633 SRR1654636 SRR1654637 ... SRR1654643
# actual IDs
ActualNames <- c("mN5",'mN7','mP1','mP4','mP5','mT3','mT5','mT8')
Groups <- data.frame(Subtypes = c("mN","mN",'mP','mP','mP','mT','mT','mT'))

Names_count <- data.frame(FinalNames, ActualNames, Groups)
Names_count

colnames(count_vals) <- ActualNames
head(count_vals)

des <- factor(Groups$Subtypes)
design <- model.matrix(~0+des)
colnames(design) <- levels(des)
design

# filter out lowly expressed genes
A <- rowSums(count_vals)
isexpr <- A > 1
table(isexpr)
# isexpr
# FALSE TRUE
# 21367 66831
count_vals <- count_vals[isexpr, ]
dim(count_vals)
y <- DGEList(counts = count_vals)

# lets do some exploratory data analysis of this RNAseq dataset
# first with Principle componenet analysis like figure 5A in Boj et al.,
# and compare whether TPM normalization can replicate their data

log_count <- log2(y$counts + 1)

pcCount <- prcomp(t(log_count))

# 2D PCA plot with ggplot2
scoresCount <- data.frame(pcCount$x, Names_count)

brewer.pal(3,"Set2")
my_palette <- brewer.pal(3,"Set2") # "#66C2A5" "#FC8D62" "#8DA0CB"

pcaTpm = (pcaCount <- ggplot(scoresCount, aes(x=PC1, y=PC2)) +
 geom_point(size = 4, aes(col=factor(scoresCount$Subtypes))) +
 ggtitle("Principal Components\nUsing Salmon Estimated Counts") +
 geom_text(aes(label=scoresCount$ActualNames),hjust=0.5, vjust=1) +
 theme_minimal())
ggsave(filename=file.path(base_dir, "results/PCA.png"), plot=pcaTpm, width=10, height=8)

# volcano plots
exp <- voom(counts = y$counts, design = design, plot = T)
fit <- lmFit(exp, design = design)

# set up contrast matrix of conditions
cont.matrix <- makeContrasts("mT-mN",'mT-mP','mN-mP', levels = design)
fit <- contrasts.fit(fit, cont.matrix)
fit <- eBayes(fit)
topTable(fit, adjust="BH", number = Inf, p=0.05)
summary(decideTests(fit))

# compare the mT vs mN and mP vs mN contrasts and sort by LogFC
options(digits = 3)

# comparing normal organoids to Tumor organoids
res_mTvsmN <- (topTable(fit, coef = 1, adjust = 'BH', n = Inf, p = 1)[,-2])
res_mTvsmN <- res_mTvsmN [order(-res_mTvsmN$logFC),]
head(res_mTvsmN)
nrow(res_mTvsmN)

res_mTvsmN$threshold = as.factor(abs(res_mTvsmN$logFC) > 2 & res_mTvsmN$P.Value < 0.05/(dim(res_mTvsmN)[1]))
# Make a basic volcano plot
g = ggplot(data=res_mTvsmN, aes(x=logFC, y=-log10(P.Value), colour=threshold)) +
  geom_point(alpha=0.4, size=1.75) +
  xlim(c(-10, 10)) + ylim(c(0, 15)) +
  xlab("log2 fold change") + ylab("-log10 p-value")
ggsave(filename=file.path(base_dir, "results/res_mTvsmN.png"), plot=g, width=10, height=10)

# comparing normal organoids to PanIN organoids
res_mNvsmP <- (topTable(fit, coef = 3, adjust='BH', n = Inf, p = 1)[,-2])
res_mNvsmP <- res_mNvsmP[order(-res_mNvsmP$logFC),]
head(res_mNvsmP)
nrow(res_mNvsmP)

res_mNvsmP$threshold = as.factor(abs(res_mNvsmP$logFC) > 2 & res_mNvsmP$P.Value < 0.05/(dim(res_mNvsmP)[1]))
# Make a basic volcano plot
g = ggplot(data=res_mNvsmP, aes(x=logFC, y=-log10(P.Value), colour=threshold)) +
  geom_point(alpha=0.4, size=1.75) +
  xlim(c(-10, 10)) + ylim(c(0, 15)) +
  xlab("log2 fold change") + ylab("-log10 p-value")
ggsave(filename=file.path(base_dir, "results/res_mNvsmP.png"), plot=g, width=10, height=10)

# Sleuth is a new tool to peform differential expresion with diffrential expresion, so we'll do that as well
s2c <- read.table(file.path(base_dir, "samples.txt"), header = TRUE, stringsAsFactors=FALSE)
s2c <- dplyr::select(s2c, sample, condition)
s2c

s2c <- dplyr::mutate(s2c, path = kal_dirs)
print(s2c)

# library('sleuth')
# so <- sleuth_prep(s2c, ~ condition)
# so <- sleuth_fit(so)
# so <- sleuth_fit(so, ~1, 'reduced')
# so <- sleuth_lrt(so, 'reduced', 'full')
# models(so)
# results_table <- sleuth_results(so, 'reduced:full', test_type = 'lrt')
# write.table(results_table, file='results/raw_sleuth_results.txt', sep="\t")

# # include gene names
# mart <- biomaRt::useMart(biomart = 'ensembl', dataset = "mmusculus_gene_ensembl")
# t2g <- biomaRt::getBM(attributes = c("ensembl_transcript_id", "ensembl_gene_id",
#     "external_gene_name"), mart = mart)
# t2g <- dplyr::rename(t2g, target_id = ensembl_transcript_id,
#   ens_gene = ensembl_gene_id, ext_gene = external_gene_name)
# so <- sleuth_prep(s2c, ~ condition, target_mapping = t2g)
# so <- sleuth_fit(so)
# so <- sleuth_fit(so, ~1, 'reduced')
# so <- sleuth_lrt(so, 'reduced', 'full')
# results_table <- sleuth_results(so, 'reduced:full', test_type = 'lrt')
# write.table(results_table, file='results/named_sleuth_results.txt', sep="\t")


<resource schema="bestseds">

  <meta name="title">Herschel Extragalactic Legacy Project (HELP) - Best fitting
    spectra</meta>
  <meta name="description">
    Best fitting spectra found by CIGALE for each HELP source
  </meta>
  <meta name="_longdoc" format="rst"> <![CDATA[
    This resource contains the best fitting spectra resulting from the analysis
    of some HELP sources with CIGALE_.

    ================ ==== =====================================================
    Column           Unit Description
    ================ ==== =====================================================
    WAVE or SPECTRAL nm   Wavelength
    FLUX             mJy  Flux density (Fν)
    LUMIN            W/nm Total luminosity
    STELLAR          W/nm Luminosity of the stellar component
    DUST             W/nm Luminosity of the dust component
    AGN              W/nm Luminosity of the AGN component
    IGM              W/nm Effect of the Inter-Galactic Medium on the luminosity
    ================ ==== =====================================================

    History
    -------
    ======== ==================================================================
    20170505 First version with preliminary COSMOS data.
    ======== ==================================================================

    .. _CIGALE: http://cigale.lam.fr

  ]]> </meta>

  <meta name="creationDate">2017-05-02</meta>
  <meta name="creator">Yannick Roehlly</meta>

  <meta name="subject">Galaxy</meta>
  <meta name="subject">Spectrum</meta>
  <meta name="subject">SED fitting</meta>

  <meta name="ssap.dataSource">artificial</meta>

  <meta name="coverage">
    <meta name="profile">AllSky ICRS</meta>
    <meta name="waveband">UV, Optical, Infrared</meta>
  </meta>

    <mixin
      fluxUnit="mJy"
      fluxUCD="phot.flux.density"
      spectralUnit="nm">//ssap#mixc</mixin>
    <column name="datalink" type="text"
      ucd="meta.ref.url;meta.data.datalink"
      tablehead="Datalink"
      description="A link to a datalink document for this spectrum."
      verbLevel="15" displayHint="type=url"/>

    <mixin ssaTable="data"
      fluxDescription="Total flux"
      spectralDescription="Wavelength"
      >//ssap#sdm-instance</mixin>

    <column name="lumin"
      tablehead="lumin"
      type="real"
      ucd="phys.luminosity"
      unit="W/nm"
      description="Total luminosity density"/>
    <column name="stellar"
      tablehead="stellar"
      type="real"
      ucd="phys.luminosity"
      unit="W/nm"
      description="Stellar (not reddened) luminosity density"/>
    <column name="dust"
      tablehead="dust"
      type="real"
      ucd="phys.luminosity"
      unit="W/nm"
      description="Luminosity density of the dust component"/>
    <column name="agn"
      tablehead="agn"
      type="real"
      ucd="phys.luminosity"
      unit="W/nm"
      description="Luminosity density of the AGN"/>
    <column name="igm"
      tablehead="igm"
      type="real"
      ucd="phys.luminosity"
      unit="W/nm"
      description="Effect of the Inter-Galactic Medium on the observed
      luminosity (negative)"/>

  <data id="import">
    <sources recurse="True">
      <pattern>data/*.fits</pattern>
    </sources>
    <fitsProdGrammar qnd="False" hdu="1" hdusField="HDUS">
      <maxHeaderBlocks>80</maxHeaderBlocks>
      <rowfilter procDef="//products#define">
        <bind name="table">"\schema.data"</bind>
        <bind name="mime">"application/fits"</bind>
        <bind name="preview">\inputRelativePath.replace(".fits", ".png")</bind>
        <bind name="preview_mime">"image/png"</bind>
      </rowfilter>
    </fitsProdGrammar>
    <make table="data">
      <rowmaker idmaps="ssa_*">

        <var name="specAx">@HDUS[1].data["WAVE"]</var>
        <var name="specLen">len(@HDUS[1].data["WAVE"])</var>

        <apply procDef="//ssap#setMeta">
          <bind name="dstitle">"%s Best CIGALE SED"%(@OBJECT)</bind>
          <bind name="pubDID">\standardPubDID</bind>
          <bind name="targname">@OBJECT</bind>
          <bind name="alpha">@RA_TARG</bind>
          <bind name="delta">@DEC_TARG</bind>
          <bind name="bandpass">"UV, Optical, IR"</bind>
          <bind name="length">@specLen</bind>
          <bind name="specstart">@specAx[0]*1.e-9</bind>
          <bind name="specend">@specAx[-1]*1.e-9</bind>
          <bind name="redshift">@REDSHIFT</bind>
        </apply>

        <apply procDef="//ssap#setMixcMeta">
          <bind name="collection">"HELP best spectra"</bind>
          <bind name="creationType">"archival"</bind>
          <bind name="dataSource">"artificial"</bind>
          <bind name="fluxCalib">"ABSOLUTE"</bind>
          <bind name="specCalib">"ABSOLUTE"</bind>
        </apply>

        <map name="datalink">\dlMetaURI{sdl}</map>
      </rowmaker>
    </make>
  </data>

  <data id="build_sdm_data" auto="False">
    <embeddedGrammar>
      <iterator>
        <setup>

            from gavo.protocols import products
            from gavo.utils import pyfits

        </setup>

          fitsPath = products.RAccref.fromString(
          self.sourceToken["accref"]).localpath
          hdus = pyfits.open(fitsPath)

          for row in hdus[1].data:
              yield {
                  "spectral": row['WAVE'],
                  "flux": row['FLUX'],
                  "lumin": row['LUMIN'],
                  "stellar": row['STELLAR'],
                  "dust": row['dust'],
                  "agn": row['agn'],
                  "igm": row['igm']
              }
          hdus.close()

      </iterator>
    </embeddedGrammar>
    <make table="spectrum">
      <parmaker>
        <apply procDef="//ssap#feedSSAToSDM"/>
      </parmaker>
    </make>
  </data>

  <service id="sdl" allowed="dlget,dlmeta">
    <meta name="title">HELP Best Spectra Datalink Service</meta>

    <datalinkCore>
      <descriptorGenerator procDef="//soda#sdm_genDesc">
        <bind name="ssaTD">"\rdId#data"</bind>
      </descriptorGenerator>
      <dataFunction procDef="//soda#sdm_genData">
        <bind name="builder">"\rdId#build_sdm_data"</bind>
      </dataFunction>
      <FEED source="//soda#sdm_plainfluxcalib"/>
      <FEED source="//soda#sdm_cutout"/>
      <FEED source="//soda#sdm_format"/>
    </datalinkCore>
  </service>

  <service id="web" defaultRenderer="form">
    <meta name="shortName">HELP Spectra web</meta>
    <meta name="title">HELP sources best fitting spectra from CIGALE.</meta>

    <dbCore queriedTable="data">
      <condDesc buildFrom="ssa_location"/>
      <condDesc buildFrom="ssa_redshift"/>
      <condDesc>
        <inputKey original="mime">
          <property name="defaultForForm">application/x-votable+xml</property>
          <values>
            <option title="SDM VOTable">application/x-votable+xml</option>
            <option title="FITS table">application/fits</option>
          </values>
        </inputKey>
      </condDesc>
    </dbCore>

    <outputTable>
      <autoCols>accref, mime, ssa_targname, datalink</autoCols>
      <FEED source="//ssap#atomicCoords"/>
      <outputField original="ssa_specstart" displayHint="displayUnit=nm"/>
      <outputField original="ssa_specend" displayHint="displayUnit=nm"/>
    </outputTable>
  </service>

  <service id="ssa" allowed="form,ssap.xml">
    <meta name="shortName">HELP Spectra SSAP</meta>
    <meta name="title">HELP sources best fitting spectra from CIGALE</meta>
    <meta name="ssap.dataSource">artificial</meta>
    <meta name="ssap.testQuery">MAXREC=1</meta>
    <meta name="ssap.creationType">archival</meta>
    <meta name="ssap.complianceLevel">query</meta>
    <publish render="ssap.xml" sets="ivo_managed"/>
    <publish render="form" sets="ivo_managed,local" service="web"/>

    <property name="datalink">sdl</property>

    <ssapCore queriedTable="data">
      <FEED source="//ssap#hcd_condDescs"/>
    </ssapCore>
  </service>

</resource>


library(ggplot2)
library(data.table)
library(dplyr)
library(Homo.sapiens)
library(ggbio)
library(GenomicRanges)
library(biovizBase)
library(cowplot)

data(genesymbol, package = "biovizBase")

if(! exists("inputFile")){
  args <- commandArgs(TRUE)
  if(length(args) == 0){
    setwd("/scratch/cqs/shengq2/macrae_linton/20190517_linton_exomeseq_3321_human/GATK4_CNV_Germline_10_CNVGenesPlot/result")
    inputFile<-"linton_exomeseq_3321.position.txt.1000"
    outputPrefix<-'linton_exomeseq_3321.position'
    sizeFactorFile<-"/scratch/cqs/shengq2/macrae_linton/20190517_linton_exomeseq_3321_human/GATK4_CNV_Germline_08_SizeFactor/result/linton_exomeseq_3321.txt.sizefactor"
    #inputFile<-'/scratch/cqs/shengq2/vickers/20190504_smallRNA_as_chipseq_GCF_000005845.2_ASM584v2/plotPeak/result/Control.position.txt'
    #outputPrefix<-'/scratch/cqs/shengq2/vickers/20190504_smallRNA_as_chipseq_GCF_000005845.2_ASM584v2/plotPeak/result/Control.position'
  }else{
    inputFile<-args[1]
    outputPrefix<-args[2]
    sizeFactorFile<-args[3]
  }
}

cat(inputFile, "\n")
rawTable<-fread(file=inputFile, sep="\t", header=T)

readSizeFactors<-function(fileName){
  sizeFactorsAll<-read.table(sizeFactorFile, sep="\t", header=T)
  sizeFactorsAll<-sizeFactorsAll[!is.na(sizeFactorsAll$SizeFactor),]
  sfMedian<-sizeFactorsAll %>% group_by(Sample) %>% summarise(Median=median(SizeFactor))

  result<-sfMedian$Median
  names(result)<-sfMedian$Sample
  return(result)
}

sizeFactors<-readSizeFactors(sizeFactorFile)

cols <- c("DEL" = "blue", "DUP" = "red", "NoIndel" = "gray")
selectedFeature<-unique(rawTable$Feature)[1]
for (selectedFeature in unique(rawTable$Feature)) {
  cat(paste0(selectedFeature, "\n"))

  dataForPlot<-rawTable[which(rawTable$Feature==selectedFeature),]
  dataForPlot$NormalizedPositionCount<-round(dataForPlot$PositionCount * sizeFactors[dataForPlot$File])
  dataForPlot$FileName<-gsub("_", " ", dataForPlot$File)

  locus=unique(dataForPlot$Locus)

  fileNumber=length(unique(dataForPlot$FileName))
  xlim=c(floor(min(dataForPlot$Position) / 1000) * 1000, ceiling(max(dataForPlot$Position) / 1000) * 1000)

  if(selectedFeature != locus){
    wh <- genesymbol[c(selectedFeature)]
    wh <- range(wh, ignore.strand = FALSE)
    g2<-autoplot(Homo.sapiens, which = wh) +
      xlim(xlim) +
      theme_classic() +
      theme(axis.line=element_blank(),
            axis.title.x=element_blank(),
            axis.text.x=element_blank(),
            axis.ticks.x=element_blank(),
            plot.margin = margin(0, 1, 0, 0, "cm"))
  }

  hasCNV<-(("CNV" %in% colnames(dataForPlot)) & (length(unique(dataForPlot$CNV)) > 1))

  if(hasCNV){
    dataForPlot$CNV[dataForPlot$CNV=="FALSE"] = "DEL"
    dataForPlot$CNV[dataForPlot$CNV=="NOREAD"] = "DEL"
    dataForPlot$CNV[dataForPlot$CNV==""] = "NoIndel"
  }

  if(grepl("_\\d+_\\d+$", selectedFeature)){
    parts=unlist(strsplit(selectedFeature, "_"))
    featureName=paste0(paste0(parts[1:(length(parts)-2)]), ":", parts[length(parts)-1], "-", parts[length(parts)])
  }else{
    featureName = selectedFeature
  }

  columns<-c("Read count", "Percentage", "Normalized read count")
  names(columns)<-c("PositionCount", "Percentage", "NormalizedPositionCount")
  column<-"NormalizedPositionCount"
  for (column in names(columns)){
    outputFile = paste0(outputPrefix, ".", selectedFeature, ".", column, ".pdf")
    #if (file.exists(outputFile)){
    #  next
    #}
    pdf(outputFile, height=max(6, length(unique(dataForPlot$FileName))), width=8, onefile=TRUE)
    g <- ggplot(dataForPlot, aes_string("Position", column)) +
      ylab(columns[column]) +
      xlim(xlim) +
      geom_line()

    if(featureName != locus){
      g <- g + ggtitle(paste0(featureName, " (", locus, ")"))
    }

    if(hasCNV){
      g <- g + geom_area(aes(fill=CNV), alpha=.5)+
        scale_fill_manual(values=cols)
    }else{
      g <- g + geom_area()
    }

    g <- g +
      facet_grid(FileName~.) +
      theme_bw() +
      theme(strip.background=element_blank(),
            axis.title.x=element_blank())

    if(selectedFeature != locus){
      g<-plot_grid(g, g2@ggplot, ncol = 1, align = 'v', axis = "lr", rel_heights=c(fileNumber, 1) )
    }

    print(g)
    dev.off()
  }
}