🤩 Seurat | 空间转录组数据分析的标准流程！~（六）（小肠示例-瑞士卷）

生信漫卷

发布于 2025-11-13 18:30:08

1210

文章被收录于专栏：R语言及实用科研软件R语言及实用科研软件

写在前面

这期我们上新一个小肠瑞士卷🍥实战：基于 Visium HD（FFPE）的空间转录组。

用Seurat跑一遍从数据解包 → 读入（8 µm bin）→ 标准预处理 → Sketch 下采样聚类 → 全量映射 → 结构域/标记基因可视化的教科书流程。

为什么选小肠？:👇

因为瑞士卷组织天然带有强序列化的空间轴（隐窝–绒毛），非常适合展示空间分层与功能带的转变；而 FFPE数据又更贴近临床样本的真实场景。😍

你只需替换为自己的Visium HD（FFPE或Fresh/Fixed Frozen）数据和基因列表，就能快速产出一套图文结果（UMAP、空间分群、热点基因热图等）。🥳

代码保持先小样本建模（Sketch）→ 再全量投影（ProjectData）的思路，在保证结构信息不丢的前提下，大幅节省计算时间。⌚️

用到的包

rm(list = ls())
library(Seurat)
library(ggplot2)
library(patchwork)
library(dplyr)
if (!requireNamespace("spacexr", quietly = TRUE)) {
  devtools::install_github("dmcable/spacexr", build_vignettes = FALSE)
}
library(spacexr)

示例数据

今天用到的是小鼠肠道的（FFPE）的Visium HD数据集。😏

我们要基于sketch无监督聚类分群，可视化空间位置，TOP基因表达可视化。🥸

来展示好看的瑞士卷吧！~😀

untar("./visium_hd/mouse_intestine/Visium_HD_Mouse_Small_Intestine_binned_outputs.tar.gz",exdir = "./visium_hd/mouse_intestine/")
untar("./visium_hd/mouse_intestine/Visium_HD_Mouse_Small_Intestine_spatial.tar.gz", exdir = "./visium_hd/mouse_intestine/")

bin.size我们设置8um，和我们之前的一样。🚀

localdir <- "./visium_hd/mouse_intestine/"
object <- Load10X_Spatial(data.dir = localdir, bin.size = 8)

标准处理

DefaultAssay(object) <- "Spatial.008um"
object <- NormalizeData(object)
object <- FindVariableFeatures(object)
object <- ScaleData(object)

Sketch

这里用到Sketch抽样，缩短我们的计算时间，可以参看上一章。🥳

object <- SketchData(
  object = object,
  ncells = 5000,
  method = "LeverageScore",
  sketched.assay = "sketch"
)

然后基于sketch的Assay进行标准流程。😂

DefaultAssay(object) <- "sketch"
object <- FindVariableFeatures(object)
object <- ScaleData(object)
object <- RunPCA(object, assay = "sketch", reduction.name = "pca.sketch")
object <- FindNeighbors(object, assay = "sketch", reduction = "pca.sketch", dims = 1:50)
object <- FindClusters(object, cluster.name = "seurat_cluster.sketched", resolution = 3)
object <- RunUMAP(object, reduction = "pca.sketch", reduction.name = "umap.sketch", return.model = T, dims = 1:50)

映射到整个data

现在我们映射到原来的整个data上。🐶

object <- ProjectData(
  object = object,
  assay = "Spatial.008um",
  full.reduction = "full.pca.sketch",
  sketched.assay = "sketch",
  sketched.reduction = "pca.sketch",
  umap.model = "umap.sketch",
  dims = 1:50,
  refdata = list(seurat_cluster.projected = "seurat_cluster.sketched")
)

我们现在做一下基础可视化！~🥳

Idents(object) <- "seurat_cluster.projected"
DefaultAssay(object) <- "Spatial.008um"

p1 <- DimPlot(object, reduction = "umap.sketch", label = F) + theme(legend.position = "bottom")
p2 <- SpatialDimPlot(object, label = F) + theme(legend.position = "bottom")
p1 | p2

看一下分群的在"瑞士卷"上的位置吧。😍

Idents(object) <- "seurat_cluster.projected"
cells <- CellsByIdentities(object, idents = c(1, 5, 18, 26))
p <- SpatialDimPlot(object, cells.highlight = cells[setdiff(names(cells), "NA")], cols.highlight = c("#FFFF00", "grey50"), facet.highlight = T, combine = T) + NoLegend()
p

看一下分群的Top marker。😏

DefaultAssay(object) <- "Spatial.008um"
Idents(object) <- "seurat_cluster.projected"
object_subset <- subset(object, cells = Cells(object[["Spatial.008um"]]), downsample = 1000)

DefaultAssay(object_subset) <- "Spatial.008um"
Idents(object_subset) <- "seurat_cluster.projected"
object_subset <- BuildClusterTree(object_subset, assay = "Spatial.008um", reduction = "full.pca.sketch", reorder = T)

markers <- FindAllMarkers(object_subset, assay = "Spatial.008um", only.pos = TRUE)
markers %>%
  group_by(cluster) %>%
  dplyr::filter(avg_log2FC > 1) %>%
  slice_head(n = 5) %>%
  ungroup() -> top5

object_subset <- ScaleData(object_subset, assay = "Spatial.008um", features = top5$gene)
p <- DoHeatmap(object_subset, assay = "Spatial.008um", features = top5$gene, size = 2.5) + theme(axis.text = element_text(size = 5.5)) + NoLegend()
p