library(ggplot2)

# functions -----------------------------------------------

geom_liquid_area <- function(mapping = NULL, data = NULL, stat = "identity",
                             position = "stack", na.rm = FALSE, show.legend = NA,
                             inherit.aes = TRUE, ...) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomArea,
    position = PositionLiquidStack,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      na.rm = na.rm,
      alpha = 0.4,
      ...
    )
  )
}

PositionLiquidStack <- ggproto("PositionLiquidStack", PositionStack,
  compute_panel = function(data, params, scales) {
    if (is.null(params$var)) {
      return(data)
    }

    # ensure all groups have the same X
    shared_x <- sort(unique(data$x))

    # interpolate all points
    data <- ggplot2:::dapply(data, c("PANEL", "group"), function(df) {
      df_list <- lapply(seq_len(nrow(df) - 1), function(i) {
        df_part <- df[c(i, i + 1), ]
        if (identical(df_part$x[1], df_part$x[2])) return(df[i, ])
        xout <- shared_x[df_part$x[1] <= shared_x & shared_x <= df_part$x[2]]
        approx_df <- df[rep(1, length(xout)), ]
        approx_df$x <- xout
        approx_df$y <- approx(x = df_part$x, y = df_part$y, xout = xout)$y
        approx_df$ymax <- approx(x = df_part$x, y = df_part$ymax, xout = xout)$y
        approx_df
      })

      df <- do.call(rbind, df_list)
      # sorry for cheating...
      df <- dplyr::distinct(df)

      # add two points at the both ends to create a cliff
      # (note that this should be done for every NAs, not only for the both ends)
      df <- rbind(head(df, n = 1), df)
      df <- rbind(head(df, n = 1), df)
      df <- rbind(df, tail(df, n = 1))
      df <- rbind(df, tail(df, n = 1))
      df[c(1:2, nrow(df) - 0:1), c("y", "ymin", "ymax")] <- 0
      df[1, "x"] <- head(shared_x, n = 1)
      df[nrow(df), "x"] <- tail(shared_x, n = 1)
      df
    })

    negative <- data$ymax < 0
    neg <- data[negative, , drop = FALSE]
    pos <- data[!negative, , drop = FALSE]

    if (any(negative, na.rm = TRUE)) {
      neg <- ggplot2:::collide(neg, NULL, "position_stack", pos_liquid_stack,
        vjust = params$vjust,
        fill = params$fill,
        reverse = params$reverse
      )
    }
    if (any(!negative, na.rm = TRUE)) {
      pos <- ggplot2:::collide(pos, NULL, "position_stack", pos_liquid_stack,
        vjust = params$vjust,
        fill = params$fill,
        reverse = params$reverse
      )
    }

    #    browser()
    rbind(neg, pos)
  }
)

# use the ymax of the underlying group as the ymin
pos_liquid_stack <- function(df, width, vjust = 1, fill = FALSE) {
  # points may stack within a group, so there may be two heights
  df_left <- ggplot2:::dapply(df, c("PANEL", "group"), head, n = 1)
  df_left <- ggplot2:::pos_stack(df_left, width, vjust, fill)

  is_cliff <- ggplot2:::dapply(df, c("PANEL", "group"), function(x) list(is_cliff = nrow(x) > 1))$is_cliff
  is_cliff <- cumsum(is_cliff) > 0

  # if no group has multiple points, use df_left as is
  if (!any(is_cliff)) return(df_left)

  df_right <- ggplot2:::dapply(df, c("PANEL", "group"), tail, n = 1)
  df_right <- ggplot2:::pos_stack(df_right, width, vjust, fill)

  rbind(df_left, df_right[is_cliff, ])
}


# main -----------------------------------------------

df <- data.frame(
  x = c(0, 2, 2, 4, 1, 2, 2, 3), y = c(1:4, 1:4), id = rep(rev(c("a", "b")), each = 4),
  stringsAsFactors = FALSE
)

ggplot(df, aes(x, y, fill = id)) + geom_liquid_area()

^{Created on 2018-12-19 by the reprex package (v0.2.1)}