单细胞绘图系列:
在读文献Resolving the intertwining of inflammation and fibrosis in human heart failure at single-cell level的时候看到一张很漂亮的图,是用雷达图来绘制不同细胞群的多个感兴趣的通路富集情况,非常直观。所以来总结一下雷达图的画法,更重要的是做一下这张图的复现。
1. 雷达图的画法
1.1 fmsb包的radarchart函数
radarchart函数接收的是一个数据框,数据框的第一行为该元素的最大取值范围,数据框的第二行为该元素的最小取值范围,第二行以下的部分是各对象中该元素的值。
maxmin <- data.frame(
total=c(5, 1),
phys=c(15, 3),
psycho=c(3, 0),
social=c(5, 1),
env=c(5, 1))
maxmin ##数据框前两行,设置取值范围
# total phys psycho social env
# 1 5 15 3 5 5
# 2 1 3 0 1 1
set.seed(123)
dat <- data.frame(
total=runif(3, 1, 5),
phys=rnorm(3, 10, 2),
psycho=c(0.5, NA, 3),
social=runif(3, 1, 5),
env=c(5, 2.5, 4))
dat ##其余行为各对象中该元素的值
# total phys psycho social env
# 1 2.150310 12.380413 0.5 2.826459 5.0
# 2 4.153221 6.620889 NA 4.827333 2.5
# 3 2.635908 12.478992 3.0 2.813337 4.0
dat <- rbind(maxmin,dat)
# total phys psycho social env
# 1 5.000000 15.000000 3.0 5.000000 5.0
# 2 1.000000 3.000000 0.0 1.000000 1.0
# 3 2.150310 12.380413 0.5 2.826459 5.0
# 4 4.153221 6.620889 NA 4.827333 2.5
# 5 2.635908 12.478992 3.0 2.813337 4.0
#绘图
op <- par(mar=c(1, 2, 2, 1),mfrow=c(2, 2))
radarchart(dat, axistype=1, seg=5, plty=1, vlabels=c("Total\nQOL", "Physical\naspects",
"Phychological\naspects", "Social\naspects", "Environmental\naspects"),
title="(axis=1, 5 segments, with specified vlabels)", vlcex=0.5)
radarchart(dat, axistype=2, pcol=topo.colors(3), plty=1, pdensity=c(5, 10, 30),
pangle=c(10, 45, 120), pfcol=topo.colors(3),
title="(topo.colors, fill, axis=2)")
radarchart(dat, axistype=3, pty=32, plty=1, axislabcol="grey", na.itp=FALSE,
title="(no points, axis=3, na.itp=FALSE)")
radarchart(dat, axistype=1, plwd=1:5, pcol=1, centerzero=TRUE,
seg=4, caxislabels=c("worst", "", "", "", "best"),
title="(use lty and lwd but b/w, axis=1,\n centerzero=TRUE, with centerlabels)")
par(op)
主要参数:
axistype
:轴标签及类型,0:5可选,(默认 0)0:没有轴标签 1:仅标中心 2: 仅标四周 3:既标中心又标四周 4:同1,小数显示 5:同3 小数显示
seg
: segment 分成几个圈
pty
: point type ,点的形状,默认 16 黑点,32:不显示点
pcol
: 样本颜色 ,默认1:8,循环使用,也可进行设置(也可以直接传入颜色)
pfcol
:填充颜色
plty
:线的形状,默认1:6,循环使用
plwd
:线的粗细,默认1
cglty
: 雷达图网格线类型,默认 :3(虚线) ; 1 ,实线
cglwd
: 雷达图网格线粗度
cglcol
: 雷达图网格线颜色, 默认:navy
axislabcol
:标签颜色
title
: 标题
vlcex
:轴 name 的字体大小缩放比例
calcex
:轴中心字体大小缩放比例
palcex
:轴四周字体大小缩放比例
注意: radarchart()函数中,有个参数maxmin默认值是T,意味着,雷达图最大值为第一行,最小值为第二行,如果选为F,雷达图就会就会自动判每个因素的最大值和最小值,此时雷达图呈现得并不对称(在同一个线上的值并不相等)
1.2 ggradar包
#install.packages('devtools')
devtools::install_github('ricardo-bion/ggradar', dependencies = TRUE)
library(ggradar)
library(ggradar)
library(dplyr)
library(scales)
library(tibble)
mtcars_radar <- mtcars %>%
as_tibble(rownames = "group") %>%
mutate_at(vars(-group), rescale) %>%
tail(4) %>%
select(1:10)
mtcars_radar
## A tibble: 4 × 10
# group mpg cyl disp hp drat wt qsec
# <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
# 1 Ford… 0.230 1 0.698 0.749 0.673 0.424 0
# 2 Ferr… 0.396 0.5 0.184 0.435 0.396 0.321 0.119
# 3 Mase… 0.196 1 0.573 1 0.359 0.526 0.0119
# 4 Volv… 0.468 0 0.124 0.201 0.622 0.324 0.488
## … with 2 more variables: vs <dbl>, am <dbl>
ggradar(mtcars_radar)
1.3 plotly包的雷达图
#plotly 包的交互式雷达图的一个示例,详情 ?plot_ly
library(plotly)
p <- plot_ly(
type = 'scatterpolar',
fill = 'toself'
) %>%
add_trace(
r = c(39, 28, 8, 7, 28, 39),
theta = c('A','B','C', 'D', 'E', 'A'),
name = 'Group A'
) %>%
add_trace(
r = c(1.5, 10, 39, 31, 15, 1.5),
theta = c('A','B','C', 'D', 'E', 'A'),
name = 'Group B'
) %>%
layout(
polar = list(
radialaxis = list(
visible = TRUE,
range = c(0,50)
)
)
)
p
2. 复现
library(fmsb)
set.seed(99)
data=as.data.frame(matrix(sample( 0:50, 18,replace=T) , ncol=6))
colnames(data)=c('IL-1 signaling pathway','Response to IFNa','NFkB signaling pathway','IL-6 signaling pathway',
'Muscle contraction','Response to IFNr')
rownames(data) <- c('Monocyte','Neutrophil','Macrophage')
# 用于生成雷达图的最大最小值
data=rbind(rep(50,5) , rep(0,5) , data)
colors_border=c(rgb(0.8549,0.64706,0.12549,0.9),rgb(1,0.49804,0.31373,0.9), rgb(0.81569,0.12549,0.56471,0.9))
colors_in=c(rgb(0.8549,0.64706,0.12549,0.5),rgb(1,0.49804,0.31373,0.5), rgb(0.81569,0.12549,0.56471,0.4))
radarchart( data , axistype=0,
pcol=colors_border , pfcol=colors_in , plwd=1.3 , plty=1,pty=32,
cglcol="black", cglty=3, cglwd=0.6,
)
legend(x=1.5, y=1, legend = rownames(data[-c(1,2),]), bty = "n", pch=20 , col=colors_border, text.col = "black", cex=1, pt.cex=2)
注意:画上面这个图里的矩阵是我随机生成的,实际操作的时候把矩阵里的数值换成zscore或者fold Enrichment。