How to create custom ggplot2 geometry with multiple geometries

Question

I read the vignette with the ggplot2 extension , but I'm a little fixated on how I can create one geometry that can add multiple geometries to the graph. Several geometries already exist in ggplot2 geometries, for example, we have things like geom_contour (multiple paths) and geom_boxplot (multiple paths and points). But I can’t understand how to expand them into new geomes.

Let's say I'm trying to make geom_manythings , which will draw two polygons and one point, calculating on one data set. One polygon will be a convex hull for all points, the second polygon will be a convex hull for a subset of points, and a single point will represent the data center. I want all of them to be displayed with a call to the same geometry, and not 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 geom_manythings to replace the three geom_* in the above code.

In an attempt to create custom geometry, I started with the code in geom_tufteboxplot and geom_boxplot as templates along with the 'extend 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 it is clear that there are many things in this geome, I must miss some fundamental details ...

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

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

Answer 1

There are a lot of problems in your code, so I suggest you try the simplified case first. In particular, the breakdown calculation was problematic. Try it,

 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 didn’t try to write a geoma after 5 years, so I don’t know how this works today)