Seurat Dimplot函数学习总结

已于 2024-05-21 07:45:34 修改
阅读量434 收藏 10
点赞数 5
文章标签： R
于 2024-05-21 02:04:25 首次发布
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/qq_45759229/article/details/139078539
版权

今天为了画这个cluster中怎么显示标签的图，研究了一个Seurat中怎么画这个图的，下面是学习过程中做的总结

运行例子

rm(list=ls())
library(Seurat)
library(SeuratData)
library(ggplot2)
library(patchwork)
pbmc3k.final <- LoadData("pbmc3k", type = "pbmc3k.final")
#print(DimPlot(pbmc3k.final,label = TRUE, repel = TRUE))

# remove the legend
p=DimPlot(pbmc3k.final,label = TRUE, repel = TRUE)+theme(legend.position = "none")
print(p)

结果如下
在这里插入图片描述这个就是我想要达到的效果，把类别的标签放在类的中心显示，但是这个是Seurat包自己实现的，我要做的事就是把Seurat包的这个Dimplot函数给抽出来，变成自己的ggplot函数

调试

在这里插入图片描述其中核心部分是下面两个函数
在这里插入图片描述一个是SingleDimPlot函数, 另一个是LabelClusters函数，

首先发现Dimplot函数会进入函数SingleDimPlot函数，其函数实现如下
在这里插入图片描述虽然这个函数看起来很复杂，其实大部分都是在判断条件，所以对于自己的需求而言，很多代码可以全删了，经过SingleDimPlot函数后，画出来的效果如图
在这里插入图片描述可以看到，此时这个结果只是普普通通的ggplot画图，所以调整图例到细胞的类别中是在LabelClusters函数里, 其中LabelClusters函数实现如下
在这里插入图片描述
这个函数也是很多条件的，其实核心代码就那么几行, 大致看完这个代码之后，可以着手删代码来

自己实现

将Seurat对象转化到画图的csv文件

在这里插入图片描述

write.csv(data,file="./pbmc_UMAP.csv")

在这里插入图片描述

这里其实有一个问题，就是当把Seurat对象存成csv文件，然后再读入时，有些变量的格式是改变的，最常见的就是因子factor类型和chacracter类型，这个一定要注意，否则很容易出错, 比如在Seurat中，data的ident列是因子类型的
在这里插入图片描述当我把pbmc_UMAP.csv重新读取进来时，该数据框各列的类型如下
在这里插入图片描述可以看到，我重新读取进来的文件的ident列变成了character类型，这一点一定要多加注意，下面的代码也说明了这一点，需要额外进行类型转换

简化代码1

rm(list=ls())
setwd("/Users/yxk/Desktop/test/Seurat_label测试/")
suppressPackageStartupMessages(library(ggplot2))
suppressPackageStartupMessages(library(cowplot))
suppressPackageStartupMessages(library(ggrepel))

data = read.csv("./pbmc_UMAP.csv",row.names = 1) # 相当于python里面的index
plot <- ggplot(data = data)

col.by ="ident"

plot = plot + geom_point(mapping = aes_string(x = "UMAP_1", 
      y = "UMAP_2", color = paste0("`", col.by, "`"), shape = NULL, 
      alpha = NULL), size = 0.6000758)

plot <- plot + guides(color = guide_legend(override.aes = list(size = 3))) + 
labs(color = NULL, title = col.by) 

plot <- plot + theme_cowplot()
print(plot)


# clusters这个是有问题的
LabelClusters = function(plot, id, clusters = NULL, labels = NULL, split.by = NULL, 
  repel = TRUE, box = FALSE, geom = "GeomPoint", position = "median", 
  ...) 
{
#   xynames <- unlist(x = GetXYAesthetics(plot = plot, geom = geom), 
#     use.names = TRUE)
  xynames=c("UMAP_1","UMAP_2")
  names(xynames)=c("x","y")
  if (!id %in% colnames(x = plot$data)) {
    stop("Cannot find variable ", id, " in plotting data")
  }
  if (!is.null(x = split.by) && !split.by %in% colnames(x = plot$data)) {
    warning("Cannot find splitting variable ", id, " in plotting data")
    split.by <- NULL
  }
  data <- plot$data[, c(xynames, id, split.by)]
  possible.clusters <- as.character(x = na.omit(object = unique(x = data[, 
    id])))
  groups <- possible.clusters
    
  if (any(!groups %in% possible.clusters)) {
    stop("The following clusters were not found: ", paste(groups[!groups %in% 
      possible.clusters], collapse = ","))
  }
  pb <- ggplot_build(plot = plot)
  if (geom == "GeomSpatial") {
    xrange.save <- layer_scales(plot = plot)$x$range$range
    yrange.save <- layer_scales(plot = plot)$y$range$range
    data[, xynames["y"]] = max(data[, xynames["y"]]) - data[, 
      xynames["y"]] + min(data[, xynames["y"]])
    if (!pb$plot$plot_env$crop) {
      y.transform <- c(0, nrow(x = pb$plot$plot_env$image)) - 
        pb$layout$panel_params[[1]]$y.range
      data[, xynames["y"]] <- data[, xynames["y"]] + sum(y.transform)
    }
  }
  data <- cbind(data, color = pb$data[[1]][[1]])
  labels.loc <- lapply(X = groups, FUN = function(group) {
    data.use <- data[data[, id] == group, , drop = FALSE]
    data.medians <- if (!is.null(x = split.by)) {
      do.call(what = "rbind", args = lapply(X = unique(x = data.use[, 
        split.by]), FUN = function(split) {
        medians <- apply(X = data.use[data.use[, split.by] == 
          split, xynames, drop = FALSE], MARGIN = 2, 
          FUN = median, na.rm = TRUE)
        medians <- as.data.frame(x = t(x = medians))
        medians[, split.by] <- split
        return(medians)
      }))
    }
    else {
      as.data.frame(x = t(x = apply(X = data.use[, xynames, 
        drop = FALSE], MARGIN = 2, FUN = median, na.rm = TRUE)))
    }
    data.medians[, id] <- group
    data.medians$color <- data.use$color[1]
    return(data.medians)
  })
  if (position == "nearest") {
    labels.loc <- lapply(X = labels.loc, FUN = function(x) {
      group.data <- data[as.character(x = data[, id]) == 
        as.character(x[3]), ]
      nearest.point <- nn2(data = group.data[, 1:2], query = as.matrix(x = x[c(1, 
        2)]), k = 1)$nn.idx
      x[1:2] <- group.data[nearest.point, 1:2]
      return(x)
    })
  }
  labels.loc <- do.call(what = "rbind", args = labels.loc)
#   labels.loc[, id] <- factor(x = labels.loc[, id], levels = levels(data[, 
#     id]))
  labels.loc$'ident'= as.factor(labels.loc$'ident') 
    
  labels <-  groups
  if (length(x = unique(x = labels.loc[, id])) != length(x = labels)) {
    stop("Length of labels (", length(x = labels), ") must be equal to the number of clusters being labeled (", 
      length(x = labels.loc), ").")
  }
  names(x = labels) <- groups
  for (group in groups) {
    labels.loc[labels.loc[, id] == group, id] <- labels[group]
  }
  #print(labels.loc)
  if (box) {
    geom.use <- ifelse(test = repel, yes = geom_label_repel, 
      no = geom_label)
    plot <- plot + geom.use(data = labels.loc, mapping = aes_string(x = xynames["x"], 
      y = xynames["y"], label = id, fill = id), show.legend = FALSE, 
      ...) + scale_fill_manual(values = labels.loc$color[order(labels.loc[, 
      id])])
  }
  else {
    geom.use <- ifelse(test = repel, yes = geom_text_repel, 
      no = geom_text)
    plot <- plot + geom.use(data = labels.loc, mapping = aes_string(x = xynames["x"], 
      y = xynames["y"], label = id), show.legend = FALSE, 
      ...)
  }
  if (geom == "GeomSpatial") {
    plot <- suppressMessages(expr = plot + coord_fixed(xlim = xrange.save, 
      ylim = yrange.save))
  }
  #print(plot)
  return(plot)
}

plot <- LabelClusters(plot = plot, id = "ident", repel = TRUE, 
  size = 4, split.by = NULL, box = FALSE, 
  color = "black")

print(plot)

结果如下
在这里插入图片描述
在这里插入图片描述

简化代码2

rm(list=ls())
setwd("/Users/yxk/Desktop/test/Seurat_label测试/")
suppressPackageStartupMessages(library(ggplot2))
suppressPackageStartupMessages(library(cowplot))
suppressPackageStartupMessages(library(ggrepel))

data = read.csv("./pbmc_UMAP.csv",row.names = 1) # 相当于python里面的index

plot <- ggplot(data = data)

col.by ="ident"
plot = plot + geom_point(mapping = aes_string(x = "UMAP_1", 
                                              y = "UMAP_2", color = paste0("`", col.by, "`"), shape = NULL, 
                                              alpha = NULL), size = 0.6000758)

plot <- plot + guides(color = guide_legend(override.aes = list(size = 3))) + 
  labs(color = NULL, title = col.by) 

plot <- plot + theme_cowplot()
print(plot)


LabelClusters = function(plot, id, clusters = NULL, labels = NULL, split.by = NULL, 
                         repel = TRUE, box = FALSE, geom = "GeomPoint", position = "median", 
                         ...) 
{
  #   xynames <- unlist(x = GetXYAesthetics(plot = plot, geom = geom), 
  #     use.names = TRUE)
  xynames=c("UMAP_1","UMAP_2")
  names(xynames)=c("x","y")
  data <- plot$data[, c(xynames, id, split.by)]
  possible.clusters <- as.character(x = na.omit(object = unique(x = data[, id])))
  groups <- possible.clusters
  pb <- ggplot_build(plot = plot)
  data <- cbind(data, color = pb$data[[1]][[1]])
  labels.loc <- lapply(X = groups, FUN = function(group) {
    data.use <- data[data[, id] == group, , drop = FALSE]
    data.medians <- as.data.frame(x = t(x = apply(X = data.use[, xynames, drop = FALSE], MARGIN = 2, FUN = median, na.rm = TRUE)))
    
    data.medians[, id] <- group
    data.medians$color <- data.use$color[1]
    return(data.medians)
  })
  labels.loc <- do.call(what = "rbind", args = labels.loc)
  #labels.loc[, id] <- factor(x = labels.loc[, id], levels = levels(data[,  id]))
  labels.loc$'ident'= as.factor(labels.loc$'ident')
  
  labels <-  groups

  names(x = labels) <- groups
  for (group in groups) {
    labels.loc[labels.loc[, id] == group, id] <- labels[group]
  }
  #print(labels.loc)

  geom.use <- ifelse(test = repel, yes = geom_text_repel, 
                     no = geom_text)
  plot <- plot + geom.use(data = labels.loc, mapping = aes_string(x = xynames["x"], 
                                                                  y = xynames["y"], label = id), show.legend = FALSE,  ...)
  return(plot)
}

plot <- LabelClusters(plot = plot, id = "ident", repel = TRUE, 
                      size = 4, split.by = NULL, box = FALSE, 
                      color = "black")

print(plot)

结果如下
在这里插入图片描述

简化代码3

 rm(list=ls())
setwd("/Users/yxk/Desktop/test/Seurat_label测试/")
suppressPackageStartupMessages(library(ggplot2))
suppressPackageStartupMessages(library(cowplot))
suppressPackageStartupMessages(library(ggrepel))

data = read.csv("./pbmc_UMAP.csv",row.names = 1) # 相当于python里面的index
plot <- ggplot(data = data)
col.by ="ident"
plot = plot + geom_point(mapping = aes_string(x = "UMAP_1", 
                                              y = "UMAP_2", color = paste0("`", col.by, "`"), shape = NULL, 
                                              alpha = NULL), size = 0.6000758)

plot <- plot + guides(color = guide_legend(override.aes = list(size = 3))) + 
  labs(color = NULL, title = col.by) 

plot <- plot + theme_cowplot()
print(plot)

###########

id = "ident"
size = 4
color = "black"
xynames=c("UMAP_1","UMAP_2")
names(xynames)=c("x","y")
data <- plot$data[, c(xynames, id)]
clusters<- as.character(x = na.omit(object = unique(x = data[, id])))
groups <- clusters
pb <- ggplot_build(plot = plot)
data <- cbind(data, color = pb$data[[1]][[1]])
labels.loc <- lapply(X = groups, FUN = function(group) {
  data.use <- data[data[, id] == group, , drop = FALSE]
  data.medians <- as.data.frame(x = t(x = apply(X = data.use[, xynames, drop = FALSE], MARGIN = 2, FUN = median, na.rm = TRUE)))
  data.medians[, id] <- group
  data.medians$color <- data.use$color[1]
  return(data.medians)
})
labels.loc <- do.call(what = "rbind", args = labels.loc)
#labels.loc[, id] <- factor(x = labels.loc[, id], levels = levels(data[,  id]))
labels.loc$'ident'= as.factor(labels.loc$'ident')

labels <-  groups

names(x = labels) <- groups
for (group in groups) {
  labels.loc[labels.loc[, id] == group, id] <- labels[group]
}
#print(labels.loc)

geom.use <- ifelse(test = TRUE, yes = geom_text_repel, 
                   no = geom_text)
plot <- plot + geom.use(data = labels.loc, mapping = aes_string(x = xynames["x"], 
                                                                y = xynames["y"], label = id), show.legend = FALSE)
print(plot)

结果如下
在这里插入图片描述

我的心永远是冰冰哒
关注
  • 5
    点赞
  • 踩
  • 10
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
单细胞测序分析软件包_seurat使用笔记
ACGTexplorer的博客
05-13 8290
本笔记主要参考 https://www.jianshu.com/p/75c6d55a63bb?from=timeline 主要是为了理清思路，记录一下，方便以后查找 Seurat软件介绍 导入分析需要的包 library(Seurat) library(dplyr) library(magrittr) 读入矩阵 #matrix.mtx, genes.tsv, and barcodes.tsv #使用Read10X函数读取矩阵数据 pbmc.data <- Read10X(data.dir = "..
Seurat中Dotplot的作图数据，其实来源于FindAllmarker得到的数据​：pct，avg_log2C 。获取百分比，平均表达量
生信小博士的博客
02-20 706
【代码】Seurat中Dotplot的作图数据，其实来源于FindAllmarker得到的数据​：pct，avg_log2C。获取百分比，平均表达量。
【DimPlot】【FeaturePlot】使用小tips
最新发布
weixin_40695088的博客
03-10 3751
【DimPlot】【FeaturePlot】使用小tips
R中seurat包DimPlot如何根据不同的resolution画图
weixin_54434521的博客
02-21 3990
DimPlot(b, reduction = "umap",label = TRUE,group.by="RNA_snn_res.0.4") 还可以根据ident画图等等
ｓｅｕｒａｔ ｄｉｍｐｌｏｔ标签重叠 有个参数ｒｅｐｅｌ 或者使用 ｇｇｒｅｐｅｌ
生信小博士的博客
06-01 1199
ｇｇｒｅｐｅｌ 　ｄｉｍｐｌｏｔ ｓｅｕｒａｔ　　标签重叠　
单细胞分析：数据整合（九）
冷冻工厂
11-20 2773
导读 本文将学习跨条件执行单细胞整合，以识别彼此相似的细胞。 1. 目标 跨条件对齐相同的细胞类型。 2. 挑战 对齐相似细胞类型的细胞，这样就不会因为样本、条件、模式或批次之间的差异而在后续分析中进行聚类。 3. 推荐 建议先不整合分析，再决定是否进行整合。 4. 整合与否 通常，在决定是否需要执行任何对齐之前，我们总是在没有整合的情况下查看聚类。不要仅仅认为可能存在差异而总是先执行整合，探索数据。如果在 Seurat 对象中同时对两种条件进行归一化并可视化细胞之间的相似性，会看到特定条件的聚类情况：
单细胞基因可视化之UMAP图修饰
qq_42090739的博客
03-14 1万+
更多精彩请至《KS科研分享与服务公众号》 除了之前说过的三种常见单细胞基因可视化方法外，还有一种最常用的就是直接在UMAP或者TSNE降维图上显示表达某基因的细胞，这种方式更加直观，但是只能显示一个基因，一般用于标记重要的基因。 1、降维可视化 降维可视化一般用Dimplot函数，如果使用的是UMAP方法，可以直接使用UMAPPlot函数，但是感觉效果不好或者很混乱，可以考虑使用PCAPlot函数。可以看到，聚类效果不错，PCA不同细胞群还是分开了。 plot1 <- UMAPPlot(sc
asc_seurat
03-19
asc_seurat
在linux中用同一个版本的R 同时安装 Seurat2 和 Seurat3的教程
09-14
主要介绍了在linux中用同一个版本的R 同时安装 Seurat2 和 Seurat3的教程，本文给大家介绍的非常详细，具有一定的参考借鉴价值,需要的朋友可以参考下
Seurat-to-RNA-Velocity:将Seurat对象与RNA Velocity结合使用的指南
05-28
本指南将演示如何结合RNA Velocity分析使用已处理/标准化的Seurat对象。 请记住，尽管Seurat是基于R的，但是所有可用的RNA Velocity软件/软件包都是Python，因此我们将在两者之间来回移动。 我们将使用以下程序： ...
study_seurat.html
06-28
study_seurat.html
scrnaseq_celltype_prediction:根据Seurat FindMarker数据预测集群的细胞类型
04-07
用法（Seurat） 下载analyseMarkers.py脚本并在您的输出文件上运行它。 如果您有一个包含每个簇的标记基因的列表（ list(clusterID0=..., clusterID1=...) ），那么获取表达值和兼容数据框的最佳工作流程是：在R / ...
利用 ggplot2 绘制 Seurat 对象中的 tSNE 或 UMAP 图
klcola的专栏
08-21 1万+
Seurat 软件自带的绘图函数 DimPlot 虽然也提供了一些参数来供我们调整图形，但有时仍然有些你希望的功能不太容易实现，比如将细胞聚类分成三组，每一组是一种颜色，利用 DimPlot 就不容易实现（步骤比较繁琐：需要给细胞的 meta.data 增加额外的分组标识列，然后用 group.by 参数来为不同的分组上色）。一种更灵活的方法是把 tSNE 或者 UMAP 降维的信息从 seurat 对象中提取出来，并利用 ggplot 作图。具体代码如下： ## 假设我们有 Seurat 对象存储在 s
Seurat | 不同单细胞转录组的整合方法
Baimoc
11-15 9741
一、涉及的新概念 参考（reference）：将跨个体，跨技术，跨模式产生的不同的单细胞数据整合后的数据集 。也就是将不同来源的数据集组合到同一空间（reference）中。 从广义上讲，在概念上类似于基因组DNA序列的参考装配。 查询（query）：单个实验产生的数据集 转化学习（transfer learning）：产生一个于参考数据集（reference）上进行训练的模型，可以将信息再重新...
Seurat 4.0学习笔记（测试数据与参考数据集的比对）
zengwanqin的博客
03-09 5314
Multimodal 参考数据的比对 Intro: Seurat v4 Reference Mapping 这篇文章介绍了将查询数据集比对到Seurat中并且将其注释的过程。在此示例中，我们将10X Genomics of 2,700 PBMC发布的第一个scRNA-seq数据集映射到我们最近描述的用228种抗体测量的162,000 PBMC的CITE-seq参考序列。我们选择了此示例来说明参考数据集指导下的监督分析如何帮助枚举在无监督分析中很难找到的细胞状态。在第二个示例中，我们演示了如何将从不同个体剖析
单细胞转录组|Seurat 4.0 使用指南
weixin_45822007的博客
03-22 9883
后台有读者翻到了一年前发的文献解读，请教了一下文章的图的做法。正好前段时间刚做过单细胞转录组分析，今天就给大家介绍一下常用工具Seurat的用法。 Seurat 4.0 使用指南 设置Seurat对象 示例数据 10X Genomics免费提供的外周血单核细胞(PBMC)数据集。通过Illumina NextSeq 500测序的2700个单细胞。示例数据下载:https://cf.10xgenomics.com/samples/cell/pbmc3k/pbmc3k_filtered_gene_bc_m..
Seurat的scATAC-seq分析流程
热门推荐
xuzhougeng blog
08-31 1万+
文章首发于个人博客 xuzhougeng.top Seurat 3.X版本能够整合scRNA-seq和scATAC-seq, 主要体现在： 基于scRNA-seq的聚类结果对scATAC-seq的细胞进行聚类 scRNA-seq和scATAC-seq共嵌入(co-embed)分析 整合步骤包括如下步骤: 从ATAC-seq中估计RNA-seq表达水平，即从ATAC-seq reads定量...
SAP Web IDE本地环境搭建
少年休闲海
02-22 3485
SAP Web IDE本地环境搭建 1、JDK的安装及配置环境变量 可通过官网自行下载JDK： Java Downloads | Oracle 直接傻瓜式安装至默认路径“C:\Program Files\Java\jdk-17.0.2”，然后配置环境变量“JAVA_HOME”、“CLASSPATH”和“PATH”。 JAVA_HOME：C:\Program Files\Java\jdk-17.0.2 CLASSPATH：.;%JAVA_HOME%\lib;%JAVA_HOME%\lib\
Android开发（1） | Fragment 的应用——新闻应用
Jormungand_V的博客
02-21 3668
文章目录 news_item.xml： <TextView xmlns:android="http://schemas.android.com/apk/res/android" android:id="@+id/news_title" android:layout_width="match_parent" android:layout_height="wrap_content" android:lines="1" android:ellipsize="
seurat merge
09-01
Seurat merge是一种将两个或多个Seurat对象合并成一个单一Seurat对象的方法。可以使用merge函数直接将两个样品的数据矩阵合并到一起，生成一个新的Seurat对象。这个合并后的对象可以用于后续的分析和可视化。 在对合并后的Seurat对象进行分析之前，通常需要进行一些预处理步骤。例如，可以使用NormalizeData函数对数据进行归一化处理，使用FindVariableFeatures函数选择具有变异性的特征基因，使用ScaleData函数对数据进行缩放处理，使用RunPCA函数进行主成分分析，使用FindNeighbors函数寻找邻居，使用FindClusters函数进行聚类，最后使用RunUMAP函数进行UMAP降维。 可以使用DimPlot函数查看合并对象的分群结果，以便更好地理解和可视化合并后的数据。<span class="em">1</span><span class="em">2</span><span class="em">3</span> #### 引用[.reference_title] - *1* *2* *3* [10x单细胞数据分析之Seurat多样品整合分析](https://blog.csdn.net/muhamuha2020/article/details/119612668)[target="_blank" data-report-click={"spm":"1018.2226.3001.9630","extra":{"utm_source":"vip_chatgpt_common_search_pc_result","utm_medium":"distribute.pc_search_result.none-task-cask-2~all~insert_cask~default-1-null.142^v93^chatsearchT3_1"}}] [.reference_item style="max-width: 100%"] [ .reference_list ]

“相关推荐”对你有帮助么？

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值