前往小程序,Get更优阅读体验!
立即前往
首页
学习
活动
专区
工具
TVP
发布
社区首页 >专栏 >🧐 Slingshot | 细胞分化轨迹这样做比较简单哦!~(一)

🧐 Slingshot | 细胞分化轨迹这样做比较简单哦!~(一)

作者头像
生信漫卷
发布2023-09-04 15:20:15
5780
发布2023-09-04 15:20:15
举报
文章被收录于专栏:R语言及实用科研软件

1写在前面

今天是医师节,祝各位医护节日快乐,夜班平安,病历全是甲级,没有错误。🥰

不知道各位医师节的福利是什么!?😂

我们医院是搞了义诊活动,哈哈哈哈哈哈哈。🫠

这么好的节日,以后尽量别搞了。😭

2用到的包

代码语言:javascript
复制
rm(list = ls())
library(slingshot)
library(tidyverse)
library(uwot)	
library(mclust)
library(RColorBrewer)
library(grDevices)

3示例数据

代码语言:javascript
复制
means <- rbind(
    matrix(rep(rep(c(0.1,0.5,1,2,3), each = 300),100),
        ncol = 300, byrow = T),
    matrix(rep(exp(atan( ((300:1)-200)/50 )),50), ncol = 300, byrow = T),
    matrix(rep(exp(atan( ((300:1)-100)/50 )),50), ncol = 300, byrow = T),
    matrix(rep(exp(atan( ((1:300)-100)/50 )),50), ncol = 300, byrow = T),
    matrix(rep(exp(atan( ((1:300)-200)/50 )),50), ncol = 300, byrow = T),
    matrix(rep(exp(atan( c((1:100)/33, rep(3,100), (100:1)/33) )),50), 
        ncol = 300, byrow = TRUE)
)

counts <- apply(means,2,function(cell_means){
    total <- rnbinom(1, mu = 7500, size = 4)
    rmultinom(1, total, cell_means)
})
rownames(counts) <- paste0('G',1:750)
colnames(counts) <- paste0('c',1:300)
sce <- SingleCellExperiment(assays = List(counts = counts))
sce

4基因过滤

这里我们把cluster size设置为≥10count设置为≥3,以这个条件进行过滤,筛选过一些低表达的。😏

代码语言:javascript
复制
geneFilter <- apply(assays(sce)$counts,1,function(x){
    sum(x >= 3) >= 10
})
sce <- sce[geneFilter, ]

5Normalization

接着我们做一下Normalization,去除一些技术因素或者生物学因素上的影响,比如batch,sequencing depth, cell cycle等等。🥰

代码语言:javascript
复制
FQnorm <- function(counts){
    rk <- apply(counts,2,rank,ties.method='min')
    counts.sort <- apply(counts,2,sort)
    refdist <- apply(counts.sort,1,median)
    norm <- apply(rk,2,function(r){ refdist[r] })
    rownames(norm) <- rownames(counts)
    return(norm)
}
assays(sce)$norm <- FQnorm(assays(sce)$counts)

6降维

这里我们用2种方法来试试,PCAUMAP。😂

6.1 方法一

在做PCA的时候,大家尽量不要对基因的表达量做scale,这样的结果会更准一些。🤐

代码语言:javascript
复制
pca <- prcomp(t(log1p(assays(sce)$norm)), scale. = F)
rd1 <- pca$x[,1:2]

plot(rd1, col = rgb(0,0,0,.5), pch=16, asp = 1)

6.2 方法二

代码语言:javascript
复制
rd2 <- uwot::umap(t(log1p(assays(sce)$norm)))
colnames(rd2) <- c('UMAP1', 'UMAP2')

plot(rd2, col = rgb(0,0,0,.5), pch=16, asp = 1)

然后我们把结果存在到之前的SingleCellExperiment文件sce里吧。😜

代码语言:javascript
复制
reducedDims(sce) <- SimpleList(PCA = rd1, UMAP = rd2)

7细胞聚类

这里我们也提供2种方法吧,Gaussian mixture modelingk-means。🥳

7.1 方法一

代码语言:javascript
复制
cl1 <- Mclust(rd1)$classification
colData(sce)$GMM <- cl1

plot(rd1, col = brewer.pal(9,"Set1")[cl1], pch=16, asp = 1)

7.2 方法二

代码语言:javascript
复制
cl2 <- kmeans(rd1, centers = 4)$cluster
colData(sce)$kmeans <- cl2

plot(rd1, col = brewer.pal(9,"Set1")[cl2], pch=16, asp = 1)

8slingshot进行Pseudotime分析

代码语言:javascript
复制
sce <- slingshot(sce, clusterLabels = 'GMM', reducedDim = 'PCA')

代码语言:javascript
复制
summary(sce$slingPseudotime_1)

代码语言:javascript
复制
colData(sce)$slingshot

single-trajectory 🤩

代码语言:javascript
复制
colors <- colorRampPalette(brewer.pal(11,'Spectral')[-6])(100)
plotcol <- colors[cut(sce$slingPseudotime_1, breaks=100)]

plot(reducedDims(sce)$PCA, col = plotcol, pch=16, asp = 1)
lines(SlingshotDataSet(sce), lwd=2, col='black')

当然,你也可以把type设置为lineages,模拟以cluster为单位的变化过程。🤓

代码语言:javascript
复制
plot(reducedDims(sce)$PCA, col = brewer.pal(9,'Set1')[sce$GMM], pch=16, asp = 1)
lines(SlingshotDataSet(sce), lwd=2, type = 'lineages', col = 'black')

9大数据的处理

示例数据都比较小,但实际你测完的数据可能会非常大。😜

这个时候我们要加上一个参数,approx_points,默认是150,一般选择100-200。🫠

如果你把approx_points设置为False,会获得尽可能多的点,和data中的细胞数有一定的关系。😭

代码语言:javascript
复制
sce5 <- slingshot(sce, clusterLabels = 'GMM', reducedDim = 'PCA',
                   approx_points = 150)

colors <- colorRampPalette(brewer.pal(11,'Spectral')[-6])(100)
plotcol <- colors[cut(sce5$slingPseudotime_1, breaks=100)]

plot(reducedDims(sce5)$PCA, col = plotcol, pch=16, asp = 1)
lines(SlingshotDataSet(sce5), lwd=2, col='black')

10将细胞投射到现有轨迹上

可能有时候,我们只想使用细胞的一个子集或者新的data来确定轨迹,我们都需要一种方法来确定新细胞沿着先前构建的轨迹的位置。🤓

这个时候我们可以用predict函数,

代码语言:javascript
复制
pto <- sce$slingshot

newPCA <- reducedDim(sce, 'PCA') + rnorm(2*ncol(sce), sd = 2)

newPTO <- slingshot::predict(pto, newPCA)

原细胞轨迹为灰色哦。🫠

代码语言:javascript
复制
newplotcol <- colors[cut(slingPseudotime(newPTO)[,1], breaks=100)]
plot(reducedDims(sce)$PCA, col = 'grey', bg = 'grey', pch=21, asp = 1,
     xlim = range(newPCA[,1]), ylim = range(newPCA[,2]))
lines(SlingshotDataSet(sce), lwd=2, col = 'black')
points(slingReducedDim(newPTO), col = newplotcol, pch = 16)

本文参与 腾讯云自媒体同步曝光计划,分享自微信公众号。
原始发表:2023-08-19,如有侵权请联系 cloudcommunity@tencent.com 删除

本文分享自 生信漫卷 微信公众号,前往查看

如有侵权,请联系 cloudcommunity@tencent.com 删除。

本文参与 腾讯云自媒体同步曝光计划  ,欢迎热爱写作的你一起参与!

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
目录
  • 1写在前面
  • 2用到的包
  • 3示例数据
  • 4基因过滤
  • 5Normalization
  • 6降维
    • 6.1 方法一
      • 6.2 方法二
      • 7细胞聚类
        • 7.1 方法一
          • 7.2 方法二
          • 8slingshot进行Pseudotime分析
          • 9大数据的处理
          • 10将细胞投射到现有轨迹上
          相关产品与服务
          大数据
          全栈大数据产品,面向海量数据场景,帮助您 “智理无数,心中有数”!
          领券
          问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档