ggplot2优雅绘制经典Pcoa分析图

ggplot2优雅绘制经典Pcoa分析图 by R语言数据分析指南

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

❝
最近在整理文档发现之前误删过一篇pcoa的经典可视化文档，本节重新发布一下。当时未加载ape包给各位读者造成了一点小疑惑。本次直接运行两年前的代码无任何报错，非常丝滑出图。数据为随意构建，图形无实际意义仅做绘图展示，仅供参考。数据会上传到交流群，购买过小编绘图文档的朋友可在所加的交流群内获取下载，有需要的朋友可关注文末介绍购买小编的R绘图文档。购买前请咨询，零基础不要买

历史记录

结果展示

图形解读

❝
此图结构非常的基础，只是绘图组成部分多除了主图外还添加了箱图+方差分析+adonis分析，因此导致数据处理步骤颇多代码量超大，但是其本质仍然属于基础图表。

加载R包

install.packages("pacman")
pacman::p_load(tidyverse,ggrepel,FactoMineR,magrittr,factoextra,RColorBrewer,vegan)
library(multcompView)
library(ape)
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)

整理pcoa分析结果

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))

方差分析

# 分别对PC1,PC2两个水平数据进行方差分析，并构建文本位置信息数据
cld1 <- multcompLetters4(aov(PC1 ~ Subtype,data=pcoadata),TukeyHSD(aov(PC1 ~ Subtype,data=pcoadata)))

dt1 <- pcoadata %>% group_by(Subtype) %>%
  dplyr::summarise(value_max=max(PC1),sd=sd(PC1)) %>% ungroup() %>% 
  arrange(desc(value_max))

text1 <- as.data.frame.list(cld1$Subtype) %>% rownames_to_column(var="Subtype") %>% 
  left_join(.,dt1,by="Subtype")


cld2 <- multcompLetters4(aov(PC2 ~ Subtype,data=pcoadata),TukeyHSD(aov(PC2 ~ Subtype,data=pcoadata)))

dt2 <- pcoadata %>% group_by(Subtype) %>%
  dplyr::summarise(value_max=max(PC2)) %>% ungroup() %>% 
  arrange(desc(value_max))

text2 <- as.data.frame.list(cld2$Subtype) %>% rownames_to_column(var="Subtype") %>% 
  left_join(.,dt2,by="Subtype")

绘制箱线图

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")

adonis 分析

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


p4 <- ggplot()+
  geom_text(aes(x=0,y = 0.1,label = paste("PERMANOVA:\ndf = ",otu.adonis$Df[1],
                                          "\nR2 =",round(otu.adonis$R2[1],5),
                              "\np-value = ",otu.adonis$`Pr(>F)`[1],sep="")),
            size=3.5,color="black",fontface="bold")+
  theme_bw()+
  theme(panel.background = element_rect(fill = 'white', colour = 'black'),
        axis.title=element_blank(),
        axis.ticks = element_blank(),
        axis.text=element_blank(),
        plot.title =element_blank(),
        legend.position = "non")

拼图

p2+p4+plot+p3 + 
  plot_layout(heights = c(1,4),widths = c(4,1),ncol = 2,nrow = 2)

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

❝
本节介绍到此结束，有需要学习R数据可视化的朋友欢迎到淘宝店铺：R语言数据分析指南，购买小编的R语言可视化文档(2024版)，购买将赠送2023年的绘图文档内容。目前此文档(2023+2024)已经更新上传200案例文档，每个案例都附有相应的数据和代码，并配有对应的注释文档，方便大家学习和参考。

2024更新的绘图内容将同时包含数据+代码+注释文档+文档清单，2023无目录仅有数据文件夹，小编只分享案例文档，不额外回答问题，无答疑服务，零基础不推荐买。

案例特点

所选案例图均属于个性化分析图表完全适用于论文发表，内容异常丰富两年累计发布案例图200+，2024年6月起提供html版注释文档更加直观易学。文档累计上千人次购买拥有良好的社群交流体验。

R代码结构清晰易懂，为防止中文乱码提供单独的注释文档

ixxmu / mp_duty

ggplot2优雅绘制经典Pcoa分析图 #5577