说明:本模板自带模拟数据(维度与示例图一致:50 个 HALLMARK 通路 × 33 个 TCGA 癌种),补充了安装包与grid::unit依赖,直接 Knit 即可得到热图与气泡图。

# ===== 依赖包(未安装会自动安装) =====
need_pkgs <- c("tidyverse","ggplot2","paletteer","ggthemes","cols4all")
to_install <- need_pkgs[!sapply(need_pkgs, requireNamespace, quietly = TRUE)]
if (length(to_install)) install.packages(to_install, repos = "https://cloud.r-project.org")

library(tidyverse)
library(ggplot2)
library(paletteer)
library(ggthemes)
library(cols4all)
library(grid)  # for unit()
set.seed(20250928)

0) 构造示例数据)

# 33 个常用 TCGA 癌种
cancers <- c("ACC","BLCA","BRCA","CESC","CHOL","COAD","DLBC","ESCA","GBM","HNSC",
             "KICH","KIRC","KIRP","LAML","LGG","LIHC","LUAD","LUSC","MESO","OV",
             "PAAD","PCPG","PRAD","READ","SARC","SKCM","STAD","TGCT","THCA","THYM",
             "UCEC","UCS","UVM")

# 50 个 HALLMARK 通路(MSigDB 官方列表)
terms <- c("XENOBIOTIC_METABOLISM","WNT_BETA_CATENIN_SIGNALING","UV_RESPONSE_UP","UV_RESPONSE_DN",
           "UNFOLDED_PROTEIN_RESPONSE","TNFA_SIGNALING_VIA_NFKB","TGF_BETA_SIGNALING","SPERMATOGENESIS",
           "REACTIVE_OXYGEN_SPECIES_PATHWAY","PROTEIN_SECRETION","PI3K_AKT_MTOR_SIGNALING","PEROXISOME",
           "PANCREAS_BETA_CELLS","P53_PATHWAY","OXIDATIVE_PHOSPHORYLATION","NOTCH_SIGNALING","MYOGENESIS",
           "MYC_TARGETS_V2","MYC_TARGETS_V1","MTORC1_SIGNALING","MITOTIC_SPINDLE","KRAS_SIGNALING_UP",
           "KRAS_SIGNALING_DN","INTERFERON_GAMMA_RESPONSE","INTERFERON_ALPHA_RESPONSE","INFLAMMATORY_RESPONSE",
           "IL6_JAK_STAT3_SIGNALING","IL2_STAT5_SIGNALING","HYPOXIA","HEME_METABOLISM","HEDGEHOG_SIGNALING",
           "GLYCOLYSIS","G2M_CHECKPOINT","FATTY_ACID_METABOLISM","ESTROGEN_RESPONSE_LATE",
           "ESTROGEN_RESPONSE_EARLY","EPITHELIAL_MESENCHYMAL_TRANSITION","E2F_TARGETS","DNA_REPAIR",
           "COMPLEMENT","COAGULATION","CHOLESTEROL_HOMEOSTASIS","BILE_ACID_METABOLISM","APOPTOSIS",
           "APICAL_SURFACE","APICAL_JUNCTION","ANDROGEN_RESPONSE","ALLOGRAFT_REJECTION","ADIPOGENESIS")

n_c <- length(cancers); n_t <- length(terms)

# ---- 相关性矩阵 m:[-0.85, 0.85] ----
m <- matrix(runif(n_c*n_t, min = -0.85, max = 0.85),
            nrow = n_c, ncol = n_t,
            dimnames = list(cancers, paste0("HALLMARK_", terms)))

# 轻微结构(可选):让 KRAS_SIGNALING_DN 一行更偏负,MYC_TARGETS_V1 更偏正
if ("HALLMARK_KRAS_SIGNALING_DN" %in% colnames(m)) {
  m[, "HALLMARK_KRAS_SIGNALING_DN"] <- m[, "HALLMARK_KRAS_SIGNALING_DN"] - 0.25
  m[, "HALLMARK_KRAS_SIGNALING_DN"] <- pmax(-0.85, m[, "HALLMARK_KRAS_SIGNALING_DN"])
}
if ("HALLMARK_MYC_TARGETS_V1" %in% colnames(m)) {
  m[, "HALLMARK_MYC_TARGETS_V1"] <- m[, "HALLMARK_MYC_TARGETS_V1"] + 0.25
  m[, "HALLMARK_MYC_TARGETS_V1"] <- pmin( 0.85, m[, "HALLMARK_MYC_TARGETS_V1"])
}

# ---- P 值矩阵 p :(1e-10, 1](对数均匀分布,能覆盖非常显著到不显著)----
p <- 10^runif(n_c*n_t, min = -10, max = 0)
p <- matrix(p, nrow = n_c, ncol = n_t,
            dimnames = list(cancers, paste0("HALLMARK_", terms)))

# ---- 显著性标记矩阵 tmp (与示例一致:""、*、、*、) ----
p_to_stars <- function(x) {
  ifelse(x < 1e-4, "",
    ifelse(x < 1e-3, "*",
      ifelse(x < 1e-2, "",
        ifelse(x < 0.05, "*", ""))))
}
tmp <- matrix(p_to_stars(p), nrow = n_c, ncol = n_t,
              dimnames = list(cancers, paste0("HALLMARK_", terms)))

1) 相关性热图(格子内放显著性星号)

将矩阵转为长格式,geom_tile 映射相关性,geom_text 放星号。

# === 你的原始写法(基本不变)===
Data_GSVA <- data.frame(t(m))
Data_GSVA$Term <- rownames(Data_GSVA) 
Data_GSVA$Term <- gsub("HALLMARK_","",Data_GSVA$Term)
Data_GSVA$Term <- gsub("_"," ",Data_GSVA$Term)
dft <- Data_GSVA %>% pivot_longer(-Term)

Data_GSVA_P <- data.frame(t(tmp))
Data_GSVA_P$Term <- rownames(Data_GSVA_P)
Data_GSVA_P$Term <- gsub("HALLMARK_","",Data_GSVA_P$Term)
Data_GSVA_P$Term <- gsub("_"," ",Data_GSVA_P$Term)
dft_P <- Data_GSVA_P %>% pivot_longer(-Term)

range(dft$value)   # 检查值域,期望约 [-0.85, 0.85]
## [1] -0.85  0.85
head(dft)          # 相关性数值
head(dft_P)        # 相关性显著性表记(星号)
Heatmap <- ggplot(data = dft, aes(x = name, y = Term)) +
  geom_tile(aes(fill = value), color = "grey") +
  geom_text(data = dft_P, aes(x = name, y = Term, label = value), vjust = 0.7) +
  scale_x_discrete(expand = c(0,0)) +
  scale_y_discrete(expand = c(0,0)) +
  labs(title = "The Hallmarks Gene Set Enrichment Analysis", x = NULL, y = NULL) +
  theme_minimal() +
  theme(panel.border = element_rect(fill = NA, color = "black", size = 1, linetype = "solid"),
        panel.grid = element_blank(),
        plot.title = element_text(hjust = 0.5, size = 20),
        axis.ticks.y = element_blank(),
        axis.title = element_blank(),
        axis.text.x = element_text(angle = 45, hjust = 1, colour = 'black', size = 12),
        axis.text.y = element_text(colour = 'black', size = 12),
        plot.margin = grid::unit(c(0.4,0.4,0.4,0.4), units = "cm")) +
  scale_fill_paletteer_c("ggthemes::Classic Red-Blue",
                         direction = -1,
                         name = "Correlation level",
                         limits = c(-0.85, 0.85),
                         breaks = seq(-0.8, 0.8, 0.4))
## Warning: The `size` argument of `element_rect()` is deprecated as of ggplot2 3.4.0.
## ℹ Please use the `linewidth` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# 拉长图例
Heatmap2 <- Heatmap + theme(legend.position = "bottom",
                            legend.text  = element_text(color = "black", size = 12),
                            legend.title = element_text(size  = 14, color = "black")) +
  guides(fill = guide_colorbar(title.position = "left", title.hjust = 0.5,
                               barwidth = 15, barheight = 1.5, ticks = FALSE))

Heatmap2

2) 相关性气泡图(颜色=相关性,大小=-log10 P 值)

shape = 21 允许填充色;将极小 P 值截断到 1e-10 后取 -log10()

# 仅此处将 Data_GSVA_P 重定义为 p
Data_GSVA_P <- data.frame(t(p))
Data_GSVA_P$Term <- rownames(Data_GSVA_P)
dft_P <- Data_GSVA_P %>% pivot_longer(-Term)

Plotdata <- dft
colnames(Plotdata)[3] <- "Correlation"
Plotdata$Pvalue <- dft_P$value

Plotdata$Pvalue[Plotdata$Pvalue < 10^(-10)] <- 10^(-10)
Plotdata$Pvalue <- -log10(Plotdata$Pvalue)
Dotplot <- ggplot(data = Plotdata, aes(x = name, y = Term, size = Pvalue)) +
  geom_point(shape = 21, aes(fill = Correlation), position = position_dodge(0)) +
  scale_size_continuous(range = c(0, 6), name = "-log10 Pvalue",
                        limits = c(0,10), breaks = seq(0,10,2), labels = seq(0,10,2)) +
  scale_fill_gradient(low = "#498EA4", high = "#E54924", name = "Correlation",
                      limits = c(-0.85, 0.85), breaks = seq(-0.8, 0.8, 0.4)) +
  labs(title = "The Hallmarks Gene Set Enrichment Analysis", x = NULL, y = NULL) +
  theme_minimal() +
  theme(panel.border = element_rect(fill = NA, color = "black", size = 1, linetype = "solid"),
        panel.grid = element_blank(),
        plot.title = element_text(hjust = 0.5, size = 20),
        axis.ticks.y = element_blank(),
        axis.title = element_blank(),
        axis.text.x = element_text(angle = 45, hjust = 1, colour = 'black', size = 12),
        axis.text.y = element_text(colour = 'black', size = 12))

# 拉长图例
Dotplot2 <- Dotplot + theme(legend.position = "bottom",
                            legend.text  = element_text(color = "black", size = 12),
                            legend.title = element_text(size  = 14, color = "black")) +
  guides(fill = guide_colorbar(title.position = "left", title.hjust = 0.5,
                               barwidth = 15, barheight = 1.5, ticks = TRUE))
Dotplot2

# 中点过渡版
Dotplot_alt <- ggplot(data = Plotdata, aes(x = name, y = Term, size = Pvalue)) +
  geom_point(shape = 21, aes(fill = Correlation), position = position_dodge(0)) +
  scale_size_continuous(range = c(0, 6), name = "-log10 Pvalue",
                        limits = c(0,10), breaks = seq(0,10,2), labels = seq(0,10,2)) +
  scale_fill_gradient2(low = "#4d685c", mid = "white", high = "#a84b7c",
                       name = "Correlation", midpoint = 0,
                       limits = c(-0.85, 0.85), breaks = seq(-0.8, 0.8, 0.4)) +
  labs(title = "The Hallmarks Gene Set Enrichment Analysis", x = NULL, y = NULL) +
  theme_minimal() +
  theme(panel.border = element_rect(fill = NA, color = "black", size = 1, linetype = "solid"),
        panel.grid = element_blank(),
        plot.title = element_text(hjust = 0.5, size = 20),
        axis.ticks.y = element_blank(),
        axis.title = element_blank(),
        axis.text.x = element_text(angle = 45, hjust = 1, colour = 'black', size = 12),
        axis.text.y = element_text(colour = 'black', size = 12))

# 拉长图例
Dotplot3 <- Dotplot_alt + theme(legend.position = "bottom",
                                legend.text  = element_text(color = "black", size = 12),
                                legend.title = element_text(size  = 14, color = "black")) +
  guides(fill = guide_colorbar(title.position = "left", title.hjust = 0.5,
                               barwidth = 15, barheight = 1.5, ticks = TRUE))
Dotplot3

3)(可选)导出当前使用的数据

方便后续复用作图数据。

write.csv(m,   "m_matrix.csv",   row.names = TRUE)
write.csv(p,   "p_matrix.csv",   row.names = TRUE)
write.csv(tmp, "tmp_matrix.csv", row.names = TRUE)