Movatterモバイル変換

This vignette documents the official extension mechanism provided in ggplot2 2.0.0. This vignette is a high-level adjunct to the low-level details found in?Stat,?Geom and?theme. You’ll learn how to extend ggplot2 by creating a new stat, geom, or theme.

As you read this document, you’ll see many things that will make you scratch your head and wonder why on earth is it designed this way? Mostly it’s historical accident - I wasn’t a terribly good R programmer when I started writing ggplot2 and I made a lot of questionable decisions. We cleaned up as many of those issues as possible in the 2.0.0 release, but some fixes simply weren’t worth the effort.

ggproto

All ggplot2 objects are built using the ggproto system of object oriented programming. This OO system is used only in one place: ggplot2. This is mostly historical accident: ggplot2 started off usingproto because I needed mutable objects. This was well before the creation of (the briefly lived)mutatr, reference classes and R6: proto was the only game in town.

But why ggproto? Well when we turned to add an official extension mechanism to ggplot2, we found a major problem that caused problems when proto objects were extended in a different package (methods were evaluated in ggplot2, not the package where the extension was added). We tried converting to R6, but it was a poor fit for the needs of ggplot2. We could’ve modified proto, but that would’ve first involved understanding exactly how proto worked, and secondly making sure that the changes didn’t affect other users of proto.

It’s strange to say, but this is a case where inventing a new OO system was actually the right answer to the problem! Fortunately Winston is now very good at creating OO systems, so it only took him a day to come up with ggproto: it maintains all the features of proto that ggplot2 needs, while allowing cross package inheritance to work.

Here’s a quick demo of ggproto in action:

A<-ggproto("A",NULL,x =1,inc =function(self) {    self$x<- self$x+1  })A$x

#> [1] 1

A$inc()A$x

#> [1] 2

A$inc()A$inc()A$x

#> [1] 4

The majority of ggplot2 classes are immutable and static: the methods neither use nor modify state in the class. They’re mostly used as a convenient way of bundling related methods together.

When you create new functionality, like a new geom or stat, the first decision to make is whether you want to build these from scratch or you want to re-use parts of pre-exiting classes. To create a new geom or stat from scratch, you will just create a new ggproto object that inherits fromStat orGeom and override the methods described below.

Creating a new stat

Stats are an important part of layers: they instruct what is displayed, not how it is displayed. They are declared in thelayer(stat) argument which has a correspondence toStat* ggproto classes which all inherit from the rootStat class.

The simplest stat

We’ll start by creating a very simple stat: one that gives the convex hull (thec hull) of a set of points. First we create a new ggproto object that inherits fromStat:

StatChull<-ggproto("StatChull", Stat,compute_group =function(data, scales) {    data[chull(data$x, data$y), , drop=FALSE]  },required_aes =c("x","y"))

The two most important components are thecompute_group() method (which does the computation), and therequired_aes field, which lists which aesthetics must be present in order for the stat to work.

Next we write a layer function. Unfortunately, due to an early design mistake I called these eitherstat_() orgeom_(). A better decision would have been to call themlayer_() functions: that’s a more accurate description because every layer involves a statand a geom. Currently it is the convention to havestat_() wrappers with fixedlayer(stat) arguments andgeom_() wrappers with fixedlayer(geom) arguments. Thestat_() andgeom_() functions both have the same ingredients and cook up new layers.

All layer functions follow the same form - you specify defaults in the function arguments and then call thelayer() function, sending... into theparams argument. The arguments in... will either be arguments for the geom (if you’re making a stat wrapper), arguments for the stat (if you’re making a geom wrapper), or aesthetics to be set.layer() takes care of teasing the different parameters apart and making sure they’re stored in the right place.

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

(Note that if you’re writing this in your own package, you’ll either need to callggplot2::layer() explicitly, or import thelayer() function into your package namespace.)

If you have standard expectations of a constructor with no side effects (e.g. checking arguments), you can also use themake_constructor() function to build one for you. There is no sensible default geom for a stat, so you have to set the default one yourself.

stat_chull<-make_constructor(StatChull,geom ="polygon")print(stat_chull)

#> function (mapping = NULL, data = NULL, geom = "polygon", position = "identity", #>     ..., na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) #> {#>     layer(mapping = mapping, data = data, geom = geom, stat = "chull", #>         position = position, show.legend = show.legend, inherit.aes = inherit.aes, #>         params = list2(na.rm = na.rm, ...))#> }#> <environment: 0x114df14c8>

Once we have a layer function we can try our new stat:

ggplot(mpg,aes(displ, hwy))+geom_point()+stat_chull(fill =NA,colour ="black")

(We’ll see later how to change the defaults of the geom so that you don’t need to specifyfill = NA every time.)

Once we’ve written this basic object, ggplot2 gives a lot for free. For example, ggplot2 automatically preserves aesthetics that are constant within each group:

ggplot(mpg,aes(displ, hwy,colour = drv))+geom_point()+stat_chull(fill =NA)

We can also override the default geom to display the convex hull in a different way:

ggplot(mpg,aes(displ, hwy))+stat_chull(geom ="point",size =4,colour ="red")+geom_point()

Stat parameters

A more complex stat will do some computation. Let’s implement a simple version ofgeom_smooth() that adds a line of best fit to a plot. We create aStatLm that inherits fromStat and a layer function,stat_lm():

StatLm<-ggproto("StatLm", Stat,required_aes =c("x","y"),compute_group =function(data, scales) {    rng<-range(data$x,na.rm =TRUE)    grid<-data.frame(x = rng)    mod<-lm(y~ x,data = data)    grid$y<-predict(mod,newdata = grid)    grid  })stat_lm<-make_constructor(StatLm,geom ="line")ggplot(mpg,aes(displ, hwy))+geom_point()+stat_lm()

StatLm is inflexible because it has no parameters. We might want to allow the user to control the model formula and the number of points used to generate the grid. To do so, we add arguments to thecompute_group() method which will get picked up bymake_constructor().

StatLm<-ggproto("StatLm", Stat,required_aes =c("x","y"),compute_group =function(data, scales,params =list(),n =100,formula = y~ x) {    rng<-range(data$x,na.rm =TRUE)    grid<-data.frame(x =seq(rng[1], rng[2],length = n))    mod<-lm(formula,data = data)    grid$y<-predict(mod,newdata = grid)    grid  })stat_lm<-make_constructor(StatLm,geom ="line")ggplot(mpg,aes(displ, hwy))+geom_point()+stat_lm(formula = y~poly(x,10))+stat_lm(formula = y~poly(x,10),geom ="point",colour ="red",n =20)

If you’re defining a constructor function yourself, it is good practise to add the parameters as arguments. We don’thave to explicitly include the new parameters in the arguments for the layer,... will get passed to the right place anyway. But you’ll need to document them somewhere so the user knows about them. Here’s a brief example. Note@inheritParams ggplot2::stat_identity: that will automatically inherit documentation for all the parameters also defined forstat_identity().

#' @export#' @inheritParams ggplot2::stat_identity#' @param formula The modelling formula passed to \code{lm}. Should only#'   involve \code{y} and \code{x}#' @param n Number of points used for interpolation.stat_lm<-function(mapping =NULL,data =NULL,geom ="line",position ="identity",na.rm =FALSE,show.legend =NA,inherit.aes =TRUE,n =50,formula = y~ x,                    ...) {layer(stat = StatLm,data = data,mapping = mapping,geom = geom,position = position,show.legend = show.legend,inherit.aes = inherit.aes,params =list(n = n,formula = formula,na.rm = na.rm, ...)  )}

stat_lm() must be exported if you want other people to use it. You could also consider exportingStatLm if you want people to extend the underlying object; this should be done with care.

Picking defaults

Sometimes you have calculations that should be performed once for the complete dataset, not once for each group. This is useful for picking sensible default values. For example, if we want to do a density estimate, it’s reasonable to pick one bandwidth for the whole plot. The following Stat creates a variation of thestat_density() that picks one bandwidth for all groups by choosing the mean of the “best” bandwidth for each group (I have no theoretical justification for this, but it doesn’t seem unreasonable).

To do this we override thesetup_params() method. It’s passed the data and a list of params, and returns an updated list.

StatDensityCommon<-ggproto("StatDensityCommon", Stat,required_aes ="x",setup_params =function(data, params) {if (!is.null(params$bandwidth))return(params)    xs<-split(data$x, data$group)    bws<-vapply(xs, bw.nrd0,numeric(1))    bw<-mean(bws)message("Picking bandwidth of ",signif(bw,3))    params$bandwidth<- bw    params  },compute_group =function(data, scales,bandwidth =1) {    d<-density(data$x,bw = bandwidth)data.frame(x = d$x,y = d$y)  })stat_density_common<-make_constructor(StatDensityCommon,geom ="line")ggplot(mpg,aes(displ,colour = drv))+stat_density_common()

ggplot(mpg,aes(displ,colour = drv))+stat_density_common(bandwidth =0.5)

I recommend usingNULL as a default value. If you pick important parameters automatically, it’s a good idea tomessage() to the user (and when printing a floating point parameter, usingsignif() to show only a few significant digits).

Variable names and default aesthetics

This stat illustrates another important point. If we want to make this stat usable with other geoms, we should return a variable calleddensity instead ofy. Then we can set up thedefault_aes to automatically mapdensity toy, which allows the user to override it to use with different geoms:

StatDensityCommon<-ggproto("StatDensity2", Stat,required_aes ="x",default_aes =aes(y =after_stat(density)),compute_group =function(data, scales,bandwidth =1) {    d<-density(data$x,bw = bandwidth)data.frame(x = d$x,density = d$y)  })ggplot(mpg,aes(displ, drv,colour =after_stat(density)))+stat_density_common(bandwidth =1,geom ="point")

However, using this stat with the area geom doesn’t work quite right. The areas don’t stack on top of each other:

ggplot(mpg,aes(displ,fill = drv))+stat_density_common(bandwidth =1,geom ="area",position ="stack")

This is because each density is computed independently, and the estimatedxs don’t line up. We can resolve that issue by computing the range of the data once insetup_params().

StatDensityCommon<-ggproto("StatDensityCommon", Stat,required_aes ="x",default_aes =aes(y =after_stat(density)),setup_params =function(data, params) {    min<-min(data$x)-3* params$bandwidth    max<-max(data$x)+3* params$bandwidthlist(bandwidth = params$bandwidth,min = min,max = max,na.rm = params$na.rm    )  },compute_group =function(data, scales, min, max,bandwidth =1) {    d<-density(data$x,bw = bandwidth,from = min,to = max)data.frame(x = d$x,density = d$y)  })ggplot(mpg,aes(displ,fill = drv))+stat_density_common(bandwidth =1,geom ="area",position ="stack")

ggplot(mpg,aes(displ, drv,fill =after_stat(density)))+stat_density_common(bandwidth =1,geom ="raster")

Exercises

1. Extendstat_chull to compute the alpha hull, as from thealphahull package. Your new stat should take analpha argument.

2. Modify the final version ofStatDensityCommon to allow the user to specify themin andmax parameters. You’ll need to modify both the layer function and thecompute_group() method.

   Note: be careful when adding parameters to a layer function. The following namescol,color,pch,cex,lty,lwd,srt,adj,bg,fg,min, andmax are intentionally renamed to accommodate base graphical parameter names. For example, a value passed asmin to a layer appears asymin in thesetup_params list of params. It is recommended you avoid using these names for layer parameters.

3. Compare and contrastStatLm toggplot2::StatSmooth. What key differences makeStatSmooth more complex thanStatLm?

Creating a new geom

Geoms are also important parts of layers: they instruct how data is displayed. They are declared in thelayer(geom) argument which has a correspondence toGeom* ggproto classes which all inherit from the rootGeom class.

It’s harder to create a new geom than a new stat because you also need to know some grid. ggplot2 is built on top of grid, so you’ll need to know the basics of drawing with grid. If you’re serious about adding a new geom, I’d recommend buyingR graphics by Paul Murrell. It tells you everything you need to know about drawing with grid.

A simple geom

It’s easiest to start with a simple example. The code below is a simplified version ofgeom_point():

GeomSimplePoint<-ggproto("GeomSimplePoint", Geom,required_aes =c("x","y"),default_aes =aes(shape =19,colour ="black"),draw_key = draw_key_point,draw_panel =function(data, panel_params, coord) {    coords<- coord$transform(data, panel_params)    grid::pointsGrob(      coords$x, coords$y,pch = coords$shape,gp = grid::gpar(col = coords$colour)    )  })# Default stat is `stat_identity()`, no need to specifygeom_simple_point<-make_constructor(GeomSimplePoint)ggplot(mpg,aes(displ, hwy))+geom_simple_point()

This is very similar to defining a new stat. You always need to provide fields/methods for the four pieces shown above:

• required_aes is a character vector which lists all the aesthetics that the user must provide.

• default_aes lists the aesthetics that have default values.

• draw_key provides the function used to draw the key in the legend. You can see a list of all the build in key functions in?draw_key

• draw_panel() is where the magic happens. This function takes three arguments and returns a grid grob. It is called once for each panel. It’s the most complicated part and is described in more detail below.

draw_panel() has three arguments:

• data: a data frame with one column for each aesthetic.

• panel_params: a list of per-panel parameters generated by the coord. You should consider this an opaque data structure: don’t look inside it, just pass along tocoord methods.

• coord: an object describing the coordinate system.

You need to usepanel_params andcoord together to transform the datacoords <- coord$transform(data, panel_params). This creates a data frame where position variables are scaled to the range 0–1. You then take this data and call a grid grob function. (Transforming for non-Cartesian coordinate systems is quite complex - you’re best off transforming your data to the form accepted by an existing ggplot2 geom and passing it.)

Collective geoms

Overridingdraw_panel() is most appropriate if there is one graphic element per row. In other cases, you want graphic element per group. For example, take polygons: each row gives one vertex of a polygon. In this case, you should instead overridedraw_group().

The following code makes a simplified version ofGeomPolygon:

GeomSimplePolygon<-ggproto("GeomPolygon", Geom,required_aes =c("x","y"),default_aes =aes(colour =NA,fill ="grey20",linewidth =0.5,linetype =1,alpha =1  ),draw_key = draw_key_polygon,draw_group =function(data, panel_params, coord) {    n<-nrow(data)if (n<=2)return(grid::nullGrob())    coords<- coord$transform(data, panel_params)# A polygon can only have a single colour, fill, etc, so take from first row    first_row<- coords[1, , drop=FALSE]    grid::polygonGrob(      coords$x, coords$y,default.units ="native",gp = grid::gpar(col = first_row$colour,fill = scales::alpha(first_row$fill, first_row$alpha),lwd = first_row$linewidth* .pt,lty = first_row$linetype      )    )  })geom_simple_polygon<-make_constructor(GeomSimplePolygon,stat ="chull")ggplot(mpg,aes(displ, hwy))+geom_point()+geom_simple_polygon(aes(colour = class),fill =NA)

There are a few things to note here:

• We overridedraw_group() instead ofdraw_panel() because we want one polygon per group, not one polygon per row.

• If the data contains two or fewer points, there’s no point trying to draw a polygon, so we return anullGrob(). This is the graphical equivalent ofNULL: it’s a grob that doesn’t draw anything and doesn’t take up any space.

• Note the units:x andy should always be drawn in “native” units. (The default units forpointGrob() is a native, so we didn’t need to change it there).lwd is measured in points, but ggplot2 uses mm, so we need to multiply it by the adjustment factor.pt.

You might want to compare this to the realGeomPolygon. You’ll see it overridesdraw_panel() because it uses some tricks to makepolygonGrob() produce multiple polygons in one call. This is considerably more complicated, but gives better performance.

Inheriting from an existing Geom

Sometimes you just want to make a small modification to an existing geom. In this case, rather than inheriting fromGeom you can inherit from an existing subclass. For example, we might want to change the defaults forGeomPolygon to work better withStatChull:

GeomPolygonHollow<-ggproto("GeomPolygonHollow", GeomPolygon,default_aes =aes(colour ="black",fill =NA,linewidth =0.5,linetype =1,alpha =NA)  )geom_chull<-make_constructor(GeomPolygonHollow,stat ="chull")ggplot(mpg,aes(displ, hwy))+geom_point()+geom_chull()

This doesn’t allow you to use different geoms with the stat, but that seems appropriate here since the convex hull is primarily a polygonal feature.

Exercises

1. Compare and contrastGeomPoint withGeomSimplePoint.

2. Compare and contrastGeomPolygon withGeomSimplePolygon.

Geoms and Stats with multiple orientation

Some layers have a specific orientation.geom_bar() e.g. have the bars along one axis,geom_line() will sort the input by one axis, etc. The original approach to using these geoms in the other orientation was to addcoord_flip() to the plot to switch the position of the x and y axes. Following ggplot2 v3.3 all the geoms will natively work in both orientations withoutcoord_flip(). The mechanism is that the layer will try to guess the orientation from the mapped data, or take direction from the user using theorientation parameter. To replicate this functionality in new stats and geoms there’s a few steps to take. We will look at the boxplot layer as an example instead of creating a new one from scratch.

Omnidirectional stats

The actual guessing of orientation will happen insetup_params() using thehas_flipped_aes() helper:

StatBoxplot$setup_params

#> <ggproto method>#>   <Wrapper function>#>     function (...) #> setup_params(..., self = self)#> #>   <Inner function (f)>#>     function (self, data, params) #> {#>     params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = TRUE, #>         group_has_equal = TRUE, main_is_optional = TRUE, default = NA)#>     if (is.na(params$flipped_aes) && any(c("x", "y") %in% names(data))) {#>         cli::cli_warn("Orientation is not uniquely specified when both the x and y aesthetics are continuous. Picking default orientation 'x'.")#>         params$flipped_aes <- FALSE#>     }#>     data <- flip_data(data, params$flipped_aes)#>     has_x <- !(is.null(data$x) && is.null(params$x))#>     has_y <- !(is.null(data$y) && is.null(params$y))#>     if (!has_x && !has_y) {#>         cli::cli_abort("{.fn {snake_class(self)}} requires an {.field x} or {.field y} aesthetic.")#>     }#>     params$width <- params$width %||% (resolution(data$x %||% #>         0, discrete = TRUE) * 0.75)#>     if (!is_mapped_discrete(data$x) && is.double(data$x) && !has_groups(data) && #>         any(data$x != data$x[1L])) {#>         cli::cli_warn(c("Continuous {.field {flipped_names(params$flipped_aes)$x}} aesthetic", #>             i = "did you forget {.code aes(group = ...)}?"))#>     }#>     params#> }

Following this is a call toflip_data() which will make sure the data is in horizontal orientation. The rest of the code can then simply assume that the data is in a specific orientation. The same thing happens insetup_data():

StatBoxplot$setup_data

#> <ggproto method>#>   <Wrapper function>#>     function (...) #> setup_data(..., self = self)#> #>   <Inner function (f)>#>     function (self, data, params) #> {#>     data <- flip_data(data, params$flipped_aes)#>     data$x <- data$x %||% 0#>     data <- remove_missing(data, na.rm = params$na.rm, vars = "x", #>         name = "stat_boxplot")#>     flip_data(data, params$flipped_aes)#> }

The data is flipped (if needed), manipulated, and flipped back as it is returned.

During the computation, this sandwiching betweenflip_data() is used as well, but right before the data is returned it will also get aflipped_aes column denoting if the data is flipped or not. This allows the stat to communicate to the geom that orientation has already been determined.

Omnidirecitonal geoms

The setup for geoms is pretty much the same, with a few twists.has_flipped_aes() is also used insetup_params(), where it will usually be picked up from theflipped_aes column given by the stat. Insetup_data() you will often see thatflipped_aes is reassigned, to make sure it exist prior to position adjustment. This is needed if the geom is used together with a stat that doesn’t handle orientation (oftenstat_identity()):

GeomBoxplot$setup_data

#> <ggproto method>#>   <Wrapper function>#>     function (...) #> setup_data(..., self = self)#> #>   <Inner function (f)>#>     function (self, data, params) #> {#>     data$flipped_aes <- params$flipped_aes#>     data <- flip_data(data, params$flipped_aes)#>     data <- compute_data_size(data, params$width, default = self$default_aes$width, #>         zero = FALSE, discrete = TRUE)#>     if (isFALSE(params$outliers)) {#>         data$outliers <- NULL#>     }#>     if (!is.null(data$outliers)) {#>         suppressWarnings({#>             out_min <- vapply(data$outliers, min, numeric(1))#>             out_max <- vapply(data$outliers, max, numeric(1))#>         })#>         data$ymin_final <- pmin(out_min, data$ymin)#>         data$ymax_final <- pmax(out_max, data$ymax)#>     }#>     if (is.null(params) || is.null(params$varwidth) || !params$varwidth || #>         is.null(data$relvarwidth)) {#>         data$xmin <- data$x - data$width/2#>         data$xmax <- data$x + data$width/2#>     }#>     else {#>         data$relvarwidth <- data$relvarwidth/max(data$relvarwidth)#>         data$xmin <- data$x - data$relvarwidth * data$width/2#>         data$xmax <- data$x + data$relvarwidth * data$width/2#>     }#>     data$width <- NULL#>     if (!is.null(data$relvarwidth)) #>         data$relvarwidth <- NULL#>     flip_data(data, params$flipped_aes)#> }

In thedraw_*() method you will once again sandwich any data manipulation betweenflip_data() calls. It is important to make sure that the data is flipped back prior to creating the grob or calling draw methods from other geoms.

Dealing with required aesthetics

Omnidirectional layers usually have two different sets of required aesthetics. Which set is used is often how it knows the orientation. To handle this gracefully therequired_aes field ofStat andGeom classes understands the| (or) operator. Looking atGeomBoxplot we can see how it is used:

GeomBoxplot$required_aes

#> [1] "x|y"            "lower|xlower"   "upper|xupper"   "middle|xmiddle"#> [5] "ymin|xmin"      "ymax|xmax"

This tells ggplot2 that either all the aesthetics before| are required or all the aesthetics after are required.

Ambiguous layers

Some layers will not have a clear interpretation of their data in terms of orientation. A classic example isgeom_line() which just by convention runs along the x-axis. There is nothing in the data itself that indicates that. For these geoms the user must indicate a flipped orientation by settingorientation = "y". The stat or geom will then callhas_flipped_aes() withambiguous = TRUE to cancel any guessing based on data format. As an example we can see thesetup_params() method ofGeomLine:

GeomLine$setup_params

#> <ggproto method>#>   <Wrapper function>#>     function (...) #> setup_params(...)#> #>   <Inner function (f)>#>     function (data, params) #> {#>     params$flipped_aes <- has_flipped_aes(data, params, ambiguous = TRUE)#>     params#> }

Creating your own theme

Themes govern how non-data elements of the plot are displayed. If you’re going to create your own complete theme, there are a few things you need to know:

• Overriding existing elements, rather than modifying them
• The four global elements that affect (almost) every other theme element
• Complete vs. incomplete elements

Overriding elements

By default, when you add a new theme element, it inherits values from the existing theme. For example, the following code sets the key colour to red, but it inherits the existing fill colour:

theme_grey()$legend.key

#> NULL

new_theme<-theme_grey()+theme(legend.key =element_rect(colour ="red"))new_theme$legend.key

#> <ggplot2::element_rect>#>  @ fill         : NULL#>  @ colour       : chr "red"#>  @ linewidth    : NULL#>  @ linetype     : NULL#>  @ linejoin     : NULL#>  @ inherit.blank: logi FALSE

To override it completely, use%+replace% instead of+:

new_theme<-theme_grey()%+replace%theme(legend.key =element_rect(colour ="red"))new_theme$legend.key

#> <ggplot2::element_rect>#>  @ fill         : NULL#>  @ colour       : chr "red"#>  @ linewidth    : NULL#>  @ linetype     : NULL#>  @ linejoin     : NULL#>  @ inherit.blank: logi FALSE

Global elements

There are four elements that affect the global appearance of the plot:

These set default properties that are inherited by more specific settings. These are most useful for setting an overall “background” colour and overall font settings (e.g. family and size).

df<-data.frame(x =1:3,y =1:3)base<-ggplot(df,aes(x, y))+geom_point()+theme_minimal()base

base+theme(text =element_text(colour ="red"))

You should generally start creating a theme by modifying these values.

Complete vs incomplete

It is useful to understand the difference between complete and incomplete theme objects. Acomplete theme object is one produced by calling a theme function with the attributecomplete = TRUE.

Theme functionstheme_grey() andtheme_bw() are examples of complete theme functions. Calls totheme() produceincomplete theme objects, since they represent (local) modifications to a theme object rather than returning a complete theme object per se. When adding an incomplete theme to a complete one, the result is a complete theme.

Complete and incomplete themes behave somewhat differently when added to a ggplot object:

• Adding an incomplete theme augments the current theme object, replacing only those properties of elements defined in the call totheme().

• Adding a complete theme wipes away the existing theme and applies the new theme.

Creating a new faceting

Facets are a way to draw small multiples of the data in different panels. One of the more daunting exercises in ggplot2 extensions is to create a new faceting system. The reason for this is that when creating new facetings you take on the responsibility of how (almost) everything is drawn on the screen, and many do not have experience with directly usinggtable andgrid upon which the ggplot2 rendering is built. If you decide to venture into faceting extensions, it is highly recommended to gain proficiency with the above-mentioned packages.

TheFacet class in ggplot2 is very powerful as it takes on responsibility of a wide range of tasks. The main tasks of aFacet object are:

• Define a layout; that is, a partitioning of the data into different plot areas (panels) as well as which panels share position scales.

• Map plot data into the correct panels, potentially duplicating data if it should exist in multiple panels (e.g. margins infacet_grid()).

• Assemble all panels into a final gtable, adding axes, strips and decorations in the process.

Apart from these three tasks, for which functionality must be implemented, there are a couple of additional extension points where sensible defaults have been provided. These can generally be ignored, but adventurous developers can override them for even more control:

• Initialization and training of positional scales for each panel.

• Decoration in front of and behind each panel.

• Drawing of axis labels

To show how a new faceting class is created we will start simple and go through each of the required methods in turn to build upfacet_duplicate() that simply duplicate our plot into two panels. After this we will tinker with it a bit to show some of the more powerful possibilities.

Creating a layout specification

A layout in the context of facets is adata.frame that defines a mapping between data and the panels it should reside in as well as which positional scales should be used. The output should at least contain the columnsPANEL,SCALE_X, andSCALE_Y, but will often contain more to help assign data to the correct panel (facet_grid() will e.g. also return the faceting variables associated with each panel). Let’s make a function that defines a duplicate layout:

layout<-function(data, params) {data.frame(PANEL =c(1L,2L),SCALE_X =1L,SCALE_Y =1L)}

This is quite simple as the faceting should just define two panels irrespectively of the input data and parameters.

Mapping data into panels

In order for ggplot2 to know which data should go where it needs the data to be assigned to a panel. The purpose of the mapping step is to assign aPANEL column to the layer data identifying which panel it belongs to.

mapping<-function(data, layout, params) {if (is.null(data)||nrow(data)==0) {return(cbind(data,PANEL =integer(0)))  }rbind(cbind(data,PANEL =1L),cbind(data,PANEL =2L)  )}

here we first investigate whether we have gotten an emptydata.frame and if not we duplicate the data and assign the original data to the first panel and the new data to the second panel.

Laying out the panels

While the two functions above have been deceivingly simple, this last one is going to take some more work. Our goal is to draw two panels beside (or above) each other with axes etc.

render<-function(panels, layout, x_scales, y_scales, ranges, coord, data,                   theme, params) {# Place panels according to settingsif (params$horizontal) {# Put panels in matrix and convert to a gtable    panels<-matrix(panels,ncol =2)    panel_table<- gtable::gtable_matrix("layout", panels,widths =unit(c(1,1),"null"),heights =unit(1,"null"),clip ="on")# Add spacing according to theme    panel_spacing<-calc_element("panel.spacing.x", theme)    panel_table<- gtable::gtable_add_col_space(panel_table, panel_spacing)  }else {    panels<-matrix(panels,ncol =1)    panel_table<- gtable::gtable_matrix("layout", panels,widths =unit(1,"null"),heights =unit(c(1,1),"null"),clip ="on")    panel_spacing<-if (is.null(theme$panel.spacing.y)) {      theme$panel.spacing    }else {      theme$panel.spacing.y    }    panel_table<- gtable::gtable_add_row_space(panel_table, panel_spacing)  }# Name panel grobs so they can be found later  panel_table$layout$name<-paste0("panel-",c(1,2))# Construct the axes  axes<-render_axes(ranges[1], ranges[1], coord, theme,transpose =TRUE)# Add axes around each panel  panel_pos_h<-panel_cols(panel_table)$l  panel_pos_v<-panel_rows(panel_table)$t  axis_width_l<-unit(grid::convertWidth(    grid::grobWidth(axes$y$left[[1]]),"cm",TRUE),"cm")  axis_width_r<-unit(grid::convertWidth(    grid::grobWidth(axes$y$right[[1]]),"cm",TRUE),"cm")## We do it reverse so we don't change the position of panels when we add axesfor (iinrev(panel_pos_h)) {    panel_table<- gtable::gtable_add_cols(panel_table, axis_width_r, i)    panel_table<- gtable::gtable_add_grob(panel_table,rep(axes$y$right,length(panel_pos_v)),t = panel_pos_v,l = i+1,clip ="off")    panel_table<- gtable::gtable_add_cols(panel_table, axis_width_l, i-1)    panel_table<- gtable::gtable_add_grob(panel_table,rep(axes$y$left,length(panel_pos_v)),t = panel_pos_v,l = i,clip ="off")  }## Recalculate as gtable has changed  panel_pos_h<-panel_cols(panel_table)$l  panel_pos_v<-panel_rows(panel_table)$t  axis_height_t<-unit(grid::convertHeight(    grid::grobHeight(axes$x$top[[1]]),"cm",TRUE),"cm")  axis_height_b<-unit(grid::convertHeight(    grid::grobHeight(axes$x$bottom[[1]]),"cm",TRUE),"cm")for (iinrev(panel_pos_v)) {    panel_table<- gtable::gtable_add_rows(panel_table, axis_height_b, i)    panel_table<- gtable::gtable_add_grob(panel_table,rep(axes$x$bottom,length(panel_pos_h)),t = i+1,l = panel_pos_h,clip ="off")    panel_table<- gtable::gtable_add_rows(panel_table, axis_height_t, i-1)    panel_table<- gtable::gtable_add_grob(panel_table,rep(axes$x$top,length(panel_pos_h)),t = i,l = panel_pos_h,clip ="off")  }  panel_table}

Assembling the Facet class

Usually all methods are defined within the class definition in the same way as is done forGeom andStat. Here we have split it out so we could go through each in turn. All that remains is to assign our functions to the correct methods as well as making a constructor

# Constructor: shrink is required to govern whether scales are trained on# Stat-transformed data or not.facet_duplicate<-function(horizontal =TRUE,shrink =TRUE) {ggproto(NULL, FacetDuplicate,shrink = shrink,params =list(horizontal = horizontal    )  )}FacetDuplicate<-ggproto("FacetDuplicate", Facet,compute_layout = layout,map_data = mapping,draw_panels = render)

Now with everything assembled, lets test it out:

p<-ggplot(mtcars,aes(x = hp,y = mpg))+geom_point()p

p+facet_duplicate()

Doing more with facets

The example above was pretty useless and we’ll now try to expand on it to add some actual usability. We are going to make a faceting that adds panels with y-transformed axes:

library(scales)facet_trans<-function(trans,horizontal =TRUE,shrink =TRUE) {ggproto(NULL, FacetTrans,shrink = shrink,params =list(trans = scales::as.transform(trans),horizontal = horizontal    )  )}FacetTrans<-ggproto("FacetTrans", Facet,# Almost as before but we want different y-scales for each panelcompute_layout =function(data, params) {data.frame(PANEL =c(1L,2L),SCALE_X =1L,SCALE_Y =c(1L,2L))  },# Same as beforemap_data =function(data, layout, params) {if (is.null(data)||nrow(data)==0) {return(cbind(data,PANEL =integer(0)))    }rbind(cbind(data,PANEL =1L),cbind(data,PANEL =2L)    )  },# This is new. We create a new scale with the defined transformationinit_scales =function(layout,x_scale =NULL,y_scale =NULL, params) {    scales<-list()if (!is.null(x_scale)) {      scales$x<-lapply(seq_len(max(layout$SCALE_X)),function(i) x_scale$clone())    }if (!is.null(y_scale)) {      y_scale_orig<- y_scale$clone()      y_scale_new<- y_scale$clone()      y_scale_new$trans<- params$trans# Make sure that oob values are kept      y_scale_new$oob<-function(x, ...) x      scales$y<-list(y_scale_orig, y_scale_new)    }    scales  },# We must make sure that the second scale is trained on transformed datatrain_scales =function(x_scales, y_scales, layout, data, params) {# Transform data for second panel prior to scale trainingif (!is.null(y_scales)) {      data<-lapply(data,function(layer_data) {        match_id<-match(layer_data$PANEL, layout$PANEL)        y_vars<-intersect(y_scales[[1]]$aesthetics,names(layer_data))        trans_scale<- layer_data$PANEL==2Lfor (iin y_vars) {          layer_data[trans_scale, i]<- y_scales[[2]]$transform(layer_data[trans_scale, i])        }        layer_data      })    }    Facet$train_scales(x_scales, y_scales, layout, data, params)  },# this is where we actually modify the data. It cannot be done in $map_data as that function# doesn't have access to the scalesfinish_data =function(data, layout, x_scales, y_scales, params) {    match_id<-match(data$PANEL, layout$PANEL)    y_vars<-intersect(y_scales[[1]]$aesthetics,names(data))    trans_scale<- data$PANEL==2Lfor (iin y_vars) {      data[trans_scale, i]<- y_scales[[2]]$transform(data[trans_scale, i])    }    data  },# A few changes from before to accommodate that axes are now not duplicate of each other# We also add a panel strip to annotate the different panelsdraw_panels =function(panels, layout, x_scales, y_scales, ranges, coord,                         data, theme, params) {# Place panels according to settingsif (params$horizontal) {# Put panels in matrix and convert to a gtable      panels<-matrix(panels,ncol =2)      panel_table<- gtable::gtable_matrix("layout", panels,widths =unit(c(1,1),"null"),heights =unit(1,"null"),clip ="on")# Add spacing according to theme      panel_spacing<-calc_element("panel.spacing.x", theme)      panel_table<- gtable::gtable_add_col_space(panel_table, panel_spacing)    }else {      panels<-matrix(panels,ncol =1)      panel_table<- gtable::gtable_matrix("layout", panels,widths =unit(1,"null"),heights =unit(c(1,1),"null"),clip ="on")      panel_spacing<-calc_element("panel.spacing.y", theme)      panel_table<- gtable::gtable_add_row_space(panel_table, panel_spacing)    }# Name panel grobs so they can be found later    panel_table$layout$name<-paste0("panel-",c(1,2))# Construct the axes    axes<-render_axes(ranges[1], ranges, coord, theme,transpose =TRUE)# Add axes around each panel    grobWidths<-function(x) {unit(vapply(x,function(x) {        grid::convertWidth(          grid::grobWidth(x),"cm",TRUE)      },numeric(1)),"cm")    }    panel_pos_h<-panel_cols(panel_table)$l    panel_pos_v<-panel_rows(panel_table)$t    axis_width_l<-grobWidths(axes$y$left)    axis_width_r<-grobWidths(axes$y$right)## We do it reverse so we don't change the position of panels when we add axesif (params$horizontal) {for (iinrev(seq_along(panel_pos_h))) {        panel_table<- gtable::gtable_add_cols(panel_table, axis_width_r[i], panel_pos_h[i])        panel_table<- gtable::gtable_add_grob(panel_table,          axes$y$right[i],t = panel_pos_v,l = panel_pos_h[i]+1,clip ="off")        panel_table<- gtable::gtable_add_cols(panel_table, axis_width_l[i], panel_pos_h[i]-1)        panel_table<- gtable::gtable_add_grob(panel_table,          axes$y$left[i],t = panel_pos_v,l = panel_pos_h[i],clip ="off")      }    }else {        panel_table<- gtable::gtable_add_cols(panel_table, axis_width_r[1], panel_pos_h)        panel_table<- gtable::gtable_add_grob(panel_table,          axes$y$right,t = panel_pos_v,l = panel_pos_h+1,clip ="off")        panel_table<- gtable::gtable_add_cols(panel_table, axis_width_l[1], panel_pos_h-1)        panel_table<- gtable::gtable_add_grob(panel_table,          axes$y$left,t = panel_pos_v,l = panel_pos_h,clip ="off")      }## Recalculate as gtable has changed    panel_pos_h<-panel_cols(panel_table)$l    panel_pos_v<-panel_rows(panel_table)$t    axis_height_t<-unit(grid::convertHeight(      grid::grobHeight(axes$x$top[[1]]),"cm",TRUE),"cm")    axis_height_b<-unit(grid::convertHeight(      grid::grobHeight(axes$x$bottom[[1]]),"cm",TRUE),"cm")for (iinrev(panel_pos_v)) {      panel_table<- gtable::gtable_add_rows(panel_table, axis_height_b, i)      panel_table<- gtable::gtable_add_grob(panel_table,rep(axes$x$bottom,length(panel_pos_h)),t = i+1,l = panel_pos_h,clip ="off")      panel_table<- gtable::gtable_add_rows(panel_table, axis_height_t, i-1)      panel_table<- gtable::gtable_add_grob(panel_table,rep(axes$x$top,length(panel_pos_h)),t = i,l = panel_pos_h,clip ="off")    }# Add strips    strips<-render_strips(x =data.frame(name =c("Original",paste0("Transformed (", params$trans$name,")"))),labeller = label_value,theme = theme)    panel_pos_h<-panel_cols(panel_table)$l    panel_pos_v<-panel_rows(panel_table)$t    strip_height<-unit(grid::convertHeight(      grid::grobHeight(strips$x$top[[1]]),"cm",TRUE),"cm")for (iinrev(seq_along(panel_pos_v))) {      panel_table<- gtable::gtable_add_rows(panel_table, strip_height, panel_pos_v[i]-1)if (params$horizontal) {        panel_table<- gtable::gtable_add_grob(panel_table, strips$x$top,t = panel_pos_v[i],l = panel_pos_h,clip ="off")      }else {        panel_table<- gtable::gtable_add_grob(panel_table, strips$x$top[i],t = panel_pos_v[i],l = panel_pos_h,clip ="off")      }    }    panel_table  })

As is very apparent, thedraw_panel method can become very unwieldy once it begins to take multiple possibilities into account. The fact that we want to support both horizontal and vertical layout leads to a lot of if/else blocks in the above code. In general, this is the big challenge when writing facet extensions so be prepared to be very meticulous when writing these methods.

Enough talk - lets see if our new and powerful faceting extension works:

ggplot(mtcars,aes(x = hp,y = mpg))+geom_point()+facet_trans('sqrt')

Extending existing facet function

As the rendering part of a facet class is often the difficult development step, it is possible to piggyback on the existing faceting classes to achieve a range of new facetings. Below we will subclassfacet_wrap() to make afacet_bootstrap() class that splits the input data into a number of panels at random.

facet_bootstrap<-function(n =9,prop =0.2,nrow =NULL,ncol =NULL,scales ="fixed",shrink =TRUE,strip.position ="top") {  facet<-facet_wrap(~.bootstrap,nrow = nrow,ncol = ncol,scales = scales,shrink = shrink,strip.position = strip.position)  facet$params$n<- n  facet$params$prop<- propggproto(NULL, FacetBootstrap,shrink = shrink,params = facet$params  )}FacetBootstrap<-ggproto("FacetBootstrap", FacetWrap,compute_layout =function(data, params) {    id<-seq_len(params$n)    dims<-wrap_dims(params$n, params$nrow, params$ncol)    layout<-data.frame(PANEL =factor(id))    layout$ROW<-as.integer((id-1L)%/% dims[2]+1L)    layout$COL<-as.integer((id-1L)%% dims[2]+1L)    layout<- layout[order(layout$PANEL), , drop=FALSE]rownames(layout)<-NULL# Add scale identification    layout$SCALE_X<-if (params$free$x) idelse1L    layout$SCALE_Y<-if (params$free$y) idelse1Lcbind(layout,.bootstrap = id)  },map_data =function(data, layout, params) {if (is.null(data)||nrow(data)==0) {return(cbind(data,PANEL =integer(0)))    }    n_samples<-round(nrow(data)* params$prop)    new_data<-lapply(seq_len(params$n),function(i) {cbind(data[sample(nrow(data), n_samples), ,drop =FALSE],PANEL = i)    })do.call(rbind, new_data)  })ggplot(diamonds,aes(carat, price))+geom_point(alpha =0.1)+facet_bootstrap(n =9,prop =0.05)

What we are doing above is to intercept thecompute_layout andmap_data methods and instead of dividing the data by a variable we randomly assigns rows to a panel based on the sampling parameters (n determines the number of panels,prop determines the proportion of data in each panel). It is important here that the layout returned bycompute_layout is a valid layout forFacetWrap as we are counting on thedraw_panel method fromFacetWrap to do all the work for us. Thus if you want to subclass FacetWrap or FacetGrid, make sure you understand the nature of their layout specification.

Exercises

1. Rewrite FacetTrans to take a vector of transformations and create an additional panel for each transformation.
2. Based on the FacetWrap implementation rewrite FacetTrans to take the strip.placement theme setting into account.
3. Think about which caveats there are in FacetBootstrap specifically related to adding multiple layers with the same data.

Creating new guides

Guides are closely related to scales and aesthetics, so an important part of guides is taking information from the scale and translating it to a graphic. This information is passed around inside guides as akey dataframe. For existing guides, you can glance at what a key contains by using theget_guide_data() function. Typical variables you may see in guides are the aesthetic mapped by the scale, such as the hexadecimal colours in the example below, what those aesthetic represent in the.value column and how they should be labelled in the.label column. Sometimes, the aesthetic is used in computations. To avoid interpreting the values and labels as aesthetics, it is customary to prefix these with..

p<-ggplot(mpg,aes(displ, hwy,colour = drv))+geom_point()+scale_colour_discrete(labels =c("4-wheel drive","front wheel drive","rear wheel drive")  )get_guide_data(p,"colour")

#>    colour .value            .label#> 1 #F8766D      4     4-wheel drive#> 2 #00BA38      f front wheel drive#> 3 #619CFF      r  rear wheel drive

Overriding scale extraction

Let’s now make a first guide extension by adjusting the guide’s key. Axes are most straightforward to extend, because they are the least complicated. We’ll build an axis that accepts custom values for the guide’skey. We can begin by making a custom ggproto class that inherits from the axis guide. An important extension point is theextract_key() method, which determines how break information is transferred from the scale to the guide. In our class, we reject the scale’s reality and substitute our own.

GuideKey<-ggproto("Guide", GuideAxis,# Some parameters are required, so it is easiest to copy the base Guide's# parameters into our new parameters.# We add a new 'key' parameter for our own guide.params =c(GuideAxis$params,list(key =NULL)),# It is important for guides to have a mapped aesthetic with the correct nameextract_key =function(scale, aesthetic, key, ...) {    key$aesthetic<- scale$map(key$aesthetic)names(key)[names(key)=="aesthetic"]<- aesthetic    key  })

Guide constructors

Now we can make a guide constructor that creates a custom key to pass along on. Thenew_guide() function instantiates a new guide with the given parameters. This function automatically rejects any parameters that are not in the class’params field, so it is important to declare these.

guide_key<-function(  aesthetic,value = aesthetic,label =as.character(aesthetic),  ...,# Standard guide argumentstheme =NULL,title =waiver(),order =0,position =waiver()) {  key<-data.frame(aesthetic,.value = value,.label = label, ...)new_guide(# Arguments passed on to the GuideKey$params fieldkey = key,theme = theme,title = title,order = order,position = position,# Declare which aesthetics are supportedavailable_aes =c("x","y"),# Set the guide classsuper = GuideKey  )}

Our new guide can now be used inside theguides() function or as theguide argument in a position scale.

ggplot(mpg,aes(displ, hwy))+geom_point()+scale_x_continuous(guide =guide_key(aesthetic =2:6+0.5)  )

Custom drawings

If we are feeling more adventurous, we can also alter they way guides are drawn. The majority of drawing code is in theGuide$build_*() methods, which is all orchestrated by theGuide$draw() method. For derived guides, such as the custom key guide we’re extending here, overriding aGuide$build_*() method should be sufficient. If you are writing a completely novel guide that does not resemble the structure of any existing guide, overriding theGuide$draw() method might be wise.

In this example, we are changing the way the labels are drawn, so we should edit theGuide$build_labels() method. We’ll edit the method so that the labels are drawn with acolour set in the key. In addition to thekey andparams variable we’ve seen before, we now also have anelements variable, which is a list of precomputed theme elements. We can use theelements$text element to draw a graphical object (grob) in the style of axis text. Perhaps the most finicky thing about drawing guides is that a lot of settings depend on the guide’sposition parameter.

# Same as beforeGuideKey<-ggproto("Guide", GuideAxis,params =c(GuideAxis$params,list(key =NULL)),extract_key =function(scale, aesthetic, key, ...) {    key$aesthetic<- scale$map(key$aesthetic)names(key)[names(key)=="aesthetic"]<- aesthetic    key  },# New method to draw labelsbuild_labels =function(key, elements, params) {    position<- params$position# Downstream code expects a list of labelslist(element_grob(      elements$text,label = key$.label,x =switch(position,left =1,right =0, key$x),y =switch(position,top =0,bottom =1, key$y),margin_x = position%in%c("left","right"),margin_y = position%in%c("top","bottom"),colour = key$colour    ))  })

Because we are incorporating the... argument toguide_key() in the key, adding acolour column to the key is straightforward. We can check that are guide looks correct in the different positions around the panel.

ggplot(mpg,aes(displ, hwy))+geom_point()+guides(x =guide_key(aesthetic =2:6+0.5,colour =c("red","grey","red","grey","red")    ),x.sec =guide_key(aesthetic =c(2,4,6),colour =c("tomato","limegreen","dodgerblue")    )  )

Exercises

• Extendguide_key() to also pass onfamily,face andsize aesthetics from the key to the labels.
• Override theGuideKey$build_ticks() method to also pass oncolour andlinewidth settings to the tick marks. Looking atGuide$build_ticks() is a good starting point.
• CompareGuideKey$extract_key() toGuide$extract_key(). What steps have been skimmed over in the example?