网络数据统计分析笔记|| 案例1分析单细胞转录组数据

前情回顾:
Gephi网络图极简教程
Network在单细胞转录组数据分析中的应用
Gephi网络图极简教程
Network在单细胞转录组数据分析中的应用
网络数据统计分析笔记|| 为什么研究网络
网络数据统计分析笔记|| 操作网络数据
网络数据统计分析笔记|| 网络数据可视化
网络数据统计分析笔记|| 网络数据的描述性分析
网络数据统计分析笔记||网络图的数学模型

单细胞数据以高纬度著称,一则来自测得细胞多,一则来自测得基因也很多。在我们的文章Network在单细胞转录组数据分析中的应用中提到用网络分析工具来解释细胞和基因异质性。网络既是一种数据结构,也是一个模型。Network在高维数据中的应用是多方面的:从可视化到网络拓扑推断。

今天我们就用刚学的热乎的Network知识探索一下我们的单细胞转录组数据吧。核心在找到细胞类型特异(cell-type specific)的某某,对它展开描述。

library(tidyverse)
library(Seurat)
library(SeuratData)
library(psych)
library(qgraph)
library(igraph)


pbmc3k.final
An object of class Seurat 
13714 features across 2638 samples within 1 assay 
Active assay: RNA (13714 features, 2000 variable features)
 2 dimensional reductions calculated: pca, umap


head(pbmc3k.final@meta.data)
               orig.ident nCount_RNA nFeature_RNA seurat_annotations percent.mt RNA_snn_res.0.5
AAACATACAACCAC     pbmc3k       2419          779       Memory CD4 T  3.0177759               1
AAACATTGAGCTAC     pbmc3k       4903         1352                  B  3.7935958               3
AAACATTGATCAGC     pbmc3k       3147         1129       Memory CD4 T  0.8897363               1
AAACCGTGCTTCCG     pbmc3k       2639          960         CD14+ Mono  1.7430845               2
AAACCGTGTATGCG     pbmc3k        980          521                 NK  1.2244898               6
AAACGCACTGGTAC     pbmc3k       2163          781       Memory CD4 T  1.6643551               1
               seurat_clusters
AAACATACAACCAC               1
AAACATTGAGCTAC               3
AAACATTGATCAGC               1
AAACCGTGCTTCCG               2
AAACCGTGTATGCG               6
AAACGCACTGGTAC               1

table(Idents(pbmc3k.final))

 Naive CD4 T Memory CD4 T   CD14+ Mono            B        CD8 T FCGR3A+ Mono           NK           DC 
         697          483          480          344          271          162          155           32 
    Platelet 
          14 

计算每个亚群的差异基因。

mk <- FindAllMarkers(pbmc3k.final)
head(mk)

计算top 20 差异基因的平均表达量,构建们细胞类型特异基因相关性网络。当然你要是能找到每个细胞亚群的有意思的基因集,那故事性要比差异基因强的多了。


genes <- mk %>% group_by(cluster) %>% top_n(20,avg_logFC)
genes<- genes$gene
aver<- AverageExpression(pbmc3k.final,features = unique(genes))

计算相关性

df <- t(aver$RNA)
rownames(df)
corr <- corr.test(df)

设置分组信息。

geneMY <- lapply(names(table(Idents(pbmc3k.final))), FUN = function(x){mk %>%filter( cluster  == x ) %>% top_n(20,avg_logFC) -> gene;
    genes<- gene$gene
    which(colnames(corr$r) %in%genes )})

names(geneMY) <- names(table(Idents(pbmc3k.final)))
pbmc3k_net <- qgraph(corr$r,groups = geneMY,threshold = .1,minimum=.6,label.norm = "AAAAAAA")

绿色表示正相关,红色表示负相关。这时候可以讲一下几个一亚群内部的相关性规律,再提一下亚群间的几个关键的基因,如和别的细胞类型关联较多的基因,为什么?

图的基本性质
pbmc_cent <- centrality_auto(pbmc3k_net)
pbmc_node_cent <- as_tibble(pbmc_cent$node.centrality, rownames = "item")
psych::describe(pbmc_node_cent$Betweenness)

  vars   n  mean    sd median trimmed  mad min max range skew kurtosis   se
X1    1 149 44.34 90.95      1   21.49 1.48   0 496   496 2.76     7.91 7.45

# turn it into a tibble
as_tibble(pbmc_node_cent$Betweenness) %>% 
    # it's calling the variable value by default, so we'll rename it
    rename(betweenness = value) %>%
    # pass that to ggplot
    ggplot(aes(x = betweenness))+
    # let's see a density plot
    geom_density() + theme_bw()
 pbmc3k_net %>% as.igraph()  -> cg1
is.weighted(cg1)
[1] TRUE
head(E(cg1)$weight)
[1] -0.1001239 -0.1002145 -0.1003801 -0.1003982  0.1004146 -0.1004702
 tail(E(cg1)$weight)
[1] 0.9999990 0.9999991 0.9999992 0.9999993 0.9999995 0.9999998
vcount(cg1)
[1] 149
length(V(cg1))
[1] 149
E(cg1)$weight <- abs(E(cg1)$weight)
as_adjacency_matrix(cg1) -> igraph
igraph <- network::as.network.matrix(igraph)
nodes_num <- length(V(cg1))
nodes_num
vcount(yeast)
edges_num <- length(E(cg1))
edges_num

#平均度(average degree)
average_degree <- mean(degree(cg1))
#或者,2x边数量/节点数量
average_degree <- 2*edges_num/nodes_num
average_degree

#平均加权度(average weighted degree),仅适用于含权网络
#average_weight_degree <- mean(strength(igraph))

#节点和边连通度(connectivity)
nodes_connectivity <- vertex.connectivity(cg1)
nodes_connectivity

edges_connectivity <- edge.connectivity(cg1)
edges_connectivity

#平均路径长度(average path length)
average_path_length <- average.path.length(cg1, directed = FALSE)
average_path_length

#网络直径(diameter)
graph_diameter <- diameter(cg1, directed = FALSE)
graph_diameter

#图密度(density)
graph_density <- graph.density(cg1)
graph_density

#聚类系数(clustering coefficient)
clustering_coefficient <- transitivity(cg1)
clustering_coefficient

#介数中心性(betweenness centralization)
betweenness_centralization <- centralization.betweenness(cg1)$centralization
betweenness_centralization

#度中心性(degree centralization)
degree_centralization <- centralization.degree(cg1)$centralization
degree_centralization

#模块性(modularity),详见 ?cluster_fast_greedy,?modularity,有多种模型
fc <- cluster_fast_greedy(cg1)
modularity <- modularity(cg1, membership(fc))


#互惠性(reciprocity),仅适用于有向网络
#reciprocity(igraph, mode = 'default')
#reciprocity(igraph, mode = 'ratio')

#选择部分做个汇总输出
igraph_character <- data.frame(
    nodes_num,    #节点数量(number of nodes)
    edges_num,    #边数量(number of edges)
    average_degree,    #平均度(average degree)
    nodes_connectivity,    #节点连通度(vertex connectivity)
    edges_connectivity,    #边连通度(edges connectivity)
    average_path_length,    #平均路径长度(average path length)
    graph_diameter,    #网络直径(diameter)
    graph_density,    #图密度(density)
    clustering_coefficient,    #聚类系数(clustering coefficient)
    betweenness_centralization,    #介数中心性(betweenness centralization)
    degree_centralization,    #度中心性
    modularity    #模块性(modularity)
)
igraph_character %>% 
knitr::kable(caption = " Descriptives")

Table:  Descriptives

| nodes_num| edges_num| average_degree| nodes_connectivity| edges_connectivity| average_path_length| graph_diameter| graph_density| clustering_coefficient| betweenness_centralization| degree_centralization| modularity|
|---------:|---------:|--------------:|------------------:|------------------:|-------------------:|--------------:|-------------:|----------------------:|--------------------------:|---------------------:|----------:|
|       149|      9921|       133.1678|                104|                104|            1.100218|       0.454341|     0.8997823|              0.9058516|                  0.0002225|             0.0934609|  0.0159255|

评估社团数量
nv <- vcount(cg1)
ne <- ecount(cg1)
degs <- degree(cg1)

# CHUNK 27
ntrials <- 1000

# CHUNK 28
num.comm.rg <- numeric(ntrials)
for(i in (1:ntrials)){
    g.rg <- sample_gnm(nv, ne)
    c.rg <- cluster_fast_greedy(g.rg)
    num.comm.rg[i] <- length(c.rg)
}

# CHUNK 29
num.comm.grg <- numeric(ntrials)
for(i in (1:ntrials)){
    g.grg <- sample_degseq(degs, method="vl")
    c.grg <- cluster_fast_greedy(g.grg)
    num.comm.grg[i] <- length(c.grg)
}


rslts <- c(num.comm.rg,num.comm.grg)
indx <- c(rep(0, ntrials), rep(1, ntrials))
counts <- table(indx, rslts)/ntrials
barplot(counts, beside=TRUE, col=c("blue", "red"),
        xlab="Number of Communities",
        ylab="Relative Frequency",
        legend=c("Fixed Size", "Fixed Degree Sequence"))

E(cg1)$weight <- abs(E(cg1)$weight)
length(cluster_fast_greedy(cg1))

[1] 4

社团大于模拟的随机图数量(上异常),说明我们细胞类型特异基因相关性网络是不同寻常的。

评估网络小世界性
ntrials <- 1000
nv <- vcount(cg1)
ne <- ecount(cg1)
cl.rg <- numeric(ntrials)
apl.rg <- numeric(ntrials)
for (i in (1:ntrials)) {
    g.rg <- sample_gnm(nv, ne, directed=TRUE)
    cl.rg[i] <- transitivity(g.rg) 
    apl.rg[i] <- mean_distance(g.rg)
}
# 
# df <- data.frame(cl.rg = cl.rg,apl.rg = apl.rg)
# head(df  %>% reshape2::melt())
# df  %>% reshape2::melt() %>%  ggplot(aes(factor(variable),value)) + geom_violin() +theme_bw()

summary(cl.rg)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
 0.6901  0.6958  0.6974  0.6974  0.6991  0.7055 
ntrials <- 1000
 summary(cl.rg)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
 0.6901  0.6958  0.6974  0.6974  0.6991  0.7055 
transitivity(cg1)
[1] 0.9058516
mean_distance(cg1)
[1] 1.100218

0.9058516 > 0.7055 小世界性也是有的。

接下来,我们可以把某个子图挖出来仔细看引起这种特异的内在因素,也就是找到了某个基因集,然后又是一波建模和验证。把这篇文章整整就是一篇SCI啊。

如何以细胞而不是以基因来构建网络呢?

可以基于网络推测细胞类型之间的关系,随着单细胞组学的完善,每个细胞都可以测到多个属性,这样就可以类比人类社会的研究方法了。有一门学科,叫做:

到那时,我们可以描述细胞之间的聚集,分离,迁移,交流。细胞之间的调节网络将会在我们面前铺展开来。


https://robchavez.github.io/datascience_gallery/html_only/network_analysis.html#example_2:_correlation_network
https://www.r-graph-gallery.com/250-correlation-network-with-igraph.html

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