时间轴点重叠规避（一维排斥）：为含图片的时间轴图实现元素排斥功能

这确实是个很实用的需求！既然现有的ggbeeswarm或ggrepel工具不支持图片元素，那咱们就从数据预处理入手，手动实现一维（或结合二维）的排斥算法来调整元素位置，避免图片重叠。下面分享几个可行的思路和具体实现：

思路1：X轴一维迭代排斥（优先保留Y轴分组） #

这个思路是给每个分组内的日期点设置最小间距，通过迭代调整重叠点的X轴位置，让图片之间拉开足够距离。核心是把日期转换成数值计算间距，再转回到日期格式。

实现代码 #

library(tidyverse)
library(ggimage)

# 定义单个分组的日期排斥函数
repel_dates <- function(dates, min_gap_days = 1) {
  # 把日期转为数值（以1970-01-01为原点的天数）方便计算
  dates_num <- as.numeric(dates)
  n <- length(dates_num)
  # 先排序，按顺序处理重叠
  ord <- order(dates_num)
  dates_sorted <- dates_num[ord]
  
  # 迭代调整，最多10次避免死循环
  for (iter in 1:10) {
    changed <- FALSE
    for (i in 2:n) {
      gap <- dates_sorted[i] - dates_sorted[i-1]
      # 如果间距小于设定的最小天数，就把后一个点往后推
      if (gap < min_gap_days) {
        adjust_val <- min_gap_days - gap
        dates_sorted[i] <- dates_sorted[i] + adjust_val
        changed <- TRUE
      }
    }
    if (!changed) break # 没有重叠就提前退出
  }
  
  # 把数值转回日期，恢复原顺序
  adjusted_dates <- as.Date(dates_sorted, origin = "1970-01-01")
  adjusted_dates[order(ord)] <- adjusted_dates
  return(adjusted_dates)
}

# 加载示例数据
test_img <- list.files(system.file("extdata", package="ggimage"), pattern="png", full.names=TRUE)
set.seed(123)
df <- tibble(date = as.Date(paste0("2020-", round(runif(45, 1, 2)), "-", round(runif(45, 1, 10)))),
             group = paste0("Timeline ", rep(1:9, each = 5)),
             img = sample(test_img, size = 45, replace = T))

# 对每个分组应用排斥算法
df_adjusted <- df %>%
  group_by(group) %>%
  mutate(date_adjusted = repel_dates(date, min_gap_days = 1.2)) %>% # 最小间距可根据图片大小调整
  ungroup()

# 绘图
df_adjusted %>% 
  ggplot() + 
  geom_line(aes(x = date, y = group, group = group), size = 5, alpha = 0.2) + 
  geom_image(aes(x = date_adjusted, y = group, image = img, group = group), asp = 1)

优缺点 #

• ✅ 保留Y轴分组的整齐性，适合严格需要分组对齐的场景
• ❌ 极端重叠情况下，日期可能会偏离原位置较多，需根据图片大小调整min_gap_days参数

思路2：双向对称排斥（更自然的X轴分布） #

如果觉得单向推开太生硬，可以改成双向对称调整：当两个点重叠时，以两点的中点为中心，向两边对称拉开距离，让位置偏移更均匀。

修改后的排斥函数 #

repel_dates_sym <- function(dates, min_gap_days = 1) {
  dates_num <- as.numeric(dates)
  n <- length(dates_num)
  ord <- order(dates_num)
  dates_sorted <- dates_num[ord]
  
  for (iter in 1:10) {
    changed <- FALSE
    for (i in 2:n) {
      gap <- dates_sorted[i] - dates_sorted[i-1]
      if (gap < min_gap_days) {
        adjust_total <- min_gap_days - gap
        # 以两点中点为中心，对称调整位置
        mid_point <- (dates_sorted[i-1] + dates_sorted[i])/2
        dates_sorted[i-1] <- mid_point - adjust_total/2
        dates_sorted[i] <- mid_point + adjust_total/2
        changed <- TRUE
      }
    }
    if (!changed) break
  }
  
  adjusted_dates <- as.Date(dates_sorted, origin = "1970-01-01")
  adjusted_dates[order(ord)] <- adjusted_dates
  return(adjusted_dates)
}

只需把思路1中的repel_dates替换成这个函数即可，调整后的点分布会更自然。

思路3：Y轴小范围抖动（模拟Beeswarm效果） #

如果允许Y轴分组有小范围偏移，这个方法更接近ggbeeswarm的视觉效果：给重叠的图片在Y轴方向添加对称的抖动量，既保留原日期的准确性，又能避免重叠。

实现代码 #

# 定义Y轴抖动函数
add_y_jitter <- function(dates, group_y, jitter_amount = 0.15) {
  # 统计每个日期下的点数
  date_counts <- table(dates)
  # 给每个重叠点分配对称的Y偏移
  y_offsets <- map_dbl(dates, function(d) {
    count <- date_counts[as.character(d)]
    if (count == 1) {
      0
    } else {
      # 生成对称偏移序列，比如-0.15, 0, 0.15
      pos_idx <- which(dates == d) %>% match(which(dates == d))
      seq(-(count-1)*jitter_amount/2, (count-1)*jitter_amount/2, length.out = count)[pos_idx]
    }
  })
  return(group_y + y_offsets)
}

# 应用抖动到数据
df_adjusted_y <- df %>%
  group_by(group) %>%
  mutate(
    group_num = as.numeric(factor(group)),
    y_adjusted = add_y_jitter(date, group_num, jitter_amount = 0.15)
  ) %>%
  ungroup()

# 绘图
df_adjusted_y %>% 
  ggplot() + 
  geom_line(aes(x = date, y = group_num, group = group), size = 5, alpha = 0.2) + 
  geom_image(aes(x = date, y = y_adjusted, image = img, group = group), asp = 1) +
  scale_y_continuous(labels = unique(df$group), breaks = unique(df_adjusted_y$group_num))

优缺点 #

• ✅ 完全保留原日期的准确性，视觉效果更自然
• ❌ Y轴分组会有轻微偏移，适合对分组对齐要求不严格的场景

内容的提问来源于stack exchange，提问作者Kene David Nwosu