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.

require(singleCellTK)
require(celda)
require(kableExtra)
require(grid)
require(knitr)
require(ggplot2)
require(gridExtra)
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

plotDimReduceCluster(sce, reducedDimName = reducedDimName, labelClusters = TRUE)

Sample Labels

plotSCEDimReduceColData(
  altExp(sce, altExpName),
  reducedDimName = reducedDimName,
  colorBy = "celda_sample_label",
  labelClusters = FALSE,
  dotSize = 0.5
)

Cell Annotations {.tabset .tabset-fade}

if (!is.null(cellAnnotFinal)) {
  for (i in seq_along(cellAnnotFinal)) {
    cat(sprintf(tab4, cellAnnotFinal[i]))

    if(isTRUE(plotLabels[i])) {
      conditionClass <- "factor"  
    } else {
      conditionClass <- NULL
    }

    print(
      plotSCEDimReduceColData(
        altExp(sce, altExpName),
        colorBy = cellAnnotFinal[i],
        conditionClass = conditionClass,
        reducedDim = reducedDimName,
        labelClusters = plotLabels[i],
        dotSize = 0.5
      )
    )
    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."
  )
}



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.

p2 <- moduleHeatmap(
  sce,
  topCells = NULL,
  displayName = displayName,
  moduleLabel = "All cells",
  useRaster = TRUE,
  returnAsList = TRUE
)
p3 <- moduleHeatmap(
  sce,
  topCells = 100,
  displayName = displayName,
  moduleLabel = "Top 100 cells",
  useRaster = TRUE,
  returnAsList = TRUE
)

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[[i]],
                    row = 2,
                    column = 1,
                    label = "")
  fig <- fill_panel(fig,
                    p3[[i]],
                    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.

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

table <- featureModuleTable(
    sce,
    useAssay = useAssay,
    altExpName = altExpName,
    displayName = displayName
  )
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,
    displayName = displayName,
    outputFile = moduleFileName
  )
}



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 features that contain the name of any marker may also be shown.

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 = features,
        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.



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.

print(celdaProbabilityMap(sce))

Session Information {.unnumbered}

sessionInfo()


campbio/celda documentation built on April 5, 2024, 11:47 a.m.