请求生成R脚本绘制年份-百分比热力图（附示例数据）

数据加载 #

首先加载提供的数据框：

combined_df <- structure(list(year = c(1970, 1971, 1972, 1973, 1974, 1975, 1976, 
1977, 1978, 1979, 1980, 1981, 1982, 1983, 1984, 1985, 1986, 1987, 
1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 
1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 
2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 
2021, 2022, 2023), BB = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, 6.70202507232401, 7.9556412729026, 7.03953712632594, 
6.07521697203472, 7.56991321118611, 8.72709739633558, 12.8736740597878, 
14.7477360931436, 15.006468305304, 10.7373868046572, 11.1901681759379, 
10.8020698576973, 11.1254851228978, 9.57309184993532, 10.2846054333765, 
10.608020698577, 4.77707006369427, 4.88322717622081, 4.81245576786978, 
3.96319886765747, 4.77707006369427, 5.20169851380042, 5.34324133050248, 
5.09554140127389, 5.1309271054494, 5.09554140127389, 4.03397027600849),
BS = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, 0.264750378214826, 0.037821482602118, 0.037821482602118, 
0.037821482602118, 0.075642965204236, 0.075642965204236, 0.113464447806354, 
0.037821482602118, 0, 0.113464447806354, 0.037821482602118, NA, 
NA, NA, NA, NA, NA, NA, NA, NA), CS = c(NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, 0.442628532516173, 0.612870275791624, 
0.408580183861083, 0.374531835205993, 0.476676881171263, 0.408580183861083, 
0.919305413687436, 0.646918624446714), DS = c(NA, NA, NA, NA, 
NA, NA, NA, NA, NA, 7.11111111111111, 6.77777777777778, 5.66666666666667, 
8, 7, 6.11111111111111, 5.55555555555556, 7, 5.88888888888889, 
6.44444444444444, NA, NA, NA, NA, 4.07142857142857, 3.92857142857143, 
4, 4.07142857142857, 4.57142857142857, 6.28571428571429, 4.28571428571429, 
5.28571428571429, 4.42857142857143, 4.21428571428571, 3.85714285714286, 
5.07142857142857, 3.87878787878788, 2.90909090909091, 2.5949953660797, 
3.1047265987025, 3.52177942539388, 3.19740500463392, 4.35588507877665, 
4.58758109360519, 5.60704355885079, 5.88507877664504, 4.30954587581094, 
3.05838739573679, 3.66079703429101, 3.17617866004963, 3.07692307692308, 
3.97022332506203, 2.72952853598015, 2.77915632754342, 2.4317617866005
), FB = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 4.41511151570323, 
5.4619936276741, 4.41511151570323, 4.46062812926718, 3.45926263086026, 
3.82339553937187, 4.64269458352299, 4.46062812926718, 4.50614474283113, 
4.36959490213928, 4.36959490213928, 4.26086956521739, 4.43478260869565, 
4.43478260869565, 4.65217391304348, 4.73913043478261, 4.21663442940039, 
4.13926499032882, 4.33268858800774, 4.13926499032882, 3.52030947775629, 
4.4100580270793, 4.10058027079304, 3.82978723404255, 4.21663442940039, 
4.68085106382979, 4.21663442940039, NA, NA, NA)), row.names = c(NA, -54L), 
class = "data.frame")

自定义配色规则 #

先定义数值区间对应的颜色，匹配你要求的规则：

• 0-4.5: 红色（#ff4444）
• 4.5-7: 深红色（#cc0000）
• 7-10: 更深红色（#990000）

• 10: 紫色（#aa33cc）

• NA值：无填充（透明）

# 定义颜色映射
color_map <- c(
  "0-4.5" = "#ff4444",
  "4.5-7" = "#cc0000",
  "7-10" = "#990000",
  ">10" = "#aa33cc"
)

# 定义区间判断函数
get_color <- function(x) {
  if (is.na(x)) return(NA)
  if (x <= 4.5) return("0-4.5")
  if (x <=7) return("4.5-7")
  if (x <=10) return("7-10")
  return(">10")
}

方案一：Base Plot实现 #

通过手动绘制矩形实现高度自定义的热力图，步骤如下：

# 提取数值矩阵，年份作为行名
heat_data <- as.matrix(combined_df[, -1])
rownames(heat_data) <- combined_df$year

# 获取行列数
n_rows <- nrow(heat_data)
n_cols <- ncol(heat_data)

# 创建颜色矩阵
color_matrix <- apply(heat_data, c(1,2), get_color)
color_matrix <- matrix(color_map[color_matrix], nrow = n_rows)

# 初始化绘图区域，调整边距适应年份标签
par(mar = c(5, 8, 4, 2))
plot(0, 0, type = "n", 
     xlim = c(0, n_cols), 
     ylim = c(0, n_rows),
     xlab = "类别", ylab = "",
     axes = FALSE)

# 绘制单元格
for (i in 1:n_rows) {
  for (j in 1:n_cols) {
    if (!is.na(color_matrix[i,j])) {
      rect(j-1, n_rows - i, j, n_rows - i + 1, 
           col = color_matrix[i,j], border = "white")
    }
  }
}

# 添加坐标轴标签
axis(1, at = 0.5:n_cols - 0.5, labels = colnames(heat_data), tick = FALSE)
axis(2, at = 0.5:n_rows - 0.5, labels = rev(rownames(heat_data)), tick = FALSE, las = 1)
title(ylab = "年份", line = 6)

# 添加图例
legend("topright", 
       legend = names(color_map),
       fill = unname(color_map),
       bty = "n", title = "数值区间")

方案二：ggplot2实现 #

代码更简洁，适合快速迭代，步骤如下：

首先安装并加载依赖包：

# 首次运行需安装包
# install.packages(c("ggplot2", "tidyr"))

library(ggplot2)
library(tidyr)

# 将数据转换为长格式
long_df <- combined_df %>%
  pivot_longer(cols = -year, names_to = "category", values_to = "value")

# 生成热力图
ggplot(long_df, aes(x = category, y = factor(year, levels = rev(year)))) +
  geom_tile(aes(fill = sapply(value, get_color)), color = "white") +
  scale_fill_manual(values = color_map, na.value = "transparent", name = "数值区间") +
  labs(x = "类别", y = "年份") +
  theme_minimal() +
  theme(axis.text.y = element_text(size = 8)) # 调整年份标签大小

说明 #

• 两种方案均严格遵循配色规则，NA值单元格保持透明
• 可直接修改color_map中的颜色代码调整配色，修改get_color函数中的阈值调整数值区间
• Base Plot方案适合精细调整绘图元素；ggplot2方案适合快速修改和迭代

内容的提问来源于stack exchange，提问作者Dag