R ggplot2 Bar Chart with Round Corners on Top of Bar

Question

I would like to create a ggplot2 bar chart with round corners at the top of the bars. Consider the following example data:

data <- data.frame(x = letters[1:3],
                   y = c(5, 1, 4))

Based on the ggchicklet package, I can draw a ggplot2 bar chart with rounded corners:

library("ggplot2")
library("ggchicklet")

ggplot(data, aes(x, y)) +
  geom_chicklet(radius = grid::unit(10, 'mm'))

However, as you can see in the image, the corners are round on both sides of the bars. How could I create a ggplot2 bar chart, where only the top of the bars are round?

Answer 1

As @GregorThomas suggests, you probably need a bit of a hacky fix. Here's my effort:

ggplot(data, aes(x, y + 2)) +
  geom_chicklet(radius = grid::unit(10, 'mm')) +
  scale_y_continuous(breaks = 0:8, labels = (-2):6) +
  coord_cartesian(ylim = c(2, 8)) +
  geom_rect(aes(xmin = 0.5, xmax = 3.5, ymin = 0, ymax = 1.95), fill = "gray95") +
  labs(y = "y")

This allows fills and outlines to be preserved:

ggplot(data, aes(x, y + 2, fill = x)) +
  geom_chicklet(radius = grid::unit(10, 'mm'), colour = "black") +
  scale_y_continuous(breaks = 0:8, labels = (-2):6) +
  coord_cartesian(ylim = c(2, 8)) +
  geom_rect(aes(xmin = 0.5, xmax = 3.5, ymin = 0, ymax = 1.95), fill = "gray95") +
  labs(y = "y")

Answer 2

Another Hack (also described by @Gregor Thomas in the comments)

Here is another hack that avoids manipulating the scale by painting a rect over the bottom rounded corners. It works with fill (but fails on outlines):

ggplot(data, aes(x, y, fill = x)) +
  geom_chicklet(radius = grid::unit(10, 'mm'), colour = NA) + 
  geom_col(aes(y = y / 2)) 

polyclip solution

Based on the hack, I cobbled together a solution that will also work with outlines. The following code creates two new geoms, geom_top_rounded_rect and geom_top_rounded_col. A top rounded rect is created by uniting the polygons from a roundrectGrob and a rectGrob with half the size (like in the hack) using gridGeometry::polyclipGrob().

geom_top_rounded_rect <- function(mapping = NULL, data = NULL,
                                       stat = "identity", position = "identity",
                                       radius = grid::unit(6, "pt"),
                                       ...,
                                       na.rm = FALSE,
                                       show.legend = NA,
                                       inherit.aes = TRUE) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomTopRoundedRect,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      radius = radius,
      na.rm = na.rm,
      ...
    )
  )
}

GeomTopRoundedRect <- ggplot2::ggproto(
  "GeomTopRoundedRect", ggplot2::Geom,

  default_aes = ggplot2::aes(
    colour = NA, fill = "grey35", size = 0.5, linetype = 1, alpha = NA
  ),

  required_aes = c("xmin", "xmax", "ymin", "ymax"),

  draw_panel = function(self, data, panel_params, coord,
                        radius = grid::unit(6, "pt")) {

    coords <- coord$transform(data, panel_params)

    grobs <- lapply(1:length(coords$xmin), function(i) {
        
      gridGeometry::polyclipGrob(
        grid::roundrectGrob(
          coords$xmin[i], coords$ymax[i],
          width = (coords$xmax[i] - coords$xmin[i]),
          height = (coords$ymax[i] - coords$ymin[i]),
          r = radius,
          default.units = "native",
          just = c("left", "top")
        ),
        grid::rectGrob(
          coords$xmin[i], coords$ymax[i] - (coords$ymax[i] - coords$ymin[i]) / 2,
          width = (coords$xmax[i] - coords$xmin[i]),
          height = (coords$ymax[i] - coords$ymin[i]) / 2,
          default.units = "native",
          just = c("left", "top")
        ),
        op = "union",
        gp = grid::gpar(
          col = coords$colour[i],
          fill = alpha(coords$fill[i], coords$alpha[i]),
          lwd = coords$size[i] * .pt,
          lty = coords$linetype[i],
          lineend = "butt"
        )
      )
    })

    grobs <- do.call(grid::gList, grobs)

    ggplot2:::ggname("geom_top_rounded_rect", grid::grobTree(children = grobs))

  },

  draw_key = ggplot2::draw_key_polygon

)

geom_top_rounded_col <- function(mapping = NULL, data = NULL,
                          position = ggplot2::position_stack(reverse = TRUE),
                          radius = grid::unit(3, "pt"), ..., width = NULL,
                          na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) {
  layer(
    data = data, mapping = mapping, stat = "identity",
    geom = GeomTopRoundedCol, position = position, show.legend = show.legend,
    inherit.aes = inherit.aes, params = list(
      width = width, radius = radius, na.rm = na.rm, ...
    )
  )
}

GeomTopRoundedCol <- ggproto(
  "GeomTopRoundedCol", GeomTopRoundedRect,

  required_aes = c("x", "y"),

  setup_params = function(data, params) {
    params$flipped_aes <- has_flipped_aes(data, params)
    params
  },

  non_missing_aes = c("xmin", "xmax", "ymin", "ymax"),

  setup_data = function(data, params) {
    data$width <- data$width %||%
      params$width %||% (resolution(data$x, FALSE) * 0.9)
    transform(data,
              ymin = pmin(y, 0), ymax = pmax(y, 0),
              xmin = x - width / 2, xmax = x + width / 2, width = NULL
    )
  },

  draw_panel = function(self, data, panel_params, coord, width = NULL, radius = grid::unit(3, "pt")) {
    ggproto_parent(GeomTopRoundedRect, self)$draw_panel(data, panel_params, coord, radius = radius)
  }

)

Usage:

ggplot(data, aes(x, y, fill = x)) +
    geom_top_rounded_col(radius = grid::unit(10, 'mm'))

With outlines:

ggplot(data, aes(x, y, fill = x)) +
    geom_top_rounded_col(radius = grid::unit(10, 'mm'), color = "black")