inst/doc/PRECAST.BreastCancer.R

In PRECAST: Embedding and Clustering with Alignment for Spatial Datasets

## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  tidy = TRUE,
  fig.width = 11,
  tidy.opts = list(width.cutoff = 95),
  message = FALSE,
  warning = FALSE,
  time_it = TRUE
)
all_times <- list()  # store the time for each chunk
knitr::knit_hooks$set(time_it = local({
  now <- NULL
  function(before, options) {
    if (before) {
      now <<- Sys.time()
    } else {
      res <- difftime(Sys.time(), now, units = "secs")
      all_times[[options$label]] <<- res
    }
  }
}))

## ----eval=FALSE---------------------------------------------------------------
#  githubURL <- "https://github.com/feiyoung/PRECAST/blob/main/vignettes_data/bc2.rda?raw=true"
#  download.file(githubURL,"bc2.rda",mode='wb')

## ----eval =  FALSE------------------------------------------------------------
#  load("bc2.rda")

## ----eval=  FALSE-------------------------------------------------------------
#  dir.file <- "Section" ## the folders Section1 and Section2, and each includes two folders spatial and filtered_feature_bc_matrix
#  seuList <- list()
#  for (r in 1:2) {
#    message("r = ", r)
#    seuList[[r]] <- DR.SC::read10XVisium(paste0(dir.file, r))
#  }
#  bc2 <- seuList

## ----eval =  FALSE------------------------------------------------------------
#  library(PRECAST)
#  library(Seurat)

## ----eval =  FALSE------------------------------------------------------------
#  bc2 ## a list including two Seurat object

## ----eval =  FALSE------------------------------------------------------------
#  head(bc2[[1]])

## ----eval= FALSE--------------------------------------------------------------
#  ## Get the gene-by-spot read count matrices
#  ## countList <- lapply(bc2, function(x) x[["RNA"]]@counts)
#  countList <- lapply(bc2, function(x){
#    assay <- DefaultAssay(x)
#    GetAssayData(x, assay = assay, slot='counts')
#  
#  } )
#  
#  M <- length(countList)
#  ## Get the meta data of each spot for each data batch
#  metadataList <- lapply(bc2, function(x) x@meta.data)
#  
#  for(r in 1:M){
#    meta_data <- metadataList[[r]]
#    all(c("row", "col") %in% colnames(meta_data)) ## the names are correct!
#    head(meta_data[,c("row", "col")])
#  }
#  
#  
#  ## ensure the row.names of metadata in metaList are the same as that of colnames count matrix in countList
#  
#  for(r in 1:M){
#    row.names(metadataList[[r]]) <- colnames(countList[[r]])
#  }
#  
#  
#  ## Create the Seurat list  object
#  
#  seuList <- list()
#  for(r in 1:M){
#    seuList[[r]] <- CreateSeuratObject(counts = countList[[r]], meta.data=metadataList[[r]], project = "BreastCancerPRECAST")
#  }
#  
#  bc2 <- seuList
#  rm(seuList)
#  head(meta_data[,c("row", "col")])

## ----eval =  FALSE------------------------------------------------------------
#  ## Create PRECASTObject.
#  set.seed(2022)
#  PRECASTObj <- CreatePRECASTObject(bc2, project = 'BC2', gene.number = 2000, selectGenesMethod = 'SPARK-X', premin.spots = 20,  premin.features=20, postmin.spots = 1, postmin.features = 10)
#  
#  ## User can retain the raw seuList by the following commond.
#  ##  PRECASTObj <-  CreatePRECASTObject(seuList, customGenelist=row.names(seuList[[1]]), rawData.preserve = TRUE)

## ----eval =  FALSE------------------------------------------------------------
#  ## check the number of genes/features after filtering step
#  PRECASTObj@seulist
#  
#  ## seuList is null since the default value `rawData.preserve` is FALSE.
#  PRECASTObj@seuList
#  
#  ## Add adjacency matrix list for a PRECASTObj object to prepare for PRECAST model fitting.
#  PRECASTObj <-  AddAdjList(PRECASTObj, platform = "Visium")
#  
#  ## Add a model setting in advance for a PRECASTObj object. verbose =TRUE helps outputing the information in the algorithm.
#  PRECASTObj <- AddParSetting(PRECASTObj, Sigma_equal=FALSE, verbose=TRUE, maxIter=30)
#  

## ----eval =  FALSE------------------------------------------------------------
#  ### Given K
#  PRECASTObj <- PRECAST(PRECASTObj, K=14)
#  

## ----eval =  FALSE------------------------------------------------------------
#  ## backup the fitting results in resList
#  resList <- PRECASTObj@resList
#  PRECASTObj <- SelectModel(PRECASTObj)
#  

## ----eval =  FALSE------------------------------------------------------------
#  print(PRECASTObj@seuList)
#  seuInt <- IntegrateSpaData(PRECASTObj, species='Human')
#  seuInt
#  ## The low-dimensional embeddings obtained by PRECAST are saved in PRECAST reduction slot.

## ----eval =FALSE--------------------------------------------------------------
#  ## assign the raw Seurat list object to it
#  ## For illustration, we generate a new seuList with more genes;
#  ## For integrating all genes, users can set `seuList <- bc2`.
#  genes <- c(row.names(PRECASTObj@seulist[[1]]), row.names(bc2[[1]])[1:10])
#  seuList <- lapply(bc2, function(x) x[genes,])
#  PRECASTObj@seuList <- seuList #
#  seuInt <- IntegrateSpaData(PRECASTObj, species='Human')
#  seuInt

## ----eval =FALSE--------------------------------------------------------------
#  PRECASTObj@seuList <- NULL
#  ## At the same time, we can set subsampling to speed up the computation.
#  seuInt <- IntegrateSpaData(PRECASTObj, species='Human', seuList=seuList, subsample_rate = 0.5)
#  seuInt

## ----eval =  FALSE------------------------------------------------------------
#  cols_cluster <- chooseColors(palettes_name = 'Classic 20', n_colors=14, plot_colors = TRUE)

## ----eval =  FALSE, fig.height = 4, fig.width=9-------------------------------
#  
#  p12 <- SpaPlot(seuInt, item='cluster', batch=NULL,point_size=1, cols=cols_cluster, combine=TRUE, nrow.legend=7)
#  p12
#  # users can plot each sample by setting combine=FALSE

## ----eval =  FALSE, fig.height = 4, fig.width=8.5-----------------------------
#  pList <- SpaPlot(seuInt, item='cluster', batch=NULL,point_size=1, cols=cols_cluster, combine=FALSE, nrow.legend=7)
#  drawFigs(pList, layout.dim = c(1,2), common.legend = TRUE, legend.position = 'right', align='hv')
#  

## ----eval =  FALSE, fig.height = 4, fig.width=5.5-----------------------------
#  seuInt <- AddUMAP(seuInt)
#  p13 <- SpaPlot(seuInt, batch=NULL,item='RGB_UMAP',point_size=2, combine=TRUE, text_size=15)
#  p13
#  #seuInt <- AddTSNE(seuInt)
#  #SpaPlot(seuInt, batch=NULL,item='RGB_TSNE',point_size=2, combine=T, text_size=15)

## ----eval =  FALSE, fig.height = 4.5, fig.width=12----------------------------
#  seuInt <- AddTSNE(seuInt, n_comp = 2)
#  p1 <- dimPlot(seuInt, item='cluster', point_size = 0.5, font_family='serif', cols=cols_cluster,border_col="gray10", nrow.legend=14, legend_pos='right') # Times New Roman
#  p2 <- dimPlot(seuInt, item='batch', point_size = 0.5,  font_family='serif', legend_pos='right')
#  
#  drawFigs(list(p1, p2), layout.dim = c(1,2), legend.position = 'right', align='hv')
#  

## ----eval =  FALSE------------------------------------------------------------
#  library(Seurat)
#  dat_deg <- FindAllMarkers(seuInt)
#  library(dplyr)
#  n <- 10
#  dat_deg %>%
#    group_by(cluster) %>%
#    top_n(n = n, wt = avg_log2FC) -> top10
#  
#  seuInt <- ScaleData(seuInt)
#  seus <- subset(seuInt, downsample = 400)
#  
#  

## ----eval =  FALSE, fig.height = 8, fig.width=9-------------------------------
#  color_id <- as.numeric(levels(Idents(seus)))
#  library(ggplot2)
#  ## HeatMap
#  p1 <- doHeatmap(seus, features = top10$gene, cell_label= "Domain",
#                  grp_label = F, grp_color = cols_cluster[color_id],
#                  pt_size=6,slot = 'scale.data') +
#    theme(legend.text = element_text(size=10),
#          legend.title = element_text(size=13, face='bold'),
#          axis.text.y = element_text(size=5, face= "italic", family='serif'))
#  p1

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