pseudocell该如何计算||或谈Seurat的扩展

library(Seurat)
library(SeuratData)
library(hexSticker)

p <- ggplot(DimPlot(pbmc3k.final,label = T)$data,aes(UMAP_1 , UMAP_2,fill=ident)) + 
  geom_point(shape=21,colour="black",stroke=0.25,alpha=0.8) +
  DimPlot(pbmc3k.final,label = T)$theme + NoLegend()+ theme_transparent()

sticker(p, package="PseudoCell", p_color = "#FFFFFF",
        url='Seurat Weekly NO.5',
        u_size =  5,spotlight = T,
        u_color = "#FFFFFF", 
        p_size=20, s_x=1, s_y=.75, 
        s_width=1.3, s_height=1,
        h_color = "#1881C2",
        h_fill = "pink",
        filename="PseudoCell.png")

在文章单细胞转录组中的pseudocell又是什么中,我们介绍了pseudocell的概念,并且在文章最后贴上了sc-MCA的计算代码。作为一个Seurat的深度用户,我们不禁要想:能不能把这段代码写成可以接受Seurat对象的函数呢?而且要保留Seurat的一般风格。下面,就让我们试试吧。

首先要获得不同assay,即对哪个assay来计算?获得assay之后,assay的哪个slot?已经确定对哪种分群来计算。确定参数后,我们来写代码:

library(purrr)
GatherData <- function(object, ...) {
  
  UseMethod("GatherData")
  
}


GatherData.Seurat <- function(object,
                              assay,
                              slot_use,
                              ...) {
  
  assay <- assay %||% "RNA"
  slot_use <- slot_use %||% "data"
  obj_data <- GetAssayData(
    object = object,
    assay = assay,
    slot = slot_use
  ) %>%
    as.matrix()
  return(obj_data)
}

这段代码来获取assay和slot的表达矩阵,返回一个Seurat的对象。


GatherData.Seurat <- function(object,
                              assay,
                              slot_use,
                              ...) {
  
  assay <- assay %||% "RNA"
  slot_use <- slot_use %||% "data"
  obj_data <- GetAssayData(
    object = object,
    assay = assay,
    slot = slot_use
  ) %>%
    as.matrix()
  return(obj_data)
}



PseudoCell  <- function(object,
                        assay_use = NULL,
                        slot_use = NULL,
                        cluster_use =NULL,
                        pseudocell.size  =NULL){
  message("tips: 
  Cluster_use : one col in metadata
  pseudocell.size : how many cell will be pseudo")
  
  Inter<- GatherData(object = object,
                     assay = assay_use,
                     slot_use = slot_use) 
  Inter[Inter<0]=0
  idd<-object@meta.data
  Inter.id<-cbind(rownames(idd),as.vector(idd[,cluster_use]))
  
  rownames(Inter.id)<-rownames(idd)
  colnames(Inter.id)<-c("CellID","Celltype")
  
  Inter.id<-as.data.frame(Inter.id)
  Inter1<-Inter[,Inter.id$CellID]
  Inter<-as.matrix(Inter1)
  pseudocell.size = pseudocell.size ## 10 test
  new_ids_list = list()
  Inter.id$Celltype <- as.factor(Inter.id$Celltype)
  for (i in 1:length(levels(Inter.id$Celltype))) {
    cluster_id = levels(Inter.id$Celltype)[i]
    cluster_cells <- rownames(Inter.id[Inter.id$Celltype == cluster_id,])
    cluster_size <- length(cluster_cells)       
    pseudo_ids <- floor(seq_along(cluster_cells)/pseudocell.size)
    pseudo_ids <- paste0(cluster_id, "_Cell", pseudo_ids)
    names(pseudo_ids) <- sample(cluster_cells)  
    new_ids_list[[i]] <- pseudo_ids     
  }
  
  new_ids <- unlist(new_ids_list)
  new_ids <- as.data.frame(new_ids)
  new_ids_length <- table(new_ids)
  
  new_colnames <- rownames(new_ids)  ###add
  all.data<-Inter[,as.character(new_colnames)] ###add
  all.data <- t(all.data)###add
  
  new.data<-aggregate(list(all.data[,1:length(all.data[1,])]),
                      list(name=new_ids[,1]),FUN=mean)
  rownames(new.data)<-new.data$name
  new.data<-new.data[,-1]
  
  new_ids_length<-as.matrix(new_ids_length)##
  short<-which(new_ids_length< pseudocell.size -1 )##
  new_good_ids<-as.matrix(new_ids_length[-short,])##
  result<-t(new.data)[,rownames(new_good_ids)]
  rownames(result)<-rownames(Inter)
  
  newobject <- CreateSeuratObject(result)
  newobject@misc$idtrans <- new_ids
  newobject@commands$PseudoCell <- LogSeuratCommand(newobject, return.command = TRUE)
  return(newobject)
}



pseudocell.size 的意思是几个单细胞变成一个pseudocell,注意不要大于最小细胞群的细胞数。

这个函数完成计算,并用LogSeuratCommand函数来计算参数保存在Seurat的对象中。下面让我们来试试吧

library(Seurat)
head(pbmc_small@meta.data)
                  orig.ident nCount_RNA nFeature_RNA RNA_snn_res.0.8 letter.idents groups RNA_snn_res.1
ATGCCAGAACGACT SeuratProject         70           47               0             A     g2             0
CATGGCCTGTGCAT SeuratProject         85           52               0             A     g1             0
GAACCTGATGAACC SeuratProject         87           50               1             B     g2             0
TGACTGGATTCTCA SeuratProject        127           56               0             A     g2             0
AGTCAGACTGCACA SeuratProject        173           53               0             A     g2             0
TCTGATACACGTGT SeuratProject         70           48               0             A     g1             0

对于既想保留样本信息又想保留细胞类型信息的需求:


pbmc_small@meta.data$samcell <- paste0(pbmc_small@meta.data$groups,'_',pbmc_small@meta.data$RNA_snn_res.1)
mypbmc@commands$PseudoCell

Command: PseudoCell(pbmc_small, "RNA", "data", "samcell", 10)
Time: 2020-12-23 15:56:53
assay_use : RNA 
slot_use : data 
cluster_use : samcell 
pseudocell.size : 10 
 mypbmc <- PseudoCell(pbmc_small, "RNA","data","samcell",10)
tips: 
  Cluster_use : one col in metadata
  pseudocell.size : how many cell will be pseudo

查看我们运行的结果返回一个新的Seurat对象。

  mypbmc
An object of class Seurat 
230 features across 7 samples within 1 assay 
Active assay: RNA (230 features, 0 variable features)

 head(mypbmc@meta.data)
           orig.ident nCount_RNA nFeature_RNA
g1_0_Cell0         g1   215.8404          156
g1_0_Cell1         g1   238.3377          144
g1_1_Cell0         g1   318.5675          164
g1_2_Cell0         g1   265.6965          186
g2_0_Cell0         g2   231.1276          166
g2_1_Cell0         g2   289.4952          152

新旧barcode的对应关系在mypbmc@misc$idtrans对象中。

 head(mypbmc@misc$idtrans)
                  new_ids
GGCATATGCTTATC g1_0_Cell0
GCGCATCTTGCTCC g1_0_Cell0
CATGGCCTGTGCAT g1_0_Cell0
AATGTTGACAGTCA g1_0_Cell0
TTACGTACGTTCAG g1_0_Cell0
AGTCTTACTTCGGA g1_0_Cell0

注意一下 pseudocell的 命名规则: 0_Cell0。_ 之前是细胞群,Cell之后是该群的第几个pseudocell(从零开始编号)。当然,你可以根据自己的心绪,自行命名。

这样,我们就为Seurat写了一个函数啦。以后相对自己的scrna数据做什么操作,直接以函数的形式嫁接到Seurat里就可以啦。

Seurat只是一个工具吗?不,它已经变成我们的一部分了。

最后编辑于
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 159,835评论 4 364
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 67,598评论 1 295
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 109,569评论 0 244
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 44,159评论 0 213
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 52,533评论 3 287
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 40,710评论 1 222
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 31,923评论 2 313
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 30,674评论 0 203
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 34,421评论 1 246
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 30,622评论 2 245
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 32,115评论 1 260
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 28,428评论 2 254
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 33,114评论 3 238
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 26,097评论 0 8
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 26,875评论 0 197
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 35,753评论 2 276
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 35,649评论 2 271