避免时间线上的点重叠（一维排斥）

Question

我想创建一个大致类似于以下示例的时间线图：在某些点有很多重叠，而在其他点没有很多重叠。

我需要什么：重叠的图像应在必要时相互排斥，消除或减少重叠。理想情况下，我可以实现垂直或水平排斥。

library(tidyverse)
library(ggimage)

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 %>% 
  ggplot() +
  geom_line(aes(x = date, y = group, group = group), size = 5, alpha = 0.2) +
  geom_image(aes(x = date, y = group, image = img, group = group), asp = 1) 

类似于ggbeeswarm::geom_beeswarm 或ggrepel::geom_text_repel 中的排斥的东西会很好，但那些不支持图像。所以我认为我需要预先应用某种一维打包算法，对每个组内的日期向量实现迭代的成对排斥，以尝试找到不重叠的排列。

有什么想法吗？非常感谢！

^{由reprex package (v2.0.1) 于 2021 年 10 月 30 日创建}

Answer 1

这是我想出的解决方案，重新利用了很棒的 packcircles 包中的 circleRepelLayout 函数 进入repel_vector 向量函数，该函数接受重叠向量和“repel_radius”，并在可能的情况下返回非重叠版本。

我使用richtext geom 演示了解决方案，因为这是我一直希望具有排斥功能的 geom。

library(packcircles)
library(tidyverse)
library(ggtext)
library(ggimage)

repel_vector <- function(vector, repel_radius = 1, repel_bounds = range(vector)){
  stopifnot(is.numeric(vector))
  
  repelled_vector <- 
    packcircles::circleRepelLayout(x = data.frame(vector, ypos = 1, repel_radius), 
                                   xysizecols = c("vector", "ypos", "repel_radius"), 
                                   xlim = repel_bounds, ylim = c(0,1), 
                                   wrap = FALSE) %>% 
    as.data.frame() %>% 
    .$layout.x

  return(repelled_vector)
}

overlapping_vec <- c(1, 1.1, 1.2, 10, 10.1, 10.2)
repelled_vec_default <- repel_vector(overlapping_vec)
repelled_vec_tighter <- repel_vector(overlapping_vec, repel_radius = 0.35)

ggplot() + 
  annotate("richtext", x = overlapping_vec, y = 3, label = "**test**", alpha = 0.5) + 
  annotate("richtext", x = repelled_vec_default, y = 2, label = "**test**", alpha = 0.5) +
  annotate("richtext", x = repelled_vec_tighter, y = 1, label = "**test**",  alpha = 0.5) + 
  scale_y_continuous(breaks = 1:3, labels = c("Tighter repel", "Default repel", "Overlapping points"))

理论上，您也可以将其应用于 2D 排斥。

---

为了解决我的问题，可以这样应用：

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) ) %>% 
  group_by(group) %>% 
  mutate(repelled_date = repel_vector(as.numeric(date), 
                                      repel_radius = 4, 
                                      repel_bounds = range(as.numeric(date)) + c(-3,3)), 
         repelled_date = as.Date(repelled_date, origin = "1970-01-01"))

df %>% 
  ggplot() +
  geom_line(aes(x = date, y = group, group = group), size = 5, alpha = 0.2) +
  geom_image(aes(x = repelled_date, y = group, image = img, group = group), asp = 1) 

^{由reprex package (v2.0.1) 于 2021-10-30 创建}