相关性热图代码

在这里插入图片描述

#加载这两个包
# 安装并加载所需包
install.packages("psych") # 如安装过了无需运行
install.packages("corrplot")# 如安装过了无需运行

library(psych)
library(corrplot)

df <- read.csv('1234.csv',header = T)  # 替换为你的文件路径(R工作目录中)

# 计算相关性矩阵
cor_matrix <- cor(df, use = "complete.obs", method = "pearson")

# 计算p值矩阵(使用cor.mtest函数,下面提供函数)
cor_test <- function(mat) {
  n <- ncol(mat)
  p_mat <- matrix(NA, n, n)
  colnames(p_mat) <- rownames(p_mat) <- colnames(mat)
  for (i in 1:(n - 1)) {
    for (j in (i + 1):n) {
      test <- cor.test(mat[, i], mat[, j])
      p_mat[i, j] <- p_mat[j, i] <- test$p.value
    }
  }
  diag(p_mat) <- 0
  return(p_mat)
}
p.mat <- cor_test(df)


# 设置输出 PDF 文件路径和大小(单位:英寸) 
pdf("correlation_heatmap.pdf", width = 7, height = 6)

# 绘制圆圈形式的相关性热图,带显著性标记
corrplot(cor_matrix, method = "circle", type = "lower",
         p.mat = p.mat,
         sig.level = c(0.001, 0.01, 0.05), 
         insig = "label_sig",            
         # addCoef.col = "black",        # 可选:显示相关系数
         tl.col = "black", tl.srt = 90,
         col = colorRampPalette(c("#0066CC", "white", "#FF3300"))(200),
         title = "相关性热图", mar = c(0,0,2,0))

dev.off()  # 关闭 PDF 设备

在这里插入图片描述

library(readxl)
library(dplyr)
library(ggplot2)
library(reshape2)
library(pheatmap)
library(psych)
library(corrplot)
library(tidyverse)
data1 <- readxl::read_xlsx("./横向表观指标.xlsx")
data2 <- read_excel("./菌落.xlsx")
merged_data <- merge(data1, data2, by = "sample")
cor_matrix <- cor(merged_data[, -1], use = "complete.obs", method = "pearson")

cor_test <- function(mat) {
  n <- ncol(mat)
  p_mat <- matrix(NA, n, n)
  colnames(p_mat) <- rownames(p_mat) <- colnames(mat)
  for (i in 1:(n - 1)) {
    for (j in (i + 1):n) {
      test <- cor.test(mat[, i], mat[, j])
      p_mat[i, j] <- p_mat[j, i] <- test$p.value
    }
  }
  diag(p_mat) <- 0
  return(p_mat)
}
p.mat <- cor_test(cor_matrix)

cor_melted <- melt(cor_matrix)
p.melted <- melt(p.mat)

# 给每个p值添加显著性标记
cor_melted$significance <- ""
cor_melted$significance[which(p.melted$value <= 0.001)] <- "***"
cor_melted$significance[which(p.melted$value <= 0.01 & p.melted$value > 0.001)] <- "**"
cor_melted$significance[which(p.melted$value <= 0.05 & p.melted$value > 0.01)] <- "*"
selected_species <- c("g__Lactobacillus", "g__norank_f__Desulfovibrionaceae", "g__Monoglobus")
cor_melted = cor_melted[cor_melted$Var2 %in% selected_species, ]
cor_melted = cor_melted[!cor_melted$Var1 %in% selected_species, ]
ggplot(cor_melted, aes(x = Var1, y = Var2, size = abs(value), color = value)) +
  geom_point() +
  scale_color_gradient2(low = "blue", high = "red", mid = "white", midpoint = 0) +
  scale_size(range = c(3, 10)) +  # 控制气泡大小
  geom_text(aes(label = significance), size = 4, color = "black") +  # 显示显著性标记
  theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  labs(title = "Correlation Bubble Plot", x = "Markers and Microbial Species", y = "Markers and Microbial Species") +
  guides(size = guide_legend(title = "Correlation Strength"), color = guide_colorbar(title = "Correlation Value"))

在这里插入图片描述

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值