Creating a waffle plot together with facets in ggplot2

Question

Is there any easy way to create waffle plots in combination with facets in ggplot2, or combing with the waffle package?

For example, replacing every bar in the below with 100 squares to represent 1 percent.

ggplot(mtcars, aes(x = factor(vs), y = hp, fill = as.factor(carb))) +
  geom_bar(stat = 'identity', position = 'fill') +
  facet_wrap('gear')

Answer 1

I'm not sure I'll ever get around to stat_waffle() / geom_waffle() but you can just use the logic in the package to do the same thing the long way round:

library(hrbrthemes)
library(tidyverse)

We need to figure out the percents then get each group to sum to 100 even, so we need a helper function that's been around on SO for a while:

smart_round <- function(x, digits = 0) { # somewhere on SO
  up <- 10 ^ digits
  x <- x * up
  y <- floor(x)
  indices <- tail(order(x-y), round(sum(x)) - sum(y))
  y[indices] <- y[indices] + 1
  y / up
}

There are 2 bits of "magic" in the waffle package. One bit is the part of the algorithm that just replicates the factor components the right number of times. We'll apply the following function row-wise to the data frame we'll make:

waffleize <- function(xdf) {
  data_frame(
    gear_vs = rep(xdf$gear_vs, xdf$pct),
    carb = rep(xdf$carb, xdf$pct)
  )
}

Now we need to:

• do the same math ggplot2 did for your example
• calculate the percents for the groups
• turn the % into parts of 100 and make each group even total to 100
• since we can't have two different geom_tile()s in one panel we need to hack a facet name that'll do the same thing
• group by said hack
• replicate each row pct times
• make sure things are ordered right
• join a 10x10 x/y grid for as many facets as we'll have (in this case, 6); this is the other bit of the waffle package's "magic"
• draw the tiles

^^ translates to 👇 (this pipe chain is a wee bit long for my comfort level, but "it works"):

count(mtcars, gear, vs, carb, wt=hp) %>% 
  group_by(gear, vs) %>% 
  mutate(pct = n/sum(n)) %>% 
  mutate(pct = (smart_round(pct, 1) * 100L) %>%  as.integer()) %>% 
  select(-n) %>% 
  ungroup() %>% 
  mutate(carb = as.character(carb))  %>% 
  mutate(gear_vs = sprintf("%s-%s", gear, vs)) %>% 
  select(gear_vs, carb, pct, -gear, -vs) %>% 
  rowwise() %>% 
  do(waffleize(.)) %>% 
  ungroup() %>% 
  arrange(gear_vs, carb) %>% 
  bind_cols(
    map_df(seq_len(length(unique(.$gear_vs))), ~expand.grid(y = 1:10, x = 1:10))
  ) %>% 
  ggplot(aes(x, y)) + 
  geom_tile(aes(fill=carb), color="white", size=0.5) +
  ggthemes::scale_fill_tableau() +
  facet_wrap(~gear_vs) +
  coord_equal() +
  labs(x=NULL, y = NULL) +
  hrbrthemes::theme_ipsum_rc(grid="") +
  theme(axis.text=element_blank())