Avoid overlap of points on a timeline (1-D repeling)

Question

I want to create a timeline plot that roughly resembles the example below: lots of overlap at some points, not a lot of overlap at others.

What I need: overlapping images should repel each other where necessary, eliminating or reducing overlap. Ideally I'd be able to implement either a vertical or horizontal repel.

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) 

Something similar to the repelling in ggbeeswarm::geom_beeswarm or ggrepel::geom_text_repel would be nice, but those don't support images. So I think I need to pre-apply some kind of 1-dimensional packing algorithm, implementing iterative pair-wise repulsion on my vector of dates within each group, to try to find a non-overlapping arrangement.

Any ideas? Thank you so much!

^{Created on 2021-10-30 by the reprex package (v2.0.1)}

Answer 1

Here is the solution I’ve been able to come up with, repurposing the circleRepelLayout function from the awesome packcircles package into the repel_vector vector function that takes in your overlapping vector and a "repel_radius", and returns, if possible, a non-overlapping version.

I demonstrate the solution with the richtext geom since this is a geom I’ve always wished had repel functionality.

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"))

In theory you apply this to 2D repelling as well.

---

To solve the problem in my question, this can be applied like so:

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) 

^{Created on 2021-10-30 by the reprex package (v2.0.1)}