Results

Row

res = 0.05

res = 0.1

res = 0.2

res = 0.3

res = 0.4

res = 0.5

res = 0.75

res = 1

res = 1.25

res = 1.5

res = 1.75

res = 2

res = 3

Row

Metrics

res = 0.05

res = 0.1

res = 0.2

res = 0.3

res = 0.4

res = 0.5

res = 0.75

res = 1

res = 1.25

res = 1.5

res = 1.75

res = 2

res = 3

DEG Table

Row

res= 0.05

res= 0.1

res= 0.2

res= 0.3

res= 0.4

res= 0.5

res= 0.75

res= 1

res= 1.25

res= 1.5

res= 1.75

res= 2

res= 3

Log (Module 1)

Description Variable Name Value
Module Preprocessing & QC
Date Sys.time() 2022-01-24 15:34:07
Input Expression Matrix input_data C:/Users/Owner/Dropbox/PDF Projects - JM/R Packages/scMiko/data/manno_count_matrix.rds
gene/cell Upper Limit (N/cell) gene.upperlimit 9000
gene/cell Lower Limit (N/cell) gene.lowerlimit 200
Filtered by unmatched reads unmatched.rate.filter.flag TRUE
Mitochondrial Content Upper Limit (%/cell) mt.upperlimit 10
Data Subsampled subsampled FALSE
Cluster Resolution cluster.resolution 1
Filtered by species species.filter.flag FALSE
Number of Workers normScale 1
Variables regressed out vars2regress percent.mt
Input Species all_input_organisms
Feature selection method feature.select.method hvg
PCA component selection method pca.component.select.method cum_var
Normalization Method norm_method SCT
PCA Method pca.method pca
Principal Components Included nDim 32
Unmatched rate upper limit unmatch.high 1
Unmatched rate lower limit unmatch.low 0
nPCA components used nDim 32
Run Time (s) elapsed.time 166.27
Run Identifier run.id output_33647PM
Scaling method scale.method sct
Output Saved save.flag TRUE

Log (Module 18)

Description Variable Name Value
Module Cluster Optimization
Date Sys.time() 2022-01-24 16:10:29
Input File input.file C:/Users/Owner/Dropbox/PDF Projects - JM/Data/scRNA-seq/01_sci-RNA-seq3_Hong_Kevin_Jason/NM_HH/Data/Preprocessed_Datasets/output_33647PM_demo_manno_10000cell.Rdata
Group singletons when clustering group.singletons FALSE
Log FC Threshold lfc.threshold 0.5
p value Threshold fdr.threshold 0.05
Positive Markers Only only.pos TRUE
Cluster Resolution cluster.resolution 0.05, 0.1, 0.2, 0.3, 0.4, 0.5, 0.75, 1, 1.25, 1.5, 1.75, 2, 3
Subsample Factor subsample_factor 1
Subsample N subsample_n 10000
Figures Printed in Notebook print.inline FALSE
PDF saved save.pdf FALSE
Run Time (s) elapsed.time 488.17
Run Identifier run.id output_41726PM

System Info

R version 4.0.3 (2020-10-10)

Platform: x86_64-w64-mingw32/x64 (64-bit)

locale: LC_COLLATE=English_Canada.1252, LC_CTYPE=English_Canada.1252, LC_MONETARY=English_Canada.1252, LC_NUMERIC=C and LC_TIME=English_Canada.1252

attached base packages: parallel, grid, stats, graphics, grDevices, utils, datasets, methods and base

other attached packages: presto(v.1.0.0), data.table(v.1.14.0), Rcpp(v.1.0.7), igraph(v.1.2.6), doParallel(v.1.0.16), iterators(v.1.0.13), foreach(v.1.5.1), cluster(v.2.1.0), future(v.1.22.1), zoo(v.1.8-9), ggExtra(v.0.9), ggpmisc(v.0.4.3), ggpp(v.0.4.2), DT(v.0.19), gridExtra(v.2.3), RColorBrewer(v.1.1-2), reshape2(v.1.4.4), plyr(v.1.8.6), scMiko(v.0.1.0), flexdashboard(v.0.5.2), tidyr(v.1.1.3), SeuratObject(v.4.0.2), Seurat(v.4.0.4), dplyr(v.1.0.7) and ggplot2(v.3.3.5)

loaded via a namespace (and not attached): readxl(v.1.3.1), backports(v.1.2.1), lazyeval(v.0.2.2), splines(v.4.0.3), crosstalk(v.1.1.1), listenv(v.0.8.0), scattermore(v.0.7), digest(v.0.6.27), yulab.utils(v.0.0.2), htmltools(v.0.5.2), viridis(v.0.6.2), fansi(v.0.5.0), magrittr(v.2.0.1), tensor(v.1.5), ROCR(v.1.0-11), openxlsx(v.4.2.4), globals(v.0.14.0), matrixStats(v.0.61.0), spatstat.sparse(v.2.0-0), colorspace(v.2.0-2), ggrepel(v.0.9.1), haven(v.2.4.3), xfun(v.0.26), crayon(v.1.4.1), jsonlite(v.1.7.2), spatstat.data(v.2.1-0), survival(v.3.2-13), glue(v.1.4.2), polyclip(v.1.10-0), gtable(v.0.3.0), MatrixModels(v.0.5-0), leiden(v.0.3.9), car(v.3.0-11), future.apply(v.1.8.1), abind(v.1.4-5), SparseM(v.1.81), scales(v.1.1.1), pheatmap(v.1.0.12), DBI(v.1.1.1), ggthemes(v.4.2.4), rstatix(v.0.7.0), miniUI(v.0.1.1.1), viridisLite(v.0.4.0), xtable(v.1.8-4), gridGraphics(v.0.5-1), reticulate(v.1.20), spatstat.core(v.2.3-0), foreign(v.0.8-80), htmlwidgets(v.1.5.4), httr(v.1.4.2), ellipsis(v.0.3.2), factoextra(v.1.0.7), ica(v.1.0-2), pkgconfig(v.2.0.3), farver(v.2.1.0), sass(v.0.4.0), uwot(v.0.1.10), deldir(v.0.2-10), utf8(v.1.2.2), ggplotify(v.0.1.0), tidyselect(v.1.1.1), labeling(v.0.4.2), rlang(v.0.4.11), later(v.1.3.0), cellranger(v.1.1.0), munsell(v.0.5.0), tools(v.4.0.3), generics(v.0.1.0), broom(v.0.7.9), ggridges(v.0.5.3), evaluate(v.0.14), stringr(v.1.4.0), fastmap(v.1.1.0), yaml(v.2.2.1), goftest(v.1.2-2), knitr(v.1.36), fs(v.1.5.0), fitdistrplus(v.1.1-5), pander(v.0.6.4), zip(v.2.2.0), purrr(v.0.3.4), RANN(v.2.6.1), pbapply(v.1.5-0), nlme(v.3.1-149), mime(v.0.11), quantreg(v.5.86), compiler(v.4.0.3), curl(v.4.3.2), plotly(v.4.9.4.1), png(v.0.1-7), ggsignif(v.0.6.3), spatstat.utils(v.2.2-0), tibble(v.3.1.4), bslib(v.0.3.0), stringi(v.1.7.4), highr(v.0.9), forcats(v.0.5.1), lattice(v.0.20-41), Matrix(v.1.3-4), vctrs(v.0.3.8), pillar(v.1.6.4), lifecycle(v.1.0.1), spatstat.geom(v.2.2-2), lmtest(v.0.9-38), jquerylib(v.0.1.4), RcppAnnoy(v.0.0.19), cowplot(v.1.1.1), irlba(v.2.3.3), conquer(v.1.0.2), httpuv(v.1.6.3), patchwork(v.1.1.1), R6(v.2.5.1), promises(v.1.2.0.1), rio(v.0.5.27), KernSmooth(v.2.23-17), parallelly(v.1.28.1), codetools(v.0.2-16), MASS(v.7.3-53), assertthat(v.0.2.1), withr(v.2.4.2), sctransform(v.0.3.2), hms(v.1.1.1), mgcv(v.1.8-33), rpart(v.4.1-15), rmarkdown(v.2.11), carData(v.3.0-4), Rtsne(v.0.15), ggpubr(v.0.4.0) and shiny(v.1.6.0)

---
title: "Cluster Optimization"
date: "`r format(Sys.time(), '%d %B, %Y')`"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    vertical_layout: fill
    source_code: embed
    theme: 
      bootswatch: flatly
    navbar:
      - { title: "scMiko", href: "https://nmikolajewicz.github.io/scMiko/" }  
editor_options: 
  chunk_output_type: inline
knit: (function(inputFile, encoding) {
    rmarkdown::render(input = inputFile,
      encoding = encoding,
      output_file = if (exists("user")){paste0(
        xfun::sans_ext(inputFile), '_',user, "_", 
        paste0(format(Sys.time(), "%d_%b_"), gsub(" ", "_", gsub(":", "_", format(Sys.time(), "%X"))), format(Sys.time(), "_%Y")), '.html'
      )} else {paste0(xfun::sans_ext(inputFile), '_',"Guest", "_", 
      paste0(format(Sys.time(), "%d_%b_"), gsub(" ", "_", gsub(":", "_", format(Sys.time(), "%X"))), format(Sys.time(), "_%Y")), '.html')},
      output_dir = if (exists("data.path")) paste0(data.path, "/HTML_Reports") else NULL
    )
  })
---


```{r setup, include=FALSE}

# clear global enviroment
rm(list = setdiff(ls(), c("data.path", "user")))
invisible({gc()})

# initiate timer
start.time <- proc.time()

# List of packages to load
packages2load <- c("scMiko", "Seurat",
                   "plyr", "dplyr", "tidyr", "reshape2", "RColorBrewer", "ggplot2", "gridExtra", 
                   "DT", "flexdashboard", "ggpmisc", "ggpmisc", "ggExtra", "grid", 
                    "zoo",    "future", "cluster", "doParallel", "parallel", "foreach",  "igraph", "presto")

# load packages
invisible(lapply(packages2load, library, character.only = TRUE))


```


```{r parameter specification}

parameter.list <- list(
  input.file = "C:/Users/Owner/Dropbox/PDF Projects - JM/Data/scRNA-seq/01_sci-RNA-seq3_Hong_Kevin_Jason/NM_HH/Data/Preprocessed_Datasets/output_33647PM_demo_manno_10000cell.Rdata",
  cluster.resolution = c(0.05, 0.1, 0.2, 0.3, 0.4, 0.5, 0.75, 1, 1.25, 1.5, 1.75, 2, 3),
  lfc.threshold = 0.5,            
  fdr.threshold = 0.05,
  group.singletons = F,                
  print.inline = FALSE, 
  subsample_factor = 1,
  subsample_n = 10000,
  n.workers =list(  
    clustering = 4, 
    deg = 4       
  ),
  only.pos = T, 
  save.pdf = F, 
  update.log = F,
  rprofile.dir = F,
  developer = F
)


```


```{r analysis log}

miko_message("Updating analysis log...")
# Module
df.log <- initiateLog("Cluster Optimization")
df.log <- addLogEntry("Input File", parameter.list$input.file, df.log, "input.file")
df.log <- addLogEntry("Group singletons when clustering", parameter.list$group.singletons, df.log, "group.singletons")
df.log <- addLogEntry("Log FC Threshold", parameter.list$lfc.threshold, df.log, "lfc.threshold")
df.log <- addLogEntry("p value Threshold", parameter.list$fdr.threshold, df.log, "fdr.threshold")
df.log <- addLogEntry("Positive Markers Only", parameter.list$only.pos, df.log, "only.pos")
df.log <- addLogEntry("Cluster Resolution", parameter.list$cluster.resolution, df.log, "cluster.resolution")
df.log <- addLogEntry("Subsample Factor", parameter.list$subsample_factor, df.log, "subsample_factor")
df.log <- addLogEntry("Subsample N", parameter.list$subsample_n, df.log, "subsample_n")
df.log <- addLogEntry("Figures Printed in Notebook", parameter.list$print.inline, df.log, "print.inline")
df.log <- addLogEntry("PDF saved", parameter.list$save.pdf, df.log, "save.pdf")

```


```{r load data, warning = FALSE}

# Specify data directories
if (parameter.list$rprofile.dir){
  dir.preprocessed <- "Preprocessed_Datasets/"
  if (!exists("data.path") & !exists("user")) {
    stop("data.path and user variables do not exist in global enviroment. Ensure that these are specified in .Rprofile. If specified, try restarting Rstudio.")
  }
  
}

miko_message("Importing data...")
if ((!grepl(".Rdata|.RData", parameter.list$input.file)) & !(grepl(".rds", parameter.list$input.file))){
  parameter.list$input.file <- paste0(parameter.list$input.file, ".Rdata")
} 

if (parameter.list$rprofile.dir){
  if (grepl(".Rdata|.RData", parameter.list$input.file)){
    load(paste(data.path, dir.preprocessed, parameter.list$input.file, sep = ""));
  } else if (grepl(".rds", parameter.list$input.file)) {
    so <- readRDS(paste(data.path, dir.preprocessed, parameter.list$input.file, sep = ""))
  }  
} else {
  if (grepl(".Rdata|.RData", parameter.list$input.file)){
    load(parameter.list$input.file);
  } else if (grepl(".rds", parameter.list$input.file)) {
    so <- readRDS(parameter.list$input.file);
  }
}

if (!exists("gNames.list")) gNames.list <- prepGeneList(so, objects())

if ("integrated" %in% names(so@assays)){
  terms2drop <- c("ica", "tsne", "nmf", "corr", "gsva", "deg", "sct")
} else {
  terms2drop <- c("ica", "tsne", "nmf", "corr", "gsva", "deg")
}

# prep seurat object
prep.list <- prepSeurat2(so, e2s = gNames.list, 
                         species = NULL, resolution= NULL, subset = NULL, 
                         subsample = 1, 
                         terms2drop = terms2drop, rmv.pattern = "so", 
                         scale.reprocessed = F, 
                         neighbors.reprocessed = T) 

# unpack results
if (exists("so")) try({rm(so)}, silent = T)
so.query <- prep.list$so
current.assay <- prep.list$assay
n.cells <- prep.list$n.cell
rm(prep.list)
invisible({gc()})
parameter.list$species <- detectSpecies(so.query)

```


```{r prior log}
# determine prior log history
cur.env <- objects()
module.logs <- cur.env[grep("^df.log_Module",cur.env)]

```



```{r cluster helper function}

# clustering data
mc.list <- multiCluster(object = so.query, 
                 resolutions = parameter.list$cluster.resolution, 
                 assay = NULL, nworkers = parameter.list$n.workers$clustering , 
                 pca_var = 0.9, 
                 group_singletons = parameter.list$group.singletons, 
                 algorithm = 1, 
                 return_object = F)

plt.umap_by_cluster <- mc.list$plots
so.query <- mc.list$object
cr_names <- mc.list$resolution_names
cluster.name <- mc.list$cluster_names
assay.pattern <- mc.list$assay_pattern
rm(mc.list); invisible({gc()})

```

```{r calculate cluster purity}

miko_message("Calculating purity scores...")


availableNNgraph <- function(object, verbose = T){
  
  suppressMessages({
    suppressWarnings({
      graph.present <- F
      try({
        cluster.graph <- object@commands[["FindClusters"]]@params[["graph.name"]]
        cluster.graph <- gsub("_s", "_", cluster.graph)
        graph.present <- cluster.graph %in% names(object@graphs)
      }, silent = T)
      
      if (!graph.present){
        try({
          cluster.graph <- paste0(current.assay, "_nn")
          graph.present <- cluster.graph %in% names(object@graphs)
        }, silent = T)  
      }
      if (!graph.present) stop("Could not find valid KNN graph")
      
    })
  })
  
  miko_message("'", cluster.graph, "' is available for neighborhood purity scoring")
  
  return(cluster.graph)
}

multiPurity <- function(object, resolutions, cluster_graph = availableNNgraph(object), 
                        n_subsample = 10000, pca_var = 0.9, assay_pattern = NULL, assay = NULL, 
                        purity_threshold = 0.9){ 

df.purity <- NULL
purity.umap.list <- list()

if (is.null(assay_pattern) & is.null(assay)){
  assay_pattern <- paste0(DefaultAssay(object), "_snn_res.")
} else if (is.null(assay_pattern) & !is.null(assay)){
  assay_pattern <- paste0(assay, "_snn_res.")
}
cluster_graph_set <- cluster_graph

# downsample data if exceeding 10000 cells
if (ncol(object) > n_subsample){
  so.sub <- object[ , sample(colnames(object), n_subsample)]
  df.pc <- propVarPCA(so.sub)
  so.sub <- FindNeighbors(so.sub, dims = 1:(sum(df.pc$pc.cum_sum < pca_var) + 1), nn.method = "rann")
}
for (i in 1:length(resolutions)) {
  current.cluster <- paste0(assay_pattern, resolutions[i])
  if (ncol(object) > n_subsample){
    
    so.sub <- neighborPurity(object = so.sub, graph = cluster_graph_set, cluster.field = current.cluster, verbose = F) 
    
    suppressMessages({
      suppressWarnings({
        purity.umap.list[[current.cluster]] <- FeaturePlot(so.sub, "purity") + 
          theme_miko(legend = T) + 
          viridis::scale_color_viridis() + 
          labs(title = "Purity Score", subtitle = paste0("Resolution: ", resolutions[i])) + 
          labs(x = "UMAP 1", y = "UMAP 2", color = "Purity")        
      })
    })
    
    
    df.purity <- bind_rows(df.purity, 
                           data.frame(resolution = as.numeric(resolutions[i]), 
                                      name = current.cluster,
                                      cell = colnames(so.sub), 
                                      cluster = so.sub@meta.data[ ,current.cluster],
                                      purity = so.sub@meta.data[ ,"purity"]))
    
  } else {
    
    # so.sub <- object; rm(object); invisible({gc()})
    object <- neighborPurity(object = object, graph = cluster_graph_set, cluster.field = current.cluster, verbose = F) 
    
    suppressMessages({
      suppressWarnings({

    purity.umap.list[[current.cluster]] <- FeaturePlot(object, "purity") + 
      theme_miko(legend = T) + 
      viridis::scale_color_viridis() + 
      labs(title = "Purity Score", subtitle = paste0("Resolution: ", resolutions[i])) + 
      labs(x = "UMAP 1", y = "UMAP 2", color = "Purity")
            
      })
    })
    
    df.purity <- bind_rows(df.purity, 
                           data.frame(resolution = as.numeric(resolutions[i]), 
                                      name = current.cluster,
                                      cell = colnames(object), 
                                      cluster = object@meta.data[ ,current.cluster],
                                      purity = object@meta.data[ ,"purity"]))
    
  }
  
}

df.purity.sum <- df.purity %>%
  dplyr::group_by(resolution, cluster) %>%
  dplyr::summarize(purity.mean1 = mean(purity, na.rm = T), 
                   purity.median1 = median(purity, na.rm = T), 
                   purity.sd1 = sd(purity, na.rm = T), .groups = 'drop') %>%
  dplyr::group_by(resolution) %>%
  dplyr::summarize(purity.mean = mean(purity.mean1, na.rm = T), 
                   purity.min = min(purity.mean1),
                   purity.max = max(purity.mean1),
                   purity.sd = sd(purity.mean1, na.rm = T), .groups = 'drop')

df.purity.sum$z <- (1 - df.purity.sum$purity.mean)/df.purity.sum$purity.sd
df.purity.sum$z[is.na(df.purity.sum$z)] <- 0
df.purity.sum$p <- pnorm(q=df.purity.sum$z, lower.tail=FALSE)

plt.cluster.purity <- df.purity.sum %>%
  ggplot(aes(x = as.numeric(resolution), y = purity.mean)) + 
   geom_line() + 
  # scale_color_manual(values = c("TRUE" = "tomato", "FALSE" = "black")) + 
  geom_point(size = 3) + #, aes(color = p < p_threshold)
  geom_hline(yintercept = purity_threshold, linetype = "dashed") + 
  theme_miko(legend = T) + 
  theme(legend.position = "bottom") + 
  labs(x = "Resolution", y = "Purity Score", title = "Purity Score") +  #, color = paste0("Impure (p<", p_threshold, ")")
  theme(panel.grid.minor = element_line(colour="grey95", size=0.1),
        panel.grid.major = element_line(colour="grey85", size=0.1),
        panel.grid.minor.y = element_blank(),
        panel.grid.major.y = element_blank()) +
    scale_x_continuous(minor_breaks = seq(0 , max(df.purity.sum$resolution, na.rm = T), 0.1) , 
                       breaks = seq(0, max(df.purity.sum$resolution, na.rm = T), 0.2))



return(
  list(
    purity_raw = df.purity,
    purity_summary = df.purity.sum,
    resolution_plot = plt.cluster.purity,
    umap_plot = purity.umap.list
  )
)

  
}

mp.list <- multiPurity(object = so.query, 
                       resolutions = parameter.list$cluster.resolution, 
                       cluster_graph = availableNNgraph(so.query), 
                       n_subsample = 10000, 
                       pca_var = 0.9, 
                       assay_pattern = assay.pattern, assay = NULL, 
                       purity_threshold = 0.9) #, p_threshold = 0.05

df.purity <- mp.list$purity_raw
df.purity.sum <- mp.list$purity_summary
plt.cluster.purity <- mp.list$resolution_plot
purity.umap.list <- mp.list$umap_plot
rm(mp.list); invisible({gc()})

if (parameter.list$print.inline){
  print(plt.cluster.purity)
 
}

```

```{r subsample data here, warning = FALSE}

try({
  if ((parameter.list$subsample_factor < 1) | (parameter.list$subsample_n < ncol(so.query))){
    so.query <-   downsampleSeurat(object = so.query, subsample.factor = parameter.list$subsample_factor, subsample.n = parameter.list$subsample_n)
  }
}, silent = T)


```

```{r check gene rep and convert if necessary, warning = FALSE}

current.assay <- DefaultAssay(so.query)
if (!is.null(gNames.list)){
  gene.rep <- checkGeneRep(gNames.list, as.vector(rownames(so.query)))
  if (gene.rep == "ensembl"){
    so.query <- ens2sym.so(so.query, gNames.list)
  }
}


```


```{r find DEG markers, warning=FALSE}

multiDEG <- function(object, groups, nworkers = 1, fdr_threshold = 0.05, logfc_threshold = 0, only_pos = T, verbose = T ){

# initiate list to store cluster markers
query_markers.list <- list()

# store current identities
cur_idents <- Idents(object)
# so.markers <- so.query

# assay for DEG
 deg_assay <- c("RNA", "SCT")[which(c("RNA", "SCT") %in% names(object@assays)) ]
 if (length(deg_assay) == 0){
   deg_assay <- DefaultAssay(object)
 } else if (length(deg_assay) > 1){
   deg_assay <- "SCT"
 }

 which_missing <- which(!(groups %in% colnames(object@meta.data)))
 if (length(which_missing) > 0) stop(paste(groups[which_missing], collapse =", "), " groups were not found in object meta data.")

# start cluster
 miko_message("Running Differential expression analysis...", verbose = verbose)
if (nworkers > length(groups)) nworkers <- length(groups)
cl <- parallel::makeCluster(nworkers)
doParallel::registerDoParallel(cl)

# iterate through each input file
marker.list <- foreach(i = 1:length(groups), .packages = c("scMiko", "Seurat", "presto", "dplyr"))  %dopar% {
  
  Idents(object) <- object@meta.data[[groups[i]]]
  
  if (length(unique(Idents(object))) < 2){
    qm.res <- NULL
  } else {
      qm.res <- presto::wilcoxauc(X = object, group_by = groups[i], assay = "data", seurat_assay = deg_assay)
      qm.res$pct_dif <- qm.res$pct_in - qm.res$pct_out    
  }

  return(qm.res)
  
}

# stop workers
parallel::stopCluster(cl)

# unpackage results
query_markers.list <- marker.list
names(query_markers.list) <- groups

# remove baggage
rm(marker.list)
rm(object)
invisible({gc()})


# all.deg.list <- query_markers.list
miko_message("Applying filters...", verbose = verbose)
for (i in 1:length(query_markers.list)){
  
  set.name <- names(query_markers.list)[i]
  qm.res <-  query_markers.list[[set.name]]

  
  if (only_pos){
    qm.res <- qm.res %>% dplyr::mutate(significant = (logFC > 0 & padj <= fdr_threshold & abs(logFC) > logfc_threshold))
  } else {
    qm.res <- qm.res %>% dplyr::mutate(significant = (padj <= fdr_threshold & abs(logFC) > logfc_threshold))
  }
  
  query_markers.list[[set.name]] <- qm.res
}

return(query_markers.list)

  
}

# run DEG analysis
all.deg.list <- multiDEG(object = so.query, groups = cluster.name, 
                               only_pos = parameter.list$only.pos,
                               nworkers = parameter.list$n.workers$deg, 
                               fdr_threshold = parameter.list$fdr.threshold, 
                               logfc_threshold = parameter.list$lfc.threshold, verbose = T )

query_markers.list <- lapply(all.deg.list, function(x) x %>% dplyr::filter(significant))

```

```{r CDI-based specificity score}

ms.list <- multiSpecificity(object = so.query, 
                            cluster_names = cluster.name, 
                            features = NULL, 
                            deg_prefilter = T, 
                             cdi_bins = seq(0, 1, by = 0.01), 
                            min.pct = 0.1, 
                            n.workers = parameter.list$n.workers$deg, 
                            return_dotplot = T,  
                            verbose = T)


# ms.list$
df.auc.spec <- ms.list$specificity_summary
qm.res.sum.sum.all <- ms.list$specificity_raw
plt.clust.spec <- ms.list$auc_plot
plt.auc.spec <- ms.list$resolution_plot
plt.auc.dot <- ms.list$dot_plot

cdi_result <- ms.list$cdi_results

if (parameter.list$print.inline){
  print(plt.clust.spec)
  print(plt.auc.spec)
}

```

```{r make wide helper function}


make.wide <- function(u_clusters, top_markers, n_top_markers, rename_clusters = TRUE){
  top_markers_wide <- data.frame()
  
  top_marker_clusters <- as.vector(top_markers$group)
  
  u_clusters <- as.numeric(as.character(u_clusters))
  u_clusters <- u_clusters[order(u_clusters)]
  for (i in 1:length(u_clusters)){
    
    top_markers_current <- top_markers$feature[top_marker_clusters == u_clusters[i]]
    n_markers_cur <- length(top_markers_current)
    
    if (!(n_markers_cur >= n_top_markers)){
      top_markers_current <- c(top_markers_current, rep(NaN, n_top_markers-n_markers_cur))
    }
    
    top_markers_wide[seq(1, n_top_markers), c(paste("c", u_clusters[i], sep = ""))] <- as.data.frame(top_markers_current)
    if (!rename_clusters){
      colnames(top_markers_wide)[i] <- u_clusters[i]
    }
  }
  
  return(top_markers_wide)
}

```


```{r get top markers function}



# function to get top cluster-specific markers
get.topmarkers <- function(query.markers, n_top_markers = 10, cluster_res_label = "", rename_clusters = TRUE){
  
  top_markers <- query.markers %>% 
    dplyr::group_by(group) %>% 
    dplyr::arrange(desc(auc)) 
  
  top_markers_filter <- top_markers[ , c("group", "feature")]
  
  top_marker.tally <- top_markers_filter %>%
    dplyr::group_by(group) %>%
    dplyr::tally()
  max.n <- max(top_marker.tally$n)
  top_markers_filter$group <- as.numeric(as.character(top_markers_filter$group))

  top_markers$group <- paste("c", as.character(top_markers$group), sep = "")
  top_markers$pval <- signif( top_markers$pval, 3)
  top_markers$padj <- signif( top_markers$padj, 3)
  top_markers$logFC <- signif( top_markers$logFC, 3)
  
  top_markers_50 <- query.markers %>% 
    dplyr::group_by(group) %>% 
    dplyr::arrange(desc(auc)) %>%
    dplyr::top_n(n = 50, wt = auc)
  
  top_markers_50 <- top_markers_50[ , c("group", "feature")]
  
  
  
  u_clusters <- as.vector(unique(top_markers_filter$group))
  u_clusters <- u_clusters[order(u_clusters)]
  
  top_markers_wide <- make.wide(u_clusters, 
                                top_markers = top_markers_filter, 
                                n_top_markers = max.n, 
                                rename_clusters = rename_clusters)
  
  top_markers_50_wide <- make.wide(u_clusters, top_markers = top_markers_50, n_top_markers = 50, rename_clusters = rename_clusters)
  
  top5_markers <- query.markers %>% 
    dplyr::group_by(group) %>% 
    dplyr::arrange(desc(auc)) %>%
    dplyr::top_n(n = 50, wt = auc)
  
  
  # assign outputs to list and return
  output <- list(top_markers, top_markers_50, top_markers_wide, top_markers_50_wide, top5_markers)
  names(output) <- c("top_markers_res",
                     "top_markers_50_res",
                     "top_markers_wide_res",
                     "top_markers_50_wide_res",
                     "top5_markers_res")
  return(output)
}

```


```{r get top cluster markers, warning = FALSE }

# get top markers
which.res2rmv <- c()
top_markers_res.list <- list()         
top_markers_50_res.list <- list()      
top_markers_wide_res.list <- list()    
top_markers_50_wide_res.list <- list() 
top5_markers_res.list <- list()  

for (i in 1:length(query_markers.list)){
  if (length( query_markers.list[[i]]) == 0) {
    which.res2rmv <- c(which.res2rmv, parameter.list$cluster.resolution[i])
    next
  }
  output.markers <- get.topmarkers(query.markers = query_markers.list[[i]], cluster_res_label = parameter.list$cluster.resolution[i])
  
  top_markers_res.list[[as.character(parameter.list$cluster.resolution[i])]] <- as.data.frame(output.markers[["top_markers_res"]])     
  top_markers_50_res.list[[as.character(parameter.list$cluster.resolution[i])]] <- as.data.frame(output.markers[["top_markers_50_res"]])     
  top_markers_wide_res.list[[as.character(parameter.list$cluster.resolution[i])]] <- as.data.frame(output.markers[["top_markers_wide_res"]])   
  top_markers_50_wide_res.list[[as.character(parameter.list$cluster.resolution[i])]] <- as.data.frame(output.markers[["top_markers_50_wide_res"]])
  top5_markers_res.list[[as.character(parameter.list$cluster.resolution[i])]] <- as.data.frame(output.markers[["top5_markers_res"]])
  # quiet(list2env(output.markers, env = environment()), all = TRUE)  
}

# omit resolution where no DEGs were observed
cr_original <- parameter.list$cluster.resolution
parameter.list$cluster.resolution <-parameter.list$cluster.resolution[!(parameter.list$cluster.resolution  %in% which.res2rmv)]

```

```{r down sample cells function}


# downsample data if necessary
downsample_cells <- function(so.query, clust.name, n.downsample = 500, seed.value = 1023){
  
  set.seed(seed.value)
  
  cluster_id <- as.vector(so.query@meta.data[[clust.name]])
  u_clusters <- unique(cluster_id)
  
  n_per_cluster <- round(n.downsample / length(u_clusters))
  
  cells_to_plot <- c()
  for (i in 1:length(u_clusters)){
    
    cell_to_sample <- Cells(so.query)[cluster_id == u_clusters[i]]
    if (length(cell_to_sample) < n_per_cluster){
      cells_to_plot <-  c(cells_to_plot, cell_to_sample)
    } else {
      cells_to_plot <-  c(cells_to_plot, sample(Cells(so.query)[cluster_id == u_clusters[i]], n_per_cluster, replace = FALSE))
    }
    
  }

  so.query_small <- subset(so.query, cells = cells_to_plot)

  return(so.query_small)
}
```


```{r heatmap new}

plt.heat.scaled.list <- list()
for (i in 1:length(all.deg.list)){
  
  u.clust <- getOrderedGroups(so.query, which.group = names(all.deg.list)[i], is.number = T)
  u.clust <- u.clust[!is.na(u.clust)]
  df.prest <- all.deg.list[[names(all.deg.list)[i]]]
e.mat <- pivot_wider(df.prest %>% dplyr::select(feature, group, avgExpr), names_from = group, values_from = avgExpr)
e.mat <- col2rowname(e.mat, "feature"); e.mat <- as.matrix(e.mat[ ,order(as.numeric(colnames(e.mat)))])
df.e.wide <- data.frame(gene = rownames(e.mat), as.data.frame(e.mat)); colnames(df.e.wide) <- c("gene", u.clust)

# deg.gene <- query_markers.list[[names(all.deg.list)[i]]]$feature

  var.features <- so.query@assays[[DefaultAssay(so.query)]]@var.features
  
  # scaled expression plots
  df.s4plt <- as.matrix(df.e.wide %>% dplyr::select(-c("gene")))
  df.s4plt <- df.s4plt[rownames(df.s4plt) %in% unique(var.features), ]
  
  # df.s4plt <- (apply(df.s4plt, 2, function(x) (x-mean(x))/sd(x)))
  df.s4plt <- t(apply(df.s4plt, 1, function(x) (x-mean(x, na.rm = T))/sd(x, na.rm = T)))
  
  scale.lim <- 2 
  df.s4plt[df.s4plt > scale.lim] <- scale.lim
  df.s4plt[df.s4plt < (-1*scale.lim)] <- (-1*scale.lim)
  
  my.breaks <- seq((-1*scale.lim), scale.lim, by = 0.01)
  # my.col <- colorRampPalette(c(scales::muted("blue"), "white",scales::muted("red")))(length(my.breaks))
  
  df.s4plt <- df.s4plt[!(apply(df.s4plt, 1, function(x) all(is.na(x)))), ]
  
  plt.heat.scaled <- pheatmap::pheatmap(df.s4plt,
                                        breaks = my.breaks,
                                        color = colorRampPalette(rev(brewer.pal(n = 7, name = "RdBu")))(length(my.breaks)),
                                        show_rownames = F,
                                        main = "Scaled Expression\nx=cluster, y=gene, z=scaled expression", silent = T)
  
  plt.heat.scaled <- ggplotify::as.ggplot(plt.heat.scaled)
  
  rm(df.s4plt);
  
  plt.heat.scaled.list[[ names(all.deg.list)[i]]] <- plt.heat.scaled
  
}

```




```{r silhouette analysis}

if (exists("so.sub")){
  msil_list <- multiSilhouette(object = so.sub, groups = cluster.name, assay_pattern = assay.pattern, verbose = T)
} else {
  msil_list <- multiSilhouette(object = so.query, groups = cluster.name, assay_pattern = assay.pattern, verbose = T)
}

sil.plot <- msil_list$silhouette_plots
plt.silw.dep <- msil_list$resolution_plot
df.silw <- msil_list$silhouette_raw
df.silw.sum <- msil_list$silhouette_summary
rm(msil_list); invisible({gc()})

if (parameter.list$print.inline){
  print(sil.plot)
  print(plt.silw.dep)
}

```


```{r res vs n clust curve}

# get resolutions
clust.names <- names(query_markers.list)
current.assay <- DefaultAssay(so.query)
clust.res <- as.numeric(gsub(assay.pattern, "",clust.names))

# get cluster number
clust.n <- purrr::map_dbl(query_markers.list, function(x) length(unique(x[["group"]])))

# get number of degs per cluster
n.deg <- purrr::map(query_markers.list, function(x){
  if (nrow(x) > 0){
    df.sum <- x %>%
      dplyr::group_by(get("group")) %>%
      dplyr::summarize(
        sig.deg = sum(padj < 0.05), .groups = 'drop'
      )
  } else {
    NULL
  }
  
})

# compute deg statistics
n.deg.summary <- purrr::map(n.deg, function(x){
  if (!is.null(x)){
    df.sum <- data.frame(
      min.n = min(x$sig.deg, na.rm = T),
      max.n = max(x$sig.deg, na.rm = T),
      mean.n =mean(x$sig.deg, na.rm = T),
      sd.n = sd(x$sig.deg, na.rm = T),
      median.n = median(x$sig.deg, na.rm = T),
      n.clust = length(x$sig.deg)
    )
  } else {
    df.sum <- data.frame(
      min.n = NA,
      max.n = NA,
      mean.n = NA,
      sd.n = NA,
      median.n = NA,
      n.clust = NA
    )
  }
})

df.clust.n <- data.frame(clust.res = clust.res, 
                         n.clust = clust.n,
                         deg.meanN = purrr::map_dbl(n.deg.summary, function(x) x$mean.n),
                         deg.medianN = purrr::map_dbl(n.deg.summary, function(x) x$median.n),
                         deg.minN = purrr::map_dbl(n.deg.summary, function(x) x$min.n),
                         deg.maxN = purrr::map_dbl(n.deg.summary, function(x) x$max.n))

df.clust.mean <- df.clust.n[ ,c("clust.res", "deg.meanN")]; df.clust.mean$type = "mean"; colnames(df.clust.mean) <- c("res", "val", "type")
df.clust.min <- df.clust.n[ ,c("clust.res", "deg.minN")]; df.clust.min$type = "min"; colnames(df.clust.min) <- c("res", "val", "type")
df.clust.max <- df.clust.n[ ,c("clust.res", "deg.maxN")]; df.clust.max$type = "max"; colnames(df.clust.max) <- c("res", "val", "type")

df.clust.long <- bind_rows(df.clust.mean, df.clust.min, df.clust.max)

plt.deg.n <- df.clust.long %>%
  dplyr::filter(type == "min") %>%
  ggplot(aes(res, val)) + 
  # , color = type
  geom_point(size = 3) + 
  geom_line() + 
  geom_hline(yintercept = 0, linetype = "dashed") + 
  theme_miko(legend = T) + 
  ggthemes::scale_color_ptol() + 
  labs(title = "Number of Differentially-Expressed Genes (DEG)", x = "Resolution", y = "min(N DEG/Cluster)", color = "Statistic")  +
  theme(panel.grid.minor = element_line(colour="grey95", size=0.1),
        panel.grid.major = element_line(colour="grey85", size=0.1),
        panel.grid.minor.y = element_blank(),
        panel.grid.major.y = element_blank()) +
    scale_x_continuous(minor_breaks = seq(0 , max(df.purity.sum$resolution, na.rm = T), 0.1) , 
                       breaks = seq(0, max(df.purity.sum$resolution, na.rm = T), 0.2))
                         

plt.clust.n <- df.clust.n %>%
  ggplot(aes(clust.res, n.clust)) + 
  geom_line() + 
  geom_point(size = 3) + 
  theme_miko() + 
  xlab("Resolution") + 
  ylab("Cluster Number") + 
  labs(title = "Cluster Resolution vs. Number of Cell Populations")  +
  theme(panel.grid.minor = element_line(colour="grey95", size=0.1),
        panel.grid.major = element_line(colour="grey85", size=0.1),
        panel.grid.minor.y = element_blank(),
        panel.grid.major.y = element_blank()) +
    scale_x_continuous(minor_breaks = seq(0 , max(df.purity.sum$resolution, na.rm = T), 0.1) , 
                       breaks = seq(0, max(df.purity.sum$resolution, na.rm = T), 0.2))

if (parameter.list$print.inline){
  print(plt.clust.n)
  print(plt.deg.n)
}
```


```{r resolution-specific performance metrics, fig.width=15, fig.height=5}

marker.spec.list <- list()
u.res <- unique(qm.res.sum.sum.all$resolution)
for (i in 1:length(u.res)){
  
  qm.res.sum.sum.cur <- qm.res.sum.sum.all
  qm.res.sum.sum.cur$is.res <- qm.res.sum.sum.cur$resolution %in% u.res[i]
  qm.res.sum.sum.cur <- qm.res.sum.sum.cur %>% dplyr::arrange(is.res)
  u.res2 <- unique(as.character(qm.res.sum.sum.cur$resolution))
  qm.res.sum.sum.cur$res <- factor(qm.res.sum.sum.cur$resolution, levels = u.res2)
  marker.spec.list[[u.res[i]]] <- qm.res.sum.sum.cur %>% 
    dplyr::arrange(is.res) %>%
  ggplot(aes(x = bin, y = pdeg, color = is.res)) + 
  geom_path(aes(group = res)) + 
  theme_miko(legend = F) +
    scale_color_manual(values = c("TRUE" = "tomato", "FALSE" = "grey")) + 
  xlab("target DEG-AUC") + 
  ylab("Proportion of Clusters\n(>=1 DEG exceeding target DEG-AUC)") + 
  geom_vline(xintercept = 0.5, linetype = "dashed") + 
  labs(title = "Marker Specificity", 
       color = "Resolution", caption = paste0("red curve: resolution = ", gsub(assay.pattern, "", u.res[i]), "; grey curve: other resolutions" ))

}

res.specific.list <- list()
for (i in 1:length(query_markers.list)){
  
  set.name <- names(query_markers.list)[i]
  set.name2 <- gsub(assay.pattern, "", set.name)
  
  if (!is.null(df.silw)){
    
    avg.sil  <- signif(mean((df.silw %>% dplyr::filter(cluster.resolution == set.name2) )$sil.width, na.rm = T), 3)
    
    if (!is.nan(avg.sil)){
      # A: silhoutte
      p1 <- sil.plot[[set.name]] + 
        theme_set(theme_get() + theme(text = element_text(family = 'Open Sans'))) +
        theme_miko(legend = T) +
        theme(axis.text.x=element_blank(),
              axis.ticks.x=element_blank()) + 
        labs(x = "Cell Index", y = "Silhouette Width") + 
        labs(title = "Silhoutte Plot", subtitle = NULL) + 
        labs(subtitle = paste0("Resolution = ", set.name2), caption = paste0("Average silhouette width = ", avg.sil))
    } else {
      p1 <- NULL
    }
  } else {
    p1 <- NULL
  }
  
  # B: purity score UMAP
  avg.pur <- signif(mean(purity.umap.list[[set.name]]$data$purity, na.rm = T), 3)
  p2 <- purity.umap.list[[set.name]] + labs(subtitle = paste0("Resolution = ", set.name2), 
                                            caption = paste0("Average purity score = ", avg.pur))  
  
  # C: marker specificity score
  p3 <- marker.spec.list[[set.name2]] + labs(subtitle = paste0("Resolution = ", set.name2))
  
  res.specific.list[[set.name]] <- cowplot::plot_grid(p1, p2, p3, nrow = 1, align = "h", axis = "tb", labels = c("H", "I", "J"))
  
  if (parameter.list$print.inline){
    print(res.specific.list[["SCT_snn_res.0.05"]])
  }
  
}

```

```{r central log}

# update central log

if (parameter.list$developer){
  run.id <- NULL
  if (!exists("user")) user <- "guest"
  
  clog.update.success <- F
  if (parameter.list$update.log){
    try({
      run.id <-  updateCentralLog(Module = "M18", input.data = parameter.list$input.file, input.subset = NA, pdf.flag = parameter.list$save.pdf)
      clog.update.success <-  T
    }, silent = F) 
  }
  
  if (is.null(run.id))  {
    warning("Central log update was unsuccessful :(\n")
    # run.id <- paste("M18_", user, "_r", paste0(format(Sys.time(), '%s')), sep = "", collapse = "")
    run.id <- paste("M18_", user, "_", gsub(":| ", "", paste0(format(Sys.time(), '%d_%m_%X'))), sep = "", collapse = "")
  }
  
} else {
  run.id <- paste("output_", gsub(":| ", "", paste0(format(Sys.time(), '%X'))), sep = "", collapse = "")
}

```


```{r output directories}

# output path
if (!exists("data.path")) data.path = ""
output.path <- paste0(data.path, "Module_Outputs/", paste0(run.id,"_",format(Sys.time(), '%d%m%y'), "/"))

# create output directories
if (parameter.list$save.pdf) {
dir.create(output.path)
dir.create(paste0(output.path, "Tables/"))
dir.create(paste0(output.path, "PDF/"))
}

```



Results
===================================== 

Sidebar {.sidebar data-width=400}
-------------------------------------

**Description**: Cells are clustered using unsupervised Louvain community detection over a range of candidate resolutions. At each resolution, i) cluster-level UMAP and heatmap representations are generated, ii) resolution-specific performance metrics are derived, and iii) cluster-specific differential expression analysis is performed. 

**Figure Legends**:\
**A|** Resolution-specific UMAP representation of cell clusters.\
**B|** Resolution-specific heatmap of top variable genes. Mean expression values are scaled row-wise.\
**C|** Resolution-specific silhouette widths. *Range* = [-1,1]\
**D|** Resolution-specific purity scores. *Range* = [0,1]\
**E|** Resolution-specific marker specificity scores. *Range* = [0,1]\
**F|** Resolution-specific number of cell clusters.\
**G|** Resolution-specific minimum number of differentially-expressed genes per cluster.\
**H|** Silhouette plot.\
**I|** Purity scores overlaid on a UMAP. See notes for details. \
**J|** Marker specificity curve. See notes for details. *Red curve*: specified resolution; *grey curves*: all other resolutions.\

**Notes**:\
**1. Purity Score**: For a given cell *i*, the purity score is defined as the proportion of cells within cell *i*'s K-nearest neighborhood (KNN) that belong to the most represented cluster within that KNN. The purity score ranges between 0 to 1. Neighborhoods in which cells belong to many different clusters are considered "*impure*" (low purity score) whereas neighborhoods in which cells belong to a single cluster are "*pure*" (high purity score). The purity score, together with the silhouette width, provides a measure of cluster consistency and may be used in guiding selection of the optimal clustering resolution.\
**2. Marker Specificity**: The marker specificity score is a measure of how well differentially-expressed genes (DEG) can discriminate (i.e., classify) clusters at a given resolution. To derive the specificity score, nCDI estimates are used to construct a *marker specificity curve* (Panel J). The x axis represents nCDI values ranging from 0 to 1. The y axis represents the proportion of clusters that have at least 1 DEG exceeding the target nCDI (on the x axis). The area under the marker specificity curve represents the *marker specificity score* and can range from 0 (no clusters have a specific DEG) to 1 (each cluster has a specific DEG). The marker specificity score can be compared across different clustering resolutions to determine at which resolution clusters have specific DEGs.\

**Definitions**:\
**res**: Clustering resolution\
**UMAP**: Uniform manifold approximation and projection\
**nCDI**: Normalized co-dependency index\

**Sample Overview**:\
Cells, n: `r ncol(so.query)`\
Genes, n: `r nrow(so.query)`\
Variable genes, n: `r length(VariableFeatures(so.query))`\

UMI/cell, median: `r round(median(so.query@meta.data[["nCount_RNA"]]))`\
genes/cell, median: `r round(median(so.query@meta.data[["nFeature_RNA"]]))`\
Species: `r parameter.list$species`


Row {.tabset}
-------------------------------------

```{r plt.umap_by_all_clusters, message=FALSE, warning=FALSE, fig.width=12, fig.height=5}


plt.clust.ov <- list()
for (i in 1:length(plt.umap_by_cluster)){
  set.name <- names(plt.umap_by_cluster)[i]
  plt.clust.ov[[set.name]] <- cowplot::plot_grid(plt.umap_by_cluster[[set.name]], plt.heat.scaled.list[[set.name]], labels = "AUTO")
}


out <- lapply(seq_along(plt.clust.ov), function(i) {
  
  
  set.name <- gsub(assay.pattern, "", names(plt.clust.ov)[i])
  set.name2 <- names(plt.clust.ov)[i]
  
  a1 <- knitr::knit_expand(text = sprintf("\n### %s\n", paste("res = ", set.name, sep = ""))) # tab header
  a2 <- knitr::knit_expand(text = sprintf("\n```{r %s, message=FALSE, warning=FALSE, fig.width=12, fig.height=5}", 
                                          paste("clust_umap", i, sep = ""))) # start r chunk
  a3 <- knitr::knit_expand(text = sprintf("\nprint(plt.clust.ov[['%s']])",set.name2)) 
  a4 <- knitr::knit_expand(text = "\n```\n") # end r chunk
  
  paste(a1, a2, a3, a4, collapse = '\n') # collapse together all lines with newline separator
  
})

```

`r paste(knitr::knit(text = paste(out, collapse = '\n')))`

```{r pdf plt.umap_by_all_clusters }

try({
  for (i in 1:length(plt.clust.ov)){
    set.name <- gsub(assay.pattern, "", names(plt.clust.ov)[i])
    suffix = "resolution.pdf"
    plot.name <- paste0("M18_umap_", gsub(".", "_", set.name, fixed = T), suffix)
    savePDF(file.name = paste0(output.path, "PDF/", plot.name), plot.handle =  plt.clust.ov[[i]], 
            fig.width = 12, fig.height = 5, save.flag = parameter.list$save.pdf)
  }
}, silent = T)


```



Row {.tabset}
-------------------------------------

### Metrics
```{r opt stat, message=FALSE, warning=FALSE, fig.width=25, fig.height=5}

sil.success <- F
try({
  plt.silw.dep + labs(subtitle = "1 = dense/separated clusters; 0 = overlapping clusters") 
  sil.success <- T
}, silent = T)
if (!sil.success) plt.silw.dep <- NULL

plt.opt.stat <- cowplot::plot_grid( plt.silw.dep + geom_hline(yintercept = 0.6, linetype = "dashed") , 
                                    plt.cluster.purity + labs(subtitle = "1 = within-neighborhood clusters consistent (pure); 0 = impure"), 
                                    plt.auc.spec + labs(subtitle = "1 = specific DEG in all clusters; 0 = no specific DEGs"),
                                    plt.clust.n + labs(title = "Number of Clusters", subtitle = ""), 
                                     plt.deg.n + labs(title = "Minimum Number of DEGs", y = "Minimum N DEGs/cluster", subtitle = ""), nrow = 1, labels = c("C", "D", "E", "F", "G"), rel_widths = c(1,1,1,1,1))

print(plt.opt.stat)

try({
savePDF(file.name = paste0(output.path, "PDF/", "M18_optimization_metrics.pdf"), 
        plot.handle =  plt.opt.stat, 
         fig.width=25, fig.height=5, save.flag = parameter.list$save.pdf)
}, silent = T)

```


```{r plt.Silhouette, message=FALSE, warning=FALSE, fig.width=15, fig.height=5}

out <- lapply(seq_along(res.specific.list), function(i) {
  
  res.val <- gsub(assay.pattern, "", names(res.specific.list)[i])
  a1 <- knitr::knit_expand(text = sprintf("\n### %s\n", paste("res = ", res.val, sep = ""))) # tab header
  a2 <- knitr::knit_expand(text = sprintf("\n```{r %s, message=FALSE, warning=FALSE, fig.width=15, fig.height=5}", 
                                          paste("sil.plt", i, sep = ""))) # start r chunk
  a3 <- knitr::knit_expand(text = sprintf("\nprint(res.specific.list[[ names(res.specific.list)[%d]]])",i)) 
  a4 <- knitr::knit_expand(text = "\n```\n") # end r chunk
  paste(a1, a2, a3, a4, collapse = '\n') # collapse together all lines with newline separator
  
})

```

`r paste(knitr::knit(text = paste(out, collapse = '\n')))`

```{r pdf plt.Silhouette }

try({
  for (i in 1:length(res.specific.list)){
    res.val <- gsub(assay.pattern, "", names(res.specific.list)[i])
    plot.name <- paste0("M18_performance_metrics_", gsub(".", "_",res.val, fixed = T), "resolution.pdf")
    savePDF(file.name = paste0(output.path, "PDF/", plot.name), plot.handle =  res.specific.list[[i]], 
            fig.width = 15, fig.height = 5, save.flag = parameter.list$save.pdf)
  }
}, silent = T)

```


DEG Table
===================================== 


Sidebar {.sidebar}
-------------------------------------

**Description**: Differentially-expressed genes (DEG) across different cluster resolutions. Differential expression performed using wilcoxon and co-dependency tests.

**Definitions**:\
**feature**: Gene symbol\
**cluster**: Cluster name\
**logFC**: Log fold-change between gene expression within vs. outside of cluster.\
**auc**: Area under receiver operator curve; measures a gene's ability to discriminate specified cluster. AUC values range 0 to 1, where 0.5 represents classification performance equal to random chance, and 1 represents perfect cluster classification.\
**p_wilcox**: Nominal p value, wilcoxon test.\
**fdr_wilcox**: Benjamini-hochberg adjusted p-value (i.e. FDR), wilcoxon test.\
**cdi**: Codependency index\
**ncdi**: Normalized CDI\
**p_cdi**: Nominal p value, codependency test.\
**fdr_cdi**: Benjamini-hochberg adjusted p-value (i.e. FDR), codependency test.\
**pct_in**: Percentage of cells within cluster with non-zero gene expression.\
**pct_out**: Percentage of cells outside cluster with non-zero gene expression.\
**pct_dif**: Difference between pct_in and pct_out.\
**sensitivity**: Proportion of within-cluster cells that express gene (true positive rate).\
**specificity**: Proportion of outside-cluster cells that do not express gene (true negative rate).\
**PPV**: Positive predictive value\
**NPV**: Negative predictive value\
**denominator**: Denominator used to normalized CDI. Dependent on cluster size.\ 
**avgExpr**: Average cluster-level gene expression.\


Row {.tabset}
-------------------------------------


```{r detailed table output v2,  echo = FALSE, eval = TRUE, message=FALSE, warning=FALSE}

for (i in 1:length(top_markers_res.list)){
  # df.deg <- top_markers_res.list[[i]]
  
  df.deg.cur <- top_markers_res.list[[i]]
  
  df.deg.cur$pct_in <- df.deg.cur$pct_in
  
  df.deg.cur$sensitivity <- df.deg.cur$pct_in/((100-df.deg.cur$pct_in) + (df.deg.cur$pct_in))
  df.deg.cur$specificity <- (100-df.deg.cur$pct_out)/((100-df.deg.cur$pct_out) + (df.deg.cur$pct_out))
  df.deg.cur$PPV <-  df.deg.cur$pct_in/( df.deg.cur$pct_in + (df.deg.cur$pct_out))
  df.deg.cur$NPV <- (100-df.deg.cur$pct_out)/((100-df.deg.cur$pct_out) + (100-df.deg.cur$pct_in))
  
  set.stem <- paste0(assay.pattern, names(top_markers_res.list)[i], "_")
  cdi_result.cur <- cdi_result %>% dplyr::filter(grepl(set.stem, feature.x))
  cdi_result.cur$cluster <- paste0("c", stringr::str_remove(cdi_result.cur$feature.x, set.stem))
  colnames(cdi_result.cur) <- c("id", "feature", "cdi", "ncdi", "denominator", "p.cdi", "fdr.cdi", "group")
  df.deg <- merge(df.deg.cur, cdi_result.cur, all.x = T)
  
  field2signif <- c("avgExpr", "logFC", "auc", "pval", "padj", "pct_in", "pct_out", "pct_dif", "cdi", "ncdi", "denominator", "p.cdi", "fdr.cdi", "sensitivity", "specificity", "PPV", "NPV")
  field2signif <- field2signif[field2signif %in% colnames(df.deg)]
  df.deg[ ,field2signif] <- signif(df.deg[ ,field2signif], 3)
  
  df.deg <- df.deg %>% dplyr::select(c("feature", "group", "logFC", "auc", "pval", "padj", "cdi", "ncdi",  "p.cdi", "fdr.cdi", "pct_in", "pct_out", "pct_dif", "sensitivity", "specificity", "PPV", "NPV", "denominator","avgExpr"))
  colnames(df.deg) <- c("feature", "cluster",  "logFC", "auc", "p_wilcox", "fdr_wilcox", "cdi", "ncdi","p_cdi", "fdr_cdi", "pct_in", "pct_out", "pct_dif", "sensitivity", "specificity", "PPV", "NPV", "denominator", "avgExpr")
  top_markers_res.list[[i]] <- df.deg
}


out_heat <- lapply(seq_along(top_markers_res.list), function(i) {
  s1 <- paste("top_markers_res.list[[", i, "]]", sep = "")
  table.name <- paste("res=", names(top_markers_res.list)[i], "")
  s4 <- paste("datatable(", s1, ", 
    filter = 'top',
    extensions = 'Buttons',
    options = list(pageLength = 50,
    dom = 'Bfrtip', 
    buttons = c('copy', 'csv', 'pdf')))", sep = "")
  
  a1 <- knitr::knit_expand(text = sprintf("### %s\n", table.name))  # tab header
  a2 <- knitr::knit_expand(text = sprintf("\n```{r %s}", paste("detailed_tab_v2", i, sep = "")))               # start r chunk
  a3 <- knitr::knit_expand(text = sprintf("\n %s",s4)) 
  a4 <- knitr::knit_expand(text = "\n```\n") # end r chunk
  
  paste(a1, a2, a3, a4, collapse = '\n') # collapse together all lines with newline separator
  
})



```

`r paste(knitr::knit(text = paste(out_heat, collapse = '\n')))`

```{r csv cm2}

for (i in 1:length(top_markers_res.list)){
  table.name <- paste0("markerStatistics_", gsub(".", "_", names(top_markers_res.list)[i], fixed = T), "resolution.csv")
  
  if (parameter.list$save.pdf){
    write.csv(top_markers_res.list[[i]], file = paste0(output.path, "Tables/", table.name), 
    row.names = F)     
  }

}

```

```{r save analysis log and Rdata results, message=FALSE, warning=FALSE}

# Run time
end.time <- proc.time()
elapsed.time <- round((end.time - start.time)[[3]], 2)
df.log[nrow(df.log)+1, 1] <- as.character("Run Time (s)")
df.log[nrow(df.log), 2] <- as.character("elapsed.time")
df.log[nrow(df.log), 3] <- as.character(elapsed.time)

df.log <- addLogEntry("Run Identifier", run.id, df.log, "run.id")

if (parameter.list$developer){
  df.log <- addLogEntry("User", user, df.log, "user")
  df.log <- addLogEntry("Central Log Updated", clog.update.success, df.log, "clog.update.success")
}


df.log_Module_18 <- df.log



```

```{r ph10,  echo = FALSE, eval = TRUE, message=FALSE, warning=FALSE}

out1 <- lapply(seq_along(module.logs), function(i) {
  
  module.n <- as.numeric(gsub("[^\\d]+", "", module.logs[i], perl=TRUE))
  
  a1 <- knitr::knit_expand(text = sprintf("\nLog (Module %s)", paste(module.n)))
  a2 <- knitr::knit_expand(text = "\n=====================================")
  a3 <- knitr::knit_expand(text = sprintf("\n```{r %s}", paste("mod_", i, sep = ""))) # start r chunk
  a4<- knitr::knit_expand(text = sprintf("\nknitr::kable(%s)",module.logs[i])) 
  a5 <- knitr::knit_expand(text = "\n```\n") # end r chunk
  
  paste(a1, a2, a3, a4, a5, collapse = '\n') # collapse together all lines with newline separator
  
})


```

`r paste(knitr::knit(text = paste(out1, collapse = '\n')))`

Log (Module 18)
===================================== 

```{r table.log_current, message=FALSE, warning=FALSE}

knitr::kable(df.log_Module_18)

```

```{r save analysis log as csv}

try({
  if (parameter.list$developer){
  write.csv(df.log_Module_18, file = paste0(output.path, "Tables/", "analysisLog.csv"), 
    row.names = F)  
  }
}, silent = T)

```



System Info
=====================================

```{r}

pander::pander(sessionInfo())

```