Clipping lines using isoband::clip_lines()

clip_lines_adhoc.md

library(ggplot2)
library(grid)

geom_clipped_line <- function(mapping = NULL, data = NULL, stat = "identity",
                              position = "identity", na.rm = FALSE,
                              show.legend = NA, inherit.aes = TRUE, ...) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomClippedLine,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      na.rm = na.rm,
      ...
    )
  )
}

GeomClippedLine <- ggproto("GeomClippedLine", GeomLine,
  draw_panel = function(self, data, panel_params, coord, ...) {
    grobs <- ggproto_parent(GeomLine, self)$draw_panel(data, panel_params, coord, ...)
    
    x <- convertX(grobs$x, "native", valueOnly = TRUE)
    y <- convertY(grobs$y, "native", valueOnly = TRUE)
    id <- grobs$id
    
    indices <- purrr::map_int(unique(grobs$id), function(i) {
      idx <- which(grobs$id == i)
      idx[length(idx) %/% 2]
    })
    boxes <- data.frame(
      x = x[indices],
      y = y[indices],
      width = convertWidth(unit(0.02, "native"), "native", valueOnly = TRUE),
      height = convertWidth(unit(0.02, "native"), "native", valueOnly = TRUE),
      theta = 0
    )
    clipped <- isoband::clip_lines(x, y, id, boxes)
    grobs$x <- unit(clipped$x, "native")
    grobs$y <- unit(clipped$y, "native")
    grobs$id <- clipped$id
    grobs$gp <- purrr::modify_if(grobs$gp, ~ length(.) != 1, ~ rep(., each = 2))
    
    # TODO: we can't know the labels?
    gList(grobs, textGrob("x", x = boxes$x, y = boxes$y, default.units = "native"))
  }
)

# TODO: need to interpolate nicely...
d <- data.frame(x = c(seq(from = 1, to = 2, length.out = 1000),
                      seq(from = 1, to = 3, length.out = 1000)),
                y = c(seq(from = 0, to = 1, length.out = 1000),
                      seq(from = 1, to = 3, length.out = 1000)),
                g = rep(c("a", "b"), each = 1000))

ggplot(d, aes(x, y, colour = g)) +
  geom_clipped_line()

^{Created on 2019-02-22 by the reprex package (v0.2.1)}