在ggplot2中对Y轴做变换，聚焦数值50附近区域

我用ggplot2绘制了分面图（数据见文末dput），通过不同method计算均值并在分面中展示，绘图代码如下：

data %>%
  ggplot() +
  aes(
    x = grad,
    y = mean
  ) +
  geom_errorbar(
    aes(
      ymin = lb,
      ymax = ub
    ),
    width = 0.2,
    alpha = 0.4
  ) +
  geom_point(
    size = 2
  ) +
  geom_line(
    linewidth = 0.8
  ) +
  geom_hline(
    yintercept = 50,
    linetype = "dashed",
    colour = "#FF0000"
  ) +
  facet_wrap(
    ~ method,
    ncol = 2,
    scales = "free"
  ) +
  theme_bw()

我需要同时查看误差棒，对比不同method对应点的数值，想对Y轴做类似scale_y_log10()的变换，实现放大50附近区域的效果，要求：

• 变换后50与51的间距大于51与52的间距
• 关于50对称：49与50的间距等于50与51的间距，48与49的间距等于51与52的间距，以此类推

数据dput：

structure(list(method = structure(c(1L, 2L, 3L, 4L, 6L, 5L, 1L, 
2L, 3L, 4L, 6L, 5L, 1L, 2L, 3L, 4L, 6L, 5L, 1L, 2L, 3L, 4L, 6L, 
5L, 1L, 2L, 3L, 4L, 6L, 5L), .Label = c("raw", "norm", "bank", 
"rand", "floor", "ceil"), class = "factor"), grad = c(2, 2, 2, 
2, 2, 2, 4, 4, 4, 4, 4, 4, 6, 6, 6, 6, 6, 6, 8, 8, 8, 8, 8, 8, 
10, 10, 10, 10, 10, 10), mean = c(49.99667915, 50.2454844, 49.9967503, 
49.996759, 50.2454844, 49.7478739, 49.994064725, 50.1187028, 
49.9940469, 49.9940169, 50.3682549, 49.6200129, 50.00164035, 
50.0847906, 50.0015683, 50.0016874, 50.4176783, 49.5857625, 50.00176225, 
50.0643196, 50.0019263, 50.0018275, 50.4386578, 49.5647442, 50.00713535, 
50.0572266, 50.0072163, 50.007149, 50.456595, 49.5574979), sd = c(0.91473404644074, 
0.91478017995276, 0.9151151931487, 0.914942290015281, 0.91478017995276, 
0.914757425175375, 0.912161337763246, 0.912320011976382, 0.912328572194664, 
0.912293149537724, 0.912251012998649, 0.912065855377804, 0.909061418603362, 
0.909071357608941, 0.909021915808113, 0.909025127237655, 0.909130605608961, 
0.909030928525895, 0.910690862745318, 0.910911812026153, 0.91094121042864, 
0.910847754625854, 0.910551266903806, 0.910647546563305, 0.906676002734588, 
0.906779575074459, 0.906664057457677, 0.906712448654729, 0.906661779570118, 
0.906787505291932), ub = c(51.7895578810238, 52.0384535527074, 
51.7903760785715, 51.7900458884299, 52.0384535527074, 51.5407984533437, 
51.781900947016, 51.9068500234737, 51.7822109015015, 51.7821114730939, 
52.1562668854774, 51.4076619765405, 51.7834007304626, 51.8665704609135, 
51.7832512549839, 51.7833766493858, 52.1995742869936, 51.3674631199108, 
51.7867163409808, 51.8497067515713, 51.7873710724401, 51.7870890990667, 
52.2233382831315, 51.3496133912641, 51.7842203153598, 51.8345145671459, 
51.7842778526171, 51.7843053993633, 52.2336520879574, 51.3348014103722
), lb = c(48.2038004189762, 48.4525152472926, 48.2031245214285, 
48.2034721115701, 48.4525152472926, 47.9549493466563, 48.206228502984, 
48.3305555765263, 48.2058828984985, 48.2059223269061, 48.5802429145226, 
47.8323638234595, 48.2198799695374, 48.3030107390865, 48.2198853450161, 
48.2199981506142, 48.6357823130064, 47.8040618800892, 48.2168081590192, 
48.2789324484287, 48.2164815275599, 48.2165659009333, 48.6539773168685, 
47.7798750087359, 48.2300503846402, 48.2799386328541, 48.230154747383, 
48.2299926006367, 48.6795379120426, 47.7801943896278)), row.names = c(NA, 
-30L), class = c("tbl_df", "tbl", "data.frame"))

你需要的是对称的非线性变换，核心是围绕50构建"压缩远离中心区域、放大中心区域"的映射，同时保持对称性。可以通过ggplot2的trans_new()自定义变换实现。

自定义对称变换函数 #

推荐基于双曲正切（tanh）的平滑变换，既能满足对称性，又能灵活调整放大强度：

library(scales)
library(ggplot2)

# 定义围绕50的对称变换，k控制压缩强度（k越大，中心放大越明显）
symmetric_trans <- function(center = 50, k = 0.5) {
  trans_new(
    name = "symmetric",
    transform = function(x) {
      delta <- x - center
      sign(delta) * tanh(k * abs(delta))
    },
    inverse = function(y) {
      center + sign(y) * (atanh(abs(y)) / k)
    },
    breaks = function(x) {
      # 自定义轴刻度，保证中心附近刻度更密集
      seq(floor(min(x)), ceiling(max(x)), by = ifelse(abs(x - center) < 5, 1, 2))
    },
    domain = c(center - 10/k, center + 10/k) # 避免atanh超出定义域
  )
}

应用到绘图中 #

将自定义变换加入原代码的scale_y_continuous()即可，误差棒的上下限会自动跟随变换，无需手动计算：

data %>%
  ggplot() +
  aes(x = grad, y = mean) +
  geom_errorbar(aes(ymin = lb, ymax = ub), width = 0.2, alpha = 0.4) +
  geom_point(size = 2) +
  geom_line(linewidth = 0.8) +
  geom_hline(yintercept = 50, linetype = "dashed", colour = "#FF0000") +
  facet_wrap(~ method, ncol = 2, scales = "free") +
  scale_y_continuous(trans = symmetric_trans(center = 50, k = 0.5)) + # 应用自定义变换
  theme_bw()

参数调整与备选方案 #

• k值调整：k越大，50附近区域的放大效果越显著，远离50的区域压缩越厉害；若觉得效果过强，可将k调至0.3左右，反之调至0.8增强效果。
• 简易分段对称变换：如果偏好类似对数的分段逻辑，可使用基于log1p的变换：

simple_symmetric_trans <- function(center = 50) {
  trans_new(
    name = "simple_symmetric",
    transform = function(x) {
      delta <- x - center
      ifelse(delta >= 0, log1p(delta), -log1p(-delta))
    },
    inverse = function(y) {
      center + ifelse(y >= 0, expm1(y), -expm1(-y))
    }
  )
}

该变换用log1p和expm1避免了数值溢出问题，同样满足对称性和中心放大需求。

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