R语言绘制按均值距离映射灰度渐变的散点图

问题场景 #

我有一个名为DF的数据框，共包含2020条观测、79066个变量：第一列为取值从1连续到2020的年份列，其余变量列均为数值型。
为保证示例可复现，我构造了覆盖2000-2020共21个年份、仅含100个变量的模拟数据框，构造代码如下：

set.seed(123)
i <- 100
DF <- data.frame(year=c(2000:2020), 
                 setNames(
                   as.data.frame(lapply(1:i, function(k) c(rnorm(21)))), 
                   paste("Var_", 1:i, sep = "")))

按行计算数值列的均值，存入DF的Aver列，对应代码：

DF$Aver <- apply(DF[, 2:101], 1, mean, na.rm=TRUE)

初始绘图逻辑为先绘制均值折线，再叠加所有变量的散点，初始代码运行后所有散点为统一灰色，期望效果为：散点颜色根据点与对应行均值的距离做灰度渐变——距离均值越近的点显示为深灰色，距离均值越远的尾部极值点灰度越浅。
初始绘图代码如下：

plot(DF$year, DF$Aver, type="l", col=1, cex=0.5, las=1, xlab="", ylab="", ylim=c(-4, 4)) 
for (i in 2:101) {
  points(DF$year, DF[, i], pch=20, cex=1, col='gray')
}

实现代码 #

核心逻辑是先计算每个散点到对应行均值的绝对距离，将距离归一化后映射到深灰到浅灰的灰度梯度上，直接替换原有绘图段代码即可，同时兼容原始7万+变量的全量数据集：

# 自动识别数值列范围，无需硬编码列索引
num_cols <- 2:(ncol(DF)-1)
# 计算所有点到对应行均值的绝对距离
dist_matrix <- abs(DF[, num_cols] - DF$Aver)
max_abs_dist <- max(dist_matrix, na.rm = TRUE)
# 生成从深灰到浅灰的100阶平滑灰度调色板
gray_scale <- gray.colors(n = 100, start = 0.2, end = 0.9, gamma = 2.2)

# 绘制底图均值线
plot(DF$year, DF$Aver, type="l", col=1, lwd=2, las=1, xlab="", ylab="", ylim=c(-4, 4)) 
# 遍历每个变量列绘制带渐变颜色的散点
for (col in num_cols) {
  # 计算当前列每个点的距离，映射到调色板索引
  point_dist <- abs(DF[, col] - DF$Aver)
  pal_index <- round((point_dist / max_abs_dist) * 99) + 1
  points(DF$year, DF[, col], pch=20, cex=1, col=gray_scale[pal_index])
}
# 再叠加一次均值线，避免被散点遮挡
lines(DF$year, DF$Aver, col=1, lwd=2)

参数调整说明 #

• 若需要靠近均值的点颜色更深，可调小gray.colors()的start参数，最小设为0即为纯黑色
• 若需要离群远点颜色更浅，可调大gray.colors()的end参数，最大设为1即为纯白色
• 若需要增强深浅颜色的对比程度，可调大gamma参数值，渐变层次会更突出

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