Creating stacked barchar in ggplot with positive and negative values

geom_twoway_bar.R

library(ggplot2)

df <- data.frame(
  "sector" = c("a", "b", "c"),
  "date" = rep(as.Date(c("1998-01-01", "1999-01-01", "2000-01-01")), each = 3),
  "value" = c(-1, 1, 1, 1, -1, -3, 1.3, 1, 2)
)

p <- ggplot(df, aes(x = date, y = value, fill = sector))

# Doesn't plot bars properly
p + 
  geom_bar(stat = "identity") + 
  geom_hline(yintercept = 0)
# Warning message:
#   Stacking not well defined when ymin != 0
# See e.g. 
# http://stackoverflow.com/questions/13734368/ggplot2-and-a-stacked-bar-chart-with-negative-values

# DOES plot bars properly, but involves code duplication, etc
p +
  geom_bar(stat = "identity", data = subset(df, value >= 0)) +
  geom_bar(stat = "identity", data = subset(df, value < 0)) +
  geom_hline(yintercept = 0)

# GOAL: make this work like expression above
### p + geom_twoway_bar()

# Incredibly kludgey and hacky solution

## Wrapper around ggplot2's `+` operator
`+.gg` <- function (e1, e2) {
  e2name <- substitute(e2)
  dots <- as.list(e2name)[-1]
  dots <- append(dots, list(gg_object = e1))

  if (deparse(e2name[[1]]) == "geom_twoway_bar")
    do.call(geom_twoway_bar, dots)
  else
    ggplot2:::`+.gg`(e1, e2)
}

geom_twoway_bar <- function(gg_object = NULL, ...) {
  if (ggplot2::is.ggplot(gg_object)) {
    
    p_obj <- eval(gg_object, envir = parent.frame())
    
    y_var <- p_obj$data[, deparse(eval(substitute(p_obj$mapping$y)))]
    
    geom_pos <- ggplot2::geom_bar(stat = "identity",
                                  data = p_obj$data[y_var >= 0, , drop = FALSE],
                                  ...)
    
    geom_neg <- ggplot2::geom_bar(stat = "identity", 
                                  data = p_obj$data[y_var < 0, , drop = FALSE], 
                                  ...)
    
    hline <- ggplot2::geom_hline(yintercept = 0)
    
    Reduce(`+`, c(geom_pos, geom_neg, hline), init = p_obj)
  }
}

# This now works
p + geom_twoway_bar()

That's a pretty succinct and expressive way to do this. The problem with making it a full-on ggalt Geom lies in this bit of ggplo2 code: https://github.com/hadley/ggplot2/blob/59c503b8e1cacf1f9264d1e233b7a305916905d6/R/position-collide.r#L57-L72. It'd be super easy to do something like (quick hack):

  setup_data = function(data, params) {
    data$width <- data$width %||%
      params$width %||% (resolution(data$x, FALSE) * 0.9)

    d_plus <- subset(data, y>=0, drop=FALSE)
    d_minus <- subset(data, y<0, drop=FALSE)

    d_plus <- transform(d_plus,
      ymin = pmin(y, 0), ymax = pmax(y, 0),
      xmin = x - width / 2, xmax = x + width / 2, width = NULL
    )

    d_minus <- transform(d_minus,
      ymin = pmin(y, 0), ymax = pmax(y, 0),
      xmin = x - width / 2, xmax = x + width / 2, width = NULL
    )

    rbind(d_plus, d_minus)

  },

  draw_panel = function(self, data, panel_scales, coord, width=NULL) {

    d_plus <- subset(data, y>=0)
    d_minus <- subset(data, y<=)

    gList(
      ggplot2::ggproto_parent(GeomRect, self)$draw_panel(d_plus, panel_scales, coord),
      ggplot2::ggproto_parent(GeomRect, self)$draw_panel(d_minus, panel_scales, coord)
    )
  }

But the stacking operation happens after the call to setup_data() and totally destroys that hard work. collide() is called by ggplot2 internally, so it can't be easily overriden by an external pkg. But, it may be possible to make a new Position object. I'll poke at that.