How to abstract this `fill` behavior with ggplot? New Geom? New Stat?

tidyverse
2

Okay - not sure if it is better than what you did, but an 'almost got it but it's getting late' approach is below which defines a new stat. The stat seems to be computing the values correctly (I plotted the points too). However, the stacking is off in group C because that is the only group where the male group provides the remainder...not exactly great behavior. Also, this solution doesn't explicitly label which group caused the remainder as your example does.

So - I guess this is a partial solution and hope it can help you figure out the rest.

  library(tidyverse)
#> Warning: package 'stringr' was built under R version 3.4.4
df <- tibble(
  x1 = c("A", "A", "B", "B", "C", "C"),
  x2 = c("M", "F", "M", "F", "M", "F"),
  x3 = c(10, 15, 20, 30, 40, 30)
) %>% 
  group_by(x2, x1) %>% 
  summarize(estimate = sum(x3)) %>% 
  ungroup() %>% 
  spread(x2, estimate) %>% 
  mutate(larger = if_else(`F` > `M`, "Larger F", "Larger M")) %>% 
  gather(x2, estimate, `F`:`M`, -x1, -larger)

Stat_Rem <- ggproto("Stat_Rem", Stat,
                     compute_group = function(data, scales) {
                       oo  <- order(data$y)
                       ll <- length(data$y)
                       ind <- which(oo == ll)
                       ss <- sum(data$y[-ind])
                       data$y[ind] <- data$y[ind] - ss
                       data
                     },
                     required_aes = c("x", "y")
)


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


ggplot(df, aes(x = x1, y = estimate, fill = x2)) +
  stat_rem() + geom_point() + 
  coord_flip()

Created on 2018-08-02 by the reprex
package (v0.2.0).

4 Likes