inst/doc/introduction.R

In tidyseurat: Brings Seurat to the Tidyverse

## ----include=FALSE------------------------------------------------------------
# Set path to plotly screenshot. We don't run the plotly code chunk as most servers do not have javascript libraries needed for interactive plotting
screenshot <- "../man/figures/plotly.png"

# The chunk below uses Rmd in man/fragments to avoid duplication, as the content is shared with the vignette and README. As suggested here: https://www.garrickadenbuie.com/blog/dry-vignette-and-readme/

visual_cue <- "../man/figures/logo_interaction-01.png"


## ----echo=FALSE, include=FALSE------------------------------------------------
library(knitr)
knitr::opts_chunk$set(warning = FALSE, message = FALSE)

## ----eval=FALSE---------------------------------------------------------------
# install.packages("tidyseurat")

## ----eval=FALSE---------------------------------------------------------------
# devtools::install_github("stemangiola/tidyseurat")

## -----------------------------------------------------------------------------
library(dplyr)
library(tidyr)
library(purrr)
library(magrittr)
library(ggplot2)
library(Seurat)
library(tidyseurat)

## -----------------------------------------------------------------------------
pbmc_small = SeuratObject::pbmc_small

## -----------------------------------------------------------------------------
pbmc_small

## -----------------------------------------------------------------------------
pbmc_small@assays

## -----------------------------------------------------------------------------
# Use colourblind-friendly colours
friendly_cols <- c("#88CCEE", "#CC6677", "#DDCC77", "#117733", "#332288", "#AA4499", "#44AA99", "#999933", "#882255", "#661100", "#6699CC")

# Set theme
my_theme <-
  list(
    scale_fill_manual(values = friendly_cols),
    scale_color_manual(values = friendly_cols),
    theme_bw() +
      theme(
        panel.border = element_blank(),
        axis.line = element_line(),
        panel.grid.major = element_line(size = 0.2),
        panel.grid.minor = element_line(size = 0.1),
        text = element_text(size = 12),
        legend.position = "bottom",
        aspect.ratio = 1,
        strip.background = element_blank(),
        axis.title.x = element_text(margin = margin(t = 10, r = 10, b = 10, l = 10)),
        axis.title.y = element_text(margin = margin(t = 10, r = 10, b = 10, l = 10))
      )
  )

## ----plot1--------------------------------------------------------------------
pbmc_small %>%
  ggplot(aes(nFeature_RNA, fill = groups)) +
  geom_histogram() +
  my_theme

## ----plot2--------------------------------------------------------------------
pbmc_small %>%
  ggplot(aes(groups, nCount_RNA, fill = groups)) +
  geom_boxplot(outlier.shape = NA) +
  geom_jitter(width = 0.1) +
  my_theme

## -----------------------------------------------------------------------------
pbmc_small %>%
  join_features(features = c("HLA-DRA", "LYZ"), shape = "long") %>%
  ggplot(aes(groups, .abundance_RNA + 1, fill = groups)) +
  geom_boxplot(outlier.shape = NA) +
  geom_jitter(aes(size = nCount_RNA), alpha = 0.5, width = 0.2) +
  scale_y_log10() +
  my_theme

## ----preprocess---------------------------------------------------------------
pbmc_small_pca <-
  pbmc_small %>%
  SCTransform(verbose = FALSE) %>%
  FindVariableFeatures(verbose = FALSE) %>%
  RunPCA(verbose = FALSE)

pbmc_small_pca

## ----pc_plot------------------------------------------------------------------
pbmc_small_pca %>%
  as_tibble() %>%
  select(contains("PC"), everything()) %>%
  GGally::ggpairs(columns = 1:5, ggplot2::aes(colour = groups)) +
  my_theme

## ----cluster------------------------------------------------------------------
pbmc_small_cluster <-
  pbmc_small_pca %>%
  FindNeighbors(verbose = FALSE) %>%
  FindClusters(method = "igraph", verbose = FALSE)

pbmc_small_cluster

## ----cluster count------------------------------------------------------------
pbmc_small_cluster %>%
  count(groups, seurat_clusters)

## ----markers_v3, eval=(packageVersion("Seurat") < package_version("4.0.0"))----
# # Identify top 10 markers per cluster
# markers <-
#   pbmc_small_cluster %>%
#   mutate(orig.ident = seurat_clusters) %>%
#   FindAllMarkers(only.pos = TRUE) %>%
#   group_by(cluster) %>%
#   top_n(10, avg_logFC)
# 
# # Plot heatmap
# pbmc_small_cluster %>%
#   DoHeatmap(
#     features = markers$gene,
#     group.colors = friendly_cols
#   )

## ----markers_v4, eval=FALSE---------------------------------------------------
# # Identify top 10 markers per cluster
# markers <-
#   pbmc_small_cluster %>%
#   FindAllMarkers(only.pos = TRUE, min.pct = 0.25, thresh.use = 0.25) %>%
#   group_by(cluster) %>%
#   top_n(10, avg_log2FC)
# 
# # Plot heatmap
# pbmc_small_cluster %>%
#   DoHeatmap(
#     features = markers$gene,
#     group.colors = friendly_cols
#   )

## ----umap, eval=FALSE---------------------------------------------------------
# pbmc_small_UMAP <-
#   pbmc_small_cluster %>%
#   RunUMAP(reduction = "pca", dims = 1:15, n.components = 3L)

## ----umap plot, eval=FALSE----------------------------------------------------
# pbmc_small_UMAP %>%
#   plot_ly(
#     x = ~`UMAP_1`,
#     y = ~`UMAP_2`,
#     z = ~`UMAP_3`,
#     color = ~seurat_clusters,
#     colors = friendly_cols[1:4]
#   )

## ----eval=FALSE---------------------------------------------------------------
# # Get cell type reference data
# blueprint <- celldex::BlueprintEncodeData()
# 
# # Infer cell identities
# cell_type_df <-
#   GetAssayData(pbmc_small_UMAP, slot = 'counts', assay = "SCT") %>%
#   log1p() %>%
#   Matrix::Matrix(sparse = TRUE) %>%
#   SingleR::SingleR(
#     ref = blueprint,
#     labels = blueprint$label.main,
#     method = "single"
#   ) %>%
#   as.data.frame() %>%
#   as_tibble(rownames = "cell") %>%
#   select(cell, first.labels)

## ----eval=FALSE---------------------------------------------------------------
# # Join UMAP and cell type info
# pbmc_small_cell_type <-
#   pbmc_small_UMAP %>%
#   left_join(cell_type_df, by = "cell")
# 
# # Reorder columns
# pbmc_small_cell_type %>%
#   select(cell, first.labels, everything())

## ----eval=FALSE---------------------------------------------------------------
# pbmc_small_cell_type %>%
#   count(seurat_clusters, first.labels)

## ----eval=FALSE---------------------------------------------------------------
# pbmc_small_cell_type %>%
# 
#   # Reshape and add classifier column
#   pivot_longer(
#     cols = c(seurat_clusters, first.labels),
#     names_to = "classifier", values_to = "label"
#   ) %>%
# 
#   # UMAP plots for cell type and cluster
#   ggplot(aes(UMAP_1, UMAP_2, color = label)) +
#   geom_point() +
#   facet_wrap(~classifier) +
#   my_theme

## ----eval=FALSE---------------------------------------------------------------
# pbmc_small_cell_type %>%
# 
#   # Add some mitochondrial abundance values
#   mutate(mitochondrial = rnorm(n())) %>%
# 
#   # Plot correlation
#   join_features(features = c("CST3", "LYZ"), shape = "wide") %>%
#   ggplot(aes(CST3 + 1, LYZ + 1, color = groups, size = mitochondrial)) +
#   geom_point() +
#   facet_wrap(~first.labels, scales = "free") +
#   scale_x_log10() +
#   scale_y_log10() +
#   my_theme

## ----eval=FALSE---------------------------------------------------------------
# pbmc_small_nested <-
#   pbmc_small_cell_type %>%
#   filter(first.labels != "Erythrocytes") %>%
#   mutate(cell_class = if_else(`first.labels` %in% c("Macrophages", "Monocytes"), "myeloid", "lymphoid")) %>%
#   nest(data = -cell_class)
# 
# pbmc_small_nested

## ----eval=FALSE---------------------------------------------------------------
# pbmc_small_nested_reanalysed <-
#   pbmc_small_nested %>%
#   mutate(data = map(
#     data, ~ .x %>%
#       FindVariableFeatures(verbose = FALSE) %>%
#       RunPCA(npcs = 10, verbose = FALSE) %>%
#       FindNeighbors(verbose = FALSE) %>%
#       FindClusters(method = "igraph", verbose = FALSE) %>%
#       RunUMAP(reduction = "pca", dims = 1:10, n.components = 3L, verbose = FALSE)
#   ))
# 
# pbmc_small_nested_reanalysed

## ----eval=FALSE---------------------------------------------------------------
# pbmc_small_nested_reanalysed %>%
# 
#   # Convert to tibble otherwise Seurat drops reduced dimensions when unifying data sets.
#   mutate(data = map(data, ~ .x %>% as_tibble())) %>%
#   unnest(data) %>%
# 
#   # Define unique clusters
#   unite("cluster", c(cell_class, seurat_clusters), remove = FALSE) %>%
# 
#   # Plotting
#   ggplot(aes(UMAP_1, UMAP_2, color = cluster)) +
#   geom_point() +
#   facet_wrap(~cell_class) +
#   my_theme

## ----eval=FALSE---------------------------------------------------------------
# pbmc_small %>%
#   aggregate_cells(groups, assays = "RNA")

## -----------------------------------------------------------------------------
sessionInfo()