单细胞分析之细胞交互-4：NicheNet

常用的细胞通讯软件：

CellphoneDB：是公开的人工校正的，储存受体、配体以及两种相互作用的数据库。此外，还考虑了结构组成，能够描述异构复合物。（配体-受体+多聚体）

iTALK：通过平均表达量方式，筛选高表达的胚体和受体，根据结果作圈图。（配体-受体）

CellChat：CellChat将细胞的基因表达数据作为输入，并结合配体受体及其辅助因子的相互作用来模拟细胞间通讯。（配体-受体+多聚体+辅因子）

NicheNet // NicheNet多样本分析 // 目标基因的配体和靶基因活性预测：通过将相互作用细胞的表达数据与信号和基因调控网络的先验知识相结合来预测相互作用细胞之间的配体-靶标联系的方法。( 配体-受体+信号通路）
附：NicheNet使用的常见问题汇总

其它细胞互作软件还包括Celltalker，SingleCellSignalR，scTensor和SoptSC（这几个也是基于配体-受体相互作用）

官网：https://github.com/saeyslab/nichenetr

Nature Methods原文

1. NicheNet介绍

1.1 NicheNet工作流程：

一般的预测细胞交互的软件往往只考虑sender细胞的配体和receiver细胞的受体表达，但细胞交互过程除了配体-受体相互作用以外，还包含了receiver细胞接受信号后相关通路的激活。
NicheNet输入基因表达数据，并将其与通过整合信号通路而构建的模型相结合。不止是预测配体与受体的相互作用，还整合了细胞内信号传导。因此，NicheNet可以预测1)来自一或多种细胞中的配体（sender）影响了与之相互作用的细胞中哪些基因的表达和2)哪些靶基因受每种配体影响以及可能涉及哪些信号传导介质。

NicheNet工作流程图

首先从公共数据库中收集配体-受体配对信息、信号通路、基因调控网络等信息，整合成配体主导的权重配体-靶基因调控模型。然后将可能受到细胞通讯影响的差异基因集输入先验模型，可以计算与这些基因相关的配体的相关性系数。最后挑选根据相关性系数排行靠前的配体，依据先验数据推测与之匹配的受体、靶基因及下游信号网络等信息。

NicheNet不同于大多数研究细胞间通讯的方法，它着眼于配体对下游基因调控作用。NicheNet可以预测哪些配体影响另一个细胞中的表达，哪些靶基因受到配体的影响以及哪些信号传导可能参与其中。

1.2 NicheNet工作pipeline

在单细胞数据中定义一个“sender/niche”细胞群（配体细胞）和一个“receiver/target”细胞群（受体细胞）并确定这两个细胞群都表达哪些基因。
定义一个感兴趣的基因集：这些基因来自受体细胞群，是可能受到与其相互作用的细胞配体调控的基因集。（例如：case-control中的差异表达基因，也可以是细胞的signature或其他基因集）
定义一个潜在的配体集：这些配体由配体细胞群中高表达（如10%以上的细胞表达）并可以与受体细胞群表达的受体相结合（通过先验数据推断）。
进行NicheNet配体活性分析：其活性主要通过配体与受体细胞中的差异基因集的相关性进行判断
推断在配体活性分析中的top-ranked配体所调控的top-predicted靶基因，以及与配体配对的受体。

NicheNet提供了一个三个功能相似的打包函数： nichenet_seuratobj_aggregate, nichenet_seuratobj_cluster_de and nichenet_seuratobj_aggregate_cluster_de.它们可以一步完成上述五步seurat对象的配体调控网络分析。

1.3 NicheNet主要功能

Specific functionalities of this package include:

assessing how well ligands expressed by a sender cell can predict changes in gene expression in the receiver cell
prioritizing ligands based on their effect on gene expression
inferring putative ligand-target links active in the system under study
inferring potential signaling paths between ligands and target genes of interest: to generate causal hypotheses and check which data sources support the predictions
validation of the prior ligand-target model
construction of user-defined prior ligand-target models
Moreover, we provide instructions on how to make intuitive visualizations of the main predictions (e.g., via circos plots).

2. Perform NicheNet analysis starting from a Seurat object

本文的演示数据集和代码来自NicheNet官方分析单细胞数据的教程：https://github.com/saeyslab/nichenetr/blob/master/vignettes/seurat_wrapper.md

我们将使用Medaglia等人的小鼠NICHE-seq数据，探索淋巴细胞性脉络膜脑膜炎病毒（LCMV）感染之前和之后72小时的腹股沟淋巴结T细胞区域的细胞间通讯。在该数据集中，观察到稳态下的CD8 T细胞与LCMV感染后的CD8 T细胞之间存在差异表达。NicheNet可用于观察淋巴结中的几种免疫细胞群（即单核细胞，树突状细胞，NK细胞，B细胞，CD4 T细胞）如何调节和诱导这些观察到的基因表达变化。

#准备
# devtools::install_github("saeyslab/nichenetr")
library(circlize)
library(nichenetr)
library(Seurat) # please update to Seurat V4
library(tidyverse)

2.1 读入NicheNet的配体-受体先验模型，配体-受体网络和加权整合网络。

ligand_target_matrix = readRDS(url("https://zenodo.org/record/3260758/files/ligand_target_matrix.rds"))
ligand_target_matrix[1:5,1:5] #target genes in rows, ligands in columns
##                 CXCL1        CXCL2        CXCL3        CXCL5         PPBP
## A1BG     3.534343e-04 4.041324e-04 3.729920e-04 3.080640e-04 2.628388e-04
## A1BG-AS1 1.650894e-04 1.509213e-04 1.583594e-04 1.317253e-04 1.231819e-04
## A1CF     5.787175e-04 4.596295e-04 3.895907e-04 3.293275e-04 3.211944e-04
## A2M      6.027058e-04 5.996617e-04 5.164365e-04 4.517236e-04 4.590521e-04
## A2M-AS1  8.898724e-05 8.243341e-05 7.484018e-05 4.912514e-05 5.120439e-05

lr_network = readRDS(url("https://zenodo.org/record/3260758/files/lr_network.rds"))
head(lr_network)
## # A tibble: 6 x 4
##   from  to    source         database
##                  
## 1 CXCL1 CXCR2 kegg_cytokines kegg    
## 2 CXCL2 CXCR2 kegg_cytokines kegg    
## 3 CXCL3 CXCR2 kegg_cytokines kegg    
## 4 CXCL5 CXCR2 kegg_cytokines kegg    
## 5 PPBP  CXCR2 kegg_cytokines kegg    
## 6 CXCL6 CXCR2 kegg_cytokines kegg

weighted_networks = readRDS(url("https://zenodo.org/record/3260758/files/weighted_networks.rds"))
head(weighted_networks$lr_sig) # interactions and their weights in the ligand-receptor + signaling network
## # A tibble: 6 x 3
##   from  to     weight
##       
## 1 A1BG  ABCC6  0.422 
## 2 A1BG  ACE2   0.101 
## 3 A1BG  ADAM10 0.0970
## 4 A1BG  AGO1   0.0525
## 5 A1BG  AKT1   0.0855
## 6 A1BG  ANXA7  0.457
head(weighted_networks$gr) # interactions and their weights in the gene regulatory network
## # A tibble: 6 x 3
##   from  to     weight
##       
## 1 A1BG  A2M    0.0294
## 2 AAAS  GFAP   0.0290
## 3 AADAC CYP3A4 0.0422
## 4 AADAC IRF8   0.0275
## 5 AATF  ATM    0.0330
## 6 AATF  ATR    0.0355

2.2 读入注释好的Seurat对象

seuratObj = readRDS(url("https://zenodo.org/record/3531889/files/seuratObj.rds"))
[email protected] %>% head()
##         nGene nUMI orig.ident aggregate res.0.6 celltype nCount_RNA nFeature_RNA
## W380370   880 1611      LN_SS        SS       1    CD8 T       1607          876
## W380372   541  891      LN_SS        SS       0    CD4 T        885          536
## W380374   742 1229      LN_SS        SS       0    CD4 T       1223          737
## W380378   847 1546      LN_SS        SS       1    CD8 T       1537          838
## W380379   839 1606      LN_SS        SS       0    CD4 T       1603          836
## W380381   517  844      LN_SS        SS       0    CD4 T        840          513
seuratObj
## An object of class Seurat 
## 13541 features across 5027 samples within 1 assay 
## Active assay: RNA (13541 features, 1575 variable features)
## 4 dimensional reductions calculated: cca, cca.aligned, tsne, pca

查看存在哪些细胞群

[email protected]$celltype %>% table() # note that the number of cells of some cell types is very low and should preferably be higher for a real application
## .
##     B CD4 T CD8 T    DC  Mono    NK  Treg 
##   382  2562  1645    18    90   131   199
DimPlot(seuratObj, reduction = "tsne")

查看分组

[email protected]$aggregate %>% table()
## .
## LCMV   SS 
## 3886 1141
DimPlot(seuratObj, reduction = "tsne", group.by = "aggregate")

2.3 进行NicheNet分析

在这个演示中，我们希望预测哪些配体可能影响CD8 T细胞在LCMV感染前后的差异表达基因。因此receiver细胞群是' CD8 T '细胞群，而sender细胞群是' CD4 T '， ' Treg '， ' Mono '， ' NK '， ' B '和' DC '。
我们感兴趣的基因是LCMV感染后CD8 T细胞中差异表达的基因。因此，将感兴趣的条件condition_oi设置为“LCMV”，而参考/稳态条件condition_reference设置为“SS”。（计算差异基因的方法是标准Seurat Wilcoxon检验）
用于预测活性靶基因和构建活性配体-受体网络的top-ranked配体的数量默认是20个。（top_n_ligands参数指定用于后续分析的高活性配体的数量）

# indicated cell types should be cell class identities
# check via: 
# seuratObj %>% Idents() %>% table()
nichenet_output = nichenet_seuratobj_aggregate(
  seurat_obj = seuratObj, 
  receiver = "CD8 T", 
  condition_colname = "aggregate", condition_oi = "LCMV", condition_reference = "SS", 
  sender = c("CD4 T","Treg", "Mono", "NK", "B", "DC"), 
  ligand_target_matrix = ligand_target_matrix, lr_network = lr_network, weighted_networks = weighted_networks, organism = "mouse")
## [1] "Read in and process NicheNet's networks"
## [1] "Define expressed ligands and receptors in receiver and sender cells"
## [1] "Perform DE analysis in receiver cell"
## [1] "Perform NicheNet ligand activity analysis"
## [1] "Infer active target genes of the prioritized ligands"
## [1] "Infer receptors of the prioritized ligands"

# 输出的是一个列表：
nichenet_output %>% names()
## [1] "ligand_activities"                "top_ligands"                      "top_targets"                     
## [4] "top_receptors"                    "ligand_target_matrix"             "ligand_target_heatmap"           
## [7] "ligand_target_df"                 "ligand_activity_target_heatmap"   "ligand_receptor_matrix"          
##[10] "ligand_receptor_heatmap"          "ligand_receptor_df"               "ligand_receptor_matrix_bonafide" 
##[13] "ligand_receptor_heatmap_bonafide" "ligand_receptor_df_bonafide"      "geneset_oi"                      
##[16] "background_expressed_genes"      
View(nichenet_output)

查看配体活性分析结果
NicheNet做的第一件事是根据预测的配体活性来确定配体的优先级。使用如下命令查看这些配体的排名:

nichenet_output$ligand_activities
## # A tibble: 44 x 6
##    test_ligand auroc  aupr pearson  rank bona_fide_ligand
##                            
##  1 Ebi3        0.662 0.238  0.219      1 FALSE           
##  2 Il15        0.596 0.160  0.109      2 TRUE            
##  3 Crlf2       0.560 0.160  0.0890     3 FALSE           
##  4 App         0.499 0.134  0.0750     4 TRUE            
##  5 Tgfb1       0.498 0.134  0.0631     5 TRUE            
##  6 Ptprc       0.539 0.142  0.0602     6 TRUE            
##  7 H2-M3       0.526 0.149  0.0533     7 TRUE            
##  8 Icam1       0.544 0.134  0.0496     8 TRUE            
##  9 Cxcl10      0.536 0.134  0.0457     9 TRUE            
## 10 Adam17      0.517 0.129  0.0378    10 TRUE            
## # ... with 34 more rows

不同的配体活性检测值（auroc, aupr,pearson相关系数）是用来评估配体对观测到的差异表达基因的预测能力。NicheNet主要参考pearson相关系数对这些配体进行排序（效果最好）。
‘bona_fide_ligand’这一列的意思是这个配体是否存在于受体-配体数据库中（有的话为TRUE）。

查看top20配体

nichenet_output$top_ligands
 [1] "Ebi3"   "Il15"   "Crlf2"  "App"    "Tgfb1"  "Ptprc"  "H2-M3" 
 [8] "Icam1"  "Cxcl10" "Adam17" "Cxcl11" "Cxcl9"  "H2-T23" "Sema4d"
[15] "Ccl5"   "C3"     "Cxcl16" "Itgb1"  "Anxa1"  "Sell"

查看哪个细胞群表达了这些配体

p = DotPlot(seuratObj, features = nichenet_output$top_ligands %>% rev(), cols = "RdYlBu") + RotatedAxis()
ggsave("top20_ligands.png", p, width = 12, height = 6)
#⚠️%>% rev()这一步是将横坐标的基因反过来排序

大多数top-ranked配体似乎主要由树突状细胞和单核细胞表达。

观察这些配体在LCMV感染后是否有有差异表达

p=DotPlot(seuratObj, features = nichenet_output$top_ligands %>% rev(), split.by = "aggregate") + RotatedAxis()
ggsave("top20_ligands_compare.png", p, width = 12, height = 8)

用小提琴图对比配体的表达情况

p=VlnPlot(seuratObj, features = nichenet_output$top_ligands, split.by = "aggregate", pt.size = 0, combine = T)
ggsave("VlnPlot_ligands_compare.png", p, width = 24, height = 16)

feature后面没有加%>% rev()，出图的基因顺序就和前两个图相反

查看配体调控靶基因

推断活跃的配体-靶标连接

p = nichenet_output$ligand_target_heatmap
ggsave("Heatmap_ligand-target.png", p, width = 12, height = 6)

这是一个普通的ggplot2对象，可以改变颜色和轴标签等等（如下图）

p = nichenet_output$ligand_target_heatmap + scale_fill_gradient2(low = "whitesmoke",  high = "royalblue", breaks = c(0,0.0045,0.009)) + xlab("anti-LCMV response genes in CD8 T cells") + ylab("Prioritized immmune cell ligands")
ggsave("Heatmap_ligand-target2.png", p, width = 12, height = 6)

查看20个 top-ranked配体的top-predicted靶基因。

x = nichenet_output$top_targets
#x2 <- nichenet_output$ligand_target_df
write.csv(x, "ligand_target.csv", row.names = F)
##  [1] "Cd274"  "Cd53"   "Ddit4"  "Id3"    "Ifit3"  "Irf1"   "Irf7"   "Irf9"   "Parp14" "Pdcd4" 
## [11] "Pml"    "Psmb9"  "Rnf213" "Stat1"  "Stat2"  "Tap1"   "Ubc"    "Zbp1"   "Cd69"   "Gbp4"  
## [21] "Basp1"  "Casp8"  "Cxcl10" "Nlrc5"  "Vim"    "Actb"   "Ifih1"  "Myh9"   "B2m"    "H2-T23"
## [31] "Rpl13a" "Cxcr4"

查看这些受体基因在病毒感染前后CD8中的表达

p = DotPlot(seuratObj %>% subset(idents = "CD8 T"), features = nichenet_output$top_targets %>% rev(), split.by = "aggregate") + RotatedAxis()
ggsave("Targets_Expression_dotplot.png", p, width = 12, height = 6)

查看部分配体调控靶基因的表达情况

p=VlnPlot(seuratObj %>% subset(idents = "CD8 T"), features = c("Zbp1","Ifit3","Irf7"), split.by = "aggregate",    pt.size = 0, combine = T)
ggsave("Targets_Expression_vlnplot.png", p, width = 12, height = 4)

若设置combine=F，就会画出三张图

查看受体情况

可视化配体和靶基因活性

p = nichenet_output$ligand_activity_target_heatmap
ggsave("Heatmap_ligand_activity_target.png", p, width = 12, height = 6)

查看配体-受体互作

p = nichenet_output$ligand_receptor_heatmap
ggsave("Heatmap_ligand-receptor.png", p, width = 12, height = 6)

x <- nichenet_output$ligand_receptor_matrix
#x <- nichenet_output$ligand_receptor_df
write.csv(x, "ligand_receptor.csv", row.names = F)

查看受体表达情况

p = DotPlot(seuratObj %>% subset(idents = "CD8 T"), 
             features = nichenet_output$top_receptors, 
             split.by = "aggregate") + RotatedAxis()
ggsave("Receptors_Expression_dotplot.png", p, width = 12, height = 6)

p = VlnPlot(seuratObj %>% subset(idents = "CD8 T"), features = nichenet_output$top_receptors, 
             split.by = "aggregate", pt.size = 0, combine = T, ncol = 8)
ggsave("Receptors_Expression_vlnplot.png", p, width = 12, height = 8)

有文献报道的配体-受体

# Show ‘bona fide’ ligand-receptor links that are described in the literature and not predicted based on PPI
p = nichenet_output$ligand_receptor_heatmap_bonafide
ggsave("Heatmap_ligand-receptor_bonafide.png", p, width = 8, height = 4)

x <- nichenet_output$ligand_receptor_matrix_bonafide
#x <- nichenet_output$ligand_receptor_df_bonafide
write.csv(x, "ligand_receptor_bonafide.csv", row.names = F)

3. Circos绘图来可视化配体-靶标和配体-受体的相互作用。

参考：https://github.com/saeyslab/nichenetr/blob/master/vignettes/circos.md
这一可视化分组根据最强表达的细胞类型预测活性配体。因此，我们需要确定每种细胞类型，它们表达的配体比其他细胞类型更强。计算发送细胞中平均配体表达量。

# avg_expression_ligands = AverageExpression(seuratObj %>% subset(subset = aggregate == "LCMV"),features = nichenet_output$top_ligands) # if want to look specifically in LCMV-only cells
avg_expression_ligands = AverageExpression(seuratObj, features = nichenet_output$top_ligands)

分配配体给发送细胞
为了给发送端细胞类型分配配体，我们可以查找哪个发送端细胞类型的表达式高于平均值+ SD。

sender_ligand_assignment = avg_expression_ligands$RNA %>% apply(1, function(ligand_expression){
  ligand_expression > (ligand_expression %>% mean() + ligand_expression %>% sd())
  }) %>% t()

sender_ligand_assignment[1:4,1:4]
#       CD8 T CD4 T  Treg     B
# Ebi3  FALSE FALSE FALSE FALSE
# Il15  FALSE FALSE FALSE FALSE
# Crlf2 FALSE FALSE FALSE FALSE
# App   FALSE FALSE FALSE FALSE

sender_ligand_assignment = sender_ligand_assignment %>% apply(2, function(x){x[x == TRUE]}) %>% purrr::keep(function(x){length(x) > 0})
names(sender_ligand_assignment)
## [1] "B"    "NK"   "Mono" "DC"

(sender_ligand_assignment)
# $B
# H2-M3 
#  TRUE 

# $NK
# Ptprc Itgb1 
#  TRUE  TRUE 

# $Mono
#   Ebi3  Crlf2    App  Tgfb1 Cxcl10 Adam17 Cxcl11  Cxcl9 Sema4d     C3  Anxa1 
#   TRUE   TRUE   TRUE   TRUE   TRUE   TRUE   TRUE   TRUE   TRUE   TRUE   TRUE 

# $DC
#   Il15  Icam1 H2-T23   Ccl5 Cxcl16  Itgb1 
#   TRUE   TRUE   TRUE   TRUE   TRUE   TRUE

顶部的配体似乎在B细胞、NK细胞、单核细胞和DCs中表达最强烈。我们也会知道在多种细胞类型中哪些配体是常见的(=特定于> 1细胞类型的配体，或在之前的代码块中未指定给某个细胞类型的配体)。现在确定哪些优先配体是由CAFs或内皮细胞表达的。

all_assigned_ligands = sender_ligand_assignment %>% lapply(function(x){names(x)}) %>% unlist()
unique_ligands = all_assigned_ligands %>% table() %>% .[. == 1] %>% names()
general_ligands = nichenet_output$top_ligands %>% setdiff(unique_ligands)

B_specific_ligands = sender_ligand_assignment$B %>% names() %>% setdiff(general_ligands)
NK_specific_ligands = sender_ligand_assignment$NK %>% names() %>% setdiff(general_ligands)
Mono_specific_ligands = sender_ligand_assignment$Mono %>% names() %>% setdiff(general_ligands)
DC_specific_ligands = sender_ligand_assignment$DC %>% names() %>% setdiff(general_ligands)

ligand_type_indication_df = tibble(
  ligand_type = c(rep("B-specific", times = B_specific_ligands %>% length()),
                  rep("NK-specific", times = NK_specific_ligands %>% length()),
                  rep("Mono-specific", times = Mono_specific_ligands %>% length()),
                  rep("DC-specific", times = DC_specific_ligands %>% length()),
                  rep("General", times = general_ligands %>% length())),
  ligand = c(B_specific_ligands, NK_specific_ligands, Mono_specific_ligands, DC_specific_ligands, general_ligands))

ligand_type_indication_df %>% head
## A tibble: 6 x 2
#  ligand_type   ligand
#            
#1 B-specific    H2-M3 
#2 NK-specific   Ptprc 
#3 Mono-specific Ebi3  
#4 Mono-specific Crlf2 
#5 Mono-specific App   
#6 Mono-specific Tgfb1

定义感兴趣的配体-目标链接
为了避免circos图中有太多配体目标链接，我们将只显示权重高于预定义截止值的链接:属于最低分数的40%的链接被删除。这并不是说用于这种可视化的边界和其他边界可以根据用户的需要进行更改。

active_ligand_target_links_df = nichenet_output$ligand_target_df %>% mutate(target_type = "LCMV-DE") %>% inner_join(ligand_type_indication_df) # if you want ot make circos plots for multiple gene sets, combine the different data frames and differentiate which target belongs to which gene set via the target type

cutoff_include_all_ligands = active_ligand_target_links_df$weight %>% quantile(0.40)

active_ligand_target_links_df_circos = active_ligand_target_links_df %>% filter(weight > cutoff_include_all_ligands)

ligands_to_remove = setdiff(active_ligand_target_links_df$ligand %>% unique(), active_ligand_target_links_df_circos$ligand %>% unique())
targets_to_remove = setdiff(active_ligand_target_links_df$target %>% unique(), active_ligand_target_links_df_circos$target %>% unique())
  
circos_links = active_ligand_target_links_df %>% filter(!target %in% targets_to_remove &!ligand %in% ligands_to_remove)

 circos_links
## A tibble: 125 x 5
#   ligand target  weight target_type ligand_type  
#                         
# 1 Ebi3   Cd274  0.00325 LCMV-DE     Mono-specific
# 2 Ebi3   Cd53   0.00321 LCMV-DE     Mono-specific
# 3 Ebi3   Ddit4  0.00335 LCMV-DE     Mono-specific
# 4 Ebi3   Id3    0.00373 LCMV-DE     Mono-specific
# 5 Ebi3   Ifit3  0.00320 LCMV-DE     Mono-specific
# 6 Ebi3   Irf1   0.00692 LCMV-DE     Mono-specific
# 7 Ebi3   Irf7   0.00312 LCMV-DE     Mono-specific
# 8 Ebi3   Irf9   0.00543 LCMV-DE     Mono-specific
# 9 Ebi3   Parp14 0.00336 LCMV-DE     Mono-specific
#10 Ebi3   Pdcd4  0.00335 LCMV-DE     Mono-specific
## … with 115 more rows

准备circos可视化:给每个片段配体和目标特定的颜色和顺序

grid_col_ligand =c("General" = "lawngreen",
            "NK-specific" = "royalblue",
            "B-specific" = "darkgreen",
            "Mono-specific" = "violet",
            "DC-specific" = "steelblue2")
grid_col_target =c(
            "LCMV-DE" = "tomato")

grid_col_tbl_ligand = tibble(ligand_type = grid_col_ligand %>% names(), color_ligand_type = grid_col_ligand)
grid_col_tbl_target = tibble(target_type = grid_col_target %>% names(), color_target_type = grid_col_target)

circos_links = circos_links %>% mutate(ligand = paste(ligand," ")) # extra space: make a difference between a gene as ligand and a gene as target!
circos_links = circos_links %>% inner_join(grid_col_tbl_ligand) %>% inner_join(grid_col_tbl_target)
links_circle = circos_links %>% select(ligand,target, weight)

ligand_color = circos_links %>% distinct(ligand,color_ligand_type)
grid_ligand_color = ligand_color$color_ligand_type %>% set_names(ligand_color$ligand)
target_color = circos_links %>% distinct(target,color_target_type)
grid_target_color = target_color$color_target_type %>% set_names(target_color$target)

grid_col =c(grid_ligand_color,grid_target_color)

# give the option that links in the circos plot will be transparant ~ ligand-target potential score
transparency = circos_links %>% mutate(weight =(weight-min(weight))/(max(weight)-min(weight))) %>% mutate(transparency = 1-weight) %>% .$transparency

准备可视化的circos:排序配体和目标

target_order = circos_links$target %>% unique()
ligand_order = c(Mono_specific_ligands, DC_specific_ligands, NK_specific_ligands,B_specific_ligands, general_ligands) %>% c(paste(.," ")) %>% intersect(circos_links$ligand)
order = c(ligand_order,target_order)

准备circos可视化:定义不同片段之间的间隙

width_same_cell_same_ligand_type = 0.5
width_different_cell = 6
width_ligand_target = 15
width_same_cell_same_target_type = 0.5

gaps = c(
  # width_ligand_target,
  rep(width_same_cell_same_ligand_type, times = (circos_links %>% filter(ligand_type == "Mono-specific") %>% distinct(ligand) %>% nrow() -1)),
  width_different_cell,
  rep(width_same_cell_same_ligand_type, times = (circos_links %>% filter(ligand_type == "DC-specific") %>% distinct(ligand) %>% nrow() -1)),
  width_different_cell,
  rep(width_same_cell_same_ligand_type, times = (circos_links %>% filter(ligand_type == "NK-specific") %>% distinct(ligand) %>% nrow() -1)),
  width_different_cell,
  rep(width_same_cell_same_ligand_type, times = (circos_links %>% filter(ligand_type == "B-specific") %>% distinct(ligand) %>% nrow() -1)),
  width_different_cell,
  rep(width_same_cell_same_ligand_type, times = (circos_links %>% filter(ligand_type == "General") %>% distinct(ligand) %>% nrow() -1)),
  width_ligand_target,
  rep(width_same_cell_same_target_type, times = (circos_links %>% filter(target_type == "LCMV-DE") %>% distinct(target) %>% nrow() -1)),
  width_ligand_target
  )

渲染circos的情节(所有链接相同的透明度)。只有表明每个靶基因的阻滞的宽度与配体-靶的调控电位成正比(~支持调控相互作用的先验知识)。

circos.par(gap.degree = gaps)
chordDiagram(links_circle, directional = 1,order=order,link.sort = TRUE, link.decreasing = FALSE, grid.col = grid_col,transparency = 0, diffHeight = 0.005, direction.type = c("diffHeight", "arrows"),link.arr.type = "big.arrow", link.visible = links_circle$weight >= cutoff_include_all_ligands,annotationTrack = "grid", 
    preAllocateTracks = list(track.height = 0.075))
# we go back to the first track and customize sector labels
circos.track(track.index = 1, panel.fun = function(x, y) {
    circos.text(CELL_META$xcenter, CELL_META$ylim[1], CELL_META$sector.index,
        facing = "clockwise", niceFacing = TRUE, adj = c(0, 0.55), cex = 1)
}, bg.border = NA) #

circos.clear()

绘制circos图(透明度由配体-靶标相互作用的调控潜力决定)

circos.par(gap.degree = gaps)
chordDiagram(links_circle, directional = 1,order=order,link.sort = TRUE, link.decreasing = FALSE, grid.col = grid_col,transparency = transparency, diffHeight = 0.005, direction.type = c("diffHeight", "arrows"),link.arr.type = "big.arrow", link.visible = links_circle$weight >= cutoff_include_all_ligands,annotationTrack = "grid", 
    preAllocateTracks = list(track.height = 0.075))
# we go back to the first track and customize sector labels
circos.track(track.index = 1, panel.fun = function(x, y) {
    circos.text(CELL_META$xcenter, CELL_META$ylim[1], CELL_META$sector.index,
        facing = "clockwise", niceFacing = TRUE, adj = c(0, 0.55), cex = 1)
}, bg.border = NA) #

circos.clear()

svg("ligand_target_circos.svg", width = 10, height = 10)
circos.par(gap.degree = gaps)
chordDiagram(links_circle, directional = 1,order=order,link.sort = TRUE, link.decreasing = FALSE, grid.col = grid_col,transparency = transparency, diffHeight = 0.005, direction.type = c("diffHeight", "arrows"),link.arr.type = "big.arrow", link.visible = links_circle$weight >= cutoff_include_all_ligands,annotationTrack = "grid",
    preAllocateTracks = list(track.height = 0.075))
# we go back to the first track and customize sector labels
circos.track(track.index = 1, panel.fun = function(x, y) {
    circos.text(CELL_META$xcenter, CELL_META$ylim[1], CELL_META$sector.index,
        facing = "clockwise", niceFacing = TRUE, adj = c(0, 0.55), cex = 1)
}, bg.border = NA) #
circos.clear()
dev.off()

在circos图中可视化优先配体与受体的相互作用

lr_network_top_df = nichenet_output$ligand_receptor_df %>% mutate(receptor_type = "LCMV_CD8T_receptor") %>% inner_join(ligand_type_indication_df)
grid_col_ligand =c("General" = "lawngreen",
            "NK-specific" = "royalblue",
            "B-specific" = "darkgreen",
            "Mono-specific" = "violet",
            "DC-specific" = "steelblue2")
grid_col_receptor =c(
            "LCMV_CD8T_receptor" = "darkred")

grid_col_tbl_ligand = tibble(ligand_type = grid_col_ligand %>% names(), color_ligand_type = grid_col_ligand)
grid_col_tbl_receptor = tibble(receptor_type = grid_col_receptor %>% names(), color_receptor_type = grid_col_receptor)

circos_links = lr_network_top_df %>% mutate(ligand = paste(ligand," ")) # extra space: make a difference between a gene as ligand and a gene as receptor!
circos_links = circos_links %>% inner_join(grid_col_tbl_ligand) %>% inner_join(grid_col_tbl_receptor)
links_circle = circos_links %>% select(ligand,receptor, weight)

ligand_color = circos_links %>% distinct(ligand,color_ligand_type)
grid_ligand_color = ligand_color$color_ligand_type %>% set_names(ligand_color$ligand)
receptor_color = circos_links %>% distinct(receptor,color_receptor_type)
grid_receptor_color = receptor_color$color_receptor_type %>% set_names(receptor_color$receptor)

grid_col =c(grid_ligand_color,grid_receptor_color)

# give the option that links in the circos plot will be transparant ~ ligand-receptor potential score
transparency = circos_links %>% mutate(weight =(weight-min(weight))/(max(weight)-min(weight))) %>% mutate(transparency = 1-weight) %>% .$transparency

制备可视化的circos:有序配体和受体

receptor_order = circos_links$receptor %>% unique()
ligand_order = c(Mono_specific_ligands, DC_specific_ligands, NK_specific_ligands,B_specific_ligands, general_ligands) %>% c(paste(.," ")) %>% intersect(circos_links$ligand)
order = c(ligand_order,receptor_order)

准备马戏团可视化:定义不同片段之间的间隙

width_same_cell_same_ligand_type = 0.5
width_different_cell = 6
width_ligand_receptor = 15
width_same_cell_same_receptor_type = 0.5

gaps = c(
  # width_ligand_target,
  rep(width_same_cell_same_ligand_type, times = (circos_links %>% filter(ligand_type == "Mono-specific") %>% distinct(ligand) %>% nrow() -1)),
  width_different_cell,
  rep(width_same_cell_same_ligand_type, times = (circos_links %>% filter(ligand_type == "DC-specific") %>% distinct(ligand) %>% nrow() -1)),
  width_different_cell,
  rep(width_same_cell_same_ligand_type, times = (circos_links %>% filter(ligand_type == "NK-specific") %>% distinct(ligand) %>% nrow() -1)),
  width_different_cell,
  rep(width_same_cell_same_ligand_type, times = (circos_links %>% filter(ligand_type == "B-specific") %>% distinct(ligand) %>% nrow() -1)),
  width_different_cell,
  rep(width_same_cell_same_ligand_type, times = (circos_links %>% filter(ligand_type == "General") %>% distinct(ligand) %>% nrow() -1)),
  width_ligand_receptor,
  rep(width_same_cell_same_receptor_type, times = (circos_links %>% filter(receptor_type == "LCMV_CD8T_receptor") %>% distinct(receptor) %>% nrow() -1)),
  width_ligand_receptor
  )

渲染马戏团的情节(所有链接相同的透明度)。只有表明每个受体的阻滞的宽度与配体-受体相互作用的重量成比例(~支持相互作用的先验知识)。

circos.par(gap.degree = gaps)
chordDiagram(links_circle, directional = 1,order=order,link.sort = TRUE, link.decreasing = FALSE, grid.col = grid_col,transparency = 0, diffHeight = 0.005, direction.type = c("diffHeight", "arrows"),link.arr.type = "big.arrow", link.visible = links_circle$weight >= cutoff_include_all_ligands,annotationTrack = "grid", 
    preAllocateTracks = list(track.height = 0.075))
# we go back to the first track and customize sector labels
circos.track(track.index = 1, panel.fun = function(x, y) {
    circos.text(CELL_META$xcenter, CELL_META$ylim[1], CELL_META$sector.index,
        facing = "clockwise", niceFacing = TRUE, adj = c(0, 0.55), cex = 0.8)
}, bg.border = NA) #

circos.clear()

渲染circos图(透明程度由配体-受体相互作用的先验相互作用权重决定——正如指示每个受体的块的宽度)

circos.par(gap.degree = gaps)
chordDiagram(links_circle, directional = 1,order=order,link.sort = TRUE, link.decreasing = FALSE, grid.col = grid_col,transparency = transparency, diffHeight = 0.005, direction.type = c("diffHeight", "arrows"),link.arr.type = "big.arrow", link.visible = links_circle$weight >= cutoff_include_all_ligands,annotationTrack = "grid", 
    preAllocateTracks = list(track.height = 0.075))
# we go back to the first track and customize sector labels
circos.track(track.index = 1, panel.fun = function(x, y) {
    circos.text(CELL_META$xcenter, CELL_META$ylim[1], CELL_META$sector.index,
        facing = "clockwise", niceFacing = TRUE, adj = c(0, 0.55), cex = 0.8)
}, bg.border = NA) #

circos.clear()

参考：https://www.jianshu.com/p/46f487f58a9c