Grid as bars in ggplot

Question

A common layout in many sites is to draw the grid as shaded bars:

I'm doing this with this function:

grid_bars <- function(data, y, n = 5, fill = "gray90") {
  breaks <- pretty(data[[y]], n)
  len <- length(breaks)-1
  all_bars <- data.frame(
    b.id = rep(1:len, 4),
    b.x = c(rep(-Inf, len), rep(Inf, len*2), rep(-Inf, len)),
    b.y = c(rep(breaks[-length(breaks)], 2), rep(breaks[-1], 2))
  )
  bars <- all_bars[all_bars$b.id %in% (1:len)[c(FALSE, TRUE)], ]
  grid <- list(
    geom_polygon(data = bars, aes(b.x, b.y, group = b.id),
                 fill = fill, colour = fill),
    scale_y_continuous(breaks = breaks),
    theme(panel.grid = element_blank())
  )
  return(grid)
}

#-------------------------------------------------

dat <- data.frame(year = 1875:1972,
                  level = as.vector(LakeHuron))

ggplot(dat, aes(year, level)) +
  grid_bars(dat, "level", 10) +
  geom_line(colour = "steelblue", size = 1.2) +
  theme_classic()

But it needs to specify data and y again. How to take those directly from the ggplot?

Answer 1

After having a look at the options for extending ggplot2 in Hadley Wickham's book on ggplot2 you probably have to set up your own Geom or Stat layer to achieve the desired result. This way you can access the data and aesthetics specified in ggplot() or even pass different data and aesthetics to your fun. Still a newbie in writing extensions for ggplot2 but a first approach may look like so:

library(ggplot2)

# Make bars dataframe
make_bars_df <- function(y, n) {
  breaks <- pretty(y, n)
  len <- length(breaks) - 1
  all_bars <- data.frame(
    group = rep(1:len, 4),
    x = c(rep(-Inf, len), rep(Inf, len * 2), rep(-Inf, len)),
    y = c(rep(breaks[-length(breaks)], 2), rep(breaks[-1], 2))
  )
  all_bars[all_bars$group %in% (1:len)[c(FALSE, TRUE)], ]
}

# Setup Geom
geom_grid_bars_y <- function(mapping = NULL, data = NULL, stat = "identity",
                           position = "identity", na.rm = FALSE, show.legend = NA,
                           inherit.aes = TRUE, n = 5, ...) {
  layer(
    geom = GeomGridBarsY, mapping = mapping,  data = data, stat = stat,
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(n = n, ...)
  )
}

GeomGridBarsY <- ggproto("GeomGridBarsY", Geom,
                        required_aes = c("y"),
                        default_aes = aes(alpha = NA, colour = NA, fill = "gray90", group = NA,
                                          linetype = "solid", size = 0.5, subgroup = NA),
                        non_missing_aes = aes("n"),
                        setup_data = function(data, params) {
                          transform(data)
                        },

                        draw_group = function(data, panel_scales, coord, n = n) {
                          bars <- make_bars_df(data[["y"]], n)
                          # setup data for GeomPolygon
                          ## If you want this to work with facets you have to take care of the PANEL
                          bars$PANEL <- factor(1)
                          # Drop x, y, group from data
                          d <- data[ , setdiff(names(data), c("x", "y", "group"))] 
                          d <- d[!duplicated(d), ]
                          # Merge information in data to  bars
                          bars <- merge(bars, d, by = "PANEL")
                          # Set color = fill
                          bars[["colour"]] <- bars[["fill"]] 
                          # Draw
                          grid::gList(
                            ggplot2::GeomPolygon$draw_panel(bars, panel_scales, coord)
                          )
                        },

                        draw_key = draw_key_rect
)

grid_bars <- function(n = 5, fill = "gray90") {
  list(
    geom_grid_bars_y(n = n, fill = fill),
    scale_y_continuous(breaks = scales::pretty_breaks(n = n)),
    theme(panel.grid = element_blank())
  )
}

dat <- data.frame(year = 1875:1972,
                  level = as.vector(LakeHuron))

ggplot(dat, aes(year, level)) +
  grid_bars(n = 10, fill = "gray95") +
  geom_line(colour = "steelblue", size = 1.2) +
  theme_classic()

Just for reference:

A first and simple approach to get grid bars one could simply adjust the size of the grid lines via theme() like so:

# Simple approach via theme
ggplot(dat, aes(year, level)) +
  geom_line(colour = "steelblue", size = 1.2) +
  scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
  theme_classic() +
  theme(panel.grid.major.y = element_line(size = 8))  

^{Created on 2020-06-14 by the reprex package (v0.3.0)}