跟着Nature Communications学作图--复杂散点图

从这个系列开始，师兄就带着大家从「各大顶级期刊中的Figuer」入手，从仿照别人的作图风格到最后实现自己游刃有余的套用在自己的分析数据上！这一系列「绝对是高质量」！还不赶紧「点赞+在看」，学起来！

❝

本期分享的是Nature Communications上一篇关于机器学习的文章中的散点图。

这个散点图的亮点在于充分利用了散点的「填充和描边属性」，将两者与图形要表达的意义相结合，另外再加上散点的「大小属性」，使得这个图非常的「美观且内涵丰富」。内容很充实，「记得点赞哦！」

❞

话不多说，直接上图！

读图

❝

这个散点图的亮点在于充分利用了散点的「填充和描边属性」，将两者与图形要表达的意义相结合，另外再加上散点的「大小属性」，使得这个图非常的「美观且内涵丰富」。

「图的含义：」大概解释一下，就是两种数据来源的数据MSK和FMI，每个圈代表一种癌症的转移，圈的填充颜色表示原发位置，圈的描边颜色为转移位置，圈的大小为这一类数据的样本量多少。x轴和y轴分别表示各种转移类型占各自肿瘤类型的百分比！

一张小小的散点图富含这么多内容，可谓是物尽其用了！「记得点赞哦！」

❞

效果预览

构建模拟数据

################# 构建数据 ########################
# FMI的数据：先创建随机字母组合表示癌症的原发位置和转移位置：
FMI <- cbind(LETTERS[sample(1:10,1000,replace = T)],LETTERS[sample(1:10,1000,replace = T)])

# 计算每种癌症内部转移至其它部位的比例：
percent <- unlist(tapply(FMI[,2], FMI[,1], function(x) table(x)/length(x)))

# 合并数据：
data_FMI <- as.data.frame(cbind(rep(LETTERS[1:10],rep(10,10)), rep(LETTERS[1:10],10)))
data_FMI$percent <- percent

# 同样的方法构建MSK的数据：
MSK <- cbind(LETTERS[sample(1:10,1000,replace = T)],LETTERS[sample(1:10,1000,replace = T)])

percent <- unlist(tapply(MSK[,2], MSK[,1], function(x) table(x)/length(x)))

data_MSK <- as.data.frame(cbind(rep(LETTERS[1:10],rep(10,10)), rep(LETTERS[1:10],10)))
data_MSK$percent <- percent


# 合并：
data <- cbind(data_FMI, data_MSK[,3])
colnames(data) <- c("primary","metastasis","percent_FMI","percent_MSK")

# 再构建一列，用于表达转移瘤的样本量；
data$meta_num <- c(sample(1:10,80, replace = T), sample(20:40,20, replace = T))

绘制

首先简单尝试一下

########################## 绘图 ##############################
library(ggplot2)

ggplot(data,aes(percent_MSK, percent_FMI))+
  geom_smooth(method="lm", 
              se=F, # 置信区间
              colour="#999999",
              linetype="dashed") +
  geom_point(aes(color=metastasis,fill=primary, 
                 size=meta_num),shape=21)+
  theme_classic()+
  scale_fill_manual(values = c("#d0db50","#8e94b8","#5fa0ca","#bddef3","#a0c0dd",
                               "#78b885","#fbed3e","#f08c41","#a988be","#fa9fb5"))+
  scale_color_manual(values = c("#d0db50","#8e94b8","#5fa0ca","#bddef3","#a0c0dd",
                                "#78b885","#fbed3e","#f08c41","#a988be","#fa9fb5"))+
  theme(legend.position = "none")

ggsave("scatter_plot_noSort.pdf",height = 6,width = 6)

发现相关性很低，调整数据（实际分析时不能这么做！！！）

############ 发现相关性几乎为0，调整数据 ##################
# 给同类型的比例排个序，相关性就高了，但是实际分析过程不能这么做！！！这里
data$percent_FMI <- unlist(tapply(data$percent_FMI, data$primary, 
                                  function(x) sort(x,decreasing = T)))

data$percent_MSK <- unlist(tapply(data$percent_MSK, data$primary, 
                                  function(x) sort(x,decreasing = T)))

Hmisc::rcorr(data$percent_FMI, data$percent_MSK)

# 去掉未转移的行：
data <- data[data$primary != data$metastasis,]

ggplot(data,aes(percent_MSK, percent_FMI))+
  geom_smooth(method="lm", 
              se=F, # 置信区间
              colour="#999999",
              linetype="dashed",
              alpha=0.2,
              size=0.5) +
  geom_point(aes(color=metastasis,fill=primary, 
                 size=meta_num),shape=21,
             stroke=1 # 描边粗细
             )+
  theme_classic()+
  scale_fill_manual(values = c("#d0db50","#8e94b8","#5fa0ca","#bddef3","#a0c0dd",
                               "#78b885","#fbed3e","#f08c41","#a988be","#fa9fb5"))+
  scale_color_manual(values = c("#d0db50","#8e94b8","#5fa0ca","#bddef3","#a0c0dd",
                                "#78b885","#fbed3e","#f08c41","#a988be","#fa9fb5"))+
  theme(legend.position = "none")+
  xlab("Metastatic Site % in MSK(2919)")+
  ylab("Metastatic Site % in FMI(4100)")+
  annotate(geom = "text", x=0.10, y=0.17,
           label = "R = 0.862, P = 1.04e-41")

ggsave("scatter_plot.pdf",height = 6,width = 6)

结果展示

• OK，大功告成啦！

❝

以上就是本期的全部内容啦！「欢迎点赞，点在看」！师兄会尽快更新哦！制作不易，你的打赏将成为师兄继续更新的十足动力！

❞