如何在R中对密度峰两侧的X轴刻度进行缩放变换？

以ggplot2包的diamonds数据集的depth变量为例，绘制其直方图后，使用scales::modulus_trans()可分别收紧X轴左侧或右侧刻度。现需实现对密度峰值（depth=62）两侧的X轴刻度同时收紧，且理想状态下可独立调整两侧modulus_trans()的参数p（即变换指数λ）。请问是否可通过trans_new()结合两个modulus_trans()实现？若不可行，还有哪些变换方法可在保持密度峰位置不变的前提下实现对其两侧的缩放？

相关代码示例 #

# 准备数据
dat0 <- ggplot2::diamonds %>% select(depth)

# 基础直方图（无X轴变换）
gg0 <- ggplot(dat0, aes(x = depth)) +
  scale_x_continuous(limits = c(30, 90), expand = c(0,0), breaks = seq(30,90,10)) +
  scale_y_continuous(limits = c(0, 20000), expand = c(0,0), trans = modulus_trans(0.3)) +
  geom_histogram(bins = 100)  

# 左侧刻度收紧示例
gg1 <- ggplot(dat0, aes(x = depth)) +
  scale_x_continuous(limits = c(30, 90), expand = c(0,0), breaks = seq(30,90,10),
                     trans = modulus_trans(2.8)) +
  scale_y_continuous(limits = c(0, 20000), expand = c(0,0), trans = modulus_trans(0.3)) +
  geom_histogram(bins = 100)

# 右侧刻度收紧示例
gg2 <- ggplot(dat0, aes(x = depth)) +
  scale_x_continuous(limits = c(30, 90), expand = c(0,0), breaks = seq(30,90,10),
                     trans = modulus_trans(-1)) +
  scale_y_continuous(limits = c(0, 20000), expand = c(0,0), trans = modulus_trans(0.3)) +
  geom_histogram(bins = 100)

解答 #

1. 能否用trans_new()结合两个modulus_trans()实现？ #

可以实现，但需要自定义分段变换逻辑——因为modulus_trans()本身是全局变换，直接组合会冲突，需基于峰值点（62）将X轴分为左右两段，分别应用不同参数的modulus_trans()，再通过trans_new()封装成自定义变换，同时要保证峰值点变换后位置不变。

示例代码（自定义分段modulus变换）：

library(scales)
library(ggplot2)
library(dplyr)

# 自定义分段modulus变换
piecewise_modulus_trans <- function(peak = 62, p_left = 2.8, p_right = -1) {
  # 初始化左右侧的modulus变换
  trans_left <- modulus_trans(p_left)
  trans_right <- modulus_trans(p_right)
  
  # 计算偏移量，保证峰值点变换后位置一致
  peak_trans_left <- trans_left$transform(peak)
  peak_trans_right <- trans_right$transform(peak)
  offset <- peak_trans_left - peak_trans_right
  
  # 定义变换函数：分段处理左右侧数值
  transform_fun <- function(x) {
    ifelse(x <= peak,
           trans_left$transform(x),
           trans_right$transform(x) + offset)
  }
  
  # 定义逆变换函数：对应还原分段数值
  inverse_fun <- function(y) {
    ifelse(y <= peak_trans_left,
           trans_left$inverse(y),
           trans_right$inverse(y - offset))
  }
  
  # 封装为自定义变换
  trans_new(
    name = "piecewise_modulus",
    transform = transform_fun,
    inverse = inverse_fun,
    breaks = function(x) {
      # 合并左右侧断点，保留峰值点
      left_breaks <- trans_left$breaks(x[x <= peak])
      right_breaks <- trans_right$breaks(x[x > peak])
      unique(c(left_breaks, peak, right_breaks))
    }
  )
}

# 使用自定义变换绘图
gg_piecewise <- ggplot(dat0, aes(x = depth)) +
  scale_x_continuous(limits = c(30, 90), expand = c(0,0),
                     trans = piecewise_modulus_trans(peak = 62, p_left = 2.8, p_right = -1)) +
  scale_y_continuous(limits = c(0, 20000), expand = c(0,0), trans = modulus_trans(0.3)) +
  geom_histogram(bins = 100)

2. 其他可行的变换方法 #

如果不想用分段modulus变换，还有以下方法可在保持峰值位置不变的前提下缩放两侧：

• 自定义分段幂变换：对峰值左右分别应用不同的幂变换（如左侧用x^a，右侧用(x-peak)^b + peak），需调整参数保证数据连续性和峰值位置不变。
• 分段Box-Cox变换：对左右两侧分别使用不同λ值的Box-Cox变换，同样通过分段处理对齐峰值点。
• 手动调整刻度位置：不使用轴变换，直接手动设置X轴断点和标签，缩小峰值两侧的刻度间距，仅调整视觉显示，适合需要精确控制刻度位置的场景。

示例（手动调整刻度）：

gg_manual <- ggplot(dat0, aes(x = depth)) +
  scale_x_continuous(limits = c(30, 90), expand = c(0,0),
                     breaks = c(30, 40, 50, 60, 62, 64, 70, 80, 90), # 峰值两侧缩小刻度间距
                     labels = c("30", "40", "50", "60", "62", "64", "70", "80", "90")) +
  scale_y_continuous(limits = c(0, 20000), expand = c(0,0), trans = modulus_trans(0.3)) +
  geom_histogram(bins = 100)

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