plot segments across facets

load libraries

library(tidyverse)

## ─ Attaching packages ─────────────────────────────────── tidyverse 1.2.1 ─

## ✔ ggplot2 3.0.0     ✔ purrr   0.2.5
## ✔ tibble  1.4.2     ✔ dplyr   0.7.6
## ✔ tidyr   0.8.1     ✔ stringr 1.3.1
## ✔ readr   1.1.1     ✔ forcats 0.3.0

## ─ Conflicts ──────────────────────────────────── tidyverse_conflicts() ─
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()

library(grid)
library(gtable)

function

plot_segment_across_facets <- function(p, from=1, to=2, point_id=1, 
                                       plotout = F,
                                       gp=gpar(lty=1, alpha=0.5)){
  if (TRUE %in% grepl("ggplot", class(p))) {
    g <- ggplot_gtable(ggplot_build(p))
  } else {
    g <- p
  }
  
  # collect panel viewport names and index numbers in the grob
  panel_vps <- c()
  id_n <- c()
  for (i in 1:length(g$grobs)) {
    if (str_detect(g$layout[i, "name"], "panel") & g$grobs[[i]]$name != "NULL") {
      p_name <- g$layout[i, "name"]
      panel_vps <- c(panel_vps, p_name)
      id_n <- c(id_n, i)
    }
  }
  
  # preprocessing for converting the panel #
  panel_vps %>%
    str_replace("panel-", "") %>%
    str_split("[\\-\\.]") %>%
    map_chr(1) -> ind_col
  ind_col <- as.numeric(ind_col)

  panel_vps %>%
    str_replace("panel-", "") %>%
    str_split("[\\-\\.]") %>%
    map_chr(2) -> ind_row
  ind_row <- as.numeric(ind_row)

  my_dim <- c(max(ind_row), max(ind_col))
  x <- 1:length(id_n)
  L <- length(x)
  x[(L+1):(my_dim[1]*my_dim[2])] <- NA
  m1 <- as.vector(matrix(x, nrow=my_dim[1], byrow=T))

  x2 <- 1:L
  xx <- as.vector(!is.na(m1))
  xx[xx] <- x2
  xx[!xx] <- NA
  m2 <- as.vector(matrix(xx, nrow=my_dim[1]))

  # convert panel # to match the sequence
  from <- m2[m1==from]
  from <- from[complete.cases(from)]
  to <- m2[m1==to]
  to <- to[complete.cases(to)]
  
  # select points to be connected
  pnames1 <- names(g$grobs[[id_n[from]]]$children)
  pnames2 <- names(g$grobs[[id_n[to]]]$children)
  
  pname1 <- pnames1[str_detect(pnames1, "geom_point.points")]
  pname2 <- pnames2[str_detect(pnames2, "geom_point.points")]
  
  p1 <- g$grobs[[id_n[from]]]$children[[pname1[1]]]
  p2 <- g$grobs[[id_n[to]]]$children[[pname2[1]]]
  
  g <- with(g$layout[id_n[from],], 
            gtable_add_grob(g, 
                            moveToGrob(p1$x[point_id], 
                                       p1$y[point_id]), t=t, l=l))
  g <- with(g$layout[id_n[to],], 
            gtable_add_grob(g, 
                            lineToGrob(p2$x[point_id], p2$y[point_id], gp=gp), 
                            t=t, l=l))
  
  g$layout$clip <- "off"
  if (plotout==TRUE) grid.draw(g) 
  return(g)
}

sample data

d <- data.frame(x = rnorm(10), y = rnorm(10), id = c("a", "a", "b", "b", "c",
                                                     "d", "e", "f", "g", "g"))
d

##             x           y id
## 1  -0.8424990  1.61146573  a
## 2   0.4055838 -0.38709906  a
## 3  -0.8226788 -0.04705237  b
## 4  -1.4608169 -1.07634814  b
## 5   0.6728395  0.41672519  c
## 6   0.3464522 -0.86289034  d
## 7  -2.3731611 -1.85731566  e
## 8   0.9625376 -1.17604202  f
## 9   1.3791485  1.09029835  g
## 10  0.3123674 -0.41158379  g

plot points

p <- ggplot(d, aes(x, y)) + 
  geom_point() + 
  facet_wrap(~id) + 
  theme_bw() +
  theme(
    strip.background = element_blank(),
    #strip.text.x = element_blank(),
    #axis.text.y=element_blank(),
    axis.line=element_blank(),
    #axis.ticks.y=element_blank(),
    axis.title=element_blank()
    #axis.text.x = element_blank()
  )
plot(p)

connect first point in each facet panels

g <- plot_segment_across_facets(p, 1, 2)
ps <- c(2,3,3,4,4,5,5,6,6,7)
while (length(ps) > 0){
  g <- plot_segment_across_facets(g, from=ps[1], to=ps[2])
  ps <- ps[-c(1:2)]
}

grid.newpage()
grid.draw(g)