#!/usr/bin/env Rscript

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

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

library(getopt)

spec = matrix(c(
  'help' , 'h', 0, "logical","print the usage of the command",
  'RT', "r", 2,"character","txt table of RT values",
  'span', "s", 2,"integer","loess smoothing span"
),ncol = 5,byrow=T)

opt = getopt(spec)

if ( !is.null(opt$help) || length(opt)==1 ) {
  #get the script name
  cmd = commandArgs(FALSE)
  self = strsplit(cmd[grep("--file",cmd)],"=")[[1]][2]
  cat(basename(self),": Create mismatch plots from rate tabs.\n\n")
  #print a friendly message and exit with a non-zero error code
  cat(getopt(spec,command = self,usage=T))
  q(status=1)
}

if ( is.null(opt$RT) ) stop("arg RT must be specified")
if ( is.null(opt$span) ) { opt$span = 300000 }

library(preprocessCore)

################################################
## Prepare counts                             ##
################################################

merge<-read.table("merge_RT.txt" , header=TRUE)

#################################################
## Loess smoothing on raw data                 ##
#################################################

chrs=grep(levels(merge$chr),pattern= "[_YM]",invert=TRUE,value=TRUE)

AllLoess=list()

for(i in 1:(ncol(merge)-3)){
  AllLoess[[i]]=data.frame();
  cat("Current dataset:", colnames(merge)[i+3], "\n");
  for(Chr in chrs){
    RTb=subset(merge, merge$chr==Chr);
    lspan=opt$span/(max(RTb$start)-min(RTb$start));
    cat("Current chrom:" , Chr, "\n");
    RTla=loess(RTb[,i+3] ~ RTb$start, span=lspan);
    RTl=data.frame(c(rep(Chr,times=RTla$n)), RTla$x, merge[which( merge$chr==Chr & merge$start %in% RTla$x),3],RTla$fitted)
    colnames(RTl)=c("chr" , "start" , "end" ,colnames(RTb)[i+3])
    if(length(AllLoess[[i]])!=0){
      AllLoess[[i]]=rbind(AllLoess[[i]],RTl)
    }
    if(length(AllLoess[[i]])==0){
      AllLoess[[i]] = RTl
    }
  }
}

for(i in 1:length(AllLoess)){
  write.table(AllLoess[[i]][complete.cases(AllLoess[[i]]),],
    gsub(".bg" , ".loess.bg" , colnames(AllLoess[[i]])) [4],
    sep= "\t" , row.names=FALSE, quote=FALSE, col.names = FALSE
  )
}

################################################
## Quantile normalization                     ##
################################################

if (ncol(merge) > 4) {

  merge_values<-as.matrix(merge[,4:ncol(merge)])

  ad<-stack(merge[,4:ncol(merge)])$values

  norm_data<-normalize.quantiles.use.target(merge_values,ad)
  merge_norm<-data.frame(merge[,1:3],norm_data)
  colnames(merge_norm)<-colnames(merge)

} else {
  merge_norm = merge
}

for(i in 4:ncol(merge_norm)){
  write.table(merge_norm[complete.cases(merge_norm[,i]), c(1,2,3,i)],
    gsub(".bg" , ".qnorm.bg", colnames(merge_norm)[i]),
    sep= "\t" ,row.names=FALSE, quote=FALSE, col.names = FALSE
  )
}

#################################################
## Loess smoothing on quantile-normalized data ##
#################################################

chrs=grep(levels(merge_norm$chr),pattern= "[_YM]",invert=TRUE,value=TRUE)

AllLoess=list()

for(i in 1:(ncol(merge_norm)-3)){
  AllLoess[[i]]=data.frame();
  cat("Current dataset:", colnames(merge_norm)[i+3], "\n");
  for(Chr in chrs){
    RTb=subset(merge_norm, merge_norm$chr==Chr);
    lspan=opt$span/(max(RTb$start)-min(RTb$start));
    cat("Current chrom:" , Chr, "\n");
    RTla=loess(RTb[,i+3] ~ RTb$start, span=lspan);
    RTl=data.frame(c(rep(Chr,times=RTla$n)), RTla$x, merge_norm[which( merge_norm$chr==Chr & merge_norm$start %in% RTla$x),3],RTla$fitted)
    colnames(RTl)=c("chr" , "start" , "end" ,colnames(RTb)[i+3])
    if(length(AllLoess[[i]])!=0){
      AllLoess[[i]]=rbind(AllLoess[[i]],RTl)
    }
    if(length(AllLoess[[i]])==0){
      AllLoess[[i]] = RTl
    }
  }
}

for(i in 1:length(AllLoess)){
  write.table(AllLoess[[i]][complete.cases(AllLoess[[i]]),],
    gsub(".bg" , ".qnorm.loess.bg" , colnames(AllLoess[[i]])) [4],
    sep= "\t" , row.names=FALSE, quote=FALSE, col.names = FALSE
  )
}

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

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

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


plot.projections = function(p, pj, reg, outdir, reg.label) {
  default.options = options()
  setup.lattice.options()
  xlim=range(pj$yr); xlim[1]=xlim[1]-0.5; xlim[2]=xlim[2]+0.5
  ylim=range(pj$ub); ylim[1]=0; ylim[2]=  ylim[2]+ 0.5
  nex = length( unique ( pj$ER ) )
  uu = xyplot( fbpre~yr|ER, data=pj, ub=pj$ub, lb=pj$lb, reg.label=reg.label,
            layout=c(1,nex), xlim=xlim, ylim=ylim,
            main=paste("Projections of fishable biomass relative to", p$start.projection.year, "--", reg ),
            ylab = "Fishable biomass (t; pre-fishery)", xlab= "Year",
#            main = reg.label,
#            xlab="Year", ylab="Relative prefishery fishable biomass (proportion)",
            panel = function(x, y, subscripts, ub, lb, ...) {
#           panel.abline(h=y[1], col="gray75", ...)
            panel.abline(h=1, col="gray75", ...)
            larrows(x, lb[subscripts], x, ub[subscripts], angle = 90, code = 3, length=0.05 )
            panel.xyplot(x, y, type="b", lty="dashed", lwd=1.4, pch=19, col="black", ...)
         }
    )
    plot(uu)
   Pr( dev="png", dname=outdir, fname=paste("projections", reg, sep="."), width=6, height=8)
   options(default.options)
}


import_package('ggplot2', attach=TRUE)
seq = import('../../../seq')

#' Plots mark enrichment around a set of coordinates
#'
#' @param model  Chromstar model object
#' @param dset   Ensembl data set to use for gene annotations
#' @param ref    Center around either gene body or TSS
#' @param flank  Number  of bp in flanking region
#' @param pp     Filter peaks by 1-posterior probability (default: no filter)
#' @param ...    Additional parameters passed to chromstaR::plotEnrichment
#' @return       A ggplot2 object
enrichment = function(model, dset, ref=c("gene", "TSS"), flank=1.5e4, pp=NULL, ...) {
    ref_lookup = setNames(c(c("start", "inside", "end"), "start"),
                          c("gene", "TSS"))
    ref = match.arg(ref)
    coords = seq$coords$gene('ensembl_gene_id', dset=dset, granges=TRUE)

    if (!is.null(pp))
        model = filter_peaks(model, pp=pp)

    add = function(p) p +
        xlab("distance from gene body") +
        theme_minimal() +
        guides(color=FALSE) +
        theme(axis.text.x = element_text(angle=45, hjust=1)) +
        facet_wrap(~ combination)

    p = chromstaR::plotEnrichment(model, coords, region=ref_lookup[ref],
            bp.around.annotation=flank, ...)
    lapply(p, add)
}


args=commandArgs(trailingOnly=TRUE)
#==============================================
rescale_w<-function(w){
            w[which(w[]==-1)]=-0.01
            w[which(w[]==-2)]=-0.02
            w[which(w[]==-3)]=-0.03
            return(w)
}
#==============================================
aln=args[1]
e=as.matrix(read.table(args[2]))
w=as.matrix(read.table(args[3]))
llh=as.matrix(read.table(args[4]))

tree=args[5]
plot_out=args[6]
ident_tree=args[7]
ident_pair=args[8]
general_info=args[9]
#==============================================
f="/project/olga-phylo/brain-evo/data/final-analysis/tree_topologies/branch_correspondence/"
e_ids=read.table(paste(f,"branch_id-",tree,sep=""))
#print(e_ids)

if(ident_tree!="NA"){
	#print(args[7])
	#print(paste(f,"branch_id-",ident_tree,sep=""))
	#e_ids_9sp=read.table(paste(f,"branch_id-",ident_tree,sep=""))
	e_ids=read.table(paste(f,"branch_id-",ident_tree,sep=""))
	#print(e_ids)
}
#==============================================
ncol_w=ncol(w)

e_range=array(0,ncol_w)
w_range=array(0,ncol_w)
w_percent=array(0,ncol_w)

e_max_llh=array(0,ncol_w)
w_max_llh=array(0,ncol_w)

flag_unstable=array(FALSE,ncol_w)

w_out_un=array(0,ncol_w)
w_out_un_e=array(0,ncol_w)
#---------------------------------------
llh_max_v=which(llh[]==max(llh[]))
llh_max=ifelse(length(llh_max_v==1),llh_max_v,llh_max_v[1])
#---------------------------------------

t_w_percent=10
t_e_len=0.0001

for(i in 1:ncol_w){
	e_range[i]=round(max(e[,i])-min(e[,i]),6)
	w_range[i]=round(max(w[,i])-min(w[,i]),6)
	w_percent[i]=w_range[i]/max(w[,i])*100

	w_max_llh[i]=w[llh_max,i]
	e_max_llh[i]=e[llh_max,i]
	w_out_un[i]=w_max_llh[i]

	if(w_percent[i]>=t_w_percent){
		flag_unstable[i]="TRUE"
		w_out_un[i]=-1
	}

	 w_out_un_e[i]=w_out_un[i]
	 if(length(which(e[,i]<=t_e_len))>0 & w_out_un_e[i]!=-1){
	    w_out_un_e[i]=-2
	 }

	w_out_un_e[which(w_max_llh[]==0.0001 & w_out_un_e[]!=-1 & w_out_un_e[]!=-2)]=-3
	w_out_un_e[which(w_max_llh[]==999 & w_out_un_e[]!=-1 & w_out_un_e[]!=-2 & w_out_un_e[]!=-3)]=-4
}
num_unstable_w=length(which(flag_unstable[]=="TRUE"))
# ====================================================================================================
##PLOTS ==============================================================================================
my_col=c("black","firebrick","royalblue","yellowgreen","darkmagenta")
pdf(paste(plot_out,"-dN-dS-analysis.pdf",sep=""),w=8,h=10)

par(mfrow=c(4,1))
# omega values amog 5 runs
plot(e_ids[,1],w[1,],xaxt="n",xlab="clades",ylab="dN/dS values (5 runs)",main=paste(tree," | OMEGA values among 5 runs",sep=""),lwd=2,cex=2)
	axis(1, labels=e_ids[,2], at=e_ids[,1],cex.axis=0.5)
	abline(v=e_ids[which(e_ids[,3]==1),1])
	lines(e_ids[,1],w[1,],col=my_col[1],lty=1)

	for(i in 2:5){
		points(e_ids[,1],w[i,],col=my_col[1],lwd=2,cex=2)
		lines(e_ids[,1],w[i,],col=my_col[i],lty=i)
	}

x=which(w_out_un_e[]==-1) # unstable due to change in dN/dS among 5 runs
y=which(w_out_un_e[]==-2) # unstable due to short edges
#z=which(w_out_un_e[]==-3) # unstable due to identical sequences
points(e_ids[x,1],w[1,x],col="firebrick",pch=19,lwd=2,cex=2)
points(e_ids[y,1],w[1,y],col="royalblue",pch=19,lwd=2,cex=2)
#points(e_ids[z,1],w[1,z],col="darkmagenta",pch=19,lwd=2)

########### Write results ####################################################

# edge lengths among 5 runs
plot(e_ids[,1],e[1,],xaxt="n",xlab="clades",ylab="edge lengths (5 runs)",main=paste(tree," | Edge lengths among 5 runs",sep=""),lwd=2,cex=2)
        axis(1, labels=e_ids[,2], at=e_ids[,1],cex.axis=0.5)
        abline(v=e_ids[which(e_ids[,3]==1),1])

        for(i in 2:5){
                points(e_ids[,1],e[i,],col=my_col[i],lwd=2,cex=2)
        }
# unstable %
plot(e_ids[,1],w_percent,col="firebrick",xaxt="n",xlab="clades",ylab="change of dN/dS values in %",
  main=paste(tree," | Stability of omega (change between max and min in %)",sep=""),lwd=2,cex=2)
	axis(1, labels=e_ids[,2], at=e_ids[,1],cex.axis=0.5)
        abline(h=c(1),v=e_ids[which(e_ids[,3]==1),1])

# correlation between unstable and short branches
plot(
    e_max_llh[which(flag_unstable[]=="FALSE")],
    w_max_llh[which(flag_unstable[]=="FALSE" )],
    xlab="edge lengths",
    ylab="dN/dS values",
    main=paste(tree," | Correlation between unstable dN/dS and short branches",sep=""),
    xlim=c(min(e_max_llh),max(e_max_llh)),
    ylim=c(min(w_max_llh),max(w_max_llh)),cex=2
)
	abline(v=c(0.00001,0.0001),col="firebrick")
	points(e_max_llh[which(flag_unstable[]=="TRUE")],w_max_llh[which(flag_unstable[]=="TRUE")],col="firebrick",pch=19,cex=2)

	x=(max(e_max_llh)-min(e_max_llh))/2
        y=(max(w_max_llh)-min(w_max_llh))/2
        text(x,y,paste("Number of unstable omega estimates ",num_unstable_w,sep=""))

# unstable differences max-min
#plot(e_ids[,1],un_omega,xaxt="n",xlab="clades",ylab="adsolute differences max-min (5 runs)",main="CONSENSUS tree")
#        axis(1, labels=e_ids[,2], at=e_ids[,1])
#	abline(v=e_ids[which(e_ids[,3]==1),1])

dev.off()
## ==============================================================================================

#############################################################################
#if(ident_tree!="NA"){
#        ## GET CORRESPONDENCE WITH 10 species TREE
#                w_ident_out_un=array(-3,ncol_w)
#                w_ident_out_un_e=array(-3,ncol_w)
#                for(i in 1:ncol_w_ident){
#                    j=e_ids_9sp[i,4]
#                    w_ident_out_un[j]=w_out_un[i]
#                    w_ident_out_un_e[j]=w_out_un_e[i]
#                }
#}

##Print info =========================================================================================
write(file=paste(args[3],"-masked-un",sep=""),paste(w_out_un,collapse=" "))
write(file=paste(args[3],"-masked-un+e_short",sep=""),paste(w_out_un_e,collapse=" "))
write(file=paste(args[3],"-max_llh",sep=""),paste(w_max_llh,collapse=" "))
write(file=paste(args[2],"-max_llh",sep=""),paste(e_max_llh,collapse=" "))
write(file=paste(args[2],"-e_range",sep=""),paste(e_range,collapse=" "))
write(file=paste(args[3],"-w_range",sep=""),paste(w_range,collapse=" "))
write(file=paste(args[3],"-w_percent",sep=""),paste(w_percent,collapse=" "))
write(file=paste(args[3],"-flag_unstable",sep=""),paste(flag_unstable,collapse=" "))

### JOINT info =======================================================================================
write(file=paste(general_info,"-masked-un",sep=""),paste(w_out_un,collapse=" "),append=TRUE)
write(file=paste(general_info,"-masked-un+e_short",sep=""),paste(w_out_un_e,collapse=" "),append=TRUE)
write(file=paste(general_info,"-w_percent",sep=""),paste(w_percent,collapse=" "),append=TRUE)
write(file=paste(general_info,"-w_max_llh",sep=""),paste(w_max_llh,collapse=" "),append=TRUE)
write(file=paste(general_info,"-e_max_llh",sep=""),paste(e_max_llh,collapse=" "),append=TRUE)

num_0=length(which(w_out_un_e[]==-3))
num_999=length(which(w_out_un_e[]==-4))
num_e=length(which(w_out_un_e[]==-2))
num_dn_ds=length(which(w_out_un_e[]==-1))
num_good=ncol_w-num_0-num_999-num_e-num_dn_ds

num_e_w=length(which(w_out_un_e[]==-2 & w_out_un[]==-1))
num_e_short_0=length(which(w_out_un_e[]==-3 & e_max_llh[]<=0.01))
num_e_short_999=length(which(w_out_un_e[]==-4 & e_max_llh[]<=0.01))

write(file=paste(general_info,"-split-of-values",sep=""),paste(num_good,num_e,num_dn_ds,num_0,num_999,num_e_w,num_e_short_0,num_e_short_999,sep=" "),append=TRUE)


#clearing the workspace
rm(list=ls())
graphics.off()
options(show.error.locations = TRUE)

# If we are in a stand alone ubiquity distribution we run
# from there otherwise we try to load the package
if(file.exists(file.path('library', 'r_general', 'ubiquity.R'))){
  source(file.path('library', 'r_general', 'ubiquity.R'))
} else {
  library(ubiquity) }

# flowctl = 'previous estimate as guess';
# flowctl = 'plot guess';
# flowctl = 'plot previous estimate';
  flowctl = 'estimate';
archive_results = TRUE

analysis_name = 'parent_metabolite_nm_data';

# For documentation explaining how to modify the commands below
# See the "R Workflow" section at the link below:
# http://presentation.ubiquity.grok.tv

# Rebuilding the system (R scripts and compiling C code)
cfg = build_system(output_directory     = file.path(".", "output"),
                   temporary_directory  = file.path(".", "transient"))

# set name                  | Description
# -------------------------------------------------------
# default                   | Original Estimates

# The following will estimate a subset of the parameters:
pnames = c('Vp',
           'Vt',
           'CLp',
           'Q',
           'slope_parent',
           'slope_metabolite');

cfg = system_select_set(cfg, "default", pnames)

# Specify the output times used for smooth profiles
cfg=system_set_option(cfg, group  = "simulation",
                           option = "output_times",
                           linspace(0,50,100))

# Loading Datasets
#
cfg = system_load_data(cfg, dsname     = "nm_pm_data",
                            data_file  = "nm_data.csv")

# Defining the cohorts
#
# Clearing all of the cohorts
cfg = system_clear_cohorts(cfg);

# Only including the 10 and 30 mpk doses
filter = list()
filter$DOSE = c(10, 30)

# Mapping information:
OBSMAP = list()
OBSMAP$PT = list(variance     = 'slope_parent*PRED^2',
                 CMT          =  1,
                 output       = 'Cpblood',
                 missing      =  -1 )

OBSMAP$MT = list(variance     = 'slope_metabolite*PRED^2',
                 CMT          =  2,
                 output       = 'Cmblood',
                 missing      =  -1 )

INPUTMAP = list()
INPUTMAP$bolus$Mpb$CMT_NUM             =  1

cfg = system_define_cohorts_nm(cfg,
                               DS       = 'nm_pm_data',
                               col_ID   = 'ID',
                               col_CMT  = 'CMT',
                               col_DV   = 'DV',
                               col_TIME = 'TIME',
                               col_AMT  = 'AMT',
                               col_RATE = 'RATE',
                               col_EVID = 'EVID',
                               col_GROUP= 'DOSE',
                               filter   =  filter,
                               INPUTS   =  INPUTMAP,
                               OBS      =  OBSMAP)

#  #----------------------------------------------------------
#  # performing estimation or loading guess/previous results
pest = system_estimate_parameters(cfg,
                                  flowctl         = flowctl,
                                  analysis_name   = analysis_name,
                                  archive_results = archive_results)

# Simulating the system at the estimates
erp = system_simulate_estimation_results(pest = pest, cfg = cfg)

plot_opts = c()

plot_opts$outputs$MT$yscale   = 'log'
plot_opts$outputs$MT$ylabel   = 'Metabolite'
#plot_opts$outputs$MT$ylim     = c(1, 100)
plot_opts$outputs$MT$xlabel   = 'Time (hours)'

plot_opts$outputs$PT$yscale   = 'log'
plot_opts$outputs$PT$ylabel   = 'Parent'
plot_opts$outputs$PT$xlabel   = 'Time (hours)'

# Plotting the simulated results at the estimates
# These figures will be placed in output/
system_plot_cohorts(erp, plot_opts, cfg, analysis_name=analysis_name)
#-------------------------------------------------------
# Writing the results to a PowerPoint report
# cfg = system_rpt_read_template(cfg, template="PowerPoint")
# cfg = system_rpt_estimation(cfg=cfg, analysis_name=analysis_name)
# system_rpt_save_report(cfg=cfg, output_file=file.path("output",paste(analysis_name, "-report.pptx", sep="")))
#-------------------------------------------------------
# Writing the results to a Word report
# cfg = system_rpt_read_template(cfg, template="Word")
# cfg = system_rpt_estimation(cfg=cfg, analysis_name=analysis_name)
# system_rpt_save_report(cfg=cfg, output_file=file.path("output",paste(analysis_name, "-report.docx", sep="")))
#-------------------------------------------------------


#starting with the counts matrix derived in snRNAhackathon_UWdata_filtered.R:
library(Seurat)
library(scater)
library(batchelor)

counts <- dat[rowSums(dat != 0) >= 500,]
dim(counts)
write.csv(as.matrix(counts),file='/Users/relyanow/Desktop/mount2/users/relyanow/test_data/UW_sn_AD.csv')

dat <- CreateSeuratObject(counts = as.matrix(counts), project = "HighLow", min.cells = 1, min.features = 3)
counts<-0
dat

# The [[ operator can add columns to object metadata. This is a great place to stash QC stats
dat[["percent.mt"]] <- PercentageFeatureSet(dat, pattern = "^MT-")

# Visualize QC metrics as a violin plot
VlnPlot(dat, features = c("nFeature_RNA", "nCount_RNA", "percent.mt"), ncol = 3)

# FeatureScatter is typically used to visualize feature-feature relationships, but can be used
# for anything calculated by the object, i.e. columns in object metadata, PC scores etc.

plot1 <- FeatureScatter(dat, feature1 = "nCount_RNA", feature2 = "percent.mt")
plot2 <- FeatureScatter(dat, feature1 = "nCount_RNA", feature2 = "nFeature_RNA")
CombinePlots(plots = list(plot1, plot2))

dat <- subset(dat, subset = nFeature_RNA > 200 & nFeature_RNA < 9000 & percent.mt < 15)

dat <- NormalizeData(dat, normalization.method = "LogNormalize", scale.factor = 10000)

str(dat)

dat <- FindVariableFeatures(object = dat,nfeatures = 10000)

str(dat@assays$RNA@var.features)

dat <- ScaleData(dat,features=dat@assays$RNA@var.features)

dat <- RunPCA(dat,npcs=50)

# Examine and visualize PCA results a few different ways
print(dat[["pca"]], dims = 1:5, nfeatures = 5)

VizDimLoadings(dat, dims = 1:2, reduction = "pca")

DimPlot(dat, reduction = "pca")

ElbowPlot(dat,50)

dat <- FindNeighbors(dat, dims = 1:25)
dat <- FindClusters(dat, resolution = 0.25)

# If you haven't installed UMAP, you can do so via reticulate::py_install(packages =
# 'umap-learn')
dat <- RunUMAP(dat, dims = 1:25)
dat <- RunTSNE(dat, dims = 1:25)

# note that you can set `label = TRUE` or use the LabelClusters function to help label
# individual clusters
DimPlot(dat, reduction = "umap")
DimPlot(dat, reduction = "tsne")

#saveRDS(dat, file = "UW_single_cell.rds")
dat<-readRDS(file = "UW_single_cell.rds")

length(rownames(dat))
counts <- dat@assays$RNA@counts

length(Labels$SEX)
head(Labels)

library(scran)

sce <- SingleCellExperiment(list(counts=counts))
clusters <- quickCluster(sce, min.size=100)
sce <- computeSumFactors(sce, cluster=clusters)

sce <- normalize(sce)
head(logcounts(sce[0:20,0:20]))
head(rownames(logcounts(sce)))

dim(logcounts(sce))
length(rownames(Labels))
head(Labels)
unique(Labels$Clinical.DX)

sce$projid = Labels$ids
sce$sex = Labels$SEX
sce$sex[Labels$SEX=='M']='male'
sce$sex[Labels$SEX!='M']='female'
sce$simpleDiagnosis[sce$projid==6672]='Control'
sce$simpleDiagnosis[sce$projid!=6672]='AD'
sce$pmi = Labels$PMI
sce$projid = as.character(Labels$ids)
sce$dataset = Labels$SEX
sce$dataset[sce$dataset=='male']='UW'
sce$dataset[sce$dataset!='female']='UW'

gene_names <-readRDS(file = "gene_names.rds")
length(gene_names)
genes=c()
for (gene in gene_names){
    genes = c(genes,which(rownames(logcounts(sce))==gene)[1])
}
length(genes)

saveRDS(sce, file = "UW_scran_normalized.rds")

sce = readRDS("UW_scran_normalized.rds")
Labels = data.frame(sce$projid)
Labels$projid = sce$projid
Labels$sex = sce$sex
Labels$simpleDiagnosis = sce$simpleDiagnosis
Labels$pmi = sce$pmi
Labels$dataset = sce$dataset
rownames(Labels) = colnames(logcounts(sce))

library(scater)
library(batchelor)
library(monocle3)

counts2 = logcounts(sce)
#counts2 = batchelor::fastMNN(counts2,batch=sce$projid)

dim(counts2)
gene_short_name <- data.frame(rownames(counts2))
rownames(gene_short_name) <- rownames(counts2)
gene_short_name$gene_short_name <- rownames(counts2)
head(gene_short_name)
length(gene_short_name)

cds <- new_cell_data_set(counts2,
                     cell_metadata = Labels,
                     gene_metadata = gene_short_name)

sum(is.na(cds$pmi))

cds$projid = as.numeric(cds$projid)
cds = preprocess_cds(cds, num_dim = 30,method="PCA",residual_model_formula_str="~projid+pmi",norm_method="size_only")
cds = reduce_dimension(cds)

plot_pc_variance_explained(cds)

cds$projid = as.character(cds$projid)
plot_cells(cds, color_cells_by="projid",cell_size=.1,label_cell_groups=0,show_trajectory_graph=FALSE)

plot_cells(cds, color_cells_by="sex",cell_size=.1,label_cell_groups=0,show_trajectory_graph=FALSE)

plot_cells(cds, color_cells_by="simpleDiagnosis",cell_size=.1,label_cell_groups=0,show_trajectory_graph=FALSE)

cds = cluster_cells(cds)
plot_cells(cds, color_cells_by="partition",cell_size=.1,show_trajectory_graph=FALSE)

plot_cells(cds, genes="CD74",cell_size=.1,show_trajectory_graph=FALSE)

counts<-0
counts2<-0
dat<-0
saveRDS(cds, file = "../data/UW_10X_RNA/UW_monocle_cds.rds")
gene_correlation <- cor(as.matrix(counts(cds)), method = c("pearson"))
dim(gene_correlation)

# chi square test for significant difference female/male ratio

cds_subset = cds[,partitions(cds)==8]
test = data.frame(clusters(cds_subset))
test$cluster = cds_subset$sex
test$cluster[inds] = 'Mic1'
test$cluster[test$cluster!='Mic1'] = 'Other'
test$sex = cds_subset$sex
test$cluster = as.factor(test$cluster)
test$sex = as.factor(test$sex)
tbl = table(test$cluster, test$sex)
library(MASS)
chisq.test(tbl)

k=softConnectivity(datE=as.matrix(counts(cds),power=6)
sizeGrWindow(10,5)
par(mfrow=c(1,2))
hist(k)
scaleFreePlot(k, main="Check scale free topology\n")

cds_subset = cds[,Labels$sex!="asdfmale"] # mic3 subcluster
cds_subset = cds_subset[,partitions(cds_subset)==9] # oligo
cds_subset = cds_subset[rowSums(exprs(cds_subset) != 0) >= 10,] # only keep genes non-zero in at least 10 cells
l = c("FTL","CAV1"
,"COX7A2"
,"RPS7"
,"B2M"
,"RPS27A"
,"HLA-A"
,"EEF1A1"
,"RPS16"
,"RPS2"
,"RPLP0"
,"RPL21"
,"BTF3"
,"RPS27"
,"RPL41"
,"PLEKHA6"
,"GSTP1"
,"RPL19"
,"RPS18"
,"RPS5"
,"HLA-C"
,"ZNF90"
,"H2AFZ"
,"DAD1"
,"POMP"
,"CD9"
,"RPS17"
,"UBXN1"
,"BAIAP2L1"
,"POLR2J"
,"PHGDH"
,"UBB")
inds = c()
for (gene in l){
    if ((gene %in% rownames(cds_subset))){
    inds = c(inds,which(rownames(cds_subset)==gene))
    }
}
inds
cds_subset = cds_subset[inds,]
cds_subset = preprocess_cds(cds_subset, num_dim = 5,method="PCA",norm_method="size_only",residual_model_formula_str="~projid")
cds_subset = reduce_dimension(cds_subset)
cds_subset = cluster_cells(cds_subset)
plot_cells(cds_subset, color_cells_by = "cluster",
           label_groups_by_cluster=FALSE,label_leaves=FALSE,
           label_branch_points=FALSE,cell_size=2,label_cell_groups=0)
# cds_subset$test = as.numeric(clusters(cds_subset))
# cds_subset$test[clusters(cds_subset)==10]=1
# cds_subset$test[clusters(cds_subset)!=10]=0
# cds_subset$test = as.factor(cds_subset$test)
# cds_subset$test = t
plot_cells(cds_subset,label_cell_groups=0,genes=c("FTL","APOE","TPT1","RPL13"),cell_size=1,show_trajectory_graph=FALSE)
plot_cells(cds_subset,label_cell_groups=0,color_cells_by="partition",cell_size=1,show_trajectory_graph=FALSE)

# cds_subset@clusters$UMAP$partitions[cds_subset@clusters$UMAP$partitions == "2"] <- "1"
# cds_subset@clusters$UMAP$partitions[cds_subset@clusters$UMAP$partitions == "3"] <- "1"
# cds_subset <- learn_graph(cds_subset,use_partition=F)
# cds_subset$ftl = as.numeric(counts(cds_subset)[which(rownames(cds_subset)=="FTL"),])
# plot_cells(cds_subset, color_cells_by = "sex",
#            label_groups_by_cluster=FALSE,label_leaves=FALSE,
#            label_branch_points=FALSE,cell_size=2,label_cell_groups=0)
# plot_cells(cds_subset, color_cells_by = "projid",
#            label_groups_by_cluster=FALSE,label_leaves=FALSE,
#            label_branch_points=FALSE,cell_size=2,label_cell_groups=0)

# cds_subset = order_cells(cds_subset,root_cells=row.names(colData(cds_subset))[1])
# plot_cells(cds_subset, color_cells_by = "pseudotime",
#            label_groups_by_cluster=FALSE,label_leaves=FALSE,
#            label_branch_points=FALSE,cell_size=2,label_cell_groups=0)

# gene_fits = fit_models(cds_subset, model_formula_str = "~test")
# fit_coefs = coefficient_table(gene_fits)
# fit_coefs <- subset(fit_coefs, term != "(Intercept)")

# fit_coefs <- subset(fit_coefs, q_value < 0.05)
# fit_coefs[order(fit_coefs$q_value),]
# write.csv(fit_coefs[order(fit_coefs$q_value),],file='/Users/relyanow/Documents/Sage/notebooks/figures/sn_Mathys/oli_UW.csv')

t = cds_subset$test

library(limma)
library(edgeR)
head(Labels$SEX)
cds$projid = sce$projid

l = c("FTL","SPP1","RPLP1","TMEM163","SLC11A1","RPLP2","RPL28","RPS20","C1QC","FTH1","RPL19","RPS15","RPL35",
"C1QB","RPL13","RPS19","RPS11","APOE","RPS27A","ACSL1","C1QA","RPL13A","PLEKHA7","RPS24","TMSB4X","RPL32","RPS2",
"VSIG4","RPS6","RPS8","RPL31","RPL27A","RPS16","RPS3","RPL10","TPT1","CST3","TMSB10","HLA-DRA","CD74","CD14",
"TXNRD1","CTSB","HLA-DRB1","ACTB","RPS9","GPX1","HIF1A","CYBA","AMBRA1","TYROBP","SLC2A5","LAPTM5","HLA-B","SIPA1L1",
"MS4A6A","TBC1D14","DPYD","TUBA1B","HCLS1","PDE4B","SRGN","EEF1A1","HSP90AA1","SAT1","EPB41L3","ADGRG1","PSAP",
"DENND3",
"RB1",
"GAPDH",
"PHC2",
"HSPA1A",
"RNF149",
"HCK",
"SH3TC1",
"NUMB")
inds = c()
for (gene in l){
    if ((gene %in% rownames(cds))){
    inds = c(inds,which(rownames(cds)==gene))
    }
}
inds
cds_subset = cds[inds,] # mic3 subcluster
cds_subset = cds_subset[,partitions(cds_subset)==8] # mic3 subcluster
#'6774' '6802' '6829' '6845' '6874'
#cds_subset = cds_subset[,c(which(cds_subset$projid=='6774'),which(cds_subset$projid=='6829'),which(cds_subset$projid=='6874'))]
#cds_subset = cds_subset[rowSums(exprs(cds_subset) != 0) >= 20,] # only keep genes non-zero in at least 10 cells
cds_subset = preprocess_cds(cds_subset, num_dim = 20,method="PCA",residual_model_formula_str="~projid+sex",norm_method="size_only")
cds_subset = reduce_dimension(cds_subset)
cds_subset = cluster_cells(cds_subset)
#cds_subset = cds_subset[,cds_subset$sex=="female"] # mic3 subcluster
plot_pc_variance_explained(cds_subset)
plot_cells(cds_subset, color_cells_by = "cluster",
           label_groups_by_cluster=FALSE,label_leaves=FALSE,
           label_branch_points=FALSE,cell_size=2,label_cell_groups=1)
pdf("/Users/relyanow/Documents/Sage/ROSMAP_sn_writeup/figures/UW_mic_tsne_using_mic1_genes.pdf")
plot_cells(cds_subset, genes = c("FTL","APOE","TPT1","RPL13"),
           label_groups_by_cluster=FALSE,label_leaves=FALSE,
           label_branch_points=FALSE,cell_size=1,label_cell_groups=0)
dev.off()
plot_cells(cds_subset, color_cells_by = "projid",
           label_groups_by_cluster=FALSE,label_leaves=FALSE,
           label_branch_points=FALSE,cell_size=2,label_cell_groups=0)
plot_cells(cds_subset, color_cells_by = "sex",
           label_groups_by_cluster=FALSE,label_leaves=FALSE,
           label_branch_points=FALSE,cell_size=2,label_cell_groups=0)

dput(as.numeric(c(which(clusters(cds_subset)==4),which(clusters(cds_subset)==11),
                which(clusters(cds_subset)==3),which(clusters(cds_subset)==15))))

library(limma)
library(edgeR)
head(Labels$SEX)
cds$projid = sce$projid

inds= c(125, 186, 231, 267, 268, 272, 342, 369, 385, 391, 431, 437,
469, 574, 692, 819, 859, 1194, 1202, 1209, 1214, 1235, 1243,
1245, 1252, 1267, 1283, 1298, 1307, 1310, 1312, 1316, 1318, 1328,
1333, 1338, 1342, 1347, 1361, 1368, 1370, 1385, 1393, 1440, 1445,
1453, 1454, 1458, 1467, 1476, 1479, 1482, 1503, 1518, 1527, 1546,
1555, 1564, 1585, 1601, 1605, 1651, 1655, 1683, 1688, 1695, 1707,
1718, 1755, 1861, 1864, 1870, 1872, 1873, 1889, 1893, 1897, 1906,
2013, 2046, 2052, 2076, 2132, 2138, 3, 6, 20, 33, 42, 56, 61,
65, 66, 67, 76, 80, 85, 134, 156, 162, 172, 173, 177, 191, 235,
241, 253, 255, 292, 296, 297, 300, 303, 304, 313, 319, 320, 321,
324, 330, 338, 341, 348, 349, 359, 427, 458, 460, 462, 478, 486,
487, 493, 496, 591, 635, 638, 640, 674, 709, 855, 875, 887, 905,
918, 938, 998, 1006, 1027, 1052, 1065, 1110, 1115, 1120, 1125,
1138, 1142, 1148, 1165, 1174, 1180, 1182, 1188, 1191, 1197, 1203,
1212, 1217, 1227, 1231, 1233, 1236, 1248, 1254, 1263, 1265, 1275,
1297, 1306, 1309, 1317, 1346, 1358, 1362, 1366, 1369, 1376, 1379,
1380, 1394, 1401, 1402, 1403, 1405, 1409, 1415, 1419, 1421, 1426,
1438, 1444, 1450, 1470, 1473, 1475, 1481, 1506, 1508, 1513, 1515,
1530, 1537, 1541, 1542, 1568, 1569, 1571, 1574, 1575, 1581, 1593,
1600, 1602, 1604, 1611, 1617, 1622, 1631, 1656, 1661, 1668, 1671,
1690, 1704, 1709, 1715, 1716, 1720, 1728, 1740, 1786, 1793, 1818,
1821, 1822, 1829, 1830, 1834, 1842, 1849, 1856, 1866, 1867, 1877,
1878, 1880, 1883, 1886, 1896, 1902, 1916, 1919, 1923, 1924, 1954,
1959, 1961, 1965, 1975, 1995, 2000, 2014, 2020, 2029, 2035, 2038,
2047, 2067, 2072, 2074, 2077, 2086, 2099, 2107, 2109, 2118, 2124,
2125, 2130, 2136, 2137, 11, 21, 29, 60, 81, 82, 90, 94, 127,
128, 129, 130, 140, 160, 176, 180, 194, 201, 237, 254, 262, 263,
275, 280, 283, 289, 299, 308, 311, 323, 367, 372, 390, 399, 408,
434, 465, 473, 481, 482, 485, 489, 494, 509, 510, 545, 553, 571,
586, 611, 624, 639, 648, 649, 659, 700, 736, 740, 766, 767, 778,
816, 838, 842, 850, 899, 903, 906, 914, 922, 925, 929, 930, 940,
947, 967, 971, 973, 995, 1004, 1008, 1010, 1011, 1034, 1037,
1049, 1057, 1063, 1085, 1089, 1094, 1112, 1123, 1129, 1154, 1331,
1422, 1424, 1429, 1437, 1509, 1512, 1514, 1532, 1547, 1550, 1629,
1632, 1640, 1645, 1678, 1702, 1706, 1710, 1722, 1729, 1734, 1742,
1753, 1754, 1769, 1779, 1792, 1795, 1824, 1836, 1840, 1844, 1875,
1891, 1928, 1949, 1957, 1991, 1994, 2007, 2025, 2045, 2063, 2116,
2123, 2133, 26, 45, 68, 143, 171, 228, 232, 239, 302, 375, 384,
392, 407, 423, 457, 497, 583, 598, 604, 615, 637, 650, 694, 696,
724, 725, 745, 757, 772, 807, 820, 828, 841, 848, 849, 852, 932,
950, 958, 961, 1012, 1015, 1053, 1069, 1079, 1093, 1096, 1097,
1124, 1139, 1152, 1155, 1156, 1157, 1159, 1199, 1350, 1351, 1374,
1375, 1384, 1567, 1594, 1616, 1652, 1665, 1666, 1771, 1797, 1814,
1815, 1904, 1911, 1918, 1936, 1941, 2005, 2048, 2065, 2078, 2082,
2093, 2098, 2114, 2127)

cds_subset = cds[,partitions(cds)==8]
'all'
length(colnames(cds)[cds$sex=="male"] )/length(colnames(cds) )
length(colnames(cds)[cds$sex=="female"])/length(colnames(cds) )
'mic'
length(colnames(cds_subset) )
length(colnames(cds_subset)[cds_subset$sex=="male"] )/length(colnames(cds_subset) )
length(colnames(cds_subset)[cds_subset$sex=="female"])/length(colnames(cds_subset) )

'mic1'
cds_subset = cds_subset[,inds]
length(colnames(cds_subset) )
length(colnames(cds_subset)[cds_subset$sex=="male"] )/length(colnames(cds_subset) )
length(colnames(cds_subset)[cds_subset$sex=="female"])/length(colnames(cds_subset) )

cds_subset = cds[,]
cds_subset = cds_subset[,partitions(cds_subset)==8]
cds_subset = cds_subset[rowSums(exprs(cds_subset) != 0) >= 20,] # only keep genes non-zero in at least 10 cells
#cds_subset = preprocess_cds(cds_subset, num_dim = 10,method="PCA",residual_model_formula_str="~projid",norm_method="size_only")

cds_subset$mic1 = cds_subset$projid
cds_subset$mic1[inds] = 'Mic1'
cds_subset$mic1[cds_subset$mic1!='Mic1']='Mic0'

#cds_subset = cds_subset[,cds_subset$sex=="female"]
#cds_subset = preprocess_cds(cds_subset, num_dim = 20,method="PCA",residual_model_formula_str="~pmi",norm_method="size_only")
cds_subset = reduce_dimension(cds_subset)
cds_subset = cluster_cells(cds_subset)

gene_fits = fit_models(cds_subset, model_formula_str = "~mic1+pmi")
fit_coefs = coefficient_table(gene_fits)
fit_coefs[which(fit_coefs$gene_short_name=='FTL'),]
fit_coefs[which(fit_coefs$gene_short_name=='APOE'),]
fit_coefs[which(fit_coefs$gene_short_name=='NACA'),]
fit_coefs[which(fit_coefs$gene_short_name=='HLA-B'),]
fit_coefs[which(fit_coefs$gene_short_name=='SPP1'),]
fit_coefs <- subset(fit_coefs, term != "(Intercept)")
fit_coefs <- subset(fit_coefs, term != "projid")
fit_coefs <- subset(fit_coefs, term != "pmi")
fit_coefs <- subset(fit_coefs, status == "OK")

fit_coefs2 <- subset(fit_coefs, q_value < 0.05)
fit_coefs2[order(fit_coefs2$q_value),]
#write.csv(fit_coefs2[order(fit_coefs2$q_value),],file='/Users/relyanow/Documents/Sage/notebooks/figures/sn_Mathys/mic0-1_subcluster_UW.csv')

library(EnhancedVolcano)
fit_coefs$pvalue=fit_coefs$q_value
fit_coefs$log2FoldChange=fit_coefs$normalized_effect
#pdf("/Users/relyanow/Documents/Sage/ROSMAP_sn_writeup/figures/volcano_UW.pdf")
EnhancedVolcano(fit_coefs,
    lab = fit_coefs$gene_short_name,
    x = 'log2FoldChange',
    y = 'pvalue',
    xlim = c(-4,4),
    xlab = bquote(~Log[2]~ 'normalized effect'),
    shape = c(17, 35, 17, 18),
    pCutoff = .05,
    FCcutoff = 1,
    colAlpha = 1,
    transcriptPointSize = 3.0,
    transcriptLabSize = 4.0,
    transcriptLabCol = 'black',
    transcriptLabFace = 'bold',
    boxedlabels = FALSE,
    legend=c('NS','Log (base 2) normalized effect','P value',
      'P value & Log (base 2) normalized effect'),
    legendPosition = 'right',
    legendLabSize = 14,
    legendIconSize = 5.0)
#dev.off()

# library
library(ggplot2)
library(viridis)

# create a dataset
specie <- c(rep("Human \n(Mathys et al.)" , 2) , rep("Human" , 2) ,rep("Mouse \n(Figerio et al.)",2) )#"Mouse (Figerio et al.)"
Sex <- rep(c("Female" , "Male") , 3)
Percent <- c(59,41,78,22,54,46)
data <- data.frame(specie,Sex,Percent)
#pdf("/Users/relyanow/Documents/Sage/ROSMAP_sn_writeup/figures/mic1_percentage.pdf")
# Grouped
ggplot(data, aes(fill=Sex, y=Percent, x=specie)) +
    geom_bar(position="dodge", stat="identity")+ theme_classic()+theme(text=element_text(size=21))
#dev.off()

plot_cells(cds_subset, color_cells_by = "cluster",
           label_groups_by_cluster=FALSE,label_leaves=FALSE,
           label_branch_points=FALSE,cell_size=2,label_cell_groups=0)

plot_cells(cds, genes=c("CD74"),
           show_trajectory_graph=FALSE,
           label_cell_groups=FALSE,
           label_leaves=FALSE,reduction_method="UMAP",cell_size=.5)
plot_cells(cds_subset, genes=c("APOE","CD74","FTL","ACTB","CST3","RPL13","IFI44L","SAT1","LYN"),
           show_trajectory_graph=FALSE,
           label_cell_groups=FALSE,
           label_leaves=FALSE,reduction_method="UMAP",cell_size=1)
unique(cds_subset$projid)
cds_subset$test = cds_subset$projid
cds_subset$test[cds_subset$test!='asdf']='Other'
cds_subset$test[cds_subset$projid=='6672']='test'
plot_cells(cds_subset, color_cells_by = "test",
           show_trajectory_graph=FALSE,
           label_cell_groups=FALSE,
           label_leaves=FALSE,reduction_method="UMAP",cell_size=1)
cds_subset$test = cds_subset$projid
cds_subset$test[cds_subset$test!='asdf']='Other'
cds_subset$test[cds_subset$projid=='6687']='test'
plot_cells(cds_subset, color_cells_by = "test",
           show_trajectory_graph=FALSE,
           label_cell_groups=FALSE,
           label_leaves=FALSE,reduction_method="UMAP",cell_size=1)
cds_subset$test = cds_subset$projid
cds_subset$test[cds_subset$test!='asdf']='Other'
cds_subset$test[cds_subset$projid=='6726']='test'
plot_cells(cds_subset, color_cells_by = "test",
           show_trajectory_graph=FALSE,
           label_cell_groups=FALSE,
           label_leaves=FALSE,reduction_method="UMAP",cell_size=1)
cds_subset$test = cds_subset$projid
cds_subset$test[cds_subset$test!='asdf']='Other'
cds_subset$test[cds_subset$projid=='6774']='test'
plot_cells(cds_subset, color_cells_by = "test",
           show_trajectory_graph=FALSE,
           label_cell_groups=FALSE,
           label_leaves=FALSE,reduction_method="UMAP",cell_size=1)
#'6774' '6802' '6829' '6845' '6874'
#'6672' '6687' '6726' '6774' '6802' '6829' '6845' '6874'
cds_subset$test = cds_subset$projid
cds_subset$test[cds_subset$test!='asdf']='Other'
cds_subset$test[cds_subset$projid=='6802']='test'
plot_cells(cds_subset, color_cells_by = "test",
           show_trajectory_graph=FALSE,
           label_cell_groups=FALSE,
           label_leaves=FALSE,reduction_method="UMAP",cell_size=1)
cds_subset$test = cds_subset$projid
cds_subset$test[cds_subset$test!='asdf']='Other'
cds_subset$test[cds_subset$projid=='6829']='test'
plot_cells(cds_subset, color_cells_by = "test",
           show_trajectory_graph=FALSE,
           label_cell_groups=FALSE,
           label_leaves=FALSE,reduction_method="UMAP",cell_size=1)
cds_subset$test = cds_subset$projid
cds_subset$test[cds_subset$test!='asdf']='Other'
cds_subset$test[cds_subset$projid=='6845']='test'
plot_cells(cds_subset, color_cells_by = "test",
           show_trajectory_graph=FALSE,
           label_cell_groups=FALSE,
           label_leaves=FALSE,reduction_method="UMAP",cell_size=1)
cds_subset$test = cds_subset$projid
cds_subset$test[cds_subset$test!='asdf']='Other'
cds_subset$test[cds_subset$projid=='6874']='test'
plot_cells(cds_subset, color_cells_by = "test",
           show_trajectory_graph=FALSE,
           label_cell_groups=FALSE,
           label_leaves=FALSE,reduction_method="UMAP",cell_size=1)

# plot_cells(cds_subset, color_cells_by="partition",cell_size=1,show_trajectory_graph=FALSE)
# cds_subset$partition = as.factor(partitions(cds_subset))
# gene_fits = fit_models(cds_subset, model_formula_str = "~partition")
# fit_coefs = coefficient_table(gene_fits)
# fit_coefs$q_value[which(fit_coefs$gene_short_name=='SLC11A1')]
# fit_coefs <- subset(fit_coefs, q_value < 0.05)
# fit_coefs <- subset(fit_coefs, term != "(Intercept)")
# fit_coefs <- subset(fit_coefs, term != "projid")
# fit_coefs <- subset(fit_coefs, term != "educ")
# fit_coefs <- subset(fit_coefs, term != "apoe_genotype44")
fit_coefs[order(fit_coefs$q_value)[0:100],]

fit_coefs[which(fit_coefs$gene_short_name=='APOE')[1],]
fit_coefs[which(fit_coefs$gene_short_name=='FTL')[1],]
fit_coefs[which(fit_coefs$gene_short_name=='SLC11A1')[1],]
fit_coefs[which(fit_coefs$gene_short_name=='C1QC')[1],]
fit_coefs[which(fit_coefs$gene_short_name=='RPS20')[1],]

match(markers,dat@assays$RNA@var.features)
#markers=c('PDGFRA', 'COL9A1', 'ST18' ,'TGFBR2' ,'GFAP' ,'FGFR3', 'CX3CR1', 'C3', 'CD74' ,'GAD2', 'GRIP2', 'SLC17A7' ,'SATB2' ,'NRGN' ,'GABRA1' ,'PROM1' )

# find all markers of cluster 0,1
#cluster1.markers <- FindMarkers(dat, ident.1 = c(0,1), min.pct = 0.25)
#head(cluster1.markers, n = 20)

markers = c('PDGFRA','COL9A1','TMEM63A','ST18','TGFBR2',
            'FGFR3','CX3CR1','C3','CD74','GAD2','GRIP2','SLC17A7','SATB2','NRGN','GABRG2','GABRA1','PROM1','GABRG1','NEUROD6')
length(markers)
names=c('OPC','OPC','Olig','Olig','Endo',
                    'Astro','Mglia','Mglia','Mglia','GABA','GABA',
                    'Glut','Glut','Glut','Neurons','Neurons','BSC','Neurons','Neurons')
length(names)
clusts=c()
for (marker in rownames(head(cluster1.markers,n=100))){
    if (length(which(marker %in% markers))>0){
        clusts = c(clusts,names[which(marker %in% markers)])
    }
}
clusts

new.cluster.ids <- c()
markers
for (i in 0:20){
    #####
    num=i
    a.markers <- FindMarkers(dat, ident.1 = c(num), min.pct = 0.25,features=markers)
    a.markers<-a.markers[a.markers$avg_logFC>0,]
    clusts=c()
    print(num)
    print(head(a.markers,n=2))
    for (marker in rownames(head(a.markers,n=1))){
        if (length(which(markers == marker))>0){
            clusts = c(clusts,names[which(markers==marker)])
        }
    }
    new.cluster.ids <- c(new.cluster.ids,clusts)

}
new.cluster.ids
names(new.cluster.ids) <- levels(dat)
dat <- RenameIdents(dat, new.cluster.ids)
DimPlot(dat, reduction = "umap", label = TRUE, pt.size = 0.5) + NoLegend()

subset <- SubsetData(object = dat, cells = colnames(dat)[Labels$ids == 6672])
types=c('OPC','Olig','Endo','Astro','Mglia','GABA','Glut','Neurons','BSC')
for (t in types){
    print(c(t,as.character(length(subset@active.ident[subset@active.ident == t]) / length(subset@active.ident))))
}
DimPlot(subset, reduction = "umap", label = TRUE, pt.size = 0.5) + NoLegend()

subset <- SubsetData(object = dat, cells = colnames(dat)[Labels$ids == 6687])
types=c('OPC','Olig','Endo','Astro','Mglia','GABA','Glut','Neurons','BSC')
for (t in types){
    print(c(t,as.character(length(subset@active.ident[subset@active.ident == t]) / length(subset@active.ident))))
}
DimPlot(subset, reduction = "umap", label = TRUE, pt.size = 0.5) + NoLegend()

subset <- SubsetData(object = dat, cells = colnames(dat)[Labels$ids == 6726])
types=c('OPC','Olig','Endo','Astro','Mglia','GABA','Glut','Neurons','BSC')
for (t in types){
    print(c(t,as.character(length(subset@active.ident[subset@active.ident == t]) / length(subset@active.ident))))
}
DimPlot(subset, reduction = "umap", label = TRUE, pt.size = 0.5) + NoLegend()

subset <- SubsetData(object = dat, cells = colnames(dat)[Labels$ids == 6774])
types=c('OPC','Olig','Endo','Astro','Mglia','GABA','Glut','Neurons','BSC')
for (t in types){
    print(c(t,as.character(length(subset@active.ident[subset@active.ident == t]) / length(subset@active.ident))))
}
DimPlot(subset, reduction = "umap", label = TRUE, pt.size = 0.5) + NoLegend()

subset <- SubsetData(object = dat, cells = colnames(dat)[Labels$ids == 6802])
types=c('OPC','Olig','Endo','Astro','Mglia','GABA','Glut','Neurons','BSC')
for (t in types){
    print(c(t,as.character(length(subset@active.ident[subset@active.ident == t]) / length(subset@active.ident))))
}
DimPlot(subset, reduction = "umap", label = TRUE, pt.size = 0.5) + NoLegend()

subset <- SubsetData(object = dat, cells = colnames(dat)[Labels$ids == 6829])
types=c('OPC','Olig','Endo','Astro','Mglia','GABA','Glut','Neurons','BSC')
for (t in types){
    print(c(t,as.character(length(subset@active.ident[subset@active.ident == t]) / length(subset@active.ident))))
}
DimPlot(subset, reduction = "umap", label = TRUE, pt.size = 0.5) + NoLegend()

subset <- SubsetData(object = dat, cells = colnames(dat)[Labels$ids == 6845])
types=c('OPC','Olig','Endo','Astro','Mglia','GABA','Glut','Neurons','BSC')
for (t in types){
    print(c(t,as.character(length(subset@active.ident[subset@active.ident == t]) / length(subset@active.ident))))
}
DimPlot(subset, reduction = "umap", label = TRUE, pt.size = 0.5) + NoLegend()

subset <- SubsetData(object = dat, cells = colnames(dat)[Labels$ids == 6874])
types=c('OPC','Olig','Endo','Astro','Mglia','GABA','Glut','Neurons','BSC')
for (t in types){
    print(c(t,as.character(length(subset@active.ident[subset@active.ident == t]) / length(subset@active.ident))))
}
DimPlot(subset, reduction = "umap", label = TRUE, pt.size = 0.5) + NoLegend()

library(monocle3)
dim(dat)
#Extract data, phenotype data, and feature data from the SeuratObject
inds <- match(dat@assays$RNA@var.features,rownames(dat))
counts <- as(as.matrix(dat@assays$RNA@data[inds,]), 'sparseMatrix')
gene_short_name<-as.matrix(rownames(dat)[inds])
nrow(counts)
nrow(gene_short_name)
rownames(counts)<-as.vector(gene_short_name)
gene_short_name <- data.frame(rownames(counts))
rownames(gene_short_name) <- rownames(counts)
gene_short_name$gene_short_name <- rownames(counts)
#counts <- sweep(as.matrix(counts2), MARGIN=2, colSums(as.matrix(counts)), `/`)*median(colSums(as.matrix(counts2)))
cds <- new_cell_data_set(counts2,
                     cell_metadata = Labels,
                     gene_metadata = gene_short_name)
head(colSums(counts))

colData(cds)$ident = as.vector(dat@active.ident)

cds = preprocess_cds(cds, num_dim = 50,method="PCA")
cds = reduce_dimension(cds)

plot_pc_variance_explained(cds)

plot_cells(cds, color_cells_by="ePRS",cell_size=.1,label_cell_groups=0,show_trajectory_graph=FALSE)

plot_cells(cds, color_cells_by="ident",cell_size=.1,label_cell_groups=0,show_trajectory_graph=FALSE)

colData(cds)$ids = as.character(colData(cds)$ids)
plot_cells(cds, color_cells_by="ids",cell_size=.1,label_cell_groups=0,show_trajectory_graph=FALSE)

str(dat)

plot_cells(cds, color_cells_by="SEX",cell_size=.1,label_cell_groups=0,show_trajectory_graph=FALSE)

plot_cells(cds, color_cells_by="Clinical.DX",cell_size=.1,label_cell_groups=0,show_trajectory_graph=FALSE)

plot_cells(cds, color_cells_by="PMI",cell_size=.1,label_cell_groups=0,show_trajectory_graph=FALSE)

plot_cells(cds, color_cells_by="Size_Factor",cell_size=.1,label_cell_groups=0,show_trajectory_graph=FALSE)


#' @importFrom ALA4R occurrences
#' @importFrom dplyr %>% filter_ select_
#' @importFrom raster extract
#' @importFrom rgeos gConvexHull writeWKT
#' @importFrom sp "coordinates<-" CRS over proj4string "proj4string<-" spTransform
#' @importFrom utils globalVariables
#' @export
dload_records <-
  function(species_group, filters, poly, proj, mask, coords) {
    records <-
      lapply(
        paste0("[", LETTERS, " TO ", paste0(LETTERS, "zzzzz"), "]"),
        function(x) {
          occurrences(
            taxon  = paste0('taxon_name:', x),
            wkt    = writeWKT(gConvexHull(poly)),
            fq     = c(sprintf("species_group:%s", species_group),
                       "coordinate_uncertainty:[0 TO 100]",
                       "-duplicate_status:D", "geospatial_kosher:true",
                       "year:[1996 TO 2016]"),
            qa     = filters,
            download_reason_id = 4
          ) %>%
            getElement("data")
        }
      ) %>%
      do.call(rbind, .) %>%
      filter_(paste("!", filters, collapse = "&")) %>%
      select_("species", coords[1], coords[2])
    coordinates(records) <- coords
    proj4string(records) <- "+init=epsg:4326"
    if (!missing(mask)) {
      records <- spTransform(records, CRS(proj4string(mask)))
      records <- records[!is.na(extract(mask, records)), ]
    } else {
      records <- spTransform(records, CRS(proj4string(poly)))
      o <- over(records, poly)
      records <- records[!is.na(o), ]
    }
    spTransform(records, CRS(proj)) %>%
      as.data.frame %>%
      data.frame(species_group = species_group, ., stringsAsFactors = FALSE)
  }

globalVariables(".")


#MATLAB code
#for problem2 using wavio

s=sound1('<name of file>')

function s = sound1(fname)
	%
	audioinfo(fname)
	s = audioread(fname);
	s = s(2000:2000+4*55100);
	figure;
	subplot(2,1,1);
	plot(s(100000:103000))
	$
	fs = fft(a);
	fs2 = abs(fs).^2
	%
	mm = max(fs2);
	ix = find(fs2>(mm/10));
	f = ix(1);
	f0 = 44100/412160;
	subplot(2,1,2);
	plot(fa2(1:3000));
	f*f0

end


#!/usr/bin/env Rscript
options(stringAsfactors = FALSE, useFancyQuotes = FALSE)
# This script is used to do adduct detection using CAMERA
# Taking the command line arguments
args <- commandArgs(trailingOnly = TRUE)

if(length(args)==0)stop("No file has been specified! Please select a file for performing findAdducts!\n")
require(xcms)
require(CAMERA)
previousEnv<-NA
output<-NA
output.pdf<-NA
plotpdf<-F
ppm<-10
polarity<-"positive"
rules<-"primary"
for(arg in args)
{
  argCase<-strsplit(x = arg,split = "=")[[1]][1]
  value<-strsplit(x = arg,split = "=")[[1]][2]
  if(argCase=="input")
  {
    previousEnv=as.character(value)
  }
  if(argCase=="ppm")
  {
    ppm=as.numeric(value)
  }
  if(argCase=="polarity")
  {
    polarity=as.character(value)
  }
  if(argCase=="output")
  {
    output=as.character(value)
  }
  if(argCase=="output.pdf")
  {
    output.pdf=as.character(value)
  }
  if(argCase=="plotpdf")
  {
    plotpdf=as.logical(value)
  }
  if(argCase=="rules")
  {
    rules=as.character(value)
  }
}
if(is.na(previousEnv) | is.na(output)) stop("Both input and output need to be specified!\n")

print.pspectra <- function(file, camera.object) {
	ncols=3
	nrows=ceiling(length(camera.object@pspectra) / ncols)
	pdf(file, width=30, height=(3*nrows))
	par(mfrow=c(nrows, ncols))
	sapply(1:length(camera.object@pspectra), function(x) {
		plotPsSpectrum(camera.object, pspec=x, maxlabel=5)
	})
	dev.off()
}

load(file = previousEnv)

toIsoCharac<-get(varNameForNextStep)

mode <- "pos"
if(polarity == "negative") {mode <- "neg"}
rulefile <- paste("rules/", rules, "_adducts_", mode, ".csv", sep="")
ruleset <- read.csv(system.file(rulefile, package = "CAMERA"))

xcmsSetAdduCharac<-findAdducts(toIsoCharac,polarity = polarity,ppm = ppm, rules=ruleset)

if(!is.na(output.pdf) & plotpdf==T) {print.pspectra(output.pdf, xcmsSetAdduCharac)}

preprocessingSteps<-c(preprocessingSteps,"findAdducts")

varNameForNextStep<-as.character("xcmsSetAdduCharac")

save(list = c("xcmsSetAdduCharac","preprocessingSteps","varNameForNextStep"),file = output)


#' @export
#' @title legend.box
#' @description couldn't accurately describe
#' @param \code{x} position
#' @param \code{y} defaults to NULL
#' @param \code{maxradius}
#' @param \code{mab} defaults to 1.2
#' @param \code{inset} defaults to 0
#' @param \code{double} defaults to FALSE
#' @family  plotting
#' @author  unknown, \email{<unknown>@@dfo-mpo.gc.ca}
#' @export
legend.box <- function (x, y = NULL, maxradius, mab = 1.2, inset = 0, double = F)
{
  auto <- if (is.character(x))
    match.arg(x, c("bottomright", "bottom", "bottomleft",
                   "left", "topleft", "top", "topright", "right", "center"))
  else NA
  asp <- get.asp()
  h <- mab * 2 * maxradius
  w <- h * asp
  if (double)
    h <- h * 2
  usr <- par("usr")
  inset <- rep(inset, length.out = 2)
  if (!is.na(auto)) {
    insetx <- inset[1L] * (usr[2L] - usr[1L])
    left <- switch(auto, bottomright = , topright = , right = usr[2L] -
                     w - insetx, bottomleft = , left = , topleft = usr[1L] +
                     insetx, bottom = , top = , center = (usr[1L] + usr[2L] -
                                                            w)/2)
    insety <- inset[2L] * (usr[4L] - usr[3L])
    top <- switch(auto, bottomright = , bottom = , bottomleft = usr[3L] +
                    h + insety, topleft = , top = , topright = usr[4L] -
                    insety, left = , right = , center = (usr[3L] + usr[4L] +
                                                           h)/2)
  }
  else {
    left <- x - 1.2 * asp * maxradius
    top <- y + 1.2 * maxradius
  }
  return(c(left, top, left + w, top - h))
}


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

options(EBImage.display = "raster")
use_condaenv("py36")

### Parameters
TRAIN_PATH <- "c00_highSNR_input/train/"
TEST_PATH <- "c00_highSNR_input/test/"
HEIGHT = 512
WIDTH = 512
CHANNELS = 1
SHAPE = c(WIDTH, HEIGHT, CHANNELS)
BATCH_SIZE = 9
EPOCHS = 200

### Get training data
images_train <- list.files(paste(TRAIN_PATH,"image",sep = ""),
                           pattern = ".tif",
                           full.names = T)
masks_train <- list.files(paste(TRAIN_PATH,"mask",sep = ""),
                          pattern = ".tif",
                          full.names = T)

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

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

## Preprocess original images
preprocess_image <- function(file, shape, level){
  image <- readTIF(file)
  image <- resize(image, w = shape[1], h = shape[2])  ## make all images of dimensions
  image <- (image - min(image))/(max(image) - min(image))         ## scale pixel values
  image <- clahe(image)                               ## local adaptive contrast enhancement
  image <- image[,,level]                                ## Select z=60 from stack
  image <- array_reshape(image, c(shape[1], shape[2],1))
  imageData(image)                                    ## return as array
}

## Preprocess masks
preprocess_masks <- function(file, new_shape, level = 60){
  require(bioimagetools)

  image <- readTIF(file)
  image <- resize(image, w = new_shape[1], h = new_shape[2])
  image <- (image - min(image))/(max(image) - min(image))
  image[image != 0] <- 1
  image <- image[,,level]
  image <- array_reshape(image, c(new_shape[1], new_shape[2],1))
  imageData(image)
}

####
# UNet implementation modified from:
# https://www.kaggle.com/mviterson/segmentation-using-r-keras-u-net-lb-0-294/notebook
####

## unet 2x2 2DConv layer
unet_layer <- function(object, filters, kernel_size = c(3, 3),
                       padding = "same", kernel_initializer = "he_normal",
                       dropout = 0.1, activation="relu"){

  object %>%
    layer_conv_2d(filters = filters, kernel_size = kernel_size, padding = padding) %>%
    ##layer_batch_normalization() %>%
    layer_activation(activation) %>%
    layer_spatial_dropout_2d(rate = dropout) %>%
    layer_conv_2d(filters = filters, kernel_size = kernel_size, padding = padding) %>%
    ##layer_batch_normalization() %>%
    layer_activation(activation)
}
unet <- function(shape, nlevels = 4, nfilters = 16, dropouts = c(0.1, 0.1, 0.2, 0.2, 0.3)){

  message("Constructing U-Net with ", nlevels, " levels initial number of filters is: ", nfilters)

  filter_sizes <- nfilters*2^seq.int(0, nlevels)

  ## Loop over contracting layers
  clayers <- clayers_pooled <- list()

  ## inputs
  clayers_pooled[[1]] <- layer_input(shape = shape)

  for(i in 2:(nlevels+1)) {
    clayers[[i]] <- unet_layer(clayers_pooled[[i - 1]],
                               filters = filter_sizes[i - 1],
                               dropout = dropouts[i-1])

    clayers_pooled[[i]] <- layer_max_pooling_2d(clayers[[i]],
                                                pool_size = c(2, 2),
                                                strides = c(2, 2))
  }

  ## Loop over expanding layers
  elayers <- list()

  ## center
  elayers[[nlevels + 1]] <- unet_layer(clayers_pooled[[nlevels + 1]],
                                       filters = filter_sizes[nlevels + 1],
                                       dropout = dropouts[nlevels + 1])

  for(i in nlevels:1) {
    elayers[[i]] <- layer_conv_2d_transpose(elayers[[i+1]],
                                            filters = filter_sizes[i],
                                            kernel_size = c(2, 2),
                                            strides = c(2, 2),
                                            padding = "same")

    elayers[[i]] <- layer_concatenate(list(elayers[[i]], clayers[[i + 1]]), axis = 3)
    elayers[[i]] <- unet_layer(elayers[[i]], filters = filter_sizes[i], dropout = dropouts[i])

  }

  ## Output layer
  outputs <- layer_conv_2d(elayers[[1]], filters = 1, kernel_size = c(1, 1), activation = "sigmoid")

  return(keras_model(inputs = clayers_pooled[[1]], outputs = outputs))
}

### Define the model
model <- unet(shape = SHAPE,
              nlevels = 3,
              nfilters = 16,
              dropouts = c(0.1, 0.1, 0.2, 0.3))
summary(model)

### Define loss
dice_coef <- function(y_true, y_pred, smooth = 1.0) {
  y_true_f <- k_flatten(y_true)
  y_pred_f <- k_flatten(y_pred)
  intersection <- k_sum(y_true_f * y_pred_f)
  (2 * intersection + smooth) / (k_sum(y_true_f) + k_sum(y_pred_f) + smooth)
}
attr(dice_coef, "py_function_name") <- "dice_coef"

dice_coef_loss <- function(y_true, y_pred) -dice_coef(y_true, y_pred)
attr(dice_coef_loss, "py_function_name") <- "dice_coef_loss"

### Compile
model %>% compile(optimizer = "adam",
                  loss = dice_coef_loss,
                  metrics = custom_metric("dice_coef",dice_coef))

set.seed(123)

### Import data
input <- sample_n(train_data, nrow(train_data)) %>%
  mutate(Y = map(MaskFile, preprocess_masks, new_shape = SHAPE, level = 60),
         X = map(ImageFile, preprocess_image, shape = SHAPE, level = 60)) %>%
  select(X,Y)

input %>%
  glimpse()

list2tensor <- function(xList) {
  xTensor <- simplify2array(xList)
  aperm(xTensor, c(4, 1, 2, 3))
}

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

X <- list2tensor(input$X)
Y <- list2tensor(input$Y)
Ybw <- list2tensor(W)
dim(Ybw)
dim(Y)
dim(X)

### Train
early_stopping <- callback_early_stopping(patience = 5)

history <- model %>%
  fit(X, Ybw,
      batch_size = BATCH_SIZE,
      epochs = EPOCHS,
      validation_split = 0.2,
      verbose = 1,
      callbacks = list(early_stopping))

### Predict on training data for sanity
Y_hat <- predict(model, x = X)

### Predict 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()

### Loop through levels in the image
level_metrics <- data.frame("Level" = 1:129,
			    "DICE" = rep(0,129))

output_prediction <- array(0L, c(129,512,512))

for(i in 1:129){
print(paste("Processing level ",i,sep=""))

input_test <- test_data[1,] %>%
            mutate(Y = map(MaskFile, preprocess_masks, new_shape = SHAPE, level = i),
                   X = map(ImageFile, preprocess_image, shape = SHAPE, level = i))

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 <- predict(model, x = X_test)

output_prediction[i,,] <- Y_hat_test

### Get metrics
dice_hat <- model %>% evaluate(X_test, Y_test)
level_metrics[i,2] <- dice_hat$dice_coef
}

dice_hat %>% glimpse()

### Save
model %>% save_model_hdf5("/scratch/network/ds65/ELE571/test_highSNR_allz_model.h5")

save.image(file = "/scratch/network/ds65/ELE571/test_ele571_highSNR_allz.RData")


SMS2FLSMSs2<-function(sumfile="summary.out",residualsFile="Catch_survey_residuals.out",bio.interact=TRUE,
                      control=NULL,FLStocksMulti=NULL,FLIndices=NULL) {

    if (is.null(control) | (!inherits(control, "FLSMS.control")))
        stop("A valid 'FLSMS.control'  must be given!")

    nsp<-slot(control,"no.species")
    if (slot(control,"last.season")==1) annual<-TRUE else annual<-FALSE
    info<-slot(control,"species.info")[,"predator"]
    first.VPA<-max(length(info[info==2])+1,1) # other predator have predator code =2
    pl.grp<-slot(control,"species.info")[,"+group"]
    max.age<-slot(control,"species.info")[,"last-age"]
    pl.grp[pl.grp==1]<-max.age[pl.grp==1]
    pl.grp[pl.grp==0]<-NA

    #read summary.out file from SMS run
    sms<-read.table(sumfile,header=TRUE)
    var.names<-names(sms)
    index<-list(sms$Species.n,sms$Age,sms$Year,sms$Quarter)

    condense<-function(x,index) {
      y<-tapply(x,index,sum)
      y[is.na(y)]<-0
      y
    }

    if ("C.obs" %in% var.names) c.n<-condense(sms$C.obs,index)  # catch numbers observed
    if ("C.hat" %in% var.names) c.n.hat<-condense(sms$C.hat,index)          # catch numbers, prediction
    if ("N" %in% var.names) s.n<-condense(sms$N,index)          # stock numbers
    if ("F" %in% var.names) harvest<-condense(sms$F,index)      # harvest rate=F
    if (bio.interact) {
        if ("M2" %in% var.names) m2<-condense(sms$M2,index)     # Predation mortality, multispecies species
    }

      condense2<-function(x,index) {
      y<-tapply(x,index,sum)
      y[y==-99.9]<-NA
      y
    }

    #read Catch_survey_residuals.out file from SMS run
    resids<-read.table(residualsFile,header=TRUE)

    # catch data
    resid.c<-subset(resids,data=="catch")
    index<-list(resid.c$Species.n,resid.c$Age,resid.c$Year,resid.c$Quarter)

    c.n.resid<-condense2(resid.c$residual,index)  # catch residuals

    # survey data
    resid<-subset(resids,data=="survey")

    ## Sorting data frames:
    resid<- resid[ order(resid$Species.n,resid$fleet,resid$Year,resid$Quarter,resid$Age) ,]

    idx.obs<-as.vector(resid$observed)
    idx.hat<-as.vector(resid$model)
    idx.obs<-as.vector(resid$residual)

    # species names
    s<-slot(control,"species.names")

    if (nsp>1) new.fls <- new("FLSMSs") else new.fls<-FLSMS

    i<-2
    n.fleet<-as.vector(info[i:(i-1+nsp)])
    i<-i+nsp
    sum.fleet<-sum(n.fleet)
    fl.info<-matrix(info[i:(i-1+sum.fleet*10)],ncol=10,nrow=sum.fleet,byrow=TRUE)
    i<-i+sum.fleet*10

    sum.var.age<-sum(fl.info[,10])
    fl.var<-as.vector(info[i:(i-1+sum.var.age)])

    CE<-scan(fleet.index,comment.char = "#",quiet=TRUE)

    i<-1
    v<-1
    sp.fl<-0
    for (sp in 1:nsp) {
     for (fl in 1:n.fleet[sp]) {
      sp.fl<-sp.fl+1
      fy<-fl.info[sp.fl,1]
      ly<-fl.info[sp.fl,2]
      alfa<-fl.info[sp.fl,3]
      beta<-fl.info[sp.fl,4]
      fa<-fl.info[sp.fl,5]
      la<-fl.info[sp.fl,6]
      la.q<-fl.info[sp.fl,7]
      la.p<-fl.info[sp.fl,8]
      seas<-fl.info[sp.fl,9]
      n.var<-fl.info[sp.fl,10]

      nyr<-ly-fy+1
      nages<-la-fa+1
      dim<-c(nages,nyr,1,1,1)
      dim2<-c(1,nyr,1,1,1)
      dimnames<-list(age=fa:la,year=fy:ly,unit="all",season=seas,area="all")
      dimnames2<-list(age="all",year=fy:ly,unit="all",season=seas,area="all")

      tmp<-matrix(CE[i:(nyr*(nages+1)+i-1)],ncol=nages+1,nrow=nyr,byrow=TRUE)

      effort<-array(tmp[,1],dim=dim2,dimnames=dimnames2)
      catch<-array(tmp[,2:(nages+1)],dim=dim,dimnames=dimnames)
      index<-catch/rep(effort,each=nages)

      indx<-FLIndex.SMS(index=as.FLQuant(index),effort=as.FLQuant(effort),catch.n=as.FLQuant(catch),
                 name = fl.names[sp.fl], desc = fl.names[sp.fl])

      indx@range<-unlist(list("min"=fa,"max"=la,"plusgroup"=NA,"minyear"=fy,"maxyear"=ly,"startf"=alfa,"endf"=beta))

      indx@range.SMS<-list("season"=seas, "power.age"=la.p,
                            "q.age"=la.q,"var.age.group"=as.vector(fl.var[v:(v-1+n.var)]))
      v<-v+n.var
      i<-i+nyr*(nages+1)
      FLIndices.[[sp.fl]]<-indx
    }
   }

    # template for quant
    c1<-c.n[1,,,]
    dc<-dim(c1)
    nc<-dimnames(c1)
    if (annual) {nc[[3]]="all"; dc[3]<-1}
    dimnames<-list(age=nc[[1]],year=nc[[2]],unit="all",season=nc[[3]],area="all")
    dim<-c(dc[1],dc[2],1,dc[3],1)
    dimnames2<-list(age='all',year=nc[[2]],unit="all",season=nc[[3]],area="all")
    dim2<-c(1,dc[2],1,dc[3],1)

    for (si in (first.VPA:nsp)) {
        sp.no<-si-first.VPA+1
        if (is.null(FLStocksMulti)) {  # create a new Stock object
            if (nsp==1) q<-c.n else q<-c.n[sp.no,,,]   # Why ?
            s.<-FLStockMulti(name =s[si], desc =s[si],plusgroup=pl.grp[si],
                     iniFLQuant=FLQuant(q,dim=dim,dimnames=dimnames,quant="age",units="1000"))
        } else s.<-new.fls[[si]]        # take the old one
        if (read.input) {
            s.@catch.n <-FLQuant(    q,dim=dim,dimnames=dimnames,quant="age",units="1000")

            if (nsp==1) q<-c.wt else q<-c.wt[sp.no,,,]   # Why ?
            if ("weca" %in% var.names) s.@catch.wt<-FLQuant(q,dim=dim,dimnames=dimnames,quant="age",units="kg")
            if ("weca" %in% var.names) s.@catch   <-FLQuant(apply(s.@catch.n*s.@catch.wt,c(2,3,4),sum),dimnames=dimnames2,quant="all",units="ton")

            if (nsp==1) q<-s.wt else q<-s.wt[sp.no,,,]   # Why ?
            if ("west" %in% var.names) s.@stock.wt<-FLQuant(q,dim=dim,dimnames=dimnames,quant="age",units="kg")

            if (nsp==1) q<-m else q<-m[sp.no,,,]   # Why ?
            if ("M" %in% var.names) s.@m          <-FLQuant(q,dim=dim,dimnames=dimnames,quant="age",units=" ")

            if (nsp==1) q<-mat else q<-mat[sp.no,,,]   # Why ?
            if ("propmat" %in% var.names) s.@mat  <-FLQuant(q,dim=dim,dimnames=dimnames,quant="age",units="proportion")

            if (bio.interact) {
               if (nsp==1) q<-m1 else q<-m1[sp.no,,,]   # Why ?
               if ("M1" %in% var.names) s.@m1    <-FLQuant(q,dim=dim,dimnames=dimnames,quant="age",units=" ")
            }
        }
        if (read.output) {
            if (nsp==1) q<-s.n else q<-s.n[sp.no,,,]   # Why ?
            if ("N" %in% var.names) s.@stock.n  <-FLQuant(q,dim=dim,dimnames=dimnames,quant="age",units="1000")

            if (nsp==1) q<-harvest else q<-harvest[sp.no,,,]   # Why ?
            if ("F" %in% var.names) s.@harvest  <-FLQuant(q,dim=dim,dimnames=dimnames,quant="age",units="f")

            if (("west" %in% var.names) & ("N" %in% var.names)) s.@stock    <-FLQuant(apply(s.@stock.n*s.@stock.wt,c(2,3,4),sum),dimnames=dimnames2,quant="all",units="ton")

            if (bio.interact) {
              if (nsp==1) q<-m2 else q<-m2[sp.no,,,]   # Why ?
               if ("M2" %in% var.names) s.@m2    <-FLQuant(q,dim=dim,dimnames=dimnames,quant="age",units=" ")
            }

        }

        if (nsp>1) new.fls[[sp.no]]<-s.
    }
    ifelse(nsp>1, return(new.fls),return(s.))
}


#' Import NWIS Daily Data for EGRET analysis
#'
#' Imports daily data from NWIS web service. This function gets the data from here: \url{https://waterservices.usgs.gov/}
#'
#' @param siteNumber character USGS site number.  This is usually an 8 digit number
#' @param parameterCd character USGS parameter code.  This is usually an 5 digit number.
#' @param startDate character starting date for data retrieval in the form YYYY-MM-DD.
#' @param endDate character ending date for data retrieval in the form YYYY-MM-DD.
#' @param verbose logical specifying whether or not to display progress message
#' @param interactive logical deprecated. Use 'verbose' instead
#' @param convert logical Option to include a conversion from cfs to cms (35.314667). The default is TRUE,
#' which is appropriate for using NWIS data in the EGRET package.  Set this to FALSE to not include the conversion. If the parameter code is not 00060 (NWIS discharge),
#' there is no conversion applied.
#' @keywords data import USGS WRTDS
#' @export
#' @return A data frame 'Daily' with the following columns:
#' \tabular{lll}{
#' Name \tab Type \tab Description \cr
#' Date \tab Date \tab Date \cr
#' Q \tab numeric \tab Discharge in m^3/s\cr
#' Julian \tab integer \tab Number of days since Jan. 1, 1850\cr
#' Month \tab integer \tab Month of the year [1-12] \cr
#' Day \tab integer \tab Day of the year [1-366] \cr
#' DecYear \tab numeric \tab Decimal year \cr
#' MonthSeq \tab integer \tab Number of months since January 1, 1850 \cr
#' Qualifier \tab character \tab Qualifying code \cr
#' i \tab integer \tab Index of days, starting with 1 \cr
#' LogQ \tab numeric \tab Natural logarithm of Q  \cr
#' Q7 \tab numeric \tab 7 day running average of Q \cr
#' Q30 \tab numeric \tab 30 day running average of Q \cr
#' }
#' @seealso \code{\link[dataRetrieval]{readNWISdv}}, \code{\link{populateDaily}}
#' @examples
#' \donttest{
#'
#' Daily <- readNWISDaily('01594440','00060', '1985-01-01', '1985-03-31')
#' DailySuspSediment <- readNWISDaily('01594440','80154', '1985-01-01', '1985-03-31',convert=FALSE)
#' }
readNWISDaily <- function (siteNumber,parameterCd="00060",
                           startDate="",endDate="",verbose = TRUE, interactive=NULL,convert=TRUE){

  if(!is.null(interactive)) {
    warning("The argument 'interactive' is deprecated. Please use 'verbose' instead")
    verbose <- interactive
  }

  url <- dataRetrieval::constructNWISURL(siteNumber,parameterCd,startDate,endDate,"dv",statCd="00003", format = "tsv")

  data_rdb <- dataRetrieval::importRDB1(url, asDateTime=FALSE)

  localDaily <- data.frame(Date=as.Date(character()),
                           Q=numeric(),
                           Julian=numeric(),
                           Month=numeric(),
                           Day=numeric(),
                           DecYear=numeric(),
                           MonthSeq=numeric(),
                           Qualifier=character(),
                           i=integer(),
                           LogQ=numeric(),
                           Q7=numeric(),
                           Q30=numeric(),
                           stringsAsFactors=FALSE)

  if(nrow(data_rdb) > 0){
    if(length(names(data_rdb)) >= 5){
      names(data_rdb) <- c('agency', 'site', 'dateTime', 'value', 'code')
      data_rdb$dateTime <- as.Date(data_rdb$dateTime)
      data_rdb$value <- as.numeric(data_rdb$value)
      #####################################
      qConvert <- ifelse("00060" == parameterCd, 35.314667, 1)
      qConvert<- ifelse(convert,qConvert,1)

      localDaily <- populateDaily(data_rdb,qConvert,verbose = verbose)
    } else {
      if("comment" %in% names(attributes(data_rdb))){
        message(attr(data_rdb, "comment"))
      }
    }

  }

  return (localDaily)
}