How to make a custom ggplot2 geom with multiple geometries

Question

I've been reading the vignette on extending ggplot2, but I'm a bit stuck on how I can make a single geom that can add multiple geometries to the plot. Multiple geometries already exist in ggplot2 geoms, for example, we have things like geom_contour (multiple paths), and geom_boxplot (multiple paths and points). But I can't quite see how to extend those into new geoms.

Let's say I'm trying to make a geom_manythings that will draw two polygons and one point by computing on a single dataset. One polygon will be a convex hull for all the points, the second polygon will be a convex hull for a subset of the points, and the single point will represent the centre of the data. I want all of these to appear with a call to one geom, rather than three separate calls, as we see here:

# example data set
set.seed(9)
n <- 1000
x <- data.frame(x = rnorm(n),
                y = rnorm(n))

# computations for the geometries 
# chull for all the points
hull <-  x[chull(x),]
# chull for all a subset of the points
subset_of_x <- x[x$x > 0 & x$y > 0 , ]
hull_of_subset <- subset_of_x[chull(subset_of_x), ]
# a point in the centre of the data
centre_point <- data.frame(x = mean(x$x), y = mean(x$y))

# plot
library(ggplot2)
ggplot(x, aes(x, y)) +
  geom_point() + 
  geom_polygon(data = x[chull(x),], alpha = 0.1) +
  geom_polygon(data = hull_of_subset, alpha = 0.3) +
  geom_point(data = centre_point, colour = "green", size = 3)

I want to have a geom_manythings to replace the three geom_* in the code above.

In an attempt to make a custom geom, I started with code in geom_tufteboxplot and geom_boxplot as templates, along with the 'extending ggplot2' vignette:

library(ggplot2)
library(proto)

GeomManythings <- ggproto(
  "GeomManythings",
  GeomPolygon,
  setup_data = function(self, data, params) {
    data <- ggproto_parent(GeomPolygon, self)$setup_data(data, params)
    data
  },

  draw_group = function(data, panel_scales, coord) {
    n <- nrow(data)
    if (n <= 2)
      return(grid::nullGrob())

    common <- data.frame(
      colour = data$colour,
      size = data$size,
      linetype = data$linetype,
      fill = alpha(data$fill, data$alpha),
      group = data$group,
      stringsAsFactors = FALSE
    )

    # custom bits...

    # polygon hull for all points
    hull <-  data[chull(data), ]
    hull_df <- data.frame(x = hull$x, 
                          y = hull$y, 
                          common, 
                          stringsAsFactors = FALSE)
    hull_grob <-
      GeomPolygon$draw_panel(hull_df, panel_scales, coord)

    # polygon hull for subset
    subset_of_x <-
      data[data$x > 0 & data$y > 0 ,]
    hull_of_subset <-
      subset_of_x[chull(subset_of_x),]
    hull_of_subset_df <- data.frame(x = hull_of_subset$x, 
                                    y = hull_of_subset$y, 
                                    common, 
                                    stringsAsFactors = FALSE)
    hull_of_subset_grob <-
      GeomPolygon$draw_panel(hull_of_subset_df, panel_scales, coord)

    # point for centre point
    centre_point <-
      data.frame(x = mean(coords$x), 
                 y = coords(data$y),
                 common, 
                 stringsAsFactors = FALSE)

    centre_point_grob <-
      GeomPoint$draw_panel(centre_point, panel_scales, coord)

    # end of custom bits

    ggname("geom_mypolygon",
           grobTree(hull_grob,
                    hull_of_subset_grob,
                    centre_point_grob))


  },

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

  draw_key = draw_key_polygon,

  default_aes = aes(
    colour = "grey20",
    fill = "grey20",
    size = 0.5,
    linetype = 1,
    alpha = 1,
  )
)

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

But clearly there are quite a few things not right in this geom, I must be missing some fundamental details...

ggplot(x, aes(x, y)) +
  geom_point() +
  geom_manythings()

How can I write this geom to get the desired result?

Answer 1

there are quite a few issues in your code, so I suggest you try with a simplified case first. In particular, the chull calculation was problematic. Try this,

library(ggplot2)
library(proto)
library(grid)

GeomManythings <- ggproto(
  "GeomManythings",
  Geom,
  setup_data = function(self, data, params) {
    data <- ggproto_parent(Geom, self)$setup_data(data, params)
    data
  },

  draw_group = function(data, panel_scales, coord) {
    n <- nrow(data)
    if (n <= 2)
      return(grid::nullGrob())


    # polygon hull for all points
    hull_df <-  data[chull(data[,c("x", "y")]), ]

    hull_grob <-
      GeomPolygon$draw_panel(hull_df, panel_scales, coord)

    # polygon hull for subset
    subset_of_x <-
      data[data$x > 0 & data$y > 0 ,]
    hull_of_subset_df <-subset_of_x[chull(subset_of_x[,c("x", "y")]),]
    hull_of_subset_df$fill <- "red" # testing
    hull_of_subset_grob <-  GeomPolygon$draw_panel(hull_of_subset_df, panel_scales, coord)

    coords <- coord$transform(data, panel_scales)     

    pg <- pointsGrob(x=mean(coords$x), y=mean(coords$y), 
                     default.units = "npc", gp=gpar(col="green", cex=3))

    ggplot2:::ggname("geom_mypolygon",
                     grobTree(hull_grob,
                              hull_of_subset_grob, pg))


  },


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

  draw_key = draw_key_polygon,

  default_aes = aes(
    colour = "grey20",
    fill = "grey50",
    size = 0.5,
    linetype = 1,
    alpha = 0.5
  )
)

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


set.seed(9)
n <- 20
d <- data.frame(x = rnorm(n),
                y = rnorm(n))

ggplot(d, aes(x, y)) +
  geom_manythings()+
  geom_point() 

(disclaimer: I haven't tried to write a geom in 5 years, so I don't know how it works nowadays)