欢迎关注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代码结构清晰易懂，为防止中文乱码提供单独的注释文档
