手把手教你做单细胞测序数据分析(六)——组间差异分析及可视化

往期回顾:

在前面的课程中我们已经进行过“单样本数据分析”、“多样本数据整合”、“细胞类型注释”等内容的学习,相信大家现在已经能够对单细胞测序数据分析流程及Seurat对象的基本结构拥有了一定的了解。这一讲主要带领大家进行组间差异的计算及可视化方法的学习,这部分内容能够帮助科研工作者直接证明该数据集的前期试验设计,从前期枯燥的数据预处理走向文章中的Figure!

视频教程:

保姆级教程 《手把手教你做单细胞测序数据分析》(六)——组间差异分析及可视化

(B站同步播出,先看一遍视频再跟着代码一起操作,建议每个视频至少看三遍)

代码:
测试数据与第四讲多样本整合相同:

读入并检查数据
library(Seurat)
## Attaching SeuratObject
library(dplyr)
## 
## 载入程辑包:'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
pbmc <- readRDS('pbmcrenamed.rds')
pbmc
## An object of class Seurat 
## 22254 features across 900 samples within 2 assays 
## Active assay: RNA (20254 features, 0 variable features)
##  1 other assay present: integrated
##  3 dimensional reductions calculated: pca, umap, tsne
DimPlot(pbmc)

640.png

names(pbmc@meta.data)
## [1] "orig.ident"               "nCount_RNA"              
## [3] "nFeature_RNA"             "percent.mt"              
## [5] "group"                    "integrated_snn_res.0.025"
## [7] "seurat_clusters"          "celltype.group"          
## [9] "celltype"
unique(pbmc$group)
## [1] "C57" "AS1" "P3"
DimPlot(pbmc,split.by = 'group')

640.png

差异分析

pbmc$celltype.group <- paste(pbmc$celltype, pbmc$group, sep = "_")
pbmc$celltype <- Idents(pbmc)
Idents(pbmc) <- "celltype.group"

mydeg <- FindMarkers(pbmc,ident.1 = 'VSMC_AS1',ident.2 = 'VSMC_C57', verbose = FALSE, test.use = 'wilcox',min.pct = 0.1)
head(mydeg)
##               p_val avg_log2FC pct.1 pct.2  p_val_adj
## Cd24a  6.327111e-07  1.4046048 0.500 0.016 0.01281493
## Spta1  9.387127e-07  0.3391453 0.375 0.000 0.01901269
## Lum    9.387127e-07  3.8953383 0.375 0.000 0.01901269
## Gda    9.387127e-07  0.6064680 0.375 0.000 0.01901269
## Isg20  6.651476e-06  1.4016408 0.500 0.032 0.13471900
## Hbb-bt 7.937909e-06  4.3779094 0.500 0.032 0.16077441

解放生产力 通过循环自动计算差异基因

cellfordeg<-levels(pbmc$celltype)
for(i in 1:length(cellfordeg)){
  CELLDEG <- FindMarkers(pbmc, ident.1 = paste0(cellfordeg[i],"_P3"), ident.2 = paste0(cellfordeg[i],"_AS1"), verbose = FALSE)
  write.csv(CELLDEG,paste0(cellfordeg[i],".CSV"))
}
list.files()
##  [1] "B cell.CSV"                 "EC.CSV"                    
##  [3] "Fibro.CSV"                  "Macro.CSV"                 
##  [5] "Mono.CSV"                   "Myeloid cells.CSV"         
##  [7] "Neut.CSV"                   "pbmcrenamed.rds"           
##  [9] "T cell.CSV"                 "VSMC.CSV"                  
## [11] "组间差异分析及可视化.html"  "组间差异分析及可视化.Rmd"  
## [13] "组间差异分析及可视化_files" "组间差异及可视化.r"

差异分析解果解读:

640.png

可视化方法

library(dplyr)
top10 <- CELLDEG  %>% top_n(n = 10, wt = avg_log2FC) %>% row.names()
top10
##  [1] "Thbs1"    "Acta2"    "Myl9"     "Tagln"    "Ccn2"     "Plvap"   
##  [7] "Igfbp7"   "Ifi27l2a" "Dcn"      "Gdf15"
pbmc <- ScaleData(pbmc, features =  rownames(pbmc))
## Centering and scaling data matrix
DoHeatmap(pbmc,features = top10,size=3)

640.png

Idents(pbmc) <- "celltype"
VlnPlot(pbmc,features = top10,split.by = 'group',idents = 'EC')
## The default behaviour of split.by has changed.
## Separate violin plots are now plotted side-by-side.
## To restore the old behaviour of a single split violin,
## set split.plot = TRUE.
##       
## This message will be shown once per session.

640.png

FeaturePlot(pbmc,features = top10,split.by = 'group')

640.png

#DotPlot(pbmc,features = top10,split.by ='group')#默认只有两种颜色
DotPlot(pbmc,features = top10,split.by ='group',cols = c('blue','yellow','pink'))

640.png

提取表达量,用ggplot2 DIY一个箱线图

####提取表达量#######
mymatrix <- as.data.frame(pbmc@assays$RNA@data)
mymatrix2<-t(mymatrix)%>%as.data.frame()
mymatrix2[,1]<-pbmc$celltype
colnames(mymatrix2)[1] <- "celltype"

mymatrix2[,ncol(mymatrix2)+1]<-pbmc$group
colnames(mymatrix2)[ncol(mymatrix2)] <- "group"

#绘图
library(ggplot2)
p1<- ggplot2::ggplot(mymatrix2,aes(x=celltype,y=Thbs1,fill=group))+
  geom_boxplot(alpha=0.7)+
  scale_y_continuous(name = "Expression")+
  scale_x_discrete(name="Celltype")+
  scale_fill_manual(values = c('DeepSkyBlue','Orange','pink'))
p1

640.png

#########另一种提取方法########
Idents(pbmc) <- colnames(pbmc)
mymatrix <- log1p(AverageExpression(pbmc, verbose = FALSE)$RNA)
mymatrix2<-t(mymatrix)%>%as.data.frame()
mymatrix2[,1]<-pbmc$celltype
colnames(mymatrix2)[1] <- "celltype"

mymatrix2[,ncol(mymatrix2)+1]<-pbmc$group
colnames(mymatrix2)[ncol(mymatrix2)] <- "group"

library(ggplot2)
p2<- ggplot2::ggplot(mymatrix2,aes(x=celltype,y=Thbs1,fill=group))+
  geom_boxplot(alpha=0.7)+
  scale_y_continuous(name = "Expression")+
  scale_x_discrete(name="Celltype")+
  scale_fill_manual(values = c('DeepSkyBlue','Orange','pink'))

640.png

###比较一下两种方法,发现并没有差异
library(patchwork)
p1|p2

640.png

本系列其他课程

手把手教你做单细胞测序数据分析(一)——绪论

手把手教你做单细胞测序数据分析(二)——各类输入文件读取

手把手教你做单细胞测序数据分析(三)——单样本分析

手把手教你做单细胞测序数据分析(四)——多样本整合

手把手教你做单细胞测序数据分析(五)——细胞类型注释

手把手教你做单细胞测序数据分析(六)——组间差异分析及可视化

手把手教你做单细胞测序数据分析(七)——基因集富集分析

欢迎关注同名公众号~

  • 1
    点赞
  • 8
    收藏
    觉得还不错? 一键收藏
  • 1
    评论
在R语言中,可以使用一些常用的包来进行单细胞测序数据分析,并去除非编码RNA。下面是一个示例代码,演示了如何使用`Seurat`包来去除非编码RNA: ```R # 安装和加载Seurat软件包 if (!requireNamespace("Seurat", quietly = TRUE)) { install.packages("Seurat") } library(Seurat) # 读取单细胞测序数据 # 这里假设你的数据已经存储在一个Seurat对象中,命名为"seuratObj" seuratObj <- Read10X("path/to/your/data") # 进行预处理和标准化 seuratObj <- NormalizeData(seuratObj) seuratObj <- FindVariableFeatures(seuratObj) seuratObj <- ScaleData(seuratObj) # 去除非编码RNA # 这里假设你已经有一个非编码RNA的注释信息,存储在一个数据框或数据表中,命名为"noncodingRNA" # 可以根据注释信息的基因名称或转录本名称来匹配并去除非编码RNA seuratObj <- subset(seuratObj, features = !(rownames(seuratObj) %in% noncodingRNA$gene_name)) # 其他数据分析步骤... # 在去除非编码RNA之后,你可以继续进行其他的单细胞测序数据分析步骤,如聚类、降维、差异表达分析等。 # 聚类和可视化 seuratObj <- FindNeighbors(seuratObj) seuratObj <- FindClusters(seuratObj) seuratObj <- RunUMAP(seuratObj) seuratObj <- FindMarkers(seuratObj) # 可视化聚类结果 DimPlot(seuratObj, group.by = "cluster") # 输出处理后的数据 # 如果需要将处理后的数据保存为Matrix Market格式,可以使用writeMM函数 writeMM(seuratObj, file = "path/to/output.mtx") ``` 请注意,这只是一个示例代码,你需要根据你的具体数据和需求进行相应的修改和调整。同时,非编码RNA的注释信息也需要根据你的数据来源和分析目的进行相应的获取和准备。 希望这个示例代码对你有帮助!如果还有其他问题,请随时提问。

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

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

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

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

抵扣说明:

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

余额充值