调整ggplot2色谱图峰段宽窄，使x轴峰处刻度均匀分布

核心思路 #

要实现碱基峰均匀分布，关键是抛弃原始时间轴，给每个碱基分配固定的均匀x轴位置，再将该碱基对应的原始信号数据缩放到这个固定宽度的区间内，从而让所有碱基的展示宽度一致，方便同源序列比对。

具体实现步骤（结合sangerseqR示例） #

1. 加载依赖包并读取数据

library(sangerseqR)
library(tidyverse)

# 读取示例ab1文件（sangerseqR自带）
ab1 <- readsangerseq(system.file("extdata", "SRR002660_1.ab1", package = "sangerseqR"))

# 提取trace数据（A/C/G/T四个通道的信号+时间）
trace_df <- bind_rows(
  tibble(time = ab1@trace$time, signal = ab1@trace$A, base = "A"),
  tibble(time = ab1@trace$time, signal = ab1@trace$C, base = "C"),
  tibble(time = ab1@trace$time, signal = ab1@trace$G, base = "G"),
  tibble(time = ab1@trace$time, signal = ab1@trace$T, base = "T")
)

# 提取碱基call的位置和对应碱基（从primary sequence的位置信息）
basecalls <- tibble(
  base = str_split(ab1@primarySeq, "")[[1]],
  peak_time = ab1@peakPos,
  index = 1:length(ab1@peakPos) # 给每个碱基分配均匀索引
)

2. 映射trace数据到均匀x轴区间

给每个碱基设定固定宽度的x区间（比如每个碱基占1个单位宽度，左右各留0.5的余量），然后将该碱基对应的原始时间范围内的信号数据，线性缩放到这个区间：

# 定义每个碱基的x轴区间范围
basecalls <- basecalls %>%
  mutate(
    x_start = index - 0.5,
    x_end = index + 0.5
  )

# 匹配每个trace数据点所属的碱基区间，并缩放x值
scaled_trace <- trace_df %>%
  # 找到每个time对应的碱基（即time落在当前碱基peak_time和下一个碱基peak_time之间）
  mutate(
    base_index = findInterval(time, basecalls$peak_time)
  ) %>%
  # 过滤掉不在碱基call范围内的信号（可选，根据需求调整）
  filter(base_index >= 1 & base_index <= nrow(basecalls)) %>%
  left_join(basecalls %>% select(index, peak_time, x_start, x_end), by = c("base_index" = "index")) %>%
  # 线性缩放time到当前碱基的x区间
  mutate(
    scaled_x = x_start + (time - peak_time) / (lead(peak_time, default = last(peak_time)) - peak_time) * (x_end - x_start)
  )

3. 绘制均匀间距的色谱图

用缩放后的scaled_x作为x轴，设置碱基对应的刻度，按碱基颜色区分信号：

# 定义碱基颜色（和sangerseqR一致）
base_colors <- c("A" = "green", "C" = "blue", "G" = "black", "T" = "red")

ggplot(scaled_trace, aes(x = scaled_x, y = signal, color = base)) +
  geom_line(linewidth = 0.3) +
  # 设置x轴刻度为碱基和对应的索引（只显示关键碱基，避免拥挤）
  scale_x_continuous(
    breaks = basecalls$index,
    labels = basecalls$base,
    expand = c(0.02, 0)
  ) +
  scale_color_manual(values = base_colors) +
  labs(
    x = "Base Position",
    y = "Relative Fluorescence Units",
    title = "Uniform Spacing Chromatogram"
  ) +
  theme_minimal() +
  theme(
    panel.grid.major.x = element_blank(),
    panel.grid.minor.x = element_blank(),
    axis.text.x = element_text(size = 8)
  )

4. 截取序列片段的处理

如果需要只展示某一段序列（比如第20到50个碱基），只需过滤basecalls和scaled_trace的对应区间：

start_pos <- 20
end_pos <- 50

filtered_basecalls <- basecalls %>% filter(index >= start_pos & index <= end_pos)
filtered_trace <- scaled_trace %>% filter(base_index >= start_pos & base_index <= end_pos)

# 重新绘制即可，x轴会自动适配截取后的碱基区间
ggplot(filtered_trace, aes(x = scaled_x, y = signal, color = base)) +
  geom_line(linewidth = 0.3) +
  scale_x_continuous(
    breaks = filtered_basecalls$index,
    labels = filtered_basecalls$base,
    expand = c(0.02, 0)
  ) +
  scale_color_manual(values = base_colors) +
  labs(
    x = "Base Position",
    y = "Relative Fluorescence Units",
    title = paste("Uniform Spacing Chromatogram (Positions", start_pos, "-", end_pos, ")")
  ) +
  theme_minimal() +
  theme(
    panel.grid.major.x = element_blank(),
    panel.grid.minor.x = element_blank(),
    axis.text.x = element_text(size = 8)
  )

效果说明 #

• 所有碱基对应的峰在x轴上间距完全一致，忽略了原始信号的时间差异
• 每个碱基的峰宽度被统一缩放，方便不同序列的色谱图直接比对
• 保留了原始信号的强度变化，不影响峰高的判断

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