ixxmu / mp_duty

抓取网络文章到github issues保存
https://archives.duty-machine.now.sh/
113 stars 30 forks source link

[会员专享] ggplot2优雅的进行PCOA分析 #2595

Closed ixxmu closed 2 years ago

ixxmu commented 2 years ago

https://mp.weixin.qq.com/s/M4vX_Pxxh4JWf-WY0_F75g

github-actions[bot] commented 2 years ago

[会员专享] ggplot2优雅的进行PCOA分析 by R语言数据分析指南

欢迎关注R语言数据分析指南

「周一VIP群」里有朋友询问如何对「PCOA图进行统计分析」例图如下,既然观众老爷们有需求,那就来写篇文档进行介绍;下面来看具体案例「数据代码已经上传VIP群,请自行下载」,细节较多各位观众老爷细细品味

论文图

复现图

图形解读

小编随意找了一份数据来进行分析,可以看到就是常见的「PCOA分析」并对「PC1,PC2」两个水平的数据进行了方差分析,并对整体数据进行了「adonis」分析,那么此图的重点已经不在于图形的绘制了,而是在于进行数据清洗得到绘图数据

有需要的观众老爷欢迎加入小编的VIP群,目前已经上传「2021-2022两年公众号文档数据+代码约190篇左右」包含付费文档,扫描文中尾二维码加小编微信「付费99元」后邀请进群,「由于群名额有限人满之后将不在添加新成员」,有需要的请尽早加入,早进早享受;「一定让你感受到物超所值」加入小编的VIP如果你有一些让我感兴趣的图表提供示例数据小编若有时间会写成推文发送

加载R包

pacman::p_load(tidyverse,ggrepel,FactoMineR,magrittr,factoextra,RColorBrewer,vegan)
library(multcompView)
library(patchwork)

导入数据

df <- read_tsv("data.xls") %>% dplyr::rename(sample="Sample_id") %>% 
  mutate(across("Subtype",str_replace,"-","_"))

PCOA分析

pcoa <- vegdist(df %>% column_to_rownames(var="sample") %>% 
                  dplyr::select(-Subtype),method = "bray") %>% 
  pcoa(correction = "none", rn = NULL)

数据整理

pcoadata <- data.frame(pcoa$vectors[,1],pcoa$vectors[,2]) %>% 
  set_colnames(c("PC1","PC2")) %>% 
  rownames_to_column(var="sample") %>% 
  left_join(.,df %>% dplyr::select(sample,Subtype),by="sample")

PCOA数据可视化

plot <- ggplot(pcoadata, aes(PC1, PC2)) +
  geom_point(aes(colour=Subtype,fill=Subtype),size=4)+
  scale_color_manual(values = colorRampPalette(brewer.pal(12,"Paired"))(4))+
  labs(x=paste0("(PC1: ",round(pcoa$values$Relative_eig[1]*100,2),"%)"),
       y=paste0("(PC2: ",round(pcoa$values$Relative_eig[2]*100,2),"%)"))+
  geom_vline(aes(xintercept = 0),linetype="dotted")+
  geom_hline(aes(yintercept = 0),linetype="dotted")+
  theme_bw()+
  theme(panel.background = element_rect(fill = 'white', colour = 'black'),
        axis.title.x = element_text(colour="black",size = 12,margin = margin(t=5),face = "bold"),
        axis.title.y = element_text(colour="black",size = 12,margin = margin(r=5),face = "bold"),
        axis.text=element_text(color="black",face = "bold"),
        plot.title =element_blank(),
        legend.title = element_blank(),
        legend.key=element_blank(),   # 图例键为空
        legend.text = element_text(color="black",size=9,face = "bold"), # 定义图例文本
        legend.spacing.x=unit(0.1,'cm'), # 定义文本书平距离
        legend.key.width=unit(0.5,'cm'), # 定义图例水平大小
        legend.key.height=unit(0.5,'cm'), # 定义图例垂直大小
        legend.background=element_blank(), # 设置背景为空
        legend.box.background=element_rect(colour="black"), # 图例绘制边框
        legend.position=c(0.001,0.999),legend.justification=c(0.0001,1))

到此我们基本上是完成了图形的主体,那接下来需要做的就是进行方差分析构建绘图数据

绘制箱线图

p2 <- ggplot(pcoadata,aes(Subtype,PC1,fill=Subtype)) +
  geom_boxplot(outlier.shape = NA,width=0.5,color="black",linetype="dotted")+
  stat_boxplot(aes(ymin = ..lower.., ymax = ..upper..),outlier.shape = NA,width=0.5)+
  stat_boxplot(geom = "errorbar", aes(ymin = ..ymax..),width=0.2,size=0.35) +
  stat_boxplot(geom = "errorbar", aes(ymax = ..ymin..),width=0.2,size=0.35) +
  labs(x=NULL,y=NULL)+
  geom_text(data=text1,aes(label=Letters,y=value_max+0.0082),angle=-90,color="black",size=4)+
  scale_fill_manual(values = colorRampPalette(brewer.pal(12,"Paired"))(4))+
  theme_bw()+
  theme(panel.background = element_rect(fill = 'white', colour = 'black'),
        axis.text=element_blank(),
        axis.ticks=element_blank(),
        plot.title =element_blank(),
        legend.position = "non")+ coord_flip()
p3 <- ggplot(pcoadata,aes(Subtype,PC2,fill=Subtype)) +
  geom_boxplot(outlier.shape = NA,width=0.5,color="black",linetype="dotted")+
  stat_boxplot(aes(ymin = ..lower.., ymax = ..upper..),outlier.shape = NA,width=0.5)+
  stat_boxplot(geom = "errorbar", aes(ymin = ..ymax..),width=0.2,size=0.35) +
  stat_boxplot(geom = "errorbar", aes(ymax = ..ymin..),width=0.2,size=0.35) +
  labs(x=NULL,y=NULL)+
  geom_text(data=text2,aes(label=Letters,y=value_max+0.0055),angle=0,color="black",size=4)+
  scale_fill_manual(values = colorRampPalette(brewer.pal(12,"Paired"))(4))+
  theme_bw()+
  theme(panel.background = element_rect(fill = 'white', colour = 'black'),
        axis.text=element_blank(),
        axis.ticks=element_blank(),
        plot.title =element_blank(),
        legend.position = "non")

otu.adonis <- adonis2(df %>% dplyr::select(-Subtype) %>% column_to_rownames(var="sample")
                    ~ Subtype,data = pcoadata,distance = "bray")

关于此部分其实可以写成函数,减少代码量;小编就不进行具体操作了,有需要获取完整代码的欢迎加入我的「VIP群」,或者付费购买即可;「一定让你感受到物超所值」

小编微信

关注下方公众号下回更新不迷路

进行adonis分析