ralgorithmggplot2dplyrggimage

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


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)


Solution

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