欢迎关注R语言数据分析指南
❝本节来对常规的相关性热图做一点改变增加一点新的元素,以往此类图内框中主要展示数据之间的R值与P值，此次通过代码在图中来添加不同组间样本的分布情况，通过图片的形式将其添加到热图框内，若数据量较小可以如此操作，同时也可根据样本分组情况进行颜色填充，若数据量较大则不太适宜。散点图的绘制可以使用循环的方式进行，可使用添加图片的形式也可以使用ggdraw函数来实现，代码方式多种多样，小编在这里只展示一类。
❝下面小编就通过一个具体案例来进行介绍，数据为随意构建无实际意义，整个过程仅供参考。数据稍后会上传到交流群内，购买过小编绘图文档的朋友可在所加的交流群内获取下载，有需要的朋友可关注文末介绍购买小编的R绘图文档。购买前请咨询，零基础不要买。
结果展示
加载R包
library(tidyverse)
library(RColorBrewer)
library(ggtext)
library(magrittr)
library(reshape)
library(psych)
# install.packages("devtools")
# devtools::install_github("Hy4m/linkET", force = TRUE)
library(linkET)
library(ggnewscale)
library(corrplot)
library(ggimage)
### 数据清洗
varechem <- read_tsv("varechem.xls") %>% column_to_rownames(var="id")
table1 <- varechem %>% rownames_to_column(var="id") %>%
pivot_longer(-id) %>%
pivot_wider(values_from = value) %>%
column_to_rownames(var="id") %>% select(1:5)
varespec <- read_tsv("varespec.xls") %>% column_to_rownames(var="id")
mantel <- mantel_test(varespec, table1,
spec_select = list(Spec01 = 1:7,
Spec02 = 8:18,
Spec03 = 19:20)) %>%
mutate(rd = cut(r, breaks = c(-Inf, 0.2, 0.4, Inf),
labels = c("< 0.2", "0.2 - 0.4", ">= 0.4")),
pd = cut(p, breaks = c(-Inf, 0.01, 0.05, Inf),
labels = c("< 0.01", "0.01 - 0.05", ">= 0.05")))
cor_matrix <- cor(table1,method = "pearson")
cor_matrix[lower.tri(cor_matrix)] <- NA
cor_matrix[cor_matrix == 1] <- NA
cor_data <- melt(cor_matrix)
res1 <- cor.mtest(table1, conf.level = 0.95)
res1$p[lower.tri(res1$p)] <- NA
p_value <- res1$p %>% as.data.frame() %>%
rownames_to_column(var="id") %>%
pivot_longer(-id) %>%
drop_na() %>%
filter(id !=name) %>%
mutate(p_signif=symnum(value,cutpoints = c(0, 0.001, 0.01, 0.05,1),
symbols = c("***", "**", "*", "")))
table1 %>% select(Ca,Mg) %>% ggplot(aes(Ca,Mg))+
geom_point(size=10,color="red")+
geom_smooth(method = "lm",se=F)+
theme_void()+
theme(panel.background = element_blank(),
plot.background = element_blank(),
plot.margin = unit(c(0,0,0,0),units="cm"))
df2 <- data.frame(x = c(1,2,3,4),y = c(4,3,2,1),
image = c("NP.pdf","PK.pdf","KCa.pdf","CaMg.pdf"))
数据可视化
plot <- hyplot(correlate(table1,method = "pearson"),diag=F,type="lower")+
geom_panel_grid(size = 0.5,color="black") +
geom_image(data=df2,aes(x, y,image=image),size=0.18)+
geom_text(data=p_value,aes(id,name,label=p_signif),
inherit.aes = F,vjust=-4,hjust=0,size=3)+
geom_text(data=cor_data %>% drop_na(),
aes(X1,X2,label=round(value,digits = 2)),
inherit.aes = F,vjust=-4,hjust=1,size=3)+
guides(size="none")+
scale_size_continuous(range = c(0,10)) +
new_scale("size")+
scale_fill_gradientn(colors=rev(COL2('RdBu',10)),na.value = "white")+
geom_couple(aes(colour=pd,size=rd),data=mantel,
label.colour = "black",
curvature=nice_curvature(),
label.fontface=0,
label.size =3.5,drop = T,
nudge_x = 0.1,
node.colour = c("white", "white"),
node.fill = c("#984EA3","#5785C1"),
node.size = c(4.5,4),
node.shape=c(23,21))+
coord_cartesian(clip="off")+
scale_size_manual(values = c(0.5,1,2))+
scale_colour_manual(values = c("#984EA3", "#4DAF4A", "grey"))+
guides(fill = guide_colorbar(title = "pearson's r",order = 1),
color = guide_legend(title = "*P* value",order = 2,
theme = theme(legend.title =
element_markdown(color="black"))),
size = guide_legend(title = "mantel's r",order = 3))+
theme(plot.margin = unit(c(0.5,0.5,0.5,0.5),units="cm"),
axis.ticks =element_blank(),
panel.background = element_blank(),
legend.key = element_blank(),
legend.background = element_blank())
ggsave(plot,file="heatmap.pdf",width =9.95,height=6.38,unit="in",dpi=300)
关注下方公众号下回更新不迷路
购买介绍
❝本节介绍到此结束，有需要学习R数据可视化的朋友欢迎到淘宝店铺：R语言数据分析指南，购买小编的R语言可视化文档(2024版)，购买将赠送2023年的绘图文档内容。目前此文档(2023+2024)已经更新上传200案例文档，每个案例都附有相应的数据和代码，并配有对应的注释文档，方便大家学习和参考。
2024更新的绘图内容将同时包含数据+代码+注释文档+文档清单，2023无目录仅有数据文件夹，小编只分享案例文档，不额外回答问题，无答疑服务，零基础不推荐买。
案例特点
所选案例图均属于个性化分析图表完全适用于论文发表，内容异常丰富两年累计发布案例图200+，2024年6月起提供html版注释文档更加直观易学。文档累计上千人次购买拥有良好的社群交流体验。R代码结构清晰易懂，为防止中文乱码提供单独的注释文档
