---
title: "Celda_CG Results"
date: "`r format(Sys.time(), '%B %d, %Y')`"
params:
  sce: sce
  altExpName: altExpName
  useAssay: useAssay
  reducedDimName: reducedDimName
  features: features
  displayName: displayName
  cellAnnot: cellAnnot
  cellAnnotLabel: cellAnnotLabel
  exactMatch: exactMatch
  moduleFileName: moduleFileName
  pdf: pdf
  showSetup: showSetup
  showSession: showSession
output: 
 html_document:
     toc: true
     toc_float: true
     number_sections: true
     theme: cosmo
     code_folding: hide
---


# Celda_CG Results

## Setup
The following code loads required libraries, reads in parameters, checks input variables, and sets up display options for the **celda_CG Results** report.
```{r setup, echo = showSetup}
require(singleCellTK)
require(celda)
require(kableExtra)
require(grid)
require(knitr)
require(ggplot2)
require(multipanelfigure)
require(SingleCellExperiment)

sce <- params$sce
features <- params$features
altExpName <- params$altExpName
useAssay <- params$useAssay
reducedDimName <- params$reducedDimName
displayName <- params$displayName
cellAnnot <- params$cellAnnot
cellAnnotLabel <- params$cellAnnotLabel
exactMatch <- params$exactMatch
moduleFileName <- params$moduleFileName
pdf <- params$pdf
showSession <- params$showSession

cellAnnotFinal <- NULL
plotLabels <- c()
if (length(cellAnnot) > 0) {
  cellAnnotFinal <- c(cellAnnotFinal, cellAnnot)
  plotLabels <- c(plotLabels, rep(FALSE, length(cellAnnot)))
}
if (length(cellAnnotLabel) > 0) {
  cellAnnotFinal <- c(cellAnnotFinal, cellAnnotLabel)
  plotLabels <- c(plotLabels, rep(TRUE, length(cellAnnotLabel)))
}

if (!is.null(cellAnnotFinal)) {
  if (!all(cellAnnotFinal %in% colnames(colData(altExp(sce,
                                                       e = altExpName))))) {
    s <-
      setdiff(cellAnnotFinal, colnames(colData(altExp(sce, e = altExpName))))
    stop(
      "The following items in 'cellAnnot' or 'cellAnnotLabel' were not found ",
      "in the colData of the object: ",
      paste0(s, ",")
    )
  }
}

L <- max(as.integer(celdaModules(sce)))
K <- max(as.integer(celdaClusters(sce)))

# Define tab levels
tab3 <- "### %s {-}
"
tab4 <- "#### %s {-}
"
space <- "

"

markerHeight <- 9
if (!is.null(features)) {
  markerHeight <- max(9, 3 * (length(features) / 3))
}

dev <- ifelse(isTRUE(pdf), c("png", "pdf"), c("png"))
opts_chunk$set(
  echo = TRUE,
  cache = FALSE,
  cache.lazy = FALSE,
  cache.comments = FALSE,
  fig.align = "center",
  fig.keep = "all",
  dev = dev
)
```




## Visualization of cells in 2-D embeddings {.tabset .tabset-fade}
Reduced dimensional 2-D plots created by algorithms such as tSNE and UMAP are useful for visualizing the relationship between cells. Each point on the plot represents a single cell. Cells closer together on the plot have more similar expression profiles across all genes. The tabs below show the `r reducedDimName` dimensions colored by different variables. The *Cluster* tab colors cells by the `r K` subpopulation labels identified by celda_CG, The *Sample Labels* tab colors cells by the sample label supplied to celda_CG. If no sample label was supplied to celda_CG, then all cells will be the same color. The *Cell Annotations* tab contains colors points by other pre-specified cell-level annotations.

### Clusters
```{r celda_clusters, fig.height = 9, fig.width = 9}
plotDimReduceCluster(sce, reducedDimName = reducedDimName, labelClusters = TRUE)
```

### Sample Labels
```{r celda_samples, fig.height = 9, fig.width = 9}
plotSCEDimReduceColData(
  altExp(sce),
  reducedDimName = reducedDimName,
  colorBy = "celda_sample_label",
  labelClusters = FALSE
)
```


### Cell Annotations {.tabset .tabset-fade}

```{r celda_cellAnnot, results = "asis", fig.height = 9, fig.width = 10}
if (!is.null(cellAnnotFinal)) {
  for (i in seq_along(cellAnnotFinal)) {
    cat(sprintf(tab4, cellAnnotFinal[i]))

    conditionClass <- ifelse(plotLabels[i], "factor", "numeric")

    print(
      plotSCEDimReduceColData(
        altExp(sce),
        sample = sce$sample,
        colorBy = cellAnnotFinal[i],
        conditionClass = conditionClass,
        reducedDim = reducedDimName,
        labelClusters = plotLabels[i]
      )
    )
    cat(space)
  }
} else {
  message(
    "No cell annotations are displayed. To plot cell annotations in this ",
    "section, you can pass the desired variables from the `colData` in the ",
    "SingleCellExperiment object via the 'cellAnnot' or 'cellAnnotLabel' ",
    "parameters."
  )
}
```

<br><br>

## Modules {.tabset .tabset-fade}
Celda performs bi-clustering of features into modules and cells into subpopulations.  Modules are groups of genes that are co-expressed across cells. The *Module Overview* tab contains the probabilities and heatmaps for each module. Module probability plots will color cells by the probability of each module on a 2-D embedding plot. Module heatmaps show the relative expression for the features in a module across the cells. Cells within the heatmap will be ordered from the lowest to highest probability of the module. The *Module Table* tab contains a complete table of all features in each module. 

### Module Overview {.tabset .tabset-fade}

Use the tabs to select modules ranging from 1 to `r L`. Module probabilities on the 2-D embedding are scaled to range between 0 and 1. Each column on the heatmap represents a cell and each row represents a feature. Expression values for each feature are z-scored normalized across all cells after normalization. Red represents higher relative expression and blue represents lower relative expression. All cells are shown in the heatmap on the left. Only the top 100 cells with the lowest module probability and the 100 cells with the highest module probability are shown in the heatmap on the right. The column color bar displays the population assignment for each cell. 

```{r celda_module_heatmaps, results = "asis", fig.height = 15, fig.width = 10}
fig.list <- list()
for (i in seq_len(L)) {
  p1 <- plotDimReduceModule(
    sce,
    reducedDimName = reducedDimName,
    useAssay = useAssay,
    altExpName = altExpName,
    modules = i
  )
  p2 <- moduleHeatmap(
    sce,
    featureModule = i,
    topCells = NULL,
    displayName = displayName,
    moduleLabel = "All cells",
    useRaster = TRUE
  )
  p3 <- moduleHeatmap(
    sce,
    featureModule = i,
    topCells = 100,
    displayName = displayName,
    moduleLabel = "Top 100 cells",
    useRaster = TRUE
  )

  fig <- multi_panel_figure(rows = 2,
                            columns = 2,
                            figure_name = paste0("fig", i))

  fig <- fill_panel(fig,
                    p1,
                    row = 1,
                    column = 1:2,
                    label = "")
  fig <- fill_panel(fig,
                    p2,
                    row = 2,
                    column = 1,
                    label = "")
  fig <- fill_panel(fig,
                    p3,
                    row = 2,
                    column = 2,
                    label = "")
  fig.list[[i]] <- fig
}
for (i in seq_len(L)) {
  cat(sprintf(tab4, paste0("L", i)))
  print(fig.list[[i]])
  cat(space)
}
```

### Module Probability Summary {.tabset .tabset-fade}

Celda orders modules by hierarchical clustering and so modules with similar numbers will have more somewhat more similar expression patterns across cells. Module probability plots are shown for groups of modules in each tab to allow for a quick exploration of these patterns across cells. 

```{r celda_module_tabs, results = "asis", fig.height = 9, fig.width = 10}
grids <- seq(0, L, by = 16)
if (tail(grids, 1) != L) {
  grids <- c(grids, L)
}

for (i in seq.int(1, length(grids) - 1)) {
  modules <- seq(grids[i] + 1, grids[i + 1])
  if (length(modules) > 1) {
    label <- paste0("L", modules[1], "-", "L", modules[length(modules)])
  } else {
    label <- paste0("L", modules[1])
  }
  cat(sprintf(tab4, label))
  print(
    plotDimReduceModule(
      sce,
      reducedDimName = reducedDimName,
      useAssay = useAssay,
      altExpName = altExpName,
      ncol = 4,
      modules = modules
    )
  )
  cat(space)
}
```


### Module Table
This section displays a table of features in each module and can be used as a quick way to lookup features of interest. The features within each module are ordered from those with highest expression at the top to those with lower expression at the bottom (same as in the heatmaps in the previous tab).

```{r celda_modules_table}
table <- featureModuleTable(sce)
kable(table, style = "html", row.names = FALSE) %>%
  kable_styling(bootstrap_options = "striped") %>%
  scroll_box(width = "100%", height = "800px")

if (!is.null(moduleFileName)) {
  featureModuleTable(
    sce,
    useAssay = useAssay,
    altExpName = altExpName,
    outputFile = moduleFileName
  )
}
```

<br><br>

## Expression of pre-selected markers {.tabset .tabset-fade}
Relative expression profiles are shown for features that match: **`r features`**. The parameter `exactMatch` is set to  ```r exactMatch```. If this parameter was set to ```FALSE```, then  additional featuers that contain the name of any marker may also be shown.

```{r plot_markers, fig.height = markerHeight, fig.width = 12}
if (!is.null(features)) {
  ix <- retrieveSCEIndex(
    inSCE = sce,
    IDs = features,
    axis = "row",
    by = displayName,
    exactMatch = exactMatch
  )
  if (length(ix) > 0) {
    print(
      plotDimReduceFeature(
        sce,
        reducedDimName = "celda_UMAP",
        features = rownames(sce)[ix],
        displayName = displayName,
        colorHigh = "red",
        colorMid = "grey",
        colorLow = "blue",
        ncol = 3
      )
    )
  } else {
    message("No matching markers were found.")
  }
} else {
  message("No features were supplied.")
}
```


## Overview Heatmaps {.tabset}
Overview heatmaps can be used to visualize the relationship between modules and cell populations at high level.

<br><br>

### Probability Map
The probability matrix on the left contains the probability of each module within each cell subpopulation. This matrix can be used to gain insights into the absolute abundance of each module within a cell subpopulation. Modules with higher probability have a higher overall expression level compared to other modules within the same cell population. The relative probability heatmap on the right is produced by taking the z-score of the module probabilities across cell subpopulations. Examining the relative abundance can be useful for finding modules that exhibit specific patterns across cell populations even if they have an overall lower absolute probability compared to other modules.
```{r celda_probability_map, echo = TRUE, eval = TRUE, fig.height = 20, fig.width = 10}
print(celdaProbabilityMap(sce))
```

### Overview Heatmap
This general heatmap shows the actual relative expression of the
top 10 features in each module (rows) for each cell (columns). Rows are z-score
normalized. The columns of the heatmap are semi-supervised by cell population and the rows are semi-supervised by module. 
```{r celda_heatmap, fig.height = 15, fig.width = 9}
grid.draw(celdaHeatmap(sce, nfeatures = 10))
```

## Session Information
```{r session, eval = showSession, echo = showSession}
sessionInfo()
```

<br><br>
