R/geom_spiral.R

In 18kimn/ggdubois: Graphics In The Style Of W.E.B. Du Bois

#' @import ggplot2

StatSpiral <- ggproto("StatSpiral", Stat,
  required_aes = c("x", "y"),
  compute_group = function(data, scales) {
    # Slope is needed to make the spiral curve inward instead of
    #   connecting to itself in a circle
    slope <- -0.2
    max_x <- max(data$y) / 2
    # four stages of loop
    # first curve start coordinates
    # first curve end coordinates
    # second curve start coordinates
    # second curve end coordinates
    y <- seq(5, by = -1.5, length.out = nrow(data))
    first <- data.frame(
      x = 0,
      xend = pmin(data$y, max_x),
      y = y,
      yend = slope * pmin(data$y, max_x) + y,
      PANEL = data$PANEL,
      group = data$group
    )
    xend <- ifelse(data$y < max_x, NA_real_, data$y - max_x)
    second <- data.frame(
      x = 0,
      xend = xend,
      y = first$yend,
      yend = slope * xend + first$yend,
      PANEL = data$PANEL,
      group = data$group
    )
    # SECOND SET
    # x0 <- 0
    # x1 <- ifelse(coords$x < max_x, NA_real_, coords$x - max_x)
    # y0 <- y1
    # y1 <- slope * x1 + y0
    # second_curve <- segmentsGrob(x0, x1, y0, y1)
    current <<- rbind(first, second)
    return(rbind(first, second))
  }
)

geom_spiral <- function(mapping = NULL, data = NULL,
                        na.rm = FALSE, show.legend = NA,
                        stat = "identity",
                        position = "identity",
                        inherit.aes = TRUE, ...) {
  layer(
    geom = GeomSegment, mapping = mapping, data = data, stat = StatSpiral,
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )
}
geom_segment <- function(mapping = NULL, data = NULL,
                         stat = "identity", position = "identity",
                         ...,
                         arrow = NULL,
                         arrow.fill = NULL,
                         lineend = "butt",
                         linejoin = "round",
                         na.rm = FALSE,
                         show.legend = NA,
                         inherit.aes = TRUE) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomSegment,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      arrow = arrow,
      arrow.fill = arrow.fill,
      lineend = lineend,
      linejoin = linejoin,
      na.rm = na.rm,
      ...
    )
  )
}