Log-shift变换未压缩数据的技术问题咨询（含复现代码）

使用geom_spatraster绘制密度图时，可视化中出现一个异常突出的亮峰，该尖峰扭曲了颜色尺度，过度压缩其他数据点的展示空间，导致底层数据结构被掩盖。标准log变换无法解决此问题，原本预期Log-shift变换（log(x + a)）能进一步压缩数据，实际效果却相反，怀疑对该变换存在理解误区。

以下是用x轴演示问题的最小可复现代码：

library(ggplot2)
library(scales)

# 使用mtcars数据集，构造极端值
mtcars[1,"disp"] <- 1500

# 定义小偏移量的Log-shift变换
my_transform <- function(x) log(x + 10)
my_inverse <- function(x) exp(x) - 10

my_trans <- scales::trans_new("yes_mate", transform = my_transform, inverse = my_inverse)

ggplot(mtcars, aes(x = disp, y = 1, color = disp)) +
  geom_point(size = 5) +
  scale_x_continuous(
    trans = my_trans,
    limits = c(100,1500),
    breaks = c(100, 500, 1000, 1500)) 

原本预期数据点会更聚集，但增大偏移量后效果相反：

# 定义大偏移量的Log-shift变换
my_transform <- function(x) log(x + 10000)
my_inverse <- function(x) exp(x) - 10000

my_trans <- scales::trans_new("yes_mate", transform = my_transform, inverse = my_inverse)

ggplot(mtcars, aes(x = disp, y = 1, color = disp)) +
  geom_point(size = 5) +
  scale_x_continuous(
    trans = my_trans,
    limits = c(100,1500),
    breaks = c(100, 500, 1000, 1500)) 

核心理解错误 #

Log-shift变换的作用逻辑与预期完全相反：

• 偏移量a越小，变换对小数值的区分度保留越好，同时对大数值的压缩（拉伸程度）越强，能有效缩小极端值与普通值的相对差距；
• 偏移量a越大，x + a中a的占比越高，log函数的非线性作用被弱化，变换越接近线性，极端值与普通值的相对差距几乎不变，自然无法起到压缩效果。

针对性解决方案 #

1. 用小偏移量的Log-shift变换

推荐使用log1p（即log(x + 1)），这是常用的Log-shift变体，能在保留小数值区分度的同时，有效压缩大数值的差距：

library(ggplot2)
library(scales)

mtcars[1,"disp"] <- 1500

# 使用log1p变换，自带逆变换expm1
my_trans <- scales::trans_new("log1p", transform = log1p, inverse = expm1)

ggplot(mtcars, aes(x = disp, y = 1, color = disp)) +
  geom_point(size = 5) +
  # x轴和颜色尺度都应用该变换
  scale_x_continuous(trans = my_trans, limits = c(100,1500), breaks = c(100, 500, 1000, 1500)) +
  scale_color_continuous(trans = my_trans)

2. 分位数变换（彻底解决尺度扭曲）

分位数变换直接将数值映射到分位数区间，完全消除极端值对尺度的影响，适合极端值占比极低的场景：

library(ggplot2)
library(scales)

mtcars[1,"disp"] <- 1500

# 计算disp的分位数区间
disp_quantiles <- quantile(mtcars$disp, probs = seq(0, 1, 0.2))
# 定义分位数变换
quantile_trans <- scales::trans_new(
  "disp_quantile",
  transform = function(x) findInterval(x, disp_quantiles) / length(disp_quantiles),
  inverse = function(p) disp_quantiles[floor(p * length(disp_quantiles)) + 1]
)

ggplot(mtcars, aes(x = disp, y = 1, color = disp)) +
  geom_point(size = 5) +
  scale_color_continuous(trans = quantile_trans)

3. 截断极端值（快速处理）

如果亮峰是异常值，可直接截断颜色尺度的上限，用squish处理超出范围的值：

library(ggplot2)
library(scales)

mtcars[1,"disp"] <- 1500

ggplot(mtcars, aes(x = disp, y = 1, color = disp)) +
  geom_point(size = 5) +
  scale_color_continuous(
    limits = c(NA, quantile(mtcars$disp, 0.99)), # 上限设为99分位数
    oob = scales::squish # 超出范围的值映射到边界颜色
  )

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