如何在ggproto中调整曼哈顿图的X轴刻度与标签？

问题描述 #

我通过ggplot2的ggproto实现了stat_manhattan函数用于生成曼哈顿图，代码可正常运行，但无法正确设置X轴的刻度位置与标签。希望将染色体（chr）编号居中显示在X轴对应区域，咨询：该需求能否在stat_manhattan函数内实现，还是编写自定义scale_x_chr类函数更为合适？

函数代码 #

StatManhattan <- ggplot2::ggproto("StatManhattan", 
                                  ggplot2::Stat,
                                  setup_params = function(data, params) {
                                    params
                                  },
                                  compute_group = function(data, scales, params, col_chrom) {
                                    message("My param has value ", scales)
                                    
                                    data_1 <- data %>% 
                                      dplyr::arrange(chr, pos) %>% 
                                      dplyr::transmute(x = cumsum(as.numeric(pos)), 
                                                       y,
                                                       chr)
                                    
                                    data_2 <- data_1 %>% 
                                      dplyr::distinct(chr) %>% 
                                      dplyr::mutate(colour = rep(col_chrom, length.out = dplyr::n()))
                                    
                                    data_1 %>% 
                                      dplyr::left_join(data_2, by = "chr") %>% 
                                      as.data.frame()
                                    
                                  },
                                  required_aes = c("y", "pos", "chr"),
                                  default_aes = aes(y = stat(y), 
                                                    x = stat(x), 
                                                    colour = stat(colour), 
                                                    size = 0.2)
)


stat_manhattan <- function(mapping = NULL, data = NULL, geom = "point",
                           position = "identity", na.rm = FALSE, show.legend = FALSE, 
                           inherit.aes = TRUE, col_chrom = c("magenta2", "grey60"),
                           ...) {
  ggplot2::layer(
    stat = StatManhattan, data = data, mapping = mapping, geom = geom, 
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, 
                  col_chrom = col_chrom,
                  ...)
  )
}

测试数据与当前绘图效果 #

当前使用以下代码绘图，生成的X轴为连续刻度，不符合需求：

# 测试数据
test_data <- tibble(chr = rep(1:3, each = 1000), 
                    bp  = c(sort(sample.int(1e6, 1000)), 
                            sort(sample.int(1e6, 1000)),
                            sort(sample.int(1e6, 1000))),
                    p = runif(3000, min=0, max=1))

# 绘图
ggplot(test_data)+aes(chr = chr, pos = bp, y =-log10(p))+stat_manhattan()

期望效果 #

希望实现的X轴效果如下，将染色体编号居中显示：

axisdf = test_data %>% 
  mutate(bp_cum = cumsum(as.numeric(bp))) %>% 
  group_by(chr) %>% 
  summarize(center=( max(bp_cum) + min(bp_cum) ) / 2 )

test_data %>% 
  mutate(bp_cum = cumsum(as.numeric(bp))) %>% 
  ggplot(., aes(x=bp_cum, y=-log10(p), colour = as.character(chr))) +
  geom_point() +
  scale_x_continuous(label = axisdf$chr, breaks= axisdf$center ) 

解决方案建议 #

结论：优先选择编写自定义scale_x_chr类函数 #

这更符合ggplot2的职责划分设计：

• Stat层的核心职责是数据转换（比如你已经实现的将bp转换为累积位置x），不应承担轴刻度、标签的渲染逻辑。
• Scale层专门负责轴的映射、刻度生成、标签显示，把X轴的染色体居中逻辑放在这里，职责更清晰，代码更易维护和复用。

具体实现思路 #

1. 自定义scale_x_chr函数

直接基于原始数据计算染色体累积位置的中心点，生成对应刻度和标签：

scale_x_chr <- function(data, chr_col = "chr", pos_col = "pos", ...) {
  # 计算每个染色体的累积位置中心点
  axis_info <- data %>%
    dplyr::arrange(!!dplyr::sym(chr_col), !!dplyr::sym(pos_col)) %>%
    dplyr::mutate(bp_cum = cumsum(as.numeric(!!dplyr::sym(pos_col)))) %>%
    dplyr::group_by(!!dplyr::sym(chr_col)) %>%
    dplyr::summarize(center = (max(bp_cum) + min(bp_cum)) / 2, .groups = "drop")
  
  ggplot2::scale_x_continuous(
    breaks = axis_info$center,
    labels = axis_info[[chr_col]],
    ...
  )
}

2. 配合stat_manhattan使用

调用时直接传入测试数据即可：

ggplot(test_data) +
  aes(chr = chr, pos = bp, y = -log10(p)) +
  stat_manhattan() +
  scale_x_chr(data = test_data, chr_col = "chr", pos_col = "bp")

3. 优化：让Stat层传递轴信息（可选）

如果不想在scale里重复计算累积位置，可以修改StatManhattan的setup_params方法，提前计算染色体中心点并传递给参数，避免重复计算：

StatManhattan <- ggplot2::ggproto("StatManhattan", 
                                  ggplot2::Stat,
                                  setup_params = function(data, params) {
                                    # 提前计算染色体中心位置
                                    axis_info <- data %>%
                                      dplyr::arrange(chr, pos) %>%
                                      dplyr::mutate(bp_cum = cumsum(as.numeric(pos))) %>%
                                      dplyr::group_by(chr) %>%
                                      dplyr::summarize(center = (max(bp_cum) + min(bp_cum)) / 2, .groups = "drop")
                                    params$axis_info <- axis_info
                                    params
                                  },
                                  compute_group = function(data, scales, params, col_chrom) {
                                    data_1 <- data %>% 
                                      dplyr::arrange(chr, pos) %>% 
                                      dplyr::transmute(x = cumsum(as.numeric(pos)), 
                                                       y,
                                                       chr)
                                    
                                    data_2 <- data_1 %>% 
                                      dplyr::distinct(chr) %>% 
                                      dplyr::mutate(colour = rep(col_chrom, length.out = dplyr::n()))
                                    
                                    data_1 %>% 
                                      dplyr::left_join(data_2, by = "chr") %>% 
                                      as.data.frame()
                                    
                                  },
                                  required_aes = c("y", "pos", "chr"),
                                  default_aes = aes(y = stat(y), 
                                                    x = stat(x), 
                                                    colour = stat(colour), 
                                                    size = 0.2)
)

然后修改scale函数接收该信息：

scale_x_chr <- function(axis_info, ...) {
  ggplot2::scale_x_continuous(
    breaks = axis_info$center,
    labels = axis_info$chr,
    ...
  )
}

使用时需要从stat的参数中提取axis_info，可以通过ggplot_build临时获取，或者封装成更便捷的函数，但第一种直接计算的方式已经足够简洁易用。

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