BiomedEngX/CircosHeatmap-aardio
2
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases 3 Wiki Activity
CircosHeatmap-aardio/dist/lib/r/site-library/ggplot2/doc/extending-ggplot2.html

1816 lines
1.5 MiB
HTML
Raw Normal View History

首次上传
2025-01-12 00:52:51 +08:00
<!DOCTYPE html>
<html>
<head>
<meta charset="utf-8" />
<meta name="generator" content="pandoc" />
<meta http-equiv="X-UA-Compatible" content="IE=EDGE" />
<meta name="viewport" content="width=device-width, initial-scale=1" />
<title>Extending ggplot2</title>
<script>// Pandoc 2.9 adds attributes on both header and div. We remove the former (to
// be compatible with the behavior of Pandoc < 2.8).
document.addEventListener('DOMContentLoaded', function(e) {
var hs = document.querySelectorAll("div.section[class*='level'] > :first-child");
var i, h, a;
for (i = 0; i < hs.length; i++) {
h = hs[i];
if (!/^h[1-6]$/i.test(h.tagName)) continue; // it should be a header h1-h6
a = h.attributes;
while (a.length > 0) h.removeAttribute(a[0].name);
}
});
</script>
<style type="text/css">
code{white-space: pre-wrap;}
span.smallcaps{font-variant: small-caps;}
span.underline{text-decoration: underline;}
div.column{display: inline-block; vertical-align: top; width: 50%;}
div.hanging-indent{margin-left: 1.5em; text-indent: -1.5em;}
ul.task-list{list-style: none;}
</style>
<style type="text/css">
code {
white-space: pre;
}
.sourceCode {
overflow: visible;
}
</style>
<style type="text/css" data-origin="pandoc">
pre > code.sourceCode { white-space: pre; position: relative; }
pre > code.sourceCode > span { display: inline-block; line-height: 1.25; }
pre > code.sourceCode > span:empty { height: 1.2em; }
.sourceCode { overflow: visible; }
code.sourceCode > span { color: inherit; text-decoration: inherit; }
div.sourceCode { margin: 1em 0; }
pre.sourceCode { margin: 0; }
@media screen {
div.sourceCode { overflow: auto; }
}
@media print {
pre > code.sourceCode { white-space: pre-wrap; }
pre > code.sourceCode > span { text-indent: -5em; padding-left: 5em; }
}
pre.numberSource code
{ counter-reset: source-line 0; }
pre.numberSource code > span
{ position: relative; left: -4em; counter-increment: source-line; }
pre.numberSource code > span > a:first-child::before
{ content: counter(source-line);
position: relative; left: -1em; text-align: right; vertical-align: baseline;
border: none; display: inline-block;
-webkit-touch-callout: none; -webkit-user-select: none;
-khtml-user-select: none; -moz-user-select: none;
-ms-user-select: none; user-select: none;
padding: 0 4px; width: 4em;
color: #aaaaaa;
}
pre.numberSource { margin-left: 3em; border-left: 1px solid #aaaaaa; padding-left: 4px; }
div.sourceCode
{ }
@media screen {
pre > code.sourceCode > span > a:first-child::before { text-decoration: underline; }
}
code span.al { color: #ff0000; font-weight: bold; }
code span.an { color: #60a0b0; font-weight: bold; font-style: italic; }
code span.at { color: #7d9029; }
code span.bn { color: #40a070; }
code span.bu { color: #008000; }
code span.cf { color: #007020; font-weight: bold; }
code span.ch { color: #4070a0; }
code span.cn { color: #880000; }
code span.co { color: #60a0b0; font-style: italic; }
code span.cv { color: #60a0b0; font-weight: bold; font-style: italic; }
code span.do { color: #ba2121; font-style: italic; }
code span.dt { color: #902000; }
code span.dv { color: #40a070; }
code span.er { color: #ff0000; font-weight: bold; }
code span.ex { }
code span.fl { color: #40a070; }
code span.fu { color: #06287e; }
code span.im { color: #008000; font-weight: bold; }
code span.in { color: #60a0b0; font-weight: bold; font-style: italic; }
code span.kw { color: #007020; font-weight: bold; }
code span.op { color: #666666; }
code span.ot { color: #007020; }
code span.pp { color: #bc7a00; }
code span.sc { color: #4070a0; }
code span.ss { color: #bb6688; }
code span.st { color: #4070a0; }
code span.va { color: #19177c; }
code span.vs { color: #4070a0; }
code span.wa { color: #60a0b0; font-weight: bold; font-style: italic; }
</style>
<script>
// apply pandoc div.sourceCode style to pre.sourceCode instead
(function() {
var sheets = document.styleSheets;
for (var i = 0; i < sheets.length; i++) {
if (sheets[i].ownerNode.dataset["origin"] !== "pandoc") continue;
try { var rules = sheets[i].cssRules; } catch (e) { continue; }
var j = 0;
while (j < rules.length) {
var rule = rules[j];
// check if there is a div.sourceCode rule
if (rule.type !== rule.STYLE_RULE || rule.selectorText !== "div.sourceCode") {
j++;
continue;
}
var style = rule.style.cssText;
// check if color or background-color is set
if (rule.style.color === '' && rule.style.backgroundColor === '') {
j++;
continue;
}
// replace div.sourceCode by a pre.sourceCode rule
sheets[i].deleteRule(j);
sheets[i].insertRule('pre.sourceCode{' + style + '}', j);
}
}
})();
</script>
<style type="text/css">body {
background-color: #fff;
margin: 1em auto;
max-width: 700px;
overflow: visible;
padding-left: 2em;
padding-right: 2em;
font-family: "Open Sans", "Helvetica Neue", Helvetica, Arial, sans-serif;
font-size: 14px;
line-height: 1.35;
}
#TOC {
clear: both;
margin: 0 0 10px 10px;
padding: 4px;
width: 400px;
border: 1px solid #CCCCCC;
border-radius: 5px;
background-color: #f6f6f6;
font-size: 13px;
line-height: 1.3;
}
#TOC .toctitle {
font-weight: bold;
font-size: 15px;
margin-left: 5px;
}
#TOC ul {
padding-left: 40px;
margin-left: -1.5em;
margin-top: 5px;
margin-bottom: 5px;
}
#TOC ul ul {
margin-left: -2em;
}
#TOC li {
line-height: 16px;
}
table {
margin: 1em auto;
border-width: 1px;
border-color: #DDDDDD;
border-style: outset;
border-collapse: collapse;
}
table th {
border-width: 2px;
padding: 5px;
border-style: inset;
}
table td {
border-width: 1px;
border-style: inset;
line-height: 18px;
padding: 5px 5px;
}
table, table th, table td {
border-left-style: none;
border-right-style: none;
}
table thead, table tr.even {
background-color: #f7f7f7;
}
p {
margin: 0.5em 0;
}
blockquote {
background-color: #f6f6f6;
padding: 0.25em 0.75em;
}
hr {
border-style: solid;
border: none;
border-top: 1px solid #777;
margin: 28px 0;
}
dl {
margin-left: 0;
}
dl dd {
margin-bottom: 13px;
margin-left: 13px;
}
dl dt {
font-weight: bold;
}
ul {
margin-top: 0;
}
ul li {
list-style: circle outside;
}
ul ul {
margin-bottom: 0;
}
pre, code {
background-color: #f7f7f7;
border-radius: 3px;
color: #333;
white-space: pre-wrap;
}
pre {
border-radius: 3px;
margin: 5px 0px 10px 0px;
padding: 10px;
}
pre:not([class]) {
background-color: #f7f7f7;
}
code {
font-family: Consolas, Monaco, 'Courier New', monospace;
font-size: 85%;
}
p > code, li > code {
padding: 2px 0px;
}
div.figure {
text-align: center;
}
img {
background-color: #FFFFFF;
padding: 2px;
border: 1px solid #DDDDDD;
border-radius: 3px;
border: 1px solid #CCCCCC;
margin: 0 5px;
}
h1 {
margin-top: 0;
font-size: 35px;
line-height: 40px;
}
h2 {
border-bottom: 4px solid #f7f7f7;
padding-top: 10px;
padding-bottom: 2px;
font-size: 145%;
}
h3 {
border-bottom: 2px solid #f7f7f7;
padding-top: 10px;
font-size: 120%;
}
h4 {
border-bottom: 1px solid #f7f7f7;
margin-left: 8px;
font-size: 105%;
}
h5, h6 {
border-bottom: 1px solid #ccc;
font-size: 105%;
}
a {
color: #0033dd;
text-decoration: none;
}
a:hover {
color: #6666ff; }
a:visited {
color: #800080; }
a:visited:hover {
color: #BB00BB; }
a[href^="http:"] {
text-decoration: underline; }
a[href^="https:"] {
text-decoration: underline; }
code > span.kw { color: #555; font-weight: bold; }
code > span.dt { color: #902000; }
code > span.dv { color: #40a070; }
code > span.bn { color: #d14; }
code > span.fl { color: #d14; }
code > span.ch { color: #d14; }
code > span.st { color: #d14; }
code > span.co { color: #888888; font-style: italic; }
code > span.ot { color: #007020; }
code > span.al { color: #ff0000; font-weight: bold; }
code > span.fu { color: #900; font-weight: bold; }
code > span.er { color: #a61717; background-color: #e3d2d2; }
</style>
</head>
<body>
<h1 class="title toc-ignore">Extending ggplot2</h1>
<p>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 <code>?Stat</code>, <code>?Geom</code> and
<code>?theme</code>. You’ll learn how to extend ggplot2 by creating a
new stat, geom, or theme.</p>
<p>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.</p>
<div id="ggproto" class="section level2">
<h2>ggproto</h2>
<p>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 using <a href="https://cran.r-project.org/package=proto">proto</a> because I
needed mutable objects. This was well before the creation of (the
briefly lived) <a href="http://vita.had.co.nz/papers/mutatr.html">mutatr</a>, reference
classes and R6: proto was the only game in town.</p>
<p>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.</p>
<p>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.</p>
<p>Here’s a quick demo of ggproto in action:</p>
<div class="sourceCode" id="cb1"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb1-1"><a href="#cb1-1" tabindex="-1"></a>A <span class="ot">&lt;-</span> <span class="fu">ggproto</span>(<span class="st">&quot;A&quot;</span>, <span class="cn">NULL</span>,</span>
<span id="cb1-2"><a href="#cb1-2" tabindex="-1"></a> <span class="at">x =</span> <span class="dv">1</span>,</span>
<span id="cb1-3"><a href="#cb1-3" tabindex="-1"></a> <span class="at">inc =</span> <span class="cf">function</span>(self) {</span>
<span id="cb1-4"><a href="#cb1-4" tabindex="-1"></a> self<span class="sc">$</span>x <span class="ot">&lt;-</span> self<span class="sc">$</span>x <span class="sc">+</span> <span class="dv">1</span></span>
<span id="cb1-5"><a href="#cb1-5" tabindex="-1"></a> }</span>
<span id="cb1-6"><a href="#cb1-6" tabindex="-1"></a>)</span>
<span id="cb1-7"><a href="#cb1-7" tabindex="-1"></a>A<span class="sc">$</span>x</span>
<span id="cb1-8"><a href="#cb1-8" tabindex="-1"></a><span class="co">#&gt; [1] 1</span></span>
<span id="cb1-9"><a href="#cb1-9" tabindex="-1"></a>A<span class="sc">$</span><span class="fu">inc</span>()</span>
<span id="cb1-10"><a href="#cb1-10" tabindex="-1"></a>A<span class="sc">$</span>x</span>
<span id="cb1-11"><a href="#cb1-11" tabindex="-1"></a><span class="co">#&gt; [1] 2</span></span>
<span id="cb1-12"><a href="#cb1-12" tabindex="-1"></a>A<span class="sc">$</span><span class="fu">inc</span>()</span>
<span id="cb1-13"><a href="#cb1-13" tabindex="-1"></a>A<span class="sc">$</span><span class="fu">inc</span>()</span>
<span id="cb1-14"><a href="#cb1-14" tabindex="-1"></a>A<span class="sc">$</span>x</span>
<span id="cb1-15"><a href="#cb1-15" tabindex="-1"></a><span class="co">#&gt; [1] 4</span></span></code></pre></div>
<p>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.</p>
<p>To create a new geom or stat, you will just create a new ggproto that
inherits from <code>Stat</code>, <code>Geom</code> and override the
methods described below.</p>
</div>
<div id="creating-a-new-stat" class="section level2">
<h2>Creating a new stat</h2>
<div id="the-simplest-stat" class="section level3">
<h3>The simplest stat</h3>
<p>We’ll start by creating a very simple stat: one that gives the convex
hull (the <em>c</em> hull) of a set of points. First we create a new
ggproto object that inherits from <code>Stat</code>:</p>
<div class="sourceCode" id="cb2"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb2-1"><a href="#cb2-1" tabindex="-1"></a>StatChull <span class="ot">&lt;-</span> <span class="fu">ggproto</span>(<span class="st">&quot;StatChull&quot;</span>, Stat,</span>
<span id="cb2-2"><a href="#cb2-2" tabindex="-1"></a> <span class="at">compute_group =</span> <span class="cf">function</span>(data, scales) {</span>
<span id="cb2-3"><a href="#cb2-3" tabindex="-1"></a> data[<span class="fu">chull</span>(data<span class="sc">$</span>x, data<span class="sc">$</span>y), , drop <span class="ot">=</span> <span class="cn">FALSE</span>]</span>
<span id="cb2-4"><a href="#cb2-4" tabindex="-1"></a> },</span>
<span id="cb2-5"><a href="#cb2-5" tabindex="-1"></a> </span>
<span id="cb2-6"><a href="#cb2-6" tabindex="-1"></a> <span class="at">required_aes =</span> <span class="fu">c</span>(<span class="st">&quot;x&quot;</span>, <span class="st">&quot;y&quot;</span>)</span>
<span id="cb2-7"><a href="#cb2-7" tabindex="-1"></a>)</span></code></pre></div>
<p>The two most important components are the
<code>compute_group()</code> method (which does the computation), and
the <code>required_aes</code> field, which lists which aesthetics must
be present in order for the stat to work.</p>
<p>Next we write a layer function. Unfortunately, due to an early design
mistake I called these either <code>stat_()</code> or
<code>geom_()</code>. A better decision would have been to call them
<code>layer_()</code> functions: that’s a more accurate description
because every layer involves a stat <em>and</em> a geom.</p>
<p>All layer functions follow the same form - you specify defaults in
the function arguments and then call the <code>layer()</code> function,
sending <code>...</code> into the <code>params</code> argument. The
arguments in <code>...</code> 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. <code>layer()</code> takes
care of teasing the different parameters apart and making sure they’re
stored in the right place:</p>
<div class="sourceCode" id="cb3"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb3-1"><a href="#cb3-1" tabindex="-1"></a>stat_chull <span class="ot">&lt;-</span> <span class="cf">function</span>(<span class="at">mapping =</span> <span class="cn">NULL</span>, <span class="at">data =</span> <span class="cn">NULL</span>, <span class="at">geom =</span> <span class="st">&quot;polygon&quot;</span>,</span>
<span id="cb3-2"><a href="#cb3-2" tabindex="-1"></a> <span class="at">position =</span> <span class="st">&quot;identity&quot;</span>, <span class="at">na.rm =</span> <span class="cn">FALSE</span>, <span class="at">show.legend =</span> <span class="cn">NA</span>, </span>
<span id="cb3-3"><a href="#cb3-3" tabindex="-1"></a> <span class="at">inherit.aes =</span> <span class="cn">TRUE</span>, ...) {</span>
<span id="cb3-4"><a href="#cb3-4" tabindex="-1"></a> <span class="fu">layer</span>(</span>
<span id="cb3-5"><a href="#cb3-5" tabindex="-1"></a> <span class="at">stat =</span> StatChull, <span class="at">data =</span> data, <span class="at">mapping =</span> mapping, <span class="at">geom =</span> geom, </span>
<span id="cb3-6"><a href="#cb3-6" tabindex="-1"></a> <span class="at">position =</span> position, <span class="at">show.legend =</span> show.legend, <span class="at">inherit.aes =</span> inherit.aes,</span>
<span id="cb3-7"><a href="#cb3-7" tabindex="-1"></a> <span class="at">params =</span> <span class="fu">list</span>(<span class="at">na.rm =</span> na.rm, ...)</span>
<span id="cb3-8"><a href="#cb3-8" tabindex="-1"></a> )</span>
<span id="cb3-9"><a href="#cb3-9" tabindex="-1"></a>}</span></code></pre></div>
<p>(Note that if you’re writing this in your own package, you’ll either
need to call <code>ggplot2::layer()</code> explicitly, or import the
<code>layer()</code> function into your package namespace.)</p>
<p>Once we have a layer function we can try our new stat:</p>
<div class="sourceCode" id="cb4"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb4-1"><a href="#cb4-1" tabindex="-1"></a><span class="fu">ggplot</span>(mpg, <span class="fu">aes</span>(displ, hwy)) <span class="sc">+</span> </span>
<span id="cb4-2"><a href="#cb4-2" tabindex="-1"></a> <span class="fu">geom_point</span>() <span class="sc">+</span> </span>
<span id="cb4-3"><a href="#cb4-3" tabindex="-1"></a> <span class="fu">stat_chull</span>(<span class="at">fill =</span> <span class="cn">NA</span>, <span class="at">colour =</span> <span class="st">&quot;black&quot;</span>)</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7J0HuBPV1oYXcOgd6YiAIIoKCiIIijSlSUc6ogiCCFykI72DFAER6b2DFKkKUkRUrlyKSBGld6mH3jk/375/uElOkjNJZiaTybefB04yZZd3z0y+WXvvteLFPErCRAIkQAIkQAIkQAIkQAImEYhvUjkshgRIgARIgARIgARIgAQUAQpQXggkQAIkQAIkQAIkQAKmEqAANRU3CyMBEiABEiABEiABEqAA5TVAAiRAAiRAAiRAAiRgKgEKUFNxszASIAESIAESIAESIAEKUF4DJEACJEACJEACJEACphKIMrU0HQq7cuWKPHjwIKicEiRIIPA+9fDhw6DyscrJUVFRgjbduXPHKlUKuh6JEiWSu3fvBp2PVTJIkiSJao+drjnch3bx4pYwYUKJFy+era45tOnevXtWuQWCqgf6JnHixLyHgqJo7Mm8h4zlG2zujnsIOsGs5zZ+x1OkSOG16mEnQCFK7t+/77VBWnYkS5ZMiU+7CDZ0Mh7OV69e1dL8sDgGfXTt2rWwqGtclYwfP76kS5dOvSDY5ZrDjw0EqF0EDl4Q0Ca7XHO4JnEPXb9+Pa7LMyz24wU7bdq0cuvWLdu8JOCZffv27aANKlbpQFxvEDl2uYfw3MZzwS73EJ5v6KObN29a5rnNIXir3L2sBwmQAAmQAAmQAAlECAEK0AjpaDaTBEiABEiABEiABKxCgALUKj3BepAACZAACZAACZBAhBCgAI2QjmYzSYAESIAESIAESMAqBChArdITrAcJkAAJkAAJkAAJRAgBCtAI6Wg2kwRIgARIgARIgASsQoAC1Co9wXqQAAmQAAmQAAmQQIQQoACNkI5mM0mABEiABEiABEjAKgTCzhE9nK7jXzAJ5yMiDZwb2yHBwSyc5sLJrF0S+sYu7YFzZiQ4nkY/2SHhmkO78NcOCdHEeA9Ztycd9w0cg6Ov7JDQjqRJk9omIh+e2Xgm2Om5jT6yS3scescRdMMK91DY3cl6hP/DRYV8go2oZIUORB0gphFayy7tQZvs1B6HALXTNQfhaaf24B6CyLHTPYQ22aU9DgFqt2sO/YN+skNyhHe0yzWH57ad7iHHNYb+wX1kRnKIXm9lhaUADfYCdwhQu8Qah2UNN79d2oOLFTe+Xdrj+PHEdWuXNmEUAWE47RKKE5You91DdmqP44cM15td7iFYotAes8SANxGg13Y8syHa7NI/eG7b6XfI+QXBrOc2tImvZI/xQF8t5D4SIAESIAESIAESIAFLEaAAtVR3sDIkQAIkQAIkQAIkYH8CFKD272O2kARIgARIgARIgAQsRYAC1FLdwcqQAAmQAAmQAAmQgP0JUIDav4/ZQhIgARIgARIgARKwFAEKUEt1BytDAiRAAiRAAiRAAvYnQAFq/z5mC0mABEiABEiABEjAUgQoQC3VHawMCZAACZAACZAACdifAAWo/fuYLSQBEiABEiABEiABSxGgALVUd7AyJEACJEACJEACJGB/AhSg9u9jtpAESIAESIAESIAELEWAAtRS3cHKkAAJkAAJkAAJkID9CVCAWrSPp02bJrVr15bmzZvL3bt3LVpLVosESIAESIAESIAE/CcQ5f8pPMNoAnXq1JEtW7Y8LmblypWya9cuyZgx4+Nt/EACJEACJEACJEAC4UqAFlCL9dzixYtdxKejetWqVXN85F8SIAESIAESIAESCGsCFKAW675ff/3VY41OnTrlcTs3kgAJkAAJkAAJkEC4EaAAtViPZcuWzWON4sWL53E7N5IACZAACZAACZBAuBGgALVYj7Vr105SpkwZq1b37t1Ti5JOnDgRax83kAAJkAAJkAAJkEA4EaAAtWBvHThwQHLlyqVqljlzZlmyZInMmDFDDh48KKVKlZJ58+ZJTEyMBWvOKpEACZAACZAACZBA3AQoQONmFJIjXnzxRSlUqJDs2LFDXnvtNXn77bdl06ZN6m+HDh3k3XfflePHj4ekbiyUBEiABEiABEiABIIhQAEaDD0Dz/3777/lmWeecSkhderUMn78eJk1a5YcOXJESpcuLXPmzKE11IUSv5AACZAACZAACVidAAWoBXsIw+tHjx6NJUAdVS1btqyyhpYvX146deokFStWlEOHDjl28y8JkAAJkAAJkAAJWJoABagFuwfWzdu3b0vevHm91i5VqlTy9ddfKwsoji9YsKDMnj2b1lCvxLiDBEiABEiABEjAKgQoQK3SE071wPA7kvsQvNMhjz9iGH7btm1SvXp16dy5s9SsWVMNzz8+gB9IgARIgARIgARIwGIEKEAt1iGoDgRowoQJ5cknn9RUO1hDZ86cKXPnzhW4acIQPb4/fPhQ0/k8iARIgARIgARIgATMJEABaiZtjWU5FiAlSJBA4xn/PQwumjZu3CjvvPOOdO3aVWrUqCGHDx/2Kw8eTAIkQAIkQAIkQAJGE6AANZpwAPk7BGgApyon9mPGjFG+Qk+fPi1vvfWWTJ8+ndbQQGDyHBIgARIgARIgAUMIUIAagjW4
<p>(We’ll see later how to change the defaults of the geom so that you
don’t need to specify <code>fill = NA</code> every time.)</p>
<p>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:</p>
<div class="sourceCode" id="cb5"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb5-1"><a href="#cb5-1" tabindex="-1"></a><span class="fu">ggplot</span>(mpg, <span class="fu">aes</span>(displ, hwy, <span class="at">colour =</span> drv)) <span class="sc">+</span> </span>
<span id="cb5-2"><a href="#cb5-2" tabindex="-1"></a> <span class="fu">geom_point</span>() <span class="sc">+</span> </span>
<span id="cb5-3"><a href="#cb5-3" tabindex="-1"></a> <span class="fu">stat_chull</span>(<span class="at">fill =</span> <span class="cn">NA</span>)</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7N0HfBRl3gfw3/ZseicJJNQkqAiIoJ6enuWUs13x1FPsh1JERSz0Ik2aUhQErHf66tnuzjt7O9udvSIqCRBIoQdCetns7vs8AxuzSTbZ3cyW2fweP8juzDNP+c5m82dmnufROUUCEwUoQAEKUIACFKAABYIkoA9SPayGAhSgAAUoQAEKUIACigADUH4QKEABClCAAhSgAAWCKsAANKjcrIwCFKAABShAAQpQgAEoPwMUoAAFKEABClCAAkEVYAAaVG5WRgEKUIACFKAABSjAAJSfAQpQgAIUoAAFKECBoAoYg1qbCpVVVlbCbrf7VZJer4dOp/P7eL8qVemgqKgo2Gw2TbbdbDajqalJJYngFWMymZTPi1bbLj8vWkvyZ1R+XhoaGrTWdPD7JTSnjN8vwXeX3438fvHsbrFYEBMT4zkD9ygCmgtAZTDQ3Nzs1+mTHwr5S6KxsdGv40N5UHJyMmTwrcW2R0dHo7q6OpR8ftVttVqVz4tW215bWwutTfMr/6Hl+rw4HA6/zluoDpLfLwaDQZM/o0lJSUpAwe+X4H165PeL/Lxo8ftF/pzW1dVBiz+jwfh+keeVqWsB3oLv2og5KEABClCAAhSgAAVUFGAAqiImi6IABShAAQpQgAIU6FqAAWjXRsxBAQpQgAIUoAAFKKCiAANQFTFZFAUoQAEKUIACFKBA1wIMQLs2Yg4KUIACFKAABShAARUFGICqiMmiKEABClCAAhSgAAW6FmAA2rURc1CAAhSgAAUoQAEKqCjAAFRFTBZFAQpQgAIUoAAFKNC1gOYmoperXsg//iSj0aisbCNXQ9Ji8rffoe6rnJRXTv6rteT6vGix7S5zrU1EL81lkpN0a7HtcqELrSZ+vwT3zMmfUfl50eL3i/w51erPqDzLgW67lr8HgvlToLkAVC7D6e8vJvmhkMGnvyspBfPEdFSX7LsW2y7PlxbbLVf5kJ8ZLbbdZe7vz0pHn79gbHN9cUtzrbVdfre43INhpXYd8vOu5c+62h6BLk9+VrT6eXF9VrT4MyrPq/xdGshVnORSpUxdC2gyAPX3S1L+gpC/4LS4trc8lfKHRottlz/oWm23dNdq22W7tfYLwhWAynWmA/kLQp5XtZP8fpFXtbT4eZEW8ntVi23X8veL/Mxo0VxeQdTqz6j8rEvzQH6/uO7kyLqYPAto936R5z5xDwUoQAEKUIACFKBAGAswAA3jk8OmUYACFKAABShAgUgUYAAaiWeVfaIABShAAQpQgAJhLMAANIxPDptGAQpQgAIUoAAFIlGAAWgknlX2iQIUoAAFKEABCoSxAAPQMD45bBoFKEABClCAAhSIRAEGoJF4VtknClCAAhSgAAUoEMYCDEDD+OSwaRSgAAUoQAEKUCASBRiARuJZZZ8oQAEKUIACFKBAGAswAA3jk8OmUYACFKAABShAgUgUYAAaiWeVfaIABShAAQpQgAJhLMAANIxPDptGAQpQgAIUoAAFIlHAGImd0kqfmh3NuGfnfShvOoRR8cMxNmuMVprOdlKAAhSgAAUoQAG/BRiA+k3XvQMdDgdGfXV+SyGfVX+Dl8vfxktDn2jZxhcUoAAFKEABClAgEgV4Cz5EZ/W6LZPb1VzcWIYndj/Xbjs3UIACFKAABShAgUgSYAAaorO5o76kw5q/rP62w+3cSAEKUIACFKAABSJFgAFoiM5kvDG2w5rTzWkdbudGClCAAhSgAAUoECkCDEBDdCYfzF3cYc2Xp1/c4XZupAAFKEABClCAApEiwAA0RGdyYHQ/vDvseZh0Jhh1BgyNORa51gG4uXA6iuqLQ9QqVksBClCAAhSgAAUCL8AANPDGHmtINichWh+F6zP+hL8euwYb8pciwRiPCQXTsKtxj8fjuIMCFKAABShAAQpoWYABaAjPXo29FpX2auRE9VFakWxKwsb85coV0fEFU7G/qTyErWPVFKAABShAAQpQIDACDEAD4+pVqTvrS5V8OVG9W/L3EoOQNoggtMHeiIniSmiFrbJlH19QgAIUoAAFKECBSBBgABrCs1jSuFupPduS5dYKGZBuyF+GclsFJhXOgLxSykQBClCAAhSgAAUiRYABaAjPZElDmXgG1IpkU2K7VgyK7o91eUtQLPLcWjgbdc317fJwAwUoQAEKUIACFNCiAAPQEJ61koZd6BeV7bEFQ2LzsSZ3IX6qLcSfv7gdTQ6bx7zcQQEKUIACFKAABbQiwAA0hGeqpHGXGID08/OfHTVlZPwwrBg0F/8t/wx3/DQPdqe9o2zcRgEKUIACFKAABTQjwAA0hKdKTrXUVQAqm3d64sl46MRleKf8Q8zfcT+cTmcIW82qKUABClCAAhSgQPcEjN07nEf7K1DZXIXD4k/bAUieyvtt1mgcyCvHrMIliDZEY3rfWzxl5XYKUIACFKAABSgQ1gIMQEN0euTznzJ5cwXU1cRLMy9CRf1h3Fe6HrEiCL2lz59du/g3BShAAQpQgAIU0IwAA9AQnaqfA9Ajk9B7
<p>We can also override the default geom to display the convex hull in a
different way:</p>
<div class="sourceCode" id="cb6"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb6-1"><a href="#cb6-1" tabindex="-1"></a><span class="fu">ggplot</span>(mpg, <span class="fu">aes</span>(displ, hwy)) <span class="sc">+</span> </span>
<span id="cb6-2"><a href="#cb6-2" tabindex="-1"></a> <span class="fu">stat_chull</span>(<span class="at">geom =</span> <span class="st">&quot;point&quot;</span>, <span class="at">size =</span> <span class="dv">4</span>, <span class="at">colour =</span> <span class="st">&quot;red&quot;</span>) <span class="sc">+</span></span>
<span id="cb6-3"><a href="#cb6-3" tabindex="-1"></a> <span class="fu">geom_point</span>()</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7N0HmBRV9vj90z05AAMSFEFAAcWAioiKi4qIgDkHFFdFRV0V1xwRcwBdDBgQMeKLYGBVhB+oiPxVDCyKiCISRCRIGMIww+S3Tkk1nWamY011zfc+D0zX7aobPre6+/Stqi5PtZGEhAACCCCAAAIIIICATQJem+qhGgQQQAABBBBAAAEETAECUHYEBBBAAAEEEEAAAVsFCEBt5aYyBBBAAAEEEEAAAQJQ9gEEEEAAAQQQQAABWwUIQG3lpjIEEEAAAQQQQAABAlD2AQQQQAABBBBAAAFbBdJtrS0BlW3evFkqKyvjKiktLU3016eqqqriKscpG6enp4v2qbS01ClNirsdmZmZUlZWFnc5TikgOzvb7I+b9jl9HbrlV9wyMjLE4/G4ap/TPpWXlzvlJRBXO3RssrKyeA3FpZjcjXkNJdc33tKt15DGCXa9b+vneH5+fo1NT7kAVIOSioqKGjsUyRO5ublm8OmWgE0HWd+ct2zZEkn3U2IdHaOtW7emRFvraqTX65VmzZqZXxDcss/ph40GoG4JcPQLgvbJLfuc7pP6GioqKqpr90yJ5/ULdtOmTaWkpMQ1XxL0PXv79u1xT6g4ZQB1f9Mgxy2vIX3f1vcFt7yG9P1Nx6i4uNgx79scgnfKq5d2IIAAAggggAACDUSAALSBDDTdRAABBBBAAAEEnCJAAOqUkaAdCCCAAAIIIIBAAxEgAG0gA003EUAAAQQQQAABpwgQgDplJGgHAggggAACCCDQQAQIQBvIQNNNBBBAAAEEEEDAKQIEoE4ZCdqBAAIIIIAAAgg0EAEC0AYy0HQTAQQQQAABBBBwikDK/RC9/ui6/osn6fZ6Rxr9cWM3JP2BWf3RXP2RWbckHRu39Ed/nFmT/vC0jpMbku5z2i/964akdxPjNeTckbReN/rD4DpWbkjaj5ycHNfckU/fs/U9wU3v2zpGbumPFe9YN91wwmso5V7Jibj9n+5UWk68d1RywgBqGzSY1ltruaU/2ic39ccKQN20z2ng6ab+6GtIgxw3vYa0T27pjxWAum2f0/HRcXJDsm7v6JZ9Tt+33fQasvYxHR99HdmRrKC3prpSMgCNdwe3AlC33GtcZ9b0xe+W/ujOqi98t/TH+vDU/dYtfdKjCHobTrfcilNnotz2GnJTf6wPMt3f3PIa0pko7Y9dwUBNQUCi8vU9W4M2t4yPvm+76XPI/wuCXe/bGpvUltxxPLC2HvIcAggggAACCCCAgKMECEAdNRw0BgEEEEAAAQQQcL8AAaj7x5geIoAAAggggAACjhIgAHXUcNAYBBBAAAEEEEDA/QIEoO4fY3qIAAIIIIAAAgg4SoAA1FHDQWMQQAABBBBAAAH3CxCAun+M6SECCCCAAAIIIOAoAQJQRw0HjUEAAQQQQAABBNwvQADq1DE2flhetpc6tXW0CwEEEEAAAQQQiFkg5e6EFHNPU2TD9P/Nk5znxkjml3PEuKWEcU9Kkco928v2CwfK9rPPFMnJTpGe0EwEEEAAAQQQQCC8ADOg4V3qJTd35ChpMvBiyZoyTbyFm8S7rVi8xcWSsWCh5N33kDTvtJ9IyfZ6aRuVIoAAAggggAACiRIgAE2UZJzlZL31tuQ+85x4t2wRT5iyNBDV1Ozo48SzeUuYNchCAAEEEEAAAQRSQ4AA1AHjlLboV2l0653i0UPuO9JzUiF9pUzOk3Lj/yoz11NVJd516yTvwUet1fiLAAIIIIAAAgiknAABqAOGLOfl10UqKnwtOd4IOa+TSvnMOAH0HSP4zDOC0DVWEFpaJlnvfyCybZtvfR4ggAACCCCAAAKpJEAA6oDRypz1uejspqY3jcBzpl55FJSOMoJQX0pLl4y583yLPEAAAQQQQAABBFJJgADUAaPl2bTJ14pZO2Y6fRk7Hqz0zzBmS70bNvrn8BgBBBBAAAEEEEgZAQJQBwxVdX6+rxVtfY8CH2T5L6alSVVBE/8cHiOAAAIIIIAAAikjQADqgKEq797N14q7JEMa+5Z2PvjCyPel8jKpOLCrb5EHCCCAAAIIIIBAKgkQgDpgtLb/80KpatTI15INkiUnGD/GpIFoa+PfJ0bwua/8PVTVHo+U9zxCqps19a3PAwQQQAABBBBAIJUECEAdMFrlhx8mZb2OlGrvzuH4r2SKBqK/G/+O2hF8alM9xi06i+692wGtpgkIIIAAAggggEBsAjsjnti2Z6sECWx94Rmp3LuzVGf4HWr3K7taz/ts1kw2fDFTqtq383uGhwgggAACCCCAQGoJEIA6ZbyMALPwk6lSNOwOqdy9tXGRUYFUNW1q/DP+5udJ6cknSOFHk6WqQ3untJh2IIAAAggggAACMQmkx7QVGyVNYPvgi2X7JRdJ2vLfxfvXX1LVuLFUduggkpOdtDopGAEEEEAAAQQQsFOAANRO7UjrMs4Frdyzg/kv0k1YDwEEEEAAAQQQSBUBDsGnykjRTgQQQAABBBBAwCUCBKAuGUi6gQACCCCAAAIIpIoAAWiq
</div>
<div id="stat-parameters" class="section level3">
<h3>Stat parameters</h3>
<p>A more complex stat will do some computation. Let’s implement a
simple version of <code>geom_smooth()</code> that adds a line of best
fit to a plot. We create a <code>StatLm</code> that inherits from
<code>Stat</code> and a layer function, <code>stat_lm()</code>:</p>
<div class="sourceCode" id="cb7"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb7-1"><a href="#cb7-1" tabindex="-1"></a>StatLm <span class="ot">&lt;-</span> <span class="fu">ggproto</span>(<span class="st">&quot;StatLm&quot;</span>, Stat, </span>
<span id="cb7-2"><a href="#cb7-2" tabindex="-1"></a> <span class="at">required_aes =</span> <span class="fu">c</span>(<span class="st">&quot;x&quot;</span>, <span class="st">&quot;y&quot;</span>),</span>
<span id="cb7-3"><a href="#cb7-3" tabindex="-1"></a> </span>
<span id="cb7-4"><a href="#cb7-4" tabindex="-1"></a> <span class="at">compute_group =</span> <span class="cf">function</span>(data, scales) {</span>
<span id="cb7-5"><a href="#cb7-5" tabindex="-1"></a> rng <span class="ot">&lt;-</span> <span class="fu">range</span>(data<span class="sc">$</span>x, <span class="at">na.rm =</span> <span class="cn">TRUE</span>)</span>
<span id="cb7-6"><a href="#cb7-6" tabindex="-1"></a> grid <span class="ot">&lt;-</span> <span class="fu">data.frame</span>(<span class="at">x =</span> rng)</span>
<span id="cb7-7"><a href="#cb7-7" tabindex="-1"></a> </span>
<span id="cb7-8"><a href="#cb7-8" tabindex="-1"></a> mod <span class="ot">&lt;-</span> <span class="fu">lm</span>(y <span class="sc">~</span> x, <span class="at">data =</span> data)</span>
<span id="cb7-9"><a href="#cb7-9" tabindex="-1"></a> grid<span class="sc">$</span>y <span class="ot">&lt;-</span> <span class="fu">predict</span>(mod, <span class="at">newdata =</span> grid)</span>
<span id="cb7-10"><a href="#cb7-10" tabindex="-1"></a> </span>
<span id="cb7-11"><a href="#cb7-11" tabindex="-1"></a> grid</span>
<span id="cb7-12"><a href="#cb7-12" tabindex="-1"></a> }</span>
<span id="cb7-13"><a href="#cb7-13" tabindex="-1"></a>)</span>
<span id="cb7-14"><a href="#cb7-14" tabindex="-1"></a></span>
<span id="cb7-15"><a href="#cb7-15" tabindex="-1"></a>stat_lm <span class="ot">&lt;-</span> <span class="cf">function</span>(<span class="at">mapping =</span> <span class="cn">NULL</span>, <span class="at">data =</span> <span class="cn">NULL</span>, <span class="at">geom =</span> <span class="st">&quot;line&quot;</span>,</span>
<span id="cb7-16"><a href="#cb7-16" tabindex="-1"></a> <span class="at">position =</span> <span class="st">&quot;identity&quot;</span>, <span class="at">na.rm =</span> <span class="cn">FALSE</span>, <span class="at">show.legend =</span> <span class="cn">NA</span>, </span>
<span id="cb7-17"><a href="#cb7-17" tabindex="-1"></a> <span class="at">inherit.aes =</span> <span class="cn">TRUE</span>, ...) {</span>
<span id="cb7-18"><a href="#cb7-18" tabindex="-1"></a> <span class="fu">layer</span>(</span>
<span id="cb7-19"><a href="#cb7-19" tabindex="-1"></a> <span class="at">stat =</span> StatLm, <span class="at">data =</span> data, <span class="at">mapping =</span> mapping, <span class="at">geom =</span> geom, </span>
<span id="cb7-20"><a href="#cb7-20" tabindex="-1"></a> <span class="at">position =</span> position, <span class="at">show.legend =</span> show.legend, <span class="at">inherit.aes =</span> inherit.aes,</span>
<span id="cb7-21"><a href="#cb7-21" tabindex="-1"></a> <span class="at">params =</span> <span class="fu">list</span>(<span class="at">na.rm =</span> na.rm, ...)</span>
<span id="cb7-22"><a href="#cb7-22" tabindex="-1"></a> )</span>
<span id="cb7-23"><a href="#cb7-23" tabindex="-1"></a>}</span>
<span id="cb7-24"><a href="#cb7-24" tabindex="-1"></a></span>
<span id="cb7-25"><a href="#cb7-25" tabindex="-1"></a><span class="fu">ggplot</span>(mpg, <span class="fu">aes</span>(displ, hwy)) <span class="sc">+</span> </span>
<span id="cb7-26"><a href="#cb7-26" tabindex="-1"></a> <span class="fu">geom_point</span>() <span class="sc">+</span> </span>
<span id="cb7-27"><a href="#cb7-27" tabindex="-1"></a> <span class="fu">stat_lm</span>()</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7N0F3BTV/sfxH9LdICqCYJKKjSKC2IGoGGAH2O01sEVFsVuxkatSCoogFiKI3YhYoMBVlO7m7/fc/z5383k2Z2dnP+f1gmd3dnbmnPfMzv72zIlyG/9JRkIAAQQQQAABBBBAwCOBTTzaD7tBAAEEEEAAAQQQQMAJEIByIiCAAAIIIIAAAgh4KkAA6ik3O0MAAQQQQAABBBAgAOUcQAABBBBAAAEEEPBUgADUU252hgACCCCAAAIIIEAAyjmAAAIIIIAAAggg4KlABU/3loWdLV682NavX5/RlsqXL28afWrDhg0Zbccvb65QoYKpTKtXr/ZLljLOR6VKlWzNmjUZb8cvG6hSpYorT5DOOX0OgzKKW8WKFa1cuXKBOudUprVr1/rlI5BRPnRsKleuzGcoI8XcvpnPUG59M9166DOkOMGr67a+x2vUqJEw6wUXgCooWbduXcICJfNCtWrVXPAZlIBNB1kX5yVLliRT/IJYR8do6dKlBZHXsjK5ySabWL169dwPhKCcc/qyUQAalABHPxBUpqCcczon9RlatmxZWadnQbyuH9h169a1lStXBuZHgq7Zq1atyrhCxS8HUOebgpygfIZ03dZ1ISifIV3fdIxWrFjhm+s2t+D98uklHwgggAACCCCAQJEIEIAWyYGmmAgggAACCCCAgF8ECED9ciTIBwIIIIAAAgggUCQCBKBFcqApJgIIIIAAAggg4BcBAlC/HAnygQACCCCAAAIIFIkAAWiRHGiKiQACCCCAAAII+EWAANQvR4J8IIAAAggggAACRSJAAFokB5piIoAAAggggAACfhEgAPXLkSAfCCCAAAIIIIBAkQiU+2dKpo2FVNbly5e7aSczyXMQp+LUrA1BmrpSszYEZZYdnatBm4pTnyFNK1pgl4+Elw1NZ8tnKCFP3l8ITSOoaxzT2eb9cMTNgK7ZSkG6buu6kOnMi3Gx8rAw9BnycipO2QVqKk5NI5XpCaHpqDSNYFCmRaxZs6YLcBYuXJiH0zo3u9S0e0EpT2hKN/140tR7QUi6qOjzE5Qvm9q1a7upOINyzukcC9JnSD94GjVq5KZ5DMoP7Vq1apmuCfouCkLS+aYgJyifIV239d26ePHiIBwed33T9K+aKtWr67b2V1riFnxpOryGAAIIIIAAAgggkHUBAtCsk7JBBBBAAAEEEEAAgdIECEBL0+E1BBBAAAEEEEAAgawLEIBmnZQNIoAAAggggAACCJQmQABamg6vIYAAAggggAACCGRdgAA066RsEAEEEEAAAQQQQKA0AQLQ0nR4DQEEEEAAAQQQQCDrAgSgWSdlgwgggAACCCCAAAKlCRCAlqbDawgggAACCCCAAAJZFyAAzTopG0QAAQQQQAABBBAoTYAAtDQdXkMAAQQQQAABBBDIugABaNZJ2SACCCCAAAIIIIBAaQIEoKXp5PG1Z555xnr27Gl9+vSxNWvW5DEn7BoBBBBAAAEEEMiuQIXsbo6tZUPg2GOPtUmTJpVs6vXXX7evvvrKGjVqVLKMBwgggAACCCCAQKEKUAPqsyM3YsSIiOAzlL3u3buHHvIXAQQQQAABBBAoaAECUJ8dvilTpsTN0Zw5c+IuZyECCCCAAAIIIFBoAgSgPjtim2++edwcVapUKe5yFiKAAAIIIIAAAoUmQADqsyN2ySWXWM2aNWNyNWbMmJhlLEAAAQQQQAABBApRgADUh0dt+vTp1q1bNxeIbrrppjZy5EjbbrvtfJhTsoQAAggggAACCKQuQC/41M08ecfzzz/vyX7YCQIIIIAAAggg4LUANaBei7M/BBBAAAEEEECgyAUIQIv8BKD4CCCAAAIIIICA1wIEoF6Lsz8EEEAAAQQQQKDIBQhAi/wEoPgIIIAAAggggIDXAgSgXouzPwQQQAABBBBAoMgFCECL/ASg+AgggAACCCCAgNcCBKBei7M/BBBAAAEEEECgyAUIQIv8BKD4CCCAAAIIIICA1wIEoF6Lsz8EEEAAAQQQQKDIBQhAi/wEoPgIIIAAAggggIDXAgSgXouzPwQQQAABBBBAoMgFCECL/ASg+AgggAACCCCAgNcCBKBei7M/BBBAAAEEEECgyAUIQIv8BKD4CCCAAAIIIICA1wIEoF6Lsz8EEEAAAQQQQKDIBQhAi/wEoPgIIIAAAggggIDXAgSgXouzPwQQQAABBBBAoMgFCECL/ASg+AgggAACCCCAgNcCBKBei7M/BBBAAAEEEECgyAUIQIv8BKD4CCCAAAIIIICA1wIEoF6Lsz8EEEAAAQQQQKDIBQhAi/wEoPgIIIAAAggggIDXAgSgXouzPwQQQAABBBBAoMgFCECL/ASg+AgggAACCCCAgNcCBKBei7M/BBBAAAEEEECgyAUIQIv8BKD4CCCAAAIIIICA1wIEoF6Lsz8EEEAAAQQQQKDIBQhAi/wEoPgIIIAAAggggIDXAgSgXouzPwQQQAABBBBAoMgFCECL/ASg+AgggAACCCCAgNcCBKBei7M/BBBA
<p><code>StatLm</code> 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 the
<code>compute_group()</code> method and our wrapper function:</p>
<div class="sourceCode" id="cb8"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb8-1"><a href="#cb8-1" tabindex="-1"></a>StatLm <span class="ot">&lt;-</span> <span class="fu">ggproto</span>(<span class="st">&quot;StatLm&quot;</span>, Stat, </span>
<span id="cb8-2"><a href="#cb8-2" tabindex="-1"></a> <span class="at">required_aes =</span> <span class="fu">c</span>(<span class="st">&quot;x&quot;</span>, <span class="st">&quot;y&quot;</span>),</span>
<span id="cb8-3"><a href="#cb8-3" tabindex="-1"></a> </span>
<span id="cb8-4"><a href="#cb8-4" tabindex="-1"></a> <span class="at">compute_group =</span> <span class="cf">function</span>(data, scales, params, <span class="at">n =</span> <span class="dv">100</span>, <span class="at">formula =</span> y <span class="sc">~</span> x) {</span>
<span id="cb8-5"><a href="#cb8-5" tabindex="-1"></a> rng <span class="ot">&lt;-</span> <span class="fu">range</span>(data<span class="sc">$</span>x, <span class="at">na.rm =</span> <span class="cn">TRUE</span>)</span>
<span id="cb8-6"><a href="#cb8-6" tabindex="-1"></a> grid <span class="ot">&lt;-</span> <span class="fu">data.frame</span>(<span class="at">x =</span> <span class="fu">seq</span>(rng[<span class="dv">1</span>], rng[<span class="dv">2</span>], <span class="at">length =</span> n))</span>
<span id="cb8-7"><a href="#cb8-7" tabindex="-1"></a> </span>
<span id="cb8-8"><a href="#cb8-8" tabindex="-1"></a> mod <span class="ot">&lt;-</span> <span class="fu">lm</span>(formula, <span class="at">data =</span> data)</span>
<span id="cb8-9"><a href="#cb8-9" tabindex="-1"></a> grid<span class="sc">$</span>y <span class="ot">&lt;-</span> <span class="fu">predict</span>(mod, <span class="at">newdata =</span> grid)</span>
<span id="cb8-10"><a href="#cb8-10" tabindex="-1"></a> </span>
<span id="cb8-11"><a href="#cb8-11" tabindex="-1"></a> grid</span>
<span id="cb8-12"><a href="#cb8-12" tabindex="-1"></a> }</span>
<span id="cb8-13"><a href="#cb8-13" tabindex="-1"></a>)</span>
<span id="cb8-14"><a href="#cb8-14" tabindex="-1"></a></span>
<span id="cb8-15"><a href="#cb8-15" tabindex="-1"></a>stat_lm <span class="ot">&lt;-</span> <span class="cf">function</span>(<span class="at">mapping =</span> <span class="cn">NULL</span>, <span class="at">data =</span> <span class="cn">NULL</span>, <span class="at">geom =</span> <span class="st">&quot;line&quot;</span>,</span>
<span id="cb8-16"><a href="#cb8-16" tabindex="-1"></a> <span class="at">position =</span> <span class="st">&quot;identity&quot;</span>, <span class="at">na.rm =</span> <span class="cn">FALSE</span>, <span class="at">show.legend =</span> <span class="cn">NA</span>, </span>
<span id="cb8-17"><a href="#cb8-17" tabindex="-1"></a> <span class="at">inherit.aes =</span> <span class="cn">TRUE</span>, <span class="at">n =</span> <span class="dv">50</span>, <span class="at">formula =</span> y <span class="sc">~</span> x, </span>
<span id="cb8-18"><a href="#cb8-18" tabindex="-1"></a> ...) {</span>
<span id="cb8-19"><a href="#cb8-19" tabindex="-1"></a> <span class="fu">layer</span>(</span>
<span id="cb8-20"><a href="#cb8-20" tabindex="-1"></a> <span class="at">stat =</span> StatLm, <span class="at">data =</span> data, <span class="at">mapping =</span> mapping, <span class="at">geom =</span> geom, </span>
<span id="cb8-21"><a href="#cb8-21" tabindex="-1"></a> <span class="at">position =</span> position, <span class="at">show.legend =</span> show.legend, <span class="at">inherit.aes =</span> inherit.aes,</span>
<span id="cb8-22"><a href="#cb8-22" tabindex="-1"></a> <span class="at">params =</span> <span class="fu">list</span>(<span class="at">n =</span> n, <span class="at">formula =</span> formula, <span class="at">na.rm =</span> na.rm, ...)</span>
<span id="cb8-23"><a href="#cb8-23" tabindex="-1"></a> )</span>
<span id="cb8-24"><a href="#cb8-24" tabindex="-1"></a>}</span>
<span id="cb8-25"><a href="#cb8-25" tabindex="-1"></a></span>
<span id="cb8-26"><a href="#cb8-26" tabindex="-1"></a><span class="fu">ggplot</span>(mpg, <span class="fu">aes</span>(displ, hwy)) <span class="sc">+</span> </span>
<span id="cb8-27"><a href="#cb8-27" tabindex="-1"></a> <span class="fu">geom_point</span>() <span class="sc">+</span> </span>
<span id="cb8-28"><a href="#cb8-28" tabindex="-1"></a> <span class="fu">stat_lm</span>(<span class="at">formula =</span> y <span class="sc">~</span> <span class="fu">poly</span>(x, <span class="dv">10</span>)) <span class="sc">+</span> </span>
<span id="cb8-29"><a href="#cb8-29" tabindex="-1"></a> <span class="fu">stat_lm</span>(<span class="at">formula =</span> y <span class="sc">~</span> <span class="fu">poly</span>(x, <span class="dv">10</span>), <span class="at">geom =</span> <span class="st">&quot;point&quot;</span>, <span class="at">colour =</span> <span class="st">&quot;red&quot;</span>, <span class="at">n =</span> <span class="dv">20</span>)</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7N0HnBRF+v/xZ2HJIElJgsiJiuEQAVE5FRQRUDCAAQUzgjknFBVFQQEDJhQVEYU/BwaM+MOAYsJDlBPFgFkQFSXHZdn9z7e9WSft7uyEnp6eT71esDM9Hare1TPzTHV1VV5xIBkJAQQQQAABBBBAAAGXBCq5dBwOgwACCCCAAAIIIICAI0AAyomAAAIIIIAAAggg4KoAAair3BwMAQQQQAABBBBAgACUcwABBBBAAAEEEEDAVQECUFe5ORgCCCCAAAIIIIAAASjnAAIIIIAAAggggICrAvmuHi0FB1uzZo1t27YtqT1VrlzZNPpUUVFRUvvxysb5+fmmMm3ZssUrWUo6H1WrVrWCgoKk9+OVHVSvXt0pj5/OOb0P/TKKW5UqVSwvL89X55zKtHXrVq+8BZLKh+qmWrVqvIeSUkzvxryH0uub7N6D7yHFCW59but7vHbt2qVmPesCUAUlhYWFpRYonhdq1qzpBJ9+CdhUyfpwXrt2bTzFz4p1VEfr1q3LiryWl8lKlSpZgwYNnB8Ifjnn9GWjANQvAY5+IKhMfjnndE7qPbR+/fryTs+seF0/sOvXr2+bNm3yzY8EfWZv3rw56QYVr1SgzjcFOX55D+lzW58LfnkP6fNNdbRx40bPfG5zCd4r717ygQACCCCAAAII5IgAAWiOVDTFRAABBBBAAAEEvCJAAOqVmiAfCCCAAAIIIIBAjggQgOZIRVNMBBBAAAEEEEDAKwIEoF6pCfKBAAIIIIAAAgjkiAABaI5UNMVEAAEEEEAAAQS8IkAA6pWaIB8IIIAAAggggECOCBCA5khFU0wEEEAAAQQQQMArAlk3EL0GXde/ZJK214w0GtzYD0kDzGrQXA0y65ekuvFLeTQ4s5IGnlY9+SHpnFO59NcPSbOJ8R7ybk0G3zcaGFx15YekctSoUcM3M/LpM1ufCX763FYd+aU8wXgnOOmGF95DWfdOTsX0fzqptJ9kZ1TyQgUqDwqmNbWWX8qjMvmpPMEA1E/nnAJPP5VH7yEFOX56D6lMfilPMAD12zmn+lE9+SEFp3f0yzmnz20/vYeC55jqR+8jN1Iw6C3tWFkZgCZ7ggcDUL/MNa6WNb35/VIenax64/ulPMEvT523fimTriJoGk6/TMWplii/vYf8VJ7gF5nON7+8h9QSpfK4FQyUFgSkark+sxW0+aV+9Lntp++h0B8Ibn1uKzYpK/njemBZJeQ1BBBAAAEEEEAAAU8JEIB6qjrIDAIIIIAAAggg4H8BAlD/1zElRAABBBBAAAEEPCVAAOqp6iAzCCCAAAIIIICA/wUIQP1fx5QQAQQQQAABBBDwlAABqKeqg8wggAACCCCAAAL+FyAA9X8dU0IEEEAAAQQQQMBTAgSgnqoOMoMAAggggAACCPhfgADU/3VMCRFAAAEEEEAAAU8JEIB6qjrIDAIIIIAAAggg4H8BAlD/1zElRAABBBBAAAEEPCVAAOqp6iAzCCCAAAIIIICA/wUIQD1ax48//ridcMIJNnjwYCsoKPBoLskWAggggAACCCBQcYH8im/CFukWOPHEE+3dd98tOcxLL71kCxcutEaNGpUs4wECCCCAAAIIIJCtArSAeqzmnnnmmbDgM5i9Y445JviQvwgggAACCCCAQFYLEIB6rPo++OCDmDlatmxZzOUsRAABBBBAAAEEsk2AANRjNbbjjjvGzFHVqlVjLmchAggggAACCCCQbQIEoB6rscsuu8zq1KkTlauXX345ahkLEEAAAQQQQACBbBQgAPVgrX311Vd2+OGHO4FokyZN7Nlnn7Xdd9/dgzklSwgggAACCCCAQMUFuAu+4maubDF58mRXjsNBEEAAAQQQQAABtwVoAXVbnOMhgAACCCCAAAI5LkAAmuMnAMVHAAEEEEAAAQTcFiAAdVuc4yGAAAIIIIAAAjkuQACa4ycAxUcAAQQQQAABBNwWIAB1W5zjIYAAAggggAACOS5AAJrjJwDFRwABBBBAAAEE3BYgAHVbnOMhgAACCCCAAAI5LkAAmuMnAMVHAAEEEEAAAQTcFiAAdVuc4yGAAAIIIIAAAjkuQACa4ycAxUcAAQQQQAABBNwWIAB1W5zjIYAAAggggAACOS5AAJrjJwDFRwABBBBAAAEE3BYgAHVbnOMhgAACCCCAAAI5LkAAmuMnAMVHAAEEEEAAAQTcFiAAdVuc4yGAAAIIIIAAAjkuQACa4ycAxUcAAQQQQAABBNwWIAB1W5zjIYAAAggggAACOS5AAJrjJwDFRwABBBBAAAEE3BYgAHVbnOMhgAACCCCAAAI5LkAAmuMnAMVHAAEEEEAAAQTcFiAAdVuc4yGAAAIIIIAAAjkuQACa4ycAxUcAAQQQQAABBNwWIAB1W5zjIYAAAggggAACOS5AAJrjJwDFRwABBBBAAAEE3BYgAHVbnOMhgAACCCCAAAI5LkAAmuMnAMVHAAEEEEAAAQTcFiAAdVuc4yGAAAIIIIAAAjkuQACa4ycAxUcAAQQQQAAB
<p>Note that we don’t <em>have</em> to explicitly include the new
parameters in the arguments for the layer, <code>...</code> 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
<code>@inheritParams ggplot2::stat_identity</code>: that will
automatically inherit documentation for all the parameters also defined
for <code>stat_identity()</code>.</p>
<div class="sourceCode" id="cb9"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb9-1"><a href="#cb9-1" tabindex="-1"></a><span class="co">#&#39; @export</span></span>
<span id="cb9-2"><a href="#cb9-2" tabindex="-1"></a><span class="co">#&#39; @inheritParams ggplot2::stat_identity</span></span>
<span id="cb9-3"><a href="#cb9-3" tabindex="-1"></a><span class="co">#&#39; @param formula The modelling formula passed to \code{lm}. Should only </span></span>
<span id="cb9-4"><a href="#cb9-4" tabindex="-1"></a><span class="co">#&#39; involve \code{y} and \code{x}</span></span>
<span id="cb9-5"><a href="#cb9-5" tabindex="-1"></a><span class="co">#&#39; @param n Number of points used for interpolation.</span></span>
<span id="cb9-6"><a href="#cb9-6" tabindex="-1"></a>stat_lm <span class="ot">&lt;-</span> <span class="cf">function</span>(<span class="at">mapping =</span> <span class="cn">NULL</span>, <span class="at">data =</span> <span class="cn">NULL</span>, <span class="at">geom =</span> <span class="st">&quot;line&quot;</span>,</span>
<span id="cb9-7"><a href="#cb9-7" tabindex="-1"></a> <span class="at">position =</span> <span class="st">&quot;identity&quot;</span>, <span class="at">na.rm =</span> <span class="cn">FALSE</span>, <span class="at">show.legend =</span> <span class="cn">NA</span>, </span>
<span id="cb9-8"><a href="#cb9-8" tabindex="-1"></a> <span class="at">inherit.aes =</span> <span class="cn">TRUE</span>, <span class="at">n =</span> <span class="dv">50</span>, <span class="at">formula =</span> y <span class="sc">~</span> x, </span>
<span id="cb9-9"><a href="#cb9-9" tabindex="-1"></a> ...) {</span>
<span id="cb9-10"><a href="#cb9-10" tabindex="-1"></a> <span class="fu">layer</span>(</span>
<span id="cb9-11"><a href="#cb9-11" tabindex="-1"></a> <span class="at">stat =</span> StatLm, <span class="at">data =</span> data, <span class="at">mapping =</span> mapping, <span class="at">geom =</span> geom, </span>
<span id="cb9-12"><a href="#cb9-12" tabindex="-1"></a> <span class="at">position =</span> position, <span class="at">show.legend =</span> show.legend, <span class="at">inherit.aes =</span> inherit.aes,</span>
<span id="cb9-13"><a href="#cb9-13" tabindex="-1"></a> <span class="at">params =</span> <span class="fu">list</span>(<span class="at">n =</span> n, <span class="at">formula =</span> formula, <span class="at">na.rm =</span> na.rm, ...)</span>
<span id="cb9-14"><a href="#cb9-14" tabindex="-1"></a> )</span>
<span id="cb9-15"><a href="#cb9-15" tabindex="-1"></a>}</span></code></pre></div>
<p><code>stat_lm()</code> must be exported if you want other people to
use it. You could also consider exporting <code>StatLm</code> if you
want people to extend the underlying object; this should be done with
care.</p>
</div>
<div id="picking-defaults" class="section level3">
<h3>Picking defaults</h3>
<p>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 the <code>stat_density()</code>
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).</p>
<p>To do this we override the <code>setup_params()</code> method. It’s
passed the data and a list of params, and returns an updated list.</p>
<div class="sourceCode" id="cb10"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb10-1"><a href="#cb10-1" tabindex="-1"></a>StatDensityCommon <span class="ot">&lt;-</span> <span class="fu">ggproto</span>(<span class="st">&quot;StatDensityCommon&quot;</span>, Stat, </span>
<span id="cb10-2"><a href="#cb10-2" tabindex="-1"></a> <span class="at">required_aes =</span> <span class="st">&quot;x&quot;</span>,</span>
<span id="cb10-3"><a href="#cb10-3" tabindex="-1"></a> </span>
<span id="cb10-4"><a href="#cb10-4" tabindex="-1"></a> <span class="at">setup_params =</span> <span class="cf">function</span>(data, params) {</span>
<span id="cb10-5"><a href="#cb10-5" tabindex="-1"></a> <span class="cf">if</span> (<span class="sc">!</span><span class="fu">is.null</span>(params<span class="sc">$</span>bandwidth))</span>
<span id="cb10-6"><a href="#cb10-6" tabindex="-1"></a> <span class="fu">return</span>(params)</span>
<span id="cb10-7"><a href="#cb10-7" tabindex="-1"></a> </span>
<span id="cb10-8"><a href="#cb10-8" tabindex="-1"></a> xs <span class="ot">&lt;-</span> <span class="fu">split</span>(data<span class="sc">$</span>x, data<span class="sc">$</span>group)</span>
<span id="cb10-9"><a href="#cb10-9" tabindex="-1"></a> bws <span class="ot">&lt;-</span> <span class="fu">vapply</span>(xs, bw.nrd0, <span class="fu">numeric</span>(<span class="dv">1</span>))</span>
<span id="cb10-10"><a href="#cb10-10" tabindex="-1"></a> bw <span class="ot">&lt;-</span> <span class="fu">mean</span>(bws)</span>
<span id="cb10-11"><a href="#cb10-11" tabindex="-1"></a> <span class="fu">message</span>(<span class="st">&quot;Picking bandwidth of &quot;</span>, <span class="fu">signif</span>(bw, <span class="dv">3</span>))</span>
<span id="cb10-12"><a href="#cb10-12" tabindex="-1"></a> </span>
<span id="cb10-13"><a href="#cb10-13" tabindex="-1"></a> params<span class="sc">$</span>bandwidth <span class="ot">&lt;-</span> bw</span>
<span id="cb10-14"><a href="#cb10-14" tabindex="-1"></a> params</span>
<span id="cb10-15"><a href="#cb10-15" tabindex="-1"></a> },</span>
<span id="cb10-16"><a href="#cb10-16" tabindex="-1"></a> </span>
<span id="cb10-17"><a href="#cb10-17" tabindex="-1"></a> <span class="at">compute_group =</span> <span class="cf">function</span>(data, scales, <span class="at">bandwidth =</span> <span class="dv">1</span>) {</span>
<span id="cb10-18"><a href="#cb10-18" tabindex="-1"></a> d <span class="ot">&lt;-</span> <span class="fu">density</span>(data<span class="sc">$</span>x, <span class="at">bw =</span> bandwidth)</span>
<span id="cb10-19"><a href="#cb10-19" tabindex="-1"></a> <span class="fu">data.frame</span>(<span class="at">x =</span> d<span class="sc">$</span>x, <span class="at">y =</span> d<span class="sc">$</span>y)</span>
<span id="cb10-20"><a href="#cb10-20" tabindex="-1"></a> } </span>
<span id="cb10-21"><a href="#cb10-21" tabindex="-1"></a>)</span>
<span id="cb10-22"><a href="#cb10-22" tabindex="-1"></a></span>
<span id="cb10-23"><a href="#cb10-23" tabindex="-1"></a>stat_density_common <span class="ot">&lt;-</span> <span class="cf">function</span>(<span class="at">mapping =</span> <span class="cn">NULL</span>, <span class="at">data =</span> <span class="cn">NULL</span>, <span class="at">geom =</span> <span class="st">&quot;line&quot;</span>,</span>
<span id="cb10-24"><a href="#cb10-24" tabindex="-1"></a> <span class="at">position =</span> <span class="st">&quot;identity&quot;</span>, <span class="at">na.rm =</span> <span class="cn">FALSE</span>, <span class="at">show.legend =</span> <span class="cn">NA</span>, </span>
<span id="cb10-25"><a href="#cb10-25" tabindex="-1"></a> <span class="at">inherit.aes =</span> <span class="cn">TRUE</span>, <span class="at">bandwidth =</span> <span class="cn">NULL</span>,</span>
<span id="cb10-26"><a href="#cb10-26" tabindex="-1"></a> ...) {</span>
<span id="cb10-27"><a href="#cb10-27" tabindex="-1"></a> <span class="fu">layer</span>(</span>
<span id="cb10-28"><a href="#cb10-28" tabindex="-1"></a> <span class="at">stat =</span> StatDensityCommon, <span class="at">data =</span> data, <span class="at">mapping =</span> mapping, <span class="at">geom =</span> geom, </span>
<span id="cb10-29"><a href="#cb10-29" tabindex="-1"></a> <span class="at">position =</span> position, <span class="at">show.legend =</span> show.legend, <span class="at">inherit.aes =</span> inherit.aes,</span>
<span id="cb10-30"><a href="#cb10-30" tabindex="-1"></a> <span class="at">params =</span> <span class="fu">list</span>(<span class="at">bandwidth =</span> bandwidth, <span class="at">na.rm =</span> na.rm, ...)</span>
<span id="cb10-31"><a href="#cb10-31" tabindex="-1"></a> )</span>
<span id="cb10-32"><a href="#cb10-32" tabindex="-1"></a>}</span>
<span id="cb10-33"><a href="#cb10-33" tabindex="-1"></a></span>
<span id="cb10-34"><a href="#cb10-34" tabindex="-1"></a><span class="fu">ggplot</span>(mpg, <span class="fu">aes</span>(displ, <span class="at">colour =</span> drv)) <span class="sc">+</span> </span>
<span id="cb10-35"><a href="#cb10-35" tabindex="-1"></a> <span class="fu">stat_density_common</span>()</span>
<span id="cb10-36"><a href="#cb10-36" tabindex="-1"></a><span class="co">#&gt; Picking bandwidth of 0.345</span></span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7L0HlCPnde95CxmNzmm6ewIn55w5zMOcREmWZEtWsmT7HdnSk96et9ZZ+9g6Psfa9dq71pNlrW1JT0+WlW2JIikOOQxiGnLIGXJy4OTUkzpnZGC/Wz3Vg+4GuoFC5fp/c8gCqupLv1sAbt/vu/dKWVEIBQRAAARAAARAAARAAAQMIuAxqB90AwIgAAIgAAIgAAIgAAIyASigeBBAAARAAARAAARAAAQMJQAF1FDc6AwEQAAEQAAEQAAEQAAKKJ4BEAABEAABEAABEAABQwlAATUUNzoDARAAARAAARAAARCAAopnAARAAARAAARAAARAwFACPkN7y+lsYGCAUqlUzhnnvPR4PCRJEqXTaedMqsyZ+Hw+4v9isViZLTmreiAQoEQi4axJlTmbUCgkM8lkMmW25Jzq/Nnh7xNEzbspU7/fL3/P4vNzkwm/Yi7JZHL8SRe/499j/p6Nx+OGfX6CwSBFIhEXUy9u6qYpoPwwOFUB5YePH3qeI8ooAf4BZcWiv78fSHIIVFRU0ODgYM4Zd7/kP9zq6+vlzw4+PzefBeUH1KnfmTdnWvyrcDgsf8/i83OTGf/u8O8PPjs3mfBnh79nh4aGDDMKeb3emwPAq4IEsARfEA0ugAAIgAAIgAAIgAAI6EEACqgeVNEmCIAACIAACIAACIBAQQJQQAuiwQUQAAEQAAEQAAEQAAE9CEAB1YMq2gQBEAABEAABEAABEChIAApoQTS4AAIgAAIgAAIgAAIgoAcBKKB6UEWbIAACIAACIAACIAACBQlAAS2IBhdAAARAAARAAARAAAT0IAAFVA+qaBMEQAAEQAAEQAAEQKAgASigBdHgAgiAAAiAAAiAAAiAgB4EoIDqQRVtggAIgAAIgAAIgAAIFCQABbQgGlwAARAAARAAARAAARDQgwAUUD2ook0QAAEQAAEQAAEQAIGCBKCAFkSDCyAAAiAAAiAAAiAAAnoQgAKqB1W0CQIgAAIgAAIgAAIgUJAAFNCCaHABBEAABEAABEAABEBADwJQQPWgijZBAARAAARAAARAAAQKEoACWhANLoAACIAACIAACIAACOhBAAqoHlTRJgiAAAiAAAiAAAiAQEECUEALosEFEAABEAABEAABEAABPQhAAdWDKtoEARAAARAAARAAARAoSAAKaEE0uAACIAACIAACIAACIKAHASigelBFmyAAAiAAAiAAAiAAAgUJQAEtiAYXQAAEQAAEQAAEQAAE9CAABVQPqmgTBEAABEAABEAABECgIAEooAXR4AIIgAAIgAAIgAAIgIAeBKCA6kEVbYIACICAAwhks0RDMYn4iAICIAACWhLwadkY2gIBEAABEHAGgXMdfvrBG7XUOeijSDBDn9jWT+tuiTljcpgFCICA6QSggJouAgzgzf699OvO5+hs9ALNCrXR7zQ9SnfWbgUYEAABkwhc7fPRP75QTzNq0vTp2/to3/kQfe/VWvqTe3tpxay4SaNCtyAAAk4igCV4J0nTZnPJinW9/+vCt+iLJ/9cKJ8XaU3lSroW76Qvn/pL+m+nvkaxDH7obCZSDNcBBDIZov8plM2aigx9+cFu2rowSv9ley8taUnQv71RQ4Mx/Gw4QMyYAgiYTgDfJKaLwL0D+B/t36VfdDxN/332F+iXq75HfzXvv9HPV/4L/Z/z/w96S1hFvyIU0WQm5V5AmDkImEBg18kKuiIsoJ8Rls9wYHTzp1f8Unzmjj5KpiV67mClCaNClyAAAk4jAAXUaRK1yXxe7nmDfnjtP+iLMz9Hv9/y4XGjfrhhO31j0V/Te4OH6G8vfmvcNbwBARDQjwBbP184EqG1c2I0rzk5riO2iN6zfJhYQYUVdBwavAEBEFBBAAqoCmioUh6BkXSU/u+L36bbajbR59s+nrexbeIaW0Z/1bmDXux5Pe89OAkCIKAtgUOXglQfSdN9K4fzNnzPshHZI37XiYq813ESBEAABIolAAW0WFK4TzMCbPnsTfXTV+d8cco2f3fGE7KS+rdin+hgKv8P4pQN4CIIgEBJBF5/P0LxpIfmT7B+Ko1UhTO0YW5UtoJmEJpJwYIjCICACgJQQFVAQxX1BAZTQ/Tj67+iDzc9TLOFx/t05c9v+a80lB6mf73yw+luxXUQAIEyCPQOe+j9qwG6fcnIlK1sWxSl3mEvnRD3ooAACICAWgJQQNWSQz1VBP6j8zfCuz1Gn2vNv/Q+sdG2YAt9uuWj9HPhrHQ5fnXiZbwHARDQiMC+82HySCRifUanbHGR8IavE8v0750LT3kfLoIACIDAVASggE5FB9c0JZASHu0/u/5rerD+HpoRaCq67c+2/i5VeSP0L5dhBS0aGm4EgRIJ7BexPpe0JqgyNPXauiSUVHZSOnQxSOy0hAICIAACaghAAVVDDXVUEfht5y7qTHbTx5ofL6l+xFtBn2r5CD3X/VtYQUsih5tBoDgCnG7zXKefVgvFspiyRmREGop76ayogwICIAACaghAAVVDDXVUEfjZxSdp
<div class="sourceCode" id="cb11"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb11-1"><a href="#cb11-1" tabindex="-1"></a></span>
<span id="cb11-2"><a href="#cb11-2" tabindex="-1"></a><span class="fu">ggplot</span>(mpg, <span class="fu">aes</span>(displ, <span class="at">colour =</span> drv)) <span class="sc">+</span> </span>
<span id="cb11-3"><a href="#cb11-3" tabindex="-1"></a> <span class="fu">stat_density_common</span>(<span class="at">bandwidth =</span> <span class="fl">0.5</span>)</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7L0HlGRXee/7r1zd1Tn39OTYk4NGOSCEEEECgzH4wSUYC8OzMdf42c942c9w7QVr2eZdaxnM8zW2LzYgRHBAEggkK4FympzzdM9Mx+mcKr/9nVb19PR0V1c459QJ/z1LqqoT9t7f7ztd/fXeX/CkVQMbCZAACZAACZAACZAACZhEwGvSOByGBEiABEiABEiABEiABDQCNED5IJAACZAACZAACZAACZhKgAaoqbg5GAmQAAmQAAmQAAmQAA1QPgMkQAIkQAIkQAIkQAKmEqABaipuDkYCJEACJEACJEACJEADlM8ACZAACZAACZAACZCAqQT8po42a7CRkREkEolZRwp/GwqFkEqlEI/HC+/EhncGg0HEYjEbzrzwKYvMkjmMui6coV3upK7toqni50ldF8/QLj2IrqU5+XeX2CSRSMQuKinZPEtmgEajUd0M0MrKSu1hlj7d1MrLyzE6OuomkSG6FuNzbGzMVXK7UdcVFRVIJpPUtQuedPllLX9Y8ufa+cqW7zJpTv7d5fP5nK9IHSTkFrwOENkFCZAACZAACZAACZBA7gRogObOileSAAmQAAmQAAmQAAnoQIAGqA4Q2QUJkAAJkAAJkAAJkEDuBGiA5s6KV5IACZAACZAACZAACehAgAaoDhDZBQmQAAmQAAmQAAmQQO4EaIDmzopXkgAJkAAJkAAJkAAJ6ECABqgOENkFCZAACZAACZAACZBA7gRogObOileSAAmQAAmQAAmQAAnoQIAGqA4Q2QUJkAAJkAAJkAAJkEDuBGiA5s6KV5IACZAACZAACZAACehAgAaoDhDZBQmQAAmQAAmQAAmQQO4EaIDmzopXkgAJkAAJkAAJkAAJ6ECABqgOENkFCZAACZAACZAACZBA7gRogObOileSAAmQAAmQAAmQAAnoQIAGqA4Q2QUJkAAJkAAJkAAJkEDuBGiA5s6KV5IACZAACZAACZAACehAgAaoDhDZBQmQAAmQAAmQAAmQQO4EaIDmzopXkgAJkAAJkAAJkAAJ6ECABqgOENkFCZAACZAACZAACZBA7gRogObOileSAAmQAAmQAAmQAAnoQIAGqA4Q2QUJkAAJkAAJkAAJkEDuBGiA5s6KV5IACZAACZAACZAACehAgAaoDhDZBQmQAAmQAAmQAAmQQO4EaIDmzopXkgAJkAAJkAAJkAAJ6ECABqgOENkFCZAACZAACZAACZBA7gRogObOilfanEA8FcdwYsTmUnD6JEACJEACJGB/An77i0AJSCA7geeHXsU/XPoOjoyfQEr9q/PX4N76u/Ebrb+OukBN9pt5lgRIgARIgARIQHcCNEB1R8oOrUIgkU7ir89/Az/qexTbIhvxh8t/G9X+SuwfO4x/7/spfnr5Sfy/a7+EnZVbrDJlzoMESIAESIAEXEGABqgr1Ow+IdPpNL545q/x+MCz+MNlv42PNL8fHo9HA/Hu+rfhN1s/jC+c/jI+c/yP8D+VEXp7zY3ug0SJSYAESIAESKBEBOgDWiLwHNZYAt/q/gF+NvA0vrTqD/DfWn51xvjMjNocbMQ/bPgqrq/cjv/71F/g2PipzCm+kgAJkAAJkAAJGEyABqjBgNm9+QQOjR3HNy58Cx9t/gDe23DPghMIeYPaFvzycBv+4NSfYzQxvuC1PEECJEACJEACJKAfARqg+rFkTxYgkFR+n39x7n9iVdly/Pel9y86ozJfGF9d+0UMJobwlx1fX/R6XkACJEACJEACJFA8ARqgxTNkDxYi8OO+n+Pk5Fn86YrfQ8AbyGlmK8JL8X8t+wweu/wUJGKejQRIgARIgARIwFgCNECN5cveTSQwlYrif136Nt5We1veke0faLwX2ys246sd/x8kXygbCZAACZAACZCAcQRogBrHlj2bTOBHvY9iID6Ez7Z9Mu+RJUL+C8s/i87oJfyg95G87+cNJEACJEACJEACuROgAZo7K15pYQKS8/PBnv/A3XW3a/6fhUx1Y2Qd7lMJ6v/x0oMYSzIgqRCGvIcESIAESIAEciFAAzQXSrzG8gSeHnwOPbE+fKz514qa6//Z9nFMpCbwUM+Pi+qHN5MACZAACZAACSxMgAbowmx4xkYEftDzCDZHNmBLRXtRs14SasF76u/Bg93/jsnkZFF98WYSIAESIAESIIH5CdAAnZ8Lj9qIwJnJ89gzdhAfanqvLrOWGvGjagv+3/se06U/dkICJEACJEACJHA1ARqgV/PgJxsSeLj/cVT4Irin7i26zF4S07+t9nbNp1R8S9lIgARIgARIgAT0JUADVF+e7M1kApJ4/if9/4V31r0VYW9It9E/3vJr6I714qmB53Trkx2RAAmQAAmQAAlME6AByifB1gReG9mPAVXF6N31b9NVDvEl3RrZqFIyPaxrv+yMBEiABEiABEgAoAHKp8DWBB4feAZNgQbsUEnk9W4fanoP9o4dwqmJs3p3zf5IgARIgARIwNUEaIC6Wv32Fl78M58ZfAFvr7sDkkhe7/Z25VNa5avE
<p>I recommend using <code>NULL</code> as a default value. If you pick
important parameters automatically, it’s a good idea to
<code>message()</code> to the user (and when printing a floating point
parameter, using <code>signif()</code> to show only a few significant
digits).</p>
</div>
<div id="variable-names-and-default-aesthetics" class="section level3">
<h3>Variable names and default aesthetics</h3>
<p>This stat illustrates another important point. If we want to make
this stat usable with other geoms, we should return a variable called
<code>density</code> instead of <code>y</code>. Then we can set up the
<code>default_aes</code> to automatically map <code>density</code> to
<code>y</code>, which allows the user to override it to use with
different geoms:</p>
<div class="sourceCode" id="cb12"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb12-1"><a href="#cb12-1" tabindex="-1"></a>StatDensityCommon <span class="ot">&lt;-</span> <span class="fu">ggproto</span>(<span class="st">&quot;StatDensity2&quot;</span>, Stat, </span>
<span id="cb12-2"><a href="#cb12-2" tabindex="-1"></a> <span class="at">required_aes =</span> <span class="st">&quot;x&quot;</span>,</span>
<span id="cb12-3"><a href="#cb12-3" tabindex="-1"></a> <span class="at">default_aes =</span> <span class="fu">aes</span>(<span class="at">y =</span> <span class="fu">after_stat</span>(density)),</span>
<span id="cb12-4"><a href="#cb12-4" tabindex="-1"></a></span>
<span id="cb12-5"><a href="#cb12-5" tabindex="-1"></a> <span class="at">compute_group =</span> <span class="cf">function</span>(data, scales, <span class="at">bandwidth =</span> <span class="dv">1</span>) {</span>
<span id="cb12-6"><a href="#cb12-6" tabindex="-1"></a> d <span class="ot">&lt;-</span> <span class="fu">density</span>(data<span class="sc">$</span>x, <span class="at">bw =</span> bandwidth)</span>
<span id="cb12-7"><a href="#cb12-7" tabindex="-1"></a> <span class="fu">data.frame</span>(<span class="at">x =</span> d<span class="sc">$</span>x, <span class="at">density =</span> d<span class="sc">$</span>y)</span>
<span id="cb12-8"><a href="#cb12-8" tabindex="-1"></a> } </span>
<span id="cb12-9"><a href="#cb12-9" tabindex="-1"></a>)</span>
<span id="cb12-10"><a href="#cb12-10" tabindex="-1"></a></span>
<span id="cb12-11"><a href="#cb12-11" tabindex="-1"></a><span class="fu">ggplot</span>(mpg, <span class="fu">aes</span>(displ, drv, <span class="at">colour =</span> <span class="fu">after_stat</span>(density))) <span class="sc">+</span> </span>
<span id="cb12-12"><a href="#cb12-12" tabindex="-1"></a> <span class="fu">stat_density_common</span>(<span class="at">bandwidth =</span> <span class="dv">1</span>, <span class="at">geom =</span> <span class="st">&quot;point&quot;</span>)</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7N0LlGRVef/93de5MMNwGUUkmkEExSSQNUCirySCikDQ6F9jNImoWagYg+aNCeZuJCsuhRiIqCuyBIxRjIBR4mvEmHiJxmhQMZEERKKCSwHzJ9xmmGH6+j6/Z5996lR1dffp6nNO9fT5FvTUOfs8+9l7f0511TN1m5F5uwQuCCCAAAIIIIAAAgg0JDDa0DgMgwACCCCAAAIIIICAC1CAckNAAAEEEEAAAQQQaFSAArRRbgZDAAEEEEAAAQQQoADlNoAAAggggAACCCDQqAAFaKPcDIYAAggggAACCCBAAcptAAEEEEAAAQQQQKBRgfFGR1vBYPfee+8KoqsNnZiYCNPT09UmXQPZxsfHg34efvjhNTCbaqcwMjISxsbGwszMTLWJ10A23R5HR0fDvn371sBsqp2C1qVzNzs7W23iNZBtcnLSZzE1NbUGZlPtFPS7pm/wm5ubqzbxGsi2YcMGX9d6fQzQ79p6/PbFjRs3+v1/nY8But1v27ZtDdxK18cU1mwBOqwHWz0Ybtq0KezevXt9nOHCKlR86pf0gQceKLSuj02tTYXasG43dSrqAVHFzIMPPljnMEPJrbXpTn09nrfNmze76a5du4ZiW+egWpuKz/V43rZu3Rr0l4b1uDbdj2hddRZpdd7ulsp90EEH+eN2nedNjzNcqhPgJfjqLMmEAAIIIIAAAgggUEKAArQEEiEIIIAAAggggAAC1QlQgFZnSSYEEEAAAQQQQACBEgIUoCWQCEEAAQQQQAABBBCoToACtDpLMiGAAAIIIIAAAgiUEKAALYFECAIIIIAAAggggEB1AhSg1VmSCQEEEEAAAQQQQKCEAAVoCSRCEEAAAQQQQAABBKoToACtzpJMCCCAAAIIIIAAAiUEKEBLIBGCAAIIIIAAAgggUJ0ABWh1lmRCAAEEEEAAAQQQKCFAAVoCiRAEEEAAAQQQQACB6gQoQKuzJBMCCCCAAAIIIIBACQEK0BJIhCCAAAIIIIAAAghUJ0ABWp0lmRBAAAEEEEAAAQRKCFCAlkAiBAEEEEAAAQQQQKA6AQrQ6izJhAACCCCAAAIIIFBCgAK0BBIhCCCAAAIIIIAAAtUJUIBWZ0kmBBBAAAEEEEAAgRICFKAlkAhBAAEEEEAAAQQQqE6AArQ6SzIhgAACCCCAAAIIlBCgAC2BRAgCCCCAAAIIIIBAdQIUoNVZkgkBBBBAAAEEEECghAAFaAkkQhBAAAEEEEAAAQSqE6AArc6STAgggAACCCCAAAIlBChASyARggACCCCAAAIIIFCdAAVodZZkQgABBBBAAAEEECghQAFaAokQBBBAAAEEEEAAgeoEKECrsyQTAggggAACCCCAQAkBCtASSIQggAACCCCAAAIIVCdAAVqdJZkQQAABBBBAAAEESghQgJZAIgQBBBBAAAEEEECgOgEK0OosyYQAAggggAACCCBQQoACtAQSIQgggAACCCCAAALVCVCAVmdJJgQQQAABBBBAAIESAhSgJZAIQQABBBBAAAEEEKhOgAK0OksyIYAAAggggAACCJQQoAAtgUQIAggggAACCCCAQHUCFKDVWZIJAQQQQAABBBBAoIQABWgJJEIQQAABBBBAAAEEqhOgAK3OkkwIIIAAAggggAACJQQoQEsgEYIAAggggAACCCBQnQAFaHWWZEIAAQQQQAABBBAoIUABWgKJEAQQQAABBBBAAIHqBChAq7MkEwIIIIAAAggggEAJAQrQEkiEIIAAAggggAACCFQnQAFanSWZEEAAAQQQQAABBEoIUICWQCIEAQQQQAABBBBAoDoBCtDqLMmEAAIIIIAAAgggUEKAArQEEiEIIIAAAggggAAC1QlQgFZnSSYEEEAAAQQQQACBEgIUoCWQCEEAAQQQQAABBBCoToACtDpLMiGAAAIIIIAAAgiUEKAALYFECAIIIIAAAggggEB1AhSg1VmSCQEEEEAAAQQQQKCEAAVoCSRCEEAAAQQQQAABBKoToACtzpJMCCCAAAIIIIAAAiUEKEBLIBGCAAIIIIAAAgggUJ0ABWh1lmRCAAEEEEAAAQQQKCFAAVoCiRAEEEAAAQQQQACB6gQoQKuzJBMCCCCAAAIIIIBACQEK0BJIhCCAAAIIIIAAAghUJ0ABWp0lmRBAAAEEEEAAAQRKCFCAlkAiBAEEEEAAAQQQQKA6AQrQ6izJhAACCCCAAAIIIFBCgAK0BBIhCCCAAAIIIIAAAtUJUIBWZ0kmBBBAAAEEEEAAgRICFKAlkAhBAAEEEEAAAQQQqE6AArQ6SzIhgAACCCCAAAIIlBCgAC2BRAgCCCCAAAIIIIBAdQIUoNVZkgkBBBBAAAEEEECghAAFaAkkQhBAAAEEEEAAAQSqE6AArc6STAgggAACCCCAAAIlBChASyARggACCCCAAAIIIFCdAAVodZZkQgABBBBAAAEEECghQAFaAokQBBBAAAEEEEAAgeoEKECrsyQTAggggAACCCCAQAkBCtASSIQggAACCCCAAAII
<p>However, using this stat with the area geom doesn’t work quite right.
The areas don’t stack on top of each other:</p>
<div class="sourceCode" id="cb13"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb13-1"><a href="#cb13-1" tabindex="-1"></a><span class="fu">ggplot</span>(mpg, <span class="fu">aes</span>(displ, <span class="at">fill =</span> drv)) <span class="sc">+</span> </span>
<span id="cb13-2"><a href="#cb13-2" tabindex="-1"></a> <span class="fu">stat_density_common</span>(<span class="at">bandwidth =</span> <span class="dv">1</span>, <span class="at">geom =</span> <span class="st">&quot;area&quot;</span>, <span class="at">position =</span> <span class="st">&quot;stack&quot;</span>)</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7L0JuGRVebD71ZmHPj3QQAOCzSSgRjAY0Gj8HW5C9KJGbm5IYgY1Ynwkjxr9xSTmEaPXJOjN/2tI/P3FRL3BAUwMQxQERCaRmYam5z7dZx76zGPNw61VTZ0+Qw27qvaw1trv4mmqau+1v+H9du36zhojuXwRCgQgAAEIQAACEIAABHwi0OSTHtRAAAIQgAAEIAABCECgQIAElBsBAhCAAAQgAAEIQMBXAiSgvuJGGQQgAAEIQAACEIAACSj3AAQgAAEIQAACEICArwRIQH3FjTIIQAACEIAABCAAARJQ7gEIQAACEIAABCAAAV8JtPiqzWVl0WhU4vG4y1KdiWtqapJIJCKZTMbZBQbVam1tLfiWTCYNstqZqc3NzaJWHstms84uMKhWW1tbwbdUKmWQ1c5MbWlpKXzXbFw1rr29veBbOp12BsOgWupZYuP9qELQ0dFR8M3G3wD1LLHx+a9+s9X3Tfnm5W+A0tHd3W3QNzUYU41OQNWDLZFIBEJOfUHVj2JQ+r10uqurq5CALi4ueqkmENmdnZ2FB4+Ncevp6Sn8IC4tLQXC1kulKpFRCZqNSdrWrVtleXnZymeJStKUb7b94aASmZNOOknm5uasjJv6DbDx+a9+s7dt2yaxWMzTBFs1dFCqE6ALvjojakAAAhCAAAQgAAEIuEiABNRFmIiCAAQgAAEIQAACEKhOgAS0OiNqQAACEIAABCAAAQi4SIAE1EWYiIIABCAAAQhAAAIQqE6ABLQ6I2pAAAIQgAAEIAABCLhIgATURZiIggAEIAABCEAAAhCoToAEtDojakAAAhCAAAQgAAEIuEiABNRFmIiCAAQgAAEIQAACEKhOgAS0OiNqQAACEIAABCAAAQi4SIAE1EWYiIIABCAAAQhAAAIQqE6ABLQ6I2pAAAIQgAAEIAABCLhIgATURZiIggAEIAABCEAAAhCoToAEtDojakAAAhCAAAQgAAEIuEiABNRFmIiCAAQgAAEIQAACEKhOgAS0OiNqQAACEIAABCAAAQi4SIAE1EWYiIIABCAAAQhAAAIQqE6ABLQ6I2pAAAIQgAAEIAABCLhIgATURZiIggAEIAABCEAAAhCoToAEtDojakAAAhCAAAQgAAEIuEiABNRFmIiCAAQgAAEIQAACEKhOgAS0OiNqQAACEIAABCAAAQi4SIAE1EWYiIIABCAAAQhAAAIQqE6ABLQ6I2pAAAIQgAAEIAABCLhIgATURZiIggAEIAABCEAAAhCoToAEtDojakAAAhCAAAQgAAEIuEiABNRFmIiCAAQgAAEIQAACEKhOoKV6FWpAAAK6EhiID8ve5UMSyRv4uo5fkbPbz9LVVOyCAAQgAAEIrBAgAV1BwRsImEPgcLRP/n7gRtm1tOeE0UdFXrPlYvnYGdfIqza9/MRx3kEAAhCAAAQ0I0AXvGYBwRwIVCNwx+RP5A/2/dna5PPFi56Z3y1/cuDjcsux26uJ4TwEIAABCEAgMAK0gAaGHsUQqJ3AnVP3yN/0/4+KF6ZzGfni4FcllUvLH532f1esy0kIQAACEIBAEARoAQ2COjohUAeBJxd2yef6/qfjK//n0NflvpmHHNenIgQgAAEIQMAvAiSgfpFGDwQaIDCTmpW/OvJ3ks3/V0v5bN8/iJqoRIEABCAAAQjoRIAEVKdoYAsEyhD4f/q/LDPpuTJnyx+OZePymaNfkky+W54CAQhAAAIQ0IUACagukcAOCJQh8MDso/Lg3GNlzlY//MLyfiYlVcdEDQhAAAIQ8JEACaiPsFEFgVoJJLNJ+YfB/13rZRvqf23k32Q6341PgQAEIAABCOhAgARUhyhgAwTKELhl4g4ZTY6XOev88HI2Kl8b+f+cX0BNCEAAAhCAgIcESEA9hItoCDRCYDkTlW+N3dKIiDXX3jZ5NxOS1hDhAwQgAAEIBEWABDQo8uiFQBUCP5i4U+bSC1VqOT+tZtB/feRm5xdQEwIQgAAEIOARARJQj8AiFgKNEFBjP787/p+NiCh57T0zD8pQfLTkOQ5CAAIQgAAE/CJAAuoXafRAoAYCP5r+qUyn3Z80pFpB/23832uwhKoQgAAEIAAB9wmQgLrPFIkQaJjAd8Z/2LCMcgL+a+pemUnVvqZoOXkchwAEIAABCNRKgAS0VmLUh4DHBJ5eeF764oOeaUnkkvLDyR97Jh/BEIAABCAAgWoESECrEeI8BHwm8B+TP/Jco0pA2R3Jc8wogAAEIACBMgRIQMuA4TAEgiAwm5qX+2d/7rnqY8lJeWTuCc/1oAACEIAABCBQigAJaCkqHINAQAR+NH2fpHNpX7TTDe8LZpRAAAIQgEAJAiSgJaBwCAJBEfjR1H2+qX50/ilRLaEUCEAAAhCAgN8ESED9Jo4+CJQh0Bvtk0Oxo2XOun84Jzn58fT97gtGIgQgAAEIQKAKARLQKoA4DQG/CNw1/TO/VK3o8bPFdUUpbyAAAQhAIPQESEBDfwsAQAcCuVxOfjLzgO+mqOWe9i8f9l0v
<p>This is because each density is computed independently, and the
estimated <code>x</code>s don’t line up. We can resolve that issue by
computing the range of the data once in <code>setup_params()</code>.</p>
<div class="sourceCode" id="cb14"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb14-1"><a href="#cb14-1" tabindex="-1"></a>StatDensityCommon <span class="ot">&lt;-</span> <span class="fu">ggproto</span>(<span class="st">&quot;StatDensityCommon&quot;</span>, Stat, </span>
<span id="cb14-2"><a href="#cb14-2" tabindex="-1"></a> <span class="at">required_aes =</span> <span class="st">&quot;x&quot;</span>,</span>
<span id="cb14-3"><a href="#cb14-3" tabindex="-1"></a> <span class="at">default_aes =</span> <span class="fu">aes</span>(<span class="at">y =</span> <span class="fu">after_stat</span>(density)),</span>
<span id="cb14-4"><a href="#cb14-4" tabindex="-1"></a></span>
<span id="cb14-5"><a href="#cb14-5" tabindex="-1"></a> <span class="at">setup_params =</span> <span class="cf">function</span>(data, params) {</span>
<span id="cb14-6"><a href="#cb14-6" tabindex="-1"></a> min <span class="ot">&lt;-</span> <span class="fu">min</span>(data<span class="sc">$</span>x) <span class="sc">-</span> <span class="dv">3</span> <span class="sc">*</span> params<span class="sc">$</span>bandwidth</span>
<span id="cb14-7"><a href="#cb14-7" tabindex="-1"></a> max <span class="ot">&lt;-</span> <span class="fu">max</span>(data<span class="sc">$</span>x) <span class="sc">+</span> <span class="dv">3</span> <span class="sc">*</span> params<span class="sc">$</span>bandwidth</span>
<span id="cb14-8"><a href="#cb14-8" tabindex="-1"></a> </span>
<span id="cb14-9"><a href="#cb14-9" tabindex="-1"></a> <span class="fu">list</span>(</span>
<span id="cb14-10"><a href="#cb14-10" tabindex="-1"></a> <span class="at">bandwidth =</span> params<span class="sc">$</span>bandwidth,</span>
<span id="cb14-11"><a href="#cb14-11" tabindex="-1"></a> <span class="at">min =</span> min,</span>
<span id="cb14-12"><a href="#cb14-12" tabindex="-1"></a> <span class="at">max =</span> max,</span>
<span id="cb14-13"><a href="#cb14-13" tabindex="-1"></a> <span class="at">na.rm =</span> params<span class="sc">$</span>na.rm</span>
<span id="cb14-14"><a href="#cb14-14" tabindex="-1"></a> )</span>
<span id="cb14-15"><a href="#cb14-15" tabindex="-1"></a> },</span>
<span id="cb14-16"><a href="#cb14-16" tabindex="-1"></a> </span>
<span id="cb14-17"><a href="#cb14-17" tabindex="-1"></a> <span class="at">compute_group =</span> <span class="cf">function</span>(data, scales, min, max, <span class="at">bandwidth =</span> <span class="dv">1</span>) {</span>
<span id="cb14-18"><a href="#cb14-18" tabindex="-1"></a> d <span class="ot">&lt;-</span> <span class="fu">density</span>(data<span class="sc">$</span>x, <span class="at">bw =</span> bandwidth, <span class="at">from =</span> min, <span class="at">to =</span> max)</span>
<span id="cb14-19"><a href="#cb14-19" tabindex="-1"></a> <span class="fu">data.frame</span>(<span class="at">x =</span> d<span class="sc">$</span>x, <span class="at">density =</span> d<span class="sc">$</span>y)</span>
<span id="cb14-20"><a href="#cb14-20" tabindex="-1"></a> } </span>
<span id="cb14-21"><a href="#cb14-21" tabindex="-1"></a>)</span>
<span id="cb14-22"><a href="#cb14-22" tabindex="-1"></a></span>
<span id="cb14-23"><a href="#cb14-23" tabindex="-1"></a><span class="fu">ggplot</span>(mpg, <span class="fu">aes</span>(displ, <span class="at">fill =</span> drv)) <span class="sc">+</span> </span>
<span id="cb14-24"><a href="#cb14-24" tabindex="-1"></a> <span class="fu">stat_density_common</span>(<span class="at">bandwidth =</span> <span class="dv">1</span>, <span class="at">geom =</span> <span class="st">&quot;area&quot;</span>, <span class="at">position =</span> <span class="st">&quot;stack&quot;</span>)</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7L0HlB3Vlai9q+7t3K0sFAiSEAgJoUCSiMZgwDCyAXsGnA3Y8u8Hy89pBpye8dgP/2YYz9iD7WEGe9nMj02wjQUYJJMkUEBCCCSEhFBuhc45h5v+Old0q1sdbqpc39HS6rpV5+yz97frVu17opYwkpAgAAEIQAACEIAABCBgEwHdpnqoBgIQgAAEIAABCEAAAkkCBKDcCBCAAAQgAAEIQAACthIgALUVN5VBAAIQgAAEIAABCBCAcg9AAAIQgAAEIAABCNhKgADUVtxUBgEIQAACEIAABCBAAMo9AAEIQAACEIAABCBgK4GwrbWZXFlnZ6d0d3ebLDU9cbqui6ZpEovF0ivgoVx5eXlJ23p7ez2kdXqqhkIhUSuPxePx9Ap4KFd+fn7Stkgk4iGt01M1HA4nv2t+XDWuoKAgaVs0Gk0PhodyqWeJH+9H5YLCwsKkbX58B6hniR+f/+qdrb5vyjYr3wGqjpKSEg99U51R1dMBqHqw9fT0OEJOfUHVS9Gp+q00uri4OBmAtrW1WVmNI7KLioqSDx4/+q2srCz5Qmxvb3eErZWVqkBGBWh+DNLGjRsnHR0dvnyWqCBN2ea3Hw4qkJkwYYI0Nzf70m/qHeDH5796Z48fP166urosDbBVQwcpNQG64FMzIgcEIAABCEAAAhCAgIkECEBNhIkoCEAAAhCAAAQgAIHUBAhAUzMiBwQgAAEIQAACEICAiQQIQE2EiSgIQAACEIAABCAAgdQECEBTMyIHBCAAAQhAAAIQgICJBAhATYSJKAhAAAIQgAAEIACB1AQIQFMzIgcEIAABCEAAAhCAgIkECEBNhIkoCEAAAhCAAAQgAIHUBAhAUzMiBwQgAAEIQAACEICAiQQIQE2EiSgIQAACEIAABCAAgdQECEBTMyIHBCAAAQhAAAIQgICJBAhATYSJKAhAAAIQgAAEIACB1AQIQFMzIgcEIAABCEAAAhCAgIkECEBNhIkoCEAAAhCAAAQgAIHUBAhAUzMiBwQgAAEIQAACEICAiQQIQE2EiSgIQAACEIAABCAAgdQECEBTMyIHBCAAAQhAAAIQgICJBAhATYSJKAhAAAIQgAAEIACB1AQIQFMzIgcEIAABCEAAAhCAgIkECEBNhIkoCEAAAhCAAAQgAIHUBAhAUzMiBwQgAAEIQAACEICAiQQIQE2EiSgIQAACEIAABCAAgdQECEBTMyIHBCAAAQhAAAIQgICJBAhATYSJKAhAAAIQgAAEIACB1AQIQFMzIgcEIAABCEAAAhCAgIkECEBNhIkoCEAAAhCAAAQgAIHUBMKps5ADAhCAgIcJxOOitTSL3tIiWkeHSE+PaLGYJHTj93d+niRKyyQ+bpwkxo4TUedIEIAABCBgOQECUMsRUwEEIGAbASOw1CsrJHSoXEJHjxjHlaLX14lmBKGpUiIvT2InnyyxGbMkNnee8XcmAWkqaFyHAAQgkCUBAtAswVEMAhBwBwHVuhne9a6Ed78nof37RevtyUoxLRKRcHl58r+8ukbiZWUSOf8CiVx0iSTGjc9KJoUgAAEIQGB4AgSgw3PhLAQg4GICmtGdHn57q+RtfzvZ0mmFqnpbmxS8skby174q0cXnSc+1HyYQtQI0MiEAgUASsC0Ara+vlzfffFNmzpwpZ5111oiwd+7cKUePHpUlS5bI+PG0OowIigsQCBqBaFTC24ygc8tmo6Vzn2iJhC0EVPd93ltbJLx9m/RecaX0XvkhkbBtj05bbKQSCEAAAnYTsGXE/datW+X222+XPXv2yN133y0rVqwY1s7/+q//kgceeEAOHz4sy5cvTwasw2bkJAQgEBgCWmOjyIonpfBH90jR43+Q8L69tgWfAyFrRgBc8PKLUvyLn4teVTnwEscQgAAEIJAhAVt+xv/85z+Xe++9VxYtWiS33HJLMrhctmyZ5Ofn96tbaUwWePnll+V3v/udlJaWyvnnny/vvvtu8m9/Jg4gAIHAENCNiUSq+zv87g5HAs6RQIdqqqX4Vw9Iz40fl8iFS0bKxnkIQAACEBiFgOUBaNRoNVBd6gsXLkyqMWXKFCkuLpaKigqZNWtWv2qqe37BggVSV1cn69evl0svvVTOO++8/uvqYL8xwUAFsn3p4x//uFx77bV9H239q2maqP+FhYW21mtHZWGje1HZNmHCBDuqs7UO/f1ldkpKSmyt147KQqGQsYqQ7nm/xXfukPjKZyWxd48d2LKqQ7WGFj75RylWyzv9wy2i5bB8k/quFRUVDfpBnpVSLiykniV+HkqlniPKd35Lym9+fP6r75pKZcYEw4SFQ3gixoRGUmoClgegtbW1or6kfY5XKo0dO1YajW61gQGoCjzLjRmo9913n8yZM0ceeuihZHf9RRdd1G+FerkODPjUC9fKm6i/4mEO+uxxqv5hVDL1lLIL20xFaoswL/st/u5OiT9jDM85eNAWVmZUEn/pBUk0NYr+xS+JFsr+ceplv43G0a929dnsZ/uUbX5OfrfPC77L/omZ
<div class="sourceCode" id="cb15"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb15-1"><a href="#cb15-1" tabindex="-1"></a><span class="fu">ggplot</span>(mpg, <span class="fu">aes</span>(displ, drv, <span class="at">fill =</span> <span class="fu">after_stat</span>(density))) <span class="sc">+</span> </span>
<span id="cb15-2"><a href="#cb15-2" tabindex="-1"></a> <span class="fu">stat_density_common</span>(<span class="at">bandwidth =</span> <span class="dv">1</span>, <span class="at">geom =</span> <span class="st">&quot;raster&quot;</span>)</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7d0JnCRlfTjud2bvAxaWGxQhXIJR8l/xSCARFASEqInBAwH1g4oXGjV45FAxKocICmhEAaN4okY0KN749z7RiIKIKCiwq+KyyLG77O70r97qY7pnZ2dqaqqqe6ae0qGr3nrP5+3p/U5dPdRIlmAhQIAAAQIECBAgUJHAcEXtaIYAAQIECBAgQIBAKiAA9UYgQIAAAQIECBCoVEAAWim3xggQIECAAAECBASg3gMECBAgQIAAAQKVCghAK+XWGAECBAgQIECAgADUe4AAAQIECBAgQKBSgbmVtjaFxlavXj2F3MVmnTdvXtiwYUOxlQ5IbQsXLgz3339/GBkZGZAeFdeN+fPnp2MrrsbBqGnOnDkhvifXrVs3GB0qsBfDw8NhaGgobNq0qcBaB6Oq+H6MT7mbjZ8l8f24cePGdHyDoV1cL3xGFmdZVU1VfUbGdpYtW1bVsGZ9OwMbgK5fv75v+AsWLEg/XGfbP4rxH/vly5engUw/fcua2MWLF4e77767rOr7Vu+SJUvCokWLwl133dW3PpTVcAzSYjAzG9+PS5cuTQPre+65pyy+vtUbPyNjYO0zsm9TkKvh2foZGcdVxWfk3LkDGzLlej/0u5BT8P2eAe0TIECAAAECBGomIACt2YQbLgECBAgQIECg3wIC0H7PgPYJECBAgAABAjUTEIDWbMINlwABAgQIECDQbwEBaL9nQPsECBAgQIAAgZoJCEBrNuGGS4AAAQIECBDot4AAtN8zoH0CBAgQIECAQM0EBKA1m3DDJUCAAAECBAj0W0AA2u8Z0D4BAgQIECBAoGYCAtCaTbjhEiBAgAABAgT6LSAA7fcMaJ8AAQIECBAgUDMBAWjNJtxwCRAgQIAAAQL9FhCA9nsGtE+AAAECBAgQqJmAALRmE264BAgQIECAAIF+CwhA+z0D2idAgAABAgQI1ExAAFqzCTdcAgQIECBAgEC/BQSg/Z4B7RMgQIAAAQIEaiYwt2bj7Qz3rj/fE266+bed7e6VJUuWhLVr14aRkZHu5Bm/PjQ0FJYvXxn+/Oc/hw0bNsz48YwdwFZbbRXuvvvusckZtocy5JlqljF1jtkcrW38HWlqa9fChYvC4sWLw+rVq0eLddaSTONWMZqYTHuyjG43iybbPUmjG/F9Mrp05+tKT/KMbrXW0pd2avLaSR5dTxPT9ObOuXPnhXnz5oZ169Y1+9i1r52301KnX7G+Zvlm9uZ6O3/7tVNutCPNNuLgOuVjXWlC/E9z6eyLm+39rfU0R3dazJFWkO7pXt06+R2LnyH33NPc1dzXlbeVPP5LYzS5azWEro2e1Z6NpGx7O3lNVxudlNBo74tNNPd39nb2dZVrlW/nja9LlmwKa+9bGzaNbGr2My3XqrdVR1pnp2wzW7PtZr5mtrie/DSTOuuj/Ynl2jvH5Ev3dKe18qbZm2VG24j74tJMb790tps707fFtrf/qeszspW/tT996aq/O3l0vbeNcWpoZR1nz2ZJmyWMNpNjrfczsti6c3SnsCILFy4MO++0Y1i+bGlhdaqofIHaBqA/vva68KLT/rN8YS1MQyDrP9abNzFacnStJ1dPcs/GaLY0ebx9SVpPcms7+TzvJHeCpVhdc38nUEkztXJ28rVLtvPGYqN50rLpZvxPq6Z0f8zfTEsbT9aH4r8rMa2VngaU3dtpf5J8w/EESPKa7kvWe/IPt9JjPV3rob3efo3lY9nkZ7i9nrwm+WJ9cV/aTqeNuB3T53Tqbe6P9bXrSPbF8kn/Yt+a6XPS13R7TvKx1S7faTPZ38of+zI0J+Zv9z32pV1fXG+3n7xGg5g//enK36m3nZa8plax37F8TG+nxTqS3fE/7bQkKTTWpGOIe9Klta9ns73Rem3Fbr2p7cT4B3EyuY307+JkktP0+BpXY2KyL6alP5s66820ZHukua/RSILGJE9aJn1t5U3q79kXt0c2hsampO6kTMzfiH1IX5tl0jrStFh/e1+znva+Rki2NyVtJ68hCVib7TbrSuuM/Un61k5PovZkPfa1lSeWa/c3baOdd4LXGBinZVrtxvqaUK12YtnYRvIa01v7Rss098XtOK3NvEm2dr7WayyZpqXbca1VLk1u7W2+jOaL++KS9ildaVYRS6d5OwW68iSr6Xsslotl4tJZaa12bTczNP/baac7Ma6Pk3+cpO584+4eW+0Wt6dXeovVtnb89SP+v3DJO944WTb7B0ggfkxaCBAgQIAAAQIECFQmIACtjFpDBAgQIECAAAECUUAA6n1AgAABAgQIECBQqYAAtFJujREgQIAAAQIECAhAvQcIECBAgAABAgQqFRCAVsqtMQIECBAgQIAAAQGo9wABAgQIECBAgEClAgLQSrk1RoAAAQIECBAgIAD1HiBAgAABAgQIEKhUQABaKbfGCBAgQIAAAQIEBKDeAwQIECBAgAABApUKCEAr5dYYAQIECBAgQICAANR7gAABAgQIECBAoFIBAWil3BojQIAAAQIECBAQgHoP
</div>
<div id="exercises" class="section level3">
<h3>Exercises</h3>
<ol style="list-style-type: decimal">
<li><p>Extend <code>stat_chull</code> to compute the alpha hull, as from
the <a href="https://cran.r-project.org/package=alphahull">alphahull</a>
package. Your new stat should take an <code>alpha</code>
argument.</p></li>
<li><p>Modify the final version of <code>StatDensityCommon</code> to
allow the user to specify the <code>min</code> and <code>max</code>
parameters. You’ll need to modify both the layer function and the
<code>compute_group()</code> method.</p>
<p>Note: be careful when adding parameters to a layer function. The
following names <em>col</em>, <em>color</em>, <em>pch</em>,
<em>cex</em>, <em>lty</em>, <em>lwd</em>, <em>srt</em>, <em>adj</em>,
<em>bg</em>, <em>fg</em>, <em>min</em>, and <em>max</em> are
intentionally renamed to accommodate base graphical parameter names. For
example, a value passed as <em>min</em> to a layer appears as
<em>ymin</em> in the <code>setup_params</code> list of params. It is
recommended you avoid using these names for layer parameters.</p></li>
<li><p>Compare and contrast <code>StatLm</code> to
<code>ggplot2::StatSmooth</code>. What key differences make
<code>StatSmooth</code> more complex than <code>StatLm</code>?</p></li>
</ol>
</div>
</div>
<div id="creating-a-new-geom" class="section level2">
<h2>Creating a new geom</h2>
<p>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 buying <a href="https://www.amazon.com/dp/B00I60M26G/ref=cm_sw_su_dp">R
graphics</a> by Paul Murrell. It tells you everything you need to know
about drawing with grid.</p>
<div id="a-simple-geom" class="section level3">
<h3>A simple geom</h3>
<p>It’s easiest to start with a simple example. The code below is a
simplified version of <code>geom_point()</code>:</p>
<div class="sourceCode" id="cb16"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb16-1"><a href="#cb16-1" tabindex="-1"></a>GeomSimplePoint <span class="ot">&lt;-</span> <span class="fu">ggproto</span>(<span class="st">&quot;GeomSimplePoint&quot;</span>, Geom,</span>
<span id="cb16-2"><a href="#cb16-2" tabindex="-1"></a> <span class="at">required_aes =</span> <span class="fu">c</span>(<span class="st">&quot;x&quot;</span>, <span class="st">&quot;y&quot;</span>),</span>
<span id="cb16-3"><a href="#cb16-3" tabindex="-1"></a> <span class="at">default_aes =</span> <span class="fu">aes</span>(<span class="at">shape =</span> <span class="dv">19</span>, <span class="at">colour =</span> <span class="st">&quot;black&quot;</span>),</span>
<span id="cb16-4"><a href="#cb16-4" tabindex="-1"></a> <span class="at">draw_key =</span> draw_key_point,</span>
<span id="cb16-5"><a href="#cb16-5" tabindex="-1"></a></span>
<span id="cb16-6"><a href="#cb16-6" tabindex="-1"></a> <span class="at">draw_panel =</span> <span class="cf">function</span>(data, panel_params, coord) {</span>
<span id="cb16-7"><a href="#cb16-7" tabindex="-1"></a> coords <span class="ot">&lt;-</span> coord<span class="sc">$</span><span class="fu">transform</span>(data, panel_params)</span>
<span id="cb16-8"><a href="#cb16-8" tabindex="-1"></a> grid<span class="sc">::</span><span class="fu">pointsGrob</span>(</span>
<span id="cb16-9"><a href="#cb16-9" tabindex="-1"></a> coords<span class="sc">$</span>x, coords<span class="sc">$</span>y,</span>
<span id="cb16-10"><a href="#cb16-10" tabindex="-1"></a> <span class="at">pch =</span> coords<span class="sc">$</span>shape,</span>
<span id="cb16-11"><a href="#cb16-11" tabindex="-1"></a> <span class="at">gp =</span> grid<span class="sc">::</span><span class="fu">gpar</span>(<span class="at">col =</span> coords<span class="sc">$</span>colour)</span>
<span id="cb16-12"><a href="#cb16-12" tabindex="-1"></a> )</span>
<span id="cb16-13"><a href="#cb16-13" tabindex="-1"></a> }</span>
<span id="cb16-14"><a href="#cb16-14" tabindex="-1"></a>)</span>
<span id="cb16-15"><a href="#cb16-15" tabindex="-1"></a></span>
<span id="cb16-16"><a href="#cb16-16" tabindex="-1"></a>geom_simple_point <span class="ot">&lt;-</span> <span class="cf">function</span>(<span class="at">mapping =</span> <span class="cn">NULL</span>, <span class="at">data =</span> <span class="cn">NULL</span>, <span class="at">stat =</span> <span class="st">&quot;identity&quot;</span>,</span>
<span id="cb16-17"><a href="#cb16-17" tabindex="-1"></a> <span class="at">position =</span> <span class="st">&quot;identity&quot;</span>, <span class="at">na.rm =</span> <span class="cn">FALSE</span>, <span class="at">show.legend =</span> <span class="cn">NA</span>, </span>
<span id="cb16-18"><a href="#cb16-18" tabindex="-1"></a> <span class="at">inherit.aes =</span> <span class="cn">TRUE</span>, ...) {</span>
<span id="cb16-19"><a href="#cb16-19" tabindex="-1"></a> <span class="fu">layer</span>(</span>
<span id="cb16-20"><a href="#cb16-20" tabindex="-1"></a> <span class="at">geom =</span> GeomSimplePoint, <span class="at">mapping =</span> mapping, <span class="at">data =</span> data, <span class="at">stat =</span> stat, </span>
<span id="cb16-21"><a href="#cb16-21" tabindex="-1"></a> <span class="at">position =</span> position, <span class="at">show.legend =</span> show.legend, <span class="at">inherit.aes =</span> inherit.aes,</span>
<span id="cb16-22"><a href="#cb16-22" tabindex="-1"></a> <span class="at">params =</span> <span class="fu">list</span>(<span class="at">na.rm =</span> na.rm, ...)</span>
<span id="cb16-23"><a href="#cb16-23" tabindex="-1"></a> )</span>
<span id="cb16-24"><a href="#cb16-24" tabindex="-1"></a>}</span>
<span id="cb16-25"><a href="#cb16-25" tabindex="-1"></a></span>
<span id="cb16-26"><a href="#cb16-26" tabindex="-1"></a><span class="fu">ggplot</span>(mpg, <span class="fu">aes</span>(displ, hwy)) <span class="sc">+</span> </span>
<span id="cb16-27"><a href="#cb16-27" tabindex="-1"></a> <span class="fu">geom_simple_point</span>()</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7J0HuNTUuoaXUpQqAoqgCCJiOVhRLKBgBwUVEXsvYMHCUSyoWLBhQxHvUVQ8duyCYEFRFDsoKogFpFlBaSKgIHj5cs2+s2fPJCuZyUwm+/2fB/ZMsrLKuzLJl5W1/n+tv9eYwSAAAQhAAAIQgAAEIFAgAmsXqByKgQAEIAABCEAAAhCAgEMAAcqJAAEIQAACEIAABCBQUAII0ILipjAIQAACEIAABCAAAQQo5wAEIAABCEAAAhCAQEEJIEALipvCIAABCEAAAhCAAAQQoJwDEIAABCAAAQhAAAIFJVC1oKXlobDFixebVatW5ZRTlSpVjLxPrV69Oqd84nJw1apVjdr0559/xqVKOdejevXqZsWKFTnnE5cM1l13Xac9STrn9DtMihe3atWqmbXWWitR55zatHLlyrj8BHKqh/pmnXXW4TeUE8VoD+Y3FC3fXHN3f0PSCYW6bus+Xrt27axVLzkBKlHy119/ZW2QzY6aNWs64jMpgk2drIvzb7/9ZtP8kkijPlqyZElJ1NWvkmuvvbapX7++84CQlHNONxsJ0KQIHD0gqE1JOed0Tuo39Pvvv/udniWxXw/Y66+/vlm+fHliHhJ0zf7jjz9yHlCJSwfqfJPIScpvSNdtXReS8hvS9U19tGzZsthct3kFH5dfL/WAAAQgAAEIQAAClYQAArSSdDTNhAAEIAABCEAAAnEhgACNS09QDwhAAAIQgAAEIFBJCCBAK0lH00wIQAACEIAABCAQFwII0Lj0BPWAAAQgAAEIQAAClYQAArSSdDTNhAAEIAABCEAAAnEhgACNS09QDwhAAAIQgAAEIFBJCCBAK0lH00wIQAACEIAABCAQFwIl54heTtf1LxfT8YpII+fGSTA5mJXTXDmZTYqpb5LSHjlnlsnxtPopCaZzTu3S3ySYoonxG4pvT7q/GzkGV18lwdSOGjVqJCYin67ZuiYk6bqtPkpKe1y94wbdiMNvqOR+yfkI/6eTSvnkGlEpDh2oOkhMK7RWUtqjNiWpPa4ATdI5J+GZpPboNySRk6TfkNqUlPa4AjRp55z6R/2UBHPDOyblnNN1O0m/IfccU//od1QIc0VvtrJKUoDmeoK7AjQpscY1sqYff1Lao5NVP/yktMe9eeq8TUqb9BZBYTiTEopTI1FJ+w0lqT3ujUznW1J+QxqJUnsKJQayiYB8bdc1W6ItKf2j63aS7kOpDwiFum5Lm3hZMt4HerWQfRCAAAQgAAEIQAACsSKAAI1Vd1AZCEAAAhCAAAQgkHwCCNDk9zEthAAEIAABCEAAArEigACNVXdQGQhAAAIQgAAEIJB8AgjQ5PcxLYQABCAAAQhAAAKxIoAAjVV3UBkIQAACEIAABCCQfAII0OT3MS2EAAQgAAEIQAACsSKAAI1Vd1AZCEAAAhCAAAQgkHwCCNDk9zEthAAEIAABCEAAArEigACNVXcY89lnn5nDDjvMNG/e3Gy88camadOmZpdddjEPPvhgzGpKdSAAAQhAAAIQgEA4AgjQcNwiOerGG280nTt3Nh999JETzkyhsxSm7YcffjCXX365ad26dWLiBkcCkEwhAAEIQAACECgJAgjQmHTTCy+8YO666y7P2ixYsMBss802RjHFMQhAAAIQgAAEIFCqBBCgMei5mTNnmrPPPtuqJr/99pvp1auXVVoSQQACEIAABCAAgTgSQIDGoFeuu+66QLV49dVXGQUNRIzEEIAABCAAAQjEiQACNAa98f777weqxerVq82nn34a6BgSQwACEIAABCAAgbgQQIDGoCeWLVsWuBbTp08PfAwHQAACEIAABCAAgTgQQIDGoBeqV68euBZy0YRBAAIQgAAEIACBUiSAAI1Br22//faBa9GuXbvAx3AABCAAAQhAAAIQiAMBBGgMeuHSSy8NVIsdd9zRrL02XRcIGokhAAEIQAACEIgNAVRMDLqiTZs2pn379tY1eeihh6zTkhACEIAABCAAAQjEjQACNCY98tRTTxkJUS+rUqWKmTBhgmnYsKFXMvZBAAIQgAAEIACBWBNAgMaoe1588UVzxRVXmFq1apWrlV6377XXXmbSpElOfPhyO/kCAQhAAAIQgAAESoxA1RKrb+Krq4hI+ifXTDNmzHAE5/rrr5/4dtNACEAAAhCAAAQqDwEEaEz7umbNmqZ169YxrR3VggAEIAABCEAAAuEJ8Ao+PDuOhAAEIAABCEAAAhAIQQABGgIah0AAAhCAAAQgAAEIhCeAAA3PjiMhAAEIQAACEIAABEIQQICGgMYhEIAABCAAAQhAAALhCSBAw7PjSAhAAAIQgAAEIACBEAQQoCGgcQgEIAABCEAAAhCAQHgCCNDw7DgSAhCAAAQgAAEIQCAEAQRoCGgcAgEIQAACEIAABCAQngACNDw7joQABCAAAQhAAAIQCEEAARoCGodAAAIQgAAEIAABCIQngAANz44jIQABCEAAAhCAAARCEECAhoDGIRCAAAQgAAEIQAAC4QkgQMOz40gIQAAC
<p>This is very similar to defining a new stat. You always need to
provide fields/methods for the four pieces shown above:</p>
<ul>
<li><p><code>required_aes</code> is a character vector which lists all
the aesthetics that the user must provide.</p></li>
<li><p><code>default_aes</code> lists the aesthetics that have default
values.</p></li>
<li><p><code>draw_key</code> provides the function used to draw the key
in the legend. You can see a list of all the build in key functions in
<code>?draw_key</code></p></li>
<li><p><code>draw_panel()</code> 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.</p></li>
</ul>
<p><code>draw_panel()</code> has three arguments:</p>
<ul>
<li><p><code>data</code>: a data frame with one column for each
aesthetic.</p></li>
<li><p><code>panel_params</code>: 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 to <code>coord</code>
methods.</p></li>
<li><p><code>coord</code>: an object describing the coordinate
system.</p></li>
</ul>
<p>You need to use <code>panel_params</code> and <code>coord</code>
together to transform the data
<code>coords &lt;- coord$transform(data, panel_params)</code>. 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.)</p>
</div>
<div id="collective-geoms" class="section level3">
<h3>Collective geoms</h3>
<p>Overriding <code>draw_panel()</code> 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 override
<code>draw_group()</code>.</p>
<p>The following code makes a simplified version of
<code>GeomPolygon</code>:</p>
<div class="sourceCode" id="cb17"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb17-1"><a href="#cb17-1" tabindex="-1"></a>GeomSimplePolygon <span class="ot">&lt;-</span> <span class="fu">ggproto</span>(<span class="st">&quot;GeomPolygon&quot;</span>, Geom,</span>
<span id="cb17-2"><a href="#cb17-2" tabindex="-1"></a> <span class="at">required_aes =</span> <span class="fu">c</span>(<span class="st">&quot;x&quot;</span>, <span class="st">&quot;y&quot;</span>),</span>
<span id="cb17-3"><a href="#cb17-3" tabindex="-1"></a> </span>
<span id="cb17-4"><a href="#cb17-4" tabindex="-1"></a> <span class="at">default_aes =</span> <span class="fu">aes</span>(</span>
<span id="cb17-5"><a href="#cb17-5" tabindex="-1"></a> <span class="at">colour =</span> <span class="cn">NA</span>, <span class="at">fill =</span> <span class="st">&quot;grey20&quot;</span>, <span class="at">linewidth =</span> <span class="fl">0.5</span>,</span>
<span id="cb17-6"><a href="#cb17-6" tabindex="-1"></a> <span class="at">linetype =</span> <span class="dv">1</span>, <span class="at">alpha =</span> <span class="dv">1</span></span>
<span id="cb17-7"><a href="#cb17-7" tabindex="-1"></a> ),</span>
<span id="cb17-8"><a href="#cb17-8" tabindex="-1"></a></span>
<span id="cb17-9"><a href="#cb17-9" tabindex="-1"></a> <span class="at">draw_key =</span> draw_key_polygon,</span>
<span id="cb17-10"><a href="#cb17-10" tabindex="-1"></a></span>
<span id="cb17-11"><a href="#cb17-11" tabindex="-1"></a> <span class="at">draw_group =</span> <span class="cf">function</span>(data, panel_params, coord) {</span>
<span id="cb17-12"><a href="#cb17-12" tabindex="-1"></a> n <span class="ot">&lt;-</span> <span class="fu">nrow</span>(data)</span>
<span id="cb17-13"><a href="#cb17-13" tabindex="-1"></a> <span class="cf">if</span> (n <span class="sc">&lt;=</span> <span class="dv">2</span>) <span class="fu">return</span>(grid<span class="sc">::</span><span class="fu">nullGrob</span>())</span>
<span id="cb17-14"><a href="#cb17-14" tabindex="-1"></a></span>
<span id="cb17-15"><a href="#cb17-15" tabindex="-1"></a> coords <span class="ot">&lt;-</span> coord<span class="sc">$</span><span class="fu">transform</span>(data, panel_params)</span>
<span id="cb17-16"><a href="#cb17-16" tabindex="-1"></a> <span class="co"># A polygon can only have a single colour, fill, etc, so take from first row</span></span>
<span id="cb17-17"><a href="#cb17-17" tabindex="-1"></a> first_row <span class="ot">&lt;-</span> coords[<span class="dv">1</span>, , drop <span class="ot">=</span> <span class="cn">FALSE</span>]</span>
<span id="cb17-18"><a href="#cb17-18" tabindex="-1"></a></span>
<span id="cb17-19"><a href="#cb17-19" tabindex="-1"></a> grid<span class="sc">::</span><span class="fu">polygonGrob</span>(</span>
<span id="cb17-20"><a href="#cb17-20" tabindex="-1"></a> coords<span class="sc">$</span>x, coords<span class="sc">$</span>y, </span>
<span id="cb17-21"><a href="#cb17-21" tabindex="-1"></a> <span class="at">default.units =</span> <span class="st">&quot;native&quot;</span>,</span>
<span id="cb17-22"><a href="#cb17-22" tabindex="-1"></a> <span class="at">gp =</span> grid<span class="sc">::</span><span class="fu">gpar</span>(</span>
<span id="cb17-23"><a href="#cb17-23" tabindex="-1"></a> <span class="at">col =</span> first_row<span class="sc">$</span>colour,</span>
<span id="cb17-24"><a href="#cb17-24" tabindex="-1"></a> <span class="at">fill =</span> scales<span class="sc">::</span><span class="fu">alpha</span>(first_row<span class="sc">$</span>fill, first_row<span class="sc">$</span>alpha),</span>
<span id="cb17-25"><a href="#cb17-25" tabindex="-1"></a> <span class="at">lwd =</span> first_row<span class="sc">$</span>linewidth <span class="sc">*</span> .pt,</span>
<span id="cb17-26"><a href="#cb17-26" tabindex="-1"></a> <span class="at">lty =</span> first_row<span class="sc">$</span>linetype</span>
<span id="cb17-27"><a href="#cb17-27" tabindex="-1"></a> )</span>
<span id="cb17-28"><a href="#cb17-28" tabindex="-1"></a> )</span>
<span id="cb17-29"><a href="#cb17-29" tabindex="-1"></a> }</span>
<span id="cb17-30"><a href="#cb17-30" tabindex="-1"></a>)</span>
<span id="cb17-31"><a href="#cb17-31" tabindex="-1"></a>geom_simple_polygon <span class="ot">&lt;-</span> <span class="cf">function</span>(<span class="at">mapping =</span> <span class="cn">NULL</span>, <span class="at">data =</span> <span class="cn">NULL</span>, <span class="at">stat =</span> <span class="st">&quot;chull&quot;</span>,</span>
<span id="cb17-32"><a href="#cb17-32" tabindex="-1"></a> <span class="at">position =</span> <span class="st">&quot;identity&quot;</span>, <span class="at">na.rm =</span> <span class="cn">FALSE</span>, <span class="at">show.legend =</span> <span class="cn">NA</span>, </span>
<span id="cb17-33"><a href="#cb17-33" tabindex="-1"></a> <span class="at">inherit.aes =</span> <span class="cn">TRUE</span>, ...) {</span>
<span id="cb17-34"><a href="#cb17-34" tabindex="-1"></a> <span class="fu">layer</span>(</span>
<span id="cb17-35"><a href="#cb17-35" tabindex="-1"></a> <span class="at">geom =</span> GeomSimplePolygon, <span class="at">mapping =</span> mapping, <span class="at">data =</span> data, <span class="at">stat =</span> stat, </span>
<span id="cb17-36"><a href="#cb17-36" tabindex="-1"></a> <span class="at">position =</span> position, <span class="at">show.legend =</span> show.legend, <span class="at">inherit.aes =</span> inherit.aes,</span>
<span id="cb17-37"><a href="#cb17-37" tabindex="-1"></a> <span class="at">params =</span> <span class="fu">list</span>(<span class="at">na.rm =</span> na.rm, ...)</span>
<span id="cb17-38"><a href="#cb17-38" tabindex="-1"></a> )</span>
<span id="cb17-39"><a href="#cb17-39" tabindex="-1"></a>}</span>
<span id="cb17-40"><a href="#cb17-40" tabindex="-1"></a></span>
<span id="cb17-41"><a href="#cb17-41" tabindex="-1"></a><span class="fu">ggplot</span>(mpg, <span class="fu">aes</span>(displ, hwy)) <span class="sc">+</span> </span>
<span id="cb17-42"><a href="#cb17-42" tabindex="-1"></a> <span class="fu">geom_point</span>() <span class="sc">+</span> </span>
<span id="cb17-43"><a href="#cb17-43" tabindex="-1"></a> <span class="fu">geom_simple_polygon</span>(<span class="fu">aes</span>(<span class="at">colour =</span> class), <span class="at">fill =</span> <span class="cn">NA</span>)</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7J0HfJvV9fd/2rI85JG9h0MSsid7k0ESdiDs0kJpoaUtUEopLS2lg1FGWX1bKPwLhIY9QhIgkDBTyCaDTGfvxLa8ZEvWeO95HDmyLduSLcmP7N/lE/ToPveee+73PpKO7zjHEFQJTCRAAiRAAiRAAiRAAiSQJALGJLXDZkiABEiABEiABEiABEhAI0ADlA8CCZAACZAACZAACZBAUgnQAE0qbjZGAiRAAiRAAiRAAiRAA5TPAAmQAAmQAAmQAAmQQFIJ0ABNKm42RgIkQAIkQAIkQAIkQAOUzwAJkAAJkAAJkAAJkEBSCZiT2locGispKYHf749ZktVqhdfrjbleMiuYTCZYLBZUVVUls9mY2zIYDBBdfT5fzHWTWUFYiq6pMO7iDS0QCCQTT8xt2Ww2Tcfq6uqY6yazgtls1r4j9O5hzm63Q1i25PssmTxT4bvTaDRC9PR4PND7uKcCT/kMyb9E/BbJb4fT6UzmI8y2dEog5QxQMSZaYvg4HA6UlZXpdBhq1BId5Z8Y2XpOIUNZvuz1nOQHXoxQvY97Wlqa9qOpd56ZmZmaMa93PcVQlh9OPRt28odRbm4uXC6XZjTp+XOUCt+dYtSJnhUVFS36fUgm/1TgKcanfH8m4rdIfj+YSEAIcAmezwEJkAAJkAAJkAAJkEBSCdAATSpuNkYCJEACJEACJEACJEADlM8ACZAACZAACZAACZBAUgnQAE0qbjZGAiRAAiRAAiRAAiRAA5TPAAmQAAmQAAmQAAmQQFIJ0ABNKm42RgIkQAIkQAIkQAIkQAOUzwAJkAAJkAAJkAAJkEBSCdAATSpuNkYCJEACJEACJEACJJByjujF4bD8izWJ81txAKznFOqX3vWUqCPi4F3veoozZdFV73oKS0miq56T6CdM9c4z5ERb7xFxZKzlMy9O6fWcUuG7M+TcXJyn6z2iWCrwDD2Xev+s6/lzQ92aJ5ByBqhEN2nJD4vUaUkEpeYRxq9E6EtU73qGDBG96yk/RKKr3vWUcU+F51N0TBU95XtC74aIfHOIjnp/PlNhzEPfwjLueo6AJXqmAk/5I05SIp5Nvf/BpXWc/0sKgZQ0QFvyoZAver3HBA996PWupxhMMmundz1DIS71rmfIANW7nvLDKT/uetczFWKsh36E5btM7zxT4bsz9GtZXV2dEKMpJD8er6nAU77f5fOeiGczNNESD5aUkdoE9L3ml9psqT0JkAAJkAAJkAAJkEAEAjRAI0BhFgmQAAmQAAmQAAmQQOII0ABNHFtKJgESIAESIAESIAESiECABmgEKMwiARIgARIgARIgARJIHAEaoIljS8kkQAIkQAIkQAIkQAIRCNAAjQCFWSRAAiRAAiRAAiRAAokjQAM0cWwpmQRIgARIgARIgARIIAIBGqARoDCLBEiABEiABEiABEggcQRogCaOLSWTAAmQAAmQAAmQAAlEIEADNAIUZpEACZAACZAACZAACSSOAA3QxLGlZBIgARIgARIgARIggQgEaIBGgMIsEiABEiABEiABEiCBxBGgAZo4tnUkL1myBN/73vdwww03YPfu3XXu8Q0JkAAJkAAJkAAJdCQCNECTMNovvPACZs6ciYULF2LBggU44YQT8OWXXyahZTZBAiRAAiRAAiRAAvojQAM0wWNy4MAB3HPPPVorVrMVRqNJu77mmmvg9XoT3DrFkwAJkAAJkAAJkID+CNAATfCYrFmzBgaDQWvlrz+eiwd+9J52Lcanz+dLcOsUTwIkQAIkQAIkQAL6I0ADNMFj0qdPHwSDQa0Vq3kU0mzTMGnCT7T3NEATDJ/iSYAESIAESIAEdEnArEut2pFSQ4YMwTnnnIPPP12ietUVJuMBTD/xQYw7vTeysrLaUU/ZFRIgARIgARIgARKIjgBnQKPj1KpSL730En552x81GblZP4fVUowRXW9DMNAqsaxMAiRAAiRAAiRAAilJgAZokobtkulXai11HdAZXXN+gKJ9Fmz8OiNJrbMZEiABEiABEiABEtAPARqgSRqL8iK/aimAzvnjkZm9AV17zMWGJRlwHeQuiCQNAZshARIgARIgARLQCQEaoEkaiAoXYDbthtWRi06DrkaG8YfIyPZi6fvZ8PMwfJJGgc2QAAmQAAmQAAnogQAN0CSNQoXLpAzQHTBZncgZcImaDHUhf8QrKC82Y91nPIyUpGFgMyRAAiRAAiRAAjogQAM0SYPgLrPDogxQszJAbRm9kdnjTFQXPYPjTy3D1hUOHN5lTZImbIYESIAESIAESIAE2pYADdAk8a8sz4DZrGZAbU6txbz8WagsXIPeA/+H3O7VWD7fCW9VkpRhMyRAAiRAAiRAAiTQhgRogCYBvrfKoPZ52pT7pV0wmuxai1k9z9aW44u2vYrx013wuE1YOj8tCdqwCRIgARIgARIgARJoWwI0QJPAX/Z/SrKlHaltzWiyIXfg5XDtfB/pTjdGnl2K7Wus2La2tggvSIAESIAESIAESKBdEqABmoRhrSip
<p>There are a few things to note here:</p>
<ul>
<li><p>We override <code>draw_group()</code> instead of
<code>draw_panel()</code> because we want one polygon per group, not one
polygon per row.</p></li>
<li><p>If the data contains two or fewer points, there’s no point trying
to draw a polygon, so we return a <code>nullGrob()</code>. This is the
graphical equivalent of <code>NULL</code>: it’s a grob that doesn’t draw
anything and doesn’t take up any space.</p></li>
<li><p>Note the units: <code>x</code> and <code>y</code> should always
be drawn in “native” units. (The default units for
<code>pointGrob()</code> is a native, so we didn’t need to change it
there). <code>lwd</code> is measured in points, but ggplot2 uses mm, so
we need to multiply it by the adjustment factor
<code>.pt</code>.</p></li>
</ul>
<p>You might want to compare this to the real <code>GeomPolygon</code>.
You’ll see it overrides <code>draw_panel()</code> because it uses some
tricks to make <code>polygonGrob()</code> produce multiple polygons in
one call. This is considerably more complicated, but gives better
performance.</p>
</div>
<div id="inheriting-from-an-existing-geom" class="section level3">
<h3>Inheriting from an existing Geom</h3>
<p>Sometimes you just want to make a small modification to an existing
geom. In this case, rather than inheriting from <code>Geom</code> you
can inherit from an existing subclass. For example, we might want to
change the defaults for <code>GeomPolygon</code> to work better with
<code>StatChull</code>:</p>
<div class="sourceCode" id="cb18"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb18-1"><a href="#cb18-1" tabindex="-1"></a>GeomPolygonHollow <span class="ot">&lt;-</span> <span class="fu">ggproto</span>(<span class="st">&quot;GeomPolygonHollow&quot;</span>, GeomPolygon,</span>
<span id="cb18-2"><a href="#cb18-2" tabindex="-1"></a> <span class="at">default_aes =</span> <span class="fu">aes</span>(<span class="at">colour =</span> <span class="st">&quot;black&quot;</span>, <span class="at">fill =</span> <span class="cn">NA</span>, <span class="at">linewidth =</span> <span class="fl">0.5</span>, <span class="at">linetype =</span> <span class="dv">1</span>,</span>
<span id="cb18-3"><a href="#cb18-3" tabindex="-1"></a> <span class="at">alpha =</span> <span class="cn">NA</span>)</span>
<span id="cb18-4"><a href="#cb18-4" tabindex="-1"></a> )</span>
<span id="cb18-5"><a href="#cb18-5" tabindex="-1"></a>geom_chull <span class="ot">&lt;-</span> <span class="cf">function</span>(<span class="at">mapping =</span> <span class="cn">NULL</span>, <span class="at">data =</span> <span class="cn">NULL</span>, </span>
<span id="cb18-6"><a href="#cb18-6" tabindex="-1"></a> <span class="at">position =</span> <span class="st">&quot;identity&quot;</span>, <span class="at">na.rm =</span> <span class="cn">FALSE</span>, <span class="at">show.legend =</span> <span class="cn">NA</span>, </span>
<span id="cb18-7"><a href="#cb18-7" tabindex="-1"></a> <span class="at">inherit.aes =</span> <span class="cn">TRUE</span>, ...) {</span>
<span id="cb18-8"><a href="#cb18-8" tabindex="-1"></a> <span class="fu">layer</span>(</span>
<span id="cb18-9"><a href="#cb18-9" tabindex="-1"></a> <span class="at">stat =</span> StatChull, <span class="at">geom =</span> GeomPolygonHollow, <span class="at">data =</span> data, <span class="at">mapping =</span> mapping,</span>
<span id="cb18-10"><a href="#cb18-10" tabindex="-1"></a> <span class="at">position =</span> position, <span class="at">show.legend =</span> show.legend, <span class="at">inherit.aes =</span> inherit.aes,</span>
<span id="cb18-11"><a href="#cb18-11" tabindex="-1"></a> <span class="at">params =</span> <span class="fu">list</span>(<span class="at">na.rm =</span> na.rm, ...)</span>
<span id="cb18-12"><a href="#cb18-12" tabindex="-1"></a> )</span>
<span id="cb18-13"><a href="#cb18-13" tabindex="-1"></a>}</span>
<span id="cb18-14"><a href="#cb18-14" tabindex="-1"></a></span>
<span id="cb18-15"><a href="#cb18-15" tabindex="-1"></a><span class="fu">ggplot</span>(mpg, <span class="fu">aes</span>(displ, hwy)) <span class="sc">+</span> </span>
<span id="cb18-16"><a href="#cb18-16" tabindex="-1"></a> <span class="fu">geom_point</span>() <span class="sc">+</span> </span>
<span id="cb18-17"><a href="#cb18-17" tabindex="-1"></a> <span class="fu">geom_chull</span>()</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7J0HuBPV1oYXcOgd6YiAIIoKCiIIijSlSUc6ogiCCFykI72DFAER6b2DFKkKUkRUrlyKSBGld6mH3jk/375/uElOkjNJZiaTybefB04yZZd3z0y+WXvvteLFPErCRAIkQAIkQAIkQAIkQAImEYhvUjkshgRIgARIgARIgARIgAQUAQpQXggkQAIkQAIkQAIkQAKmEqAANRU3CyMBEiABEiABEiABEqAA5TVAAiRAAiRAAiRAAiRgKgEKUFNxszASIAESIAESIAESIAEKUF4DJEACJEACJEACJEACphKIMrU0HQq7cuWKPHjwIKicEiRIIPA+9fDhw6DyscrJUVFRgjbduXPHKlUKuh6JEiWSu3fvBp2PVTJIkiSJao+drjnch3bx4pYwYUKJFy+era45tOnevXtWuQWCqgf6JnHixLyHgqJo7Mm8h4zlG2zujnsIOsGs5zZ+x1OkSOG16mEnQCFK7t+/77VBWnYkS5ZMiU+7CDZ0Mh7OV69e1dL8sDgGfXTt2rWwqGtclYwfP76kS5dOvSDY5ZrDjw0EqF0EDl4Q0Ca7XHO4JnEPXb9+Pa7LMyz24wU7bdq0cuvWLdu8JOCZffv27aANKlbpQFxvEDl2uYfw3MZzwS73EJ5v6KObN29a5rnNIXir3L2sBwmQAAmQAAmQAAlECAEK0AjpaDaTBEiABEiABEiABKxCgALUKj3BepAACZAACZAACZBAhBCgAI2QjmYzSYAESIAESIAESMAqBChArdITrAcJkAAJkAAJkAAJRAgBCtAI6Wg2kwRIgARIgARIgASsQoAC1Co9wXqQAAmQAAmQAAmQQIQQoACNkI5mM0mABEiABEiABEjAKgTCzhE9nK7jXzAJ5yMiDZwb2yHBwSyc5sLJrF0S+sYu7YFzZiQ4nkY/2SHhmkO78NcOCdHEeA9Ztycd9w0cg6Ov7JDQjqRJk9omIh+e2Xgm2Om5jT6yS3scescRdMMK91DY3cl6hP/DRYV8go2oZIUORB0gphFayy7tQZvs1B6HALXTNQfhaaf24B6CyLHTPYQ22aU9DgFqt2sO/YN+skNyhHe0yzWH57ad7iHHNYb+wX1kRnKIXm9lhaUADfYCdwhQu8Qah2UNN79d2oOLFTe+Xdrj+PHEdWuXNmEUAWE47RKKE5You91DdmqP44cM15td7iFYotAes8SANxGg13Y8syHa7NI/eG7b6XfI+QXBrOc2tImvZI/xQF8t5D4SIAESIAESIAESIAFLEaAAtVR3sDIkQAIkQAIkQAIkYH8CFKD272O2kARIgARIgARIgAQsRYAC1FLdwcqQAAmQAAmQAAmQgP0JUIDav4/ZQhIgARIgARIgARKwFAEKUEt1BytDAiRAAiRAAiRAAvYnQAFq/z5mC0mABEiABEiABEjAUgQoQC3VHawMCZAACZAACZAACdifAAWo/fuYLSQBEiABEiABEiABSxGgALVUd7AyJEACJEACJEACJGB/AhSg9u9jtpAESIAESIAESIAELEWAAtRS3cHKkAAJkAAJkAAJkID9CVCAWrSPp02bJrVr15bmzZvL3bt3LVpLVosESIAESIAESIAE/CcQ5f8pPMNoAnXq1JEtW7Y8LmblypWya9cuyZgx4+Nt/EACJEACJEACJEAC4UqAFlCL9dzixYtdxKejetWqVXN85F8SIAESIAESIAESCGsCFKAW675ff/3VY41OnTrlcTs3kgAJkAAJkAAJkEC4EaAAtViPZcuWzWON4sWL53E7N5IACZAACZAACZBAuBGgALVYj7Vr105SpkwZq1b37t1Ti5JOnDgRax83kAAJkAAJkAAJkEA4EaAAtWBvHThwQHLlyqVqljlzZlmyZInMmDFDDh48KKVKlZJ58+ZJTEyMBWvOKpEACZAACZAACZBA3AQoQONmFJIjXnzxRSlUqJDs2LFDXnvtNXn77bdl06ZN6m+HDh3k3XfflePHj4ekbiyUBEiABEiABEiABIIhQAEaDD0Dz/3777/lmWeecSkhderUMn78eJk1a5YcOXJESpcuLXPmzKE11IUSv5AACZAACZAACVidAAWoBXsIw+tHjx6NJUAdVS1btqyyhpYvX146deokFStWlEOHDjl28y8JkAAJkAAJkAAJWJoABagFuwfWzdu3b0vevHm91i5VqlTy9ddfKwsoji9YsKDMnj2b1lCvxLiDBEiABEiABEjAKgQoQK3SE071wPA7kvsQvNMhjz9iGH7btm1SvXp16dy5s9SsWVMNzz8+gB9IgARIgARIgARIwGIEKEAt1iGoDgRowoQJ5cknn9RUO1hDZ86cKXPnzhW4acIQPb4/fPhQ0/k8iARIgARIgARIgATMJEABaiZtjWU5FiAlSJBA4xn/PQwumjZu3CjvvPOOdO3aVWrUqCGHDx/2Kw8eTAIkQAIkQAIkQAJGE6AANZpwAPk7BGgApyon9mPGjFG+Qk+fPi1vvfWWTJ8+ndbQQGDyHBIgARIgARIgAUMIUIAagjW4
<p>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.</p>
</div>
<div id="exercises-1" class="section level3">
<h3>Exercises</h3>
<ol style="list-style-type: decimal">
<li><p>Compare and contrast <code>GeomPoint</code> with
<code>GeomSimplePoint</code>.</p></li>
<li><p>Compare and contrast <code>GeomPolygon</code> with
<code>GeomSimplePolygon</code>.</p></li>
</ol>
</div>
</div>
<div id="geoms-and-stats-with-multiple-orientation" class="section level2">
<h2>Geoms and Stats with multiple orientation</h2>
<p>Some layers have a specific orientation. <code>geom_bar()</code>
e.g. have the bars along one axis, <code>geom_line()</code> will sort
the input by one axis, etc. The original approach to using these geoms
in the other orientation was to add <code>coord_flip()</code> 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 without
<code>coord_flip()</code>. The mechanism is that the layer will try to
guess the orientation from the mapped data, or take direction from the
user using the <code>orientation</code> 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.</p>
<div id="omnidirectional-stats" class="section level3">
<h3>Omnidirectional stats</h3>
<p>The actual guessing of orientation will happen in
<code>setup_params()</code> using the <code>has_flipped_aes()</code>
helper:</p>
<div class="sourceCode" id="cb19"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb19-1"><a href="#cb19-1" tabindex="-1"></a>StatBoxplot<span class="sc">$</span>setup_params</span>
<span id="cb19-2"><a href="#cb19-2" tabindex="-1"></a><span class="co">#&gt; &lt;ggproto method&gt;</span></span>
<span id="cb19-3"><a href="#cb19-3" tabindex="-1"></a><span class="co">#&gt; &lt;Wrapper function&gt;</span></span>
<span id="cb19-4"><a href="#cb19-4" tabindex="-1"></a><span class="co">#&gt; function (...) </span></span>
<span id="cb19-5"><a href="#cb19-5" tabindex="-1"></a><span class="co">#&gt; setup_params(..., self = self)</span></span>
<span id="cb19-6"><a href="#cb19-6" tabindex="-1"></a><span class="co">#&gt; </span></span>
<span id="cb19-7"><a href="#cb19-7" tabindex="-1"></a><span class="co">#&gt; &lt;Inner function (f)&gt;</span></span>
<span id="cb19-8"><a href="#cb19-8" tabindex="-1"></a><span class="co">#&gt; function (self, data, params) </span></span>
<span id="cb19-9"><a href="#cb19-9" tabindex="-1"></a><span class="co">#&gt; {</span></span>
<span id="cb19-10"><a href="#cb19-10" tabindex="-1"></a><span class="co">#&gt; params$flipped_aes &lt;- has_flipped_aes(data, params, main_is_orthogonal = TRUE, </span></span>
<span id="cb19-11"><a href="#cb19-11" tabindex="-1"></a><span class="co">#&gt; group_has_equal = TRUE, main_is_optional = TRUE)</span></span>
<span id="cb19-12"><a href="#cb19-12" tabindex="-1"></a><span class="co">#&gt; data &lt;- flip_data(data, params$flipped_aes)</span></span>
<span id="cb19-13"><a href="#cb19-13" tabindex="-1"></a><span class="co">#&gt; has_x &lt;- !(is.null(data$x) &amp;&amp; is.null(params$x))</span></span>
<span id="cb19-14"><a href="#cb19-14" tabindex="-1"></a><span class="co">#&gt; has_y &lt;- !(is.null(data$y) &amp;&amp; is.null(params$y))</span></span>
<span id="cb19-15"><a href="#cb19-15" tabindex="-1"></a><span class="co">#&gt; if (!has_x &amp;&amp; !has_y) {</span></span>
<span id="cb19-16"><a href="#cb19-16" tabindex="-1"></a><span class="co">#&gt; cli::cli_abort(&quot;{.fn {snake_class(self)}} requires an {.field x} or {.field y} aesthetic.&quot;)</span></span>
<span id="cb19-17"><a href="#cb19-17" tabindex="-1"></a><span class="co">#&gt; }</span></span>
<span id="cb19-18"><a href="#cb19-18" tabindex="-1"></a><span class="co">#&gt; params$width &lt;- params$width %||% (resolution(data$x %||% </span></span>
<span id="cb19-19"><a href="#cb19-19" tabindex="-1"></a><span class="co">#&gt; 0, discrete = TRUE) * 0.75)</span></span>
<span id="cb19-20"><a href="#cb19-20" tabindex="-1"></a><span class="co">#&gt; if (!is_mapped_discrete(data$x) &amp;&amp; is.double(data$x) &amp;&amp; !has_groups(data) &amp;&amp; </span></span>
<span id="cb19-21"><a href="#cb19-21" tabindex="-1"></a><span class="co">#&gt; any(data$x != data$x[1L])) {</span></span>
<span id="cb19-22"><a href="#cb19-22" tabindex="-1"></a><span class="co">#&gt; cli::cli_warn(c(&quot;Continuous {.field {flipped_names(params$flipped_aes)$x}} aesthetic&quot;, </span></span>
<span id="cb19-23"><a href="#cb19-23" tabindex="-1"></a><span class="co">#&gt; i = &quot;did you forget {.code aes(group = ...)}?&quot;))</span></span>
<span id="cb19-24"><a href="#cb19-24" tabindex="-1"></a><span class="co">#&gt; }</span></span>
<span id="cb19-25"><a href="#cb19-25" tabindex="-1"></a><span class="co">#&gt; params</span></span>
<span id="cb19-26"><a href="#cb19-26" tabindex="-1"></a><span class="co">#&gt; }</span></span></code></pre></div>
<p>Following this is a call to <code>flip_data()</code> 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 in <code>setup_data()</code>:</p>
<div class="sourceCode" id="cb20"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb20-1"><a href="#cb20-1" tabindex="-1"></a>StatBoxplot<span class="sc">$</span>setup_data</span>
<span id="cb20-2"><a href="#cb20-2" tabindex="-1"></a><span class="co">#&gt; &lt;ggproto method&gt;</span></span>
<span id="cb20-3"><a href="#cb20-3" tabindex="-1"></a><span class="co">#&gt; &lt;Wrapper function&gt;</span></span>
<span id="cb20-4"><a href="#cb20-4" tabindex="-1"></a><span class="co">#&gt; function (...) </span></span>
<span id="cb20-5"><a href="#cb20-5" tabindex="-1"></a><span class="co">#&gt; setup_data(..., self = self)</span></span>
<span id="cb20-6"><a href="#cb20-6" tabindex="-1"></a><span class="co">#&gt; </span></span>
<span id="cb20-7"><a href="#cb20-7" tabindex="-1"></a><span class="co">#&gt; &lt;Inner function (f)&gt;</span></span>
<span id="cb20-8"><a href="#cb20-8" tabindex="-1"></a><span class="co">#&gt; function (self, data, params) </span></span>
<span id="cb20-9"><a href="#cb20-9" tabindex="-1"></a><span class="co">#&gt; {</span></span>
<span id="cb20-10"><a href="#cb20-10" tabindex="-1"></a><span class="co">#&gt; data &lt;- flip_data(data, params$flipped_aes)</span></span>
<span id="cb20-11"><a href="#cb20-11" tabindex="-1"></a><span class="co">#&gt; data$x &lt;- data$x %||% 0</span></span>
<span id="cb20-12"><a href="#cb20-12" tabindex="-1"></a><span class="co">#&gt; data &lt;- remove_missing(data, na.rm = params$na.rm, vars = &quot;x&quot;, </span></span>
<span id="cb20-13"><a href="#cb20-13" tabindex="-1"></a><span class="co">#&gt; name = &quot;stat_boxplot&quot;)</span></span>
<span id="cb20-14"><a href="#cb20-14" tabindex="-1"></a><span class="co">#&gt; flip_data(data, params$flipped_aes)</span></span>
<span id="cb20-15"><a href="#cb20-15" tabindex="-1"></a><span class="co">#&gt; }</span></span></code></pre></div>
<p>The data is flipped (if needed), manipulated, and flipped back as it
is returned.</p>
<p>During the computation, this sandwiching between
<code>flip_data()</code> is used as well, but right before the data is
returned it will also get a <code>flipped_aes</code> column denoting if
the data is flipped or not. This allows the stat to communicate to the
geom that orientation has already been determined.</p>
</div>
<div id="omnidirecitonal-geoms" class="section level3">
<h3>Omnidirecitonal geoms</h3>
<p>The setup for geoms is pretty much the same, with a few twists.
<code>has_flipped_aes()</code> is also used in
<code>setup_params()</code>, where it will usually be picked up from the
<code>flipped_aes</code> column given by the stat. In
<code>setup_data()</code> you will often see that
<code>flipped_aes</code> 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 (often
<code>stat_identity()</code>):</p>
<div class="sourceCode" id="cb21"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb21-1"><a href="#cb21-1" tabindex="-1"></a>GeomBoxplot<span class="sc">$</span>setup_data</span>
<span id="cb21-2"><a href="#cb21-2" tabindex="-1"></a><span class="co">#&gt; &lt;ggproto method&gt;</span></span>
<span id="cb21-3"><a href="#cb21-3" tabindex="-1"></a><span class="co">#&gt; &lt;Wrapper function&gt;</span></span>
<span id="cb21-4"><a href="#cb21-4" tabindex="-1"></a><span class="co">#&gt; function (...) </span></span>
<span id="cb21-5"><a href="#cb21-5" tabindex="-1"></a><span class="co">#&gt; setup_data(...)</span></span>
<span id="cb21-6"><a href="#cb21-6" tabindex="-1"></a><span class="co">#&gt; </span></span>
<span id="cb21-7"><a href="#cb21-7" tabindex="-1"></a><span class="co">#&gt; &lt;Inner function (f)&gt;</span></span>
<span id="cb21-8"><a href="#cb21-8" tabindex="-1"></a><span class="co">#&gt; function (data, params) </span></span>
<span id="cb21-9"><a href="#cb21-9" tabindex="-1"></a><span class="co">#&gt; {</span></span>
<span id="cb21-10"><a href="#cb21-10" tabindex="-1"></a><span class="co">#&gt; data$flipped_aes &lt;- params$flipped_aes</span></span>
<span id="cb21-11"><a href="#cb21-11" tabindex="-1"></a><span class="co">#&gt; data &lt;- flip_data(data, params$flipped_aes)</span></span>
<span id="cb21-12"><a href="#cb21-12" tabindex="-1"></a><span class="co">#&gt; data$width &lt;- data$width %||% params$width %||% (resolution(data$x, </span></span>
<span id="cb21-13"><a href="#cb21-13" tabindex="-1"></a><span class="co">#&gt; FALSE, TRUE) * 0.9)</span></span>
<span id="cb21-14"><a href="#cb21-14" tabindex="-1"></a><span class="co">#&gt; if (isFALSE(params$outliers)) {</span></span>
<span id="cb21-15"><a href="#cb21-15" tabindex="-1"></a><span class="co">#&gt; data$outliers &lt;- NULL</span></span>
<span id="cb21-16"><a href="#cb21-16" tabindex="-1"></a><span class="co">#&gt; }</span></span>
<span id="cb21-17"><a href="#cb21-17" tabindex="-1"></a><span class="co">#&gt; if (!is.null(data$outliers)) {</span></span>
<span id="cb21-18"><a href="#cb21-18" tabindex="-1"></a><span class="co">#&gt; suppressWarnings({</span></span>
<span id="cb21-19"><a href="#cb21-19" tabindex="-1"></a><span class="co">#&gt; out_min &lt;- vapply(data$outliers, min, numeric(1))</span></span>
<span id="cb21-20"><a href="#cb21-20" tabindex="-1"></a><span class="co">#&gt; out_max &lt;- vapply(data$outliers, max, numeric(1))</span></span>
<span id="cb21-21"><a href="#cb21-21" tabindex="-1"></a><span class="co">#&gt; })</span></span>
<span id="cb21-22"><a href="#cb21-22" tabindex="-1"></a><span class="co">#&gt; data$ymin_final &lt;- pmin(out_min, data$ymin)</span></span>
<span id="cb21-23"><a href="#cb21-23" tabindex="-1"></a><span class="co">#&gt; data$ymax_final &lt;- pmax(out_max, data$ymax)</span></span>
<span id="cb21-24"><a href="#cb21-24" tabindex="-1"></a><span class="co">#&gt; }</span></span>
<span id="cb21-25"><a href="#cb21-25" tabindex="-1"></a><span class="co">#&gt; if (is.null(params) || is.null(params$varwidth) || !params$varwidth || </span></span>
<span id="cb21-26"><a href="#cb21-26" tabindex="-1"></a><span class="co">#&gt; is.null(data$relvarwidth)) {</span></span>
<span id="cb21-27"><a href="#cb21-27" tabindex="-1"></a><span class="co">#&gt; data$xmin &lt;- data$x - data$width/2</span></span>
<span id="cb21-28"><a href="#cb21-28" tabindex="-1"></a><span class="co">#&gt; data$xmax &lt;- data$x + data$width/2</span></span>
<span id="cb21-29"><a href="#cb21-29" tabindex="-1"></a><span class="co">#&gt; }</span></span>
<span id="cb21-30"><a href="#cb21-30" tabindex="-1"></a><span class="co">#&gt; else {</span></span>
<span id="cb21-31"><a href="#cb21-31" tabindex="-1"></a><span class="co">#&gt; data$relvarwidth &lt;- data$relvarwidth/max(data$relvarwidth)</span></span>
<span id="cb21-32"><a href="#cb21-32" tabindex="-1"></a><span class="co">#&gt; data$xmin &lt;- data$x - data$relvarwidth * data$width/2</span></span>
<span id="cb21-33"><a href="#cb21-33" tabindex="-1"></a><span class="co">#&gt; data$xmax &lt;- data$x + data$relvarwidth * data$width/2</span></span>
<span id="cb21-34"><a href="#cb21-34" tabindex="-1"></a><span class="co">#&gt; }</span></span>
<span id="cb21-35"><a href="#cb21-35" tabindex="-1"></a><span class="co">#&gt; data$width &lt;- NULL</span></span>
<span id="cb21-36"><a href="#cb21-36" tabindex="-1"></a><span class="co">#&gt; if (!is.null(data$relvarwidth)) </span></span>
<span id="cb21-37"><a href="#cb21-37" tabindex="-1"></a><span class="co">#&gt; data$relvarwidth &lt;- NULL</span></span>
<span id="cb21-38"><a href="#cb21-38" tabindex="-1"></a><span class="co">#&gt; flip_data(data, params$flipped_aes)</span></span>
<span id="cb21-39"><a href="#cb21-39" tabindex="-1"></a><span class="co">#&gt; }</span></span></code></pre></div>
<p>In the <code>draw_*()</code> method you will once again sandwich any
data manipulation between <code>flip_data()</code> 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.</p>
</div>
<div id="dealing-with-required-aesthetics" class="section level3">
<h3>Dealing with required aesthetics</h3>
<p>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 the <code>required_aes</code> field of
<code>Stat</code> and <code>Geom</code> classes understands the
<code>|</code> (or) operator. Looking at <code>GeomBoxplot</code> we can
see how it is used:</p>
<div class="sourceCode" id="cb22"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb22-1"><a href="#cb22-1" tabindex="-1"></a>GeomBoxplot<span class="sc">$</span>required_aes</span>
<span id="cb22-2"><a href="#cb22-2" tabindex="-1"></a><span class="co">#&gt; [1] &quot;x|y&quot; &quot;lower|xlower&quot; &quot;upper|xupper&quot; &quot;middle|xmiddle&quot;</span></span>
<span id="cb22-3"><a href="#cb22-3" tabindex="-1"></a><span class="co">#&gt; [5] &quot;ymin|xmin&quot; &quot;ymax|xmax&quot;</span></span></code></pre></div>
<p>This tells ggplot2 that either all the aesthetics before
<code>|</code> are required or all the aesthetics after are
required.</p>
</div>
<div id="ambiguous-layers" class="section level3">
<h3>Ambiguous layers</h3>
<p>Some layers will not have a clear interpretation of their data in
terms of orientation. A classic example is <code>geom_line()</code>
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 setting <code>orientation = &quot;y&quot;</code>. The
stat or geom will then call <code>has_flipped_aes()</code> with
<code>ambiguous = TRUE</code> to cancel any guessing based on data
format. As an example we can see the <code>setup_params()</code> method
of <code>GeomLine</code>:</p>
<div class="sourceCode" id="cb23"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb23-1"><a href="#cb23-1" tabindex="-1"></a>GeomLine<span class="sc">$</span>setup_params</span>
<span id="cb23-2"><a href="#cb23-2" tabindex="-1"></a><span class="co">#&gt; &lt;ggproto method&gt;</span></span>
<span id="cb23-3"><a href="#cb23-3" tabindex="-1"></a><span class="co">#&gt; &lt;Wrapper function&gt;</span></span>
<span id="cb23-4"><a href="#cb23-4" tabindex="-1"></a><span class="co">#&gt; function (...) </span></span>
<span id="cb23-5"><a href="#cb23-5" tabindex="-1"></a><span class="co">#&gt; setup_params(...)</span></span>
<span id="cb23-6"><a href="#cb23-6" tabindex="-1"></a><span class="co">#&gt; </span></span>
<span id="cb23-7"><a href="#cb23-7" tabindex="-1"></a><span class="co">#&gt; &lt;Inner function (f)&gt;</span></span>
<span id="cb23-8"><a href="#cb23-8" tabindex="-1"></a><span class="co">#&gt; function (data, params) </span></span>
<span id="cb23-9"><a href="#cb23-9" tabindex="-1"></a><span class="co">#&gt; {</span></span>
<span id="cb23-10"><a href="#cb23-10" tabindex="-1"></a><span class="co">#&gt; params$flipped_aes &lt;- has_flipped_aes(data, params, ambiguous = TRUE)</span></span>
<span id="cb23-11"><a href="#cb23-11" tabindex="-1"></a><span class="co">#&gt; params</span></span>
<span id="cb23-12"><a href="#cb23-12" tabindex="-1"></a><span class="co">#&gt; }</span></span></code></pre></div>
</div>
</div>
<div id="creating-your-own-theme" class="section level2">
<h2>Creating your own theme</h2>
<p>If you’re going to create your own complete theme, there are a few
things you need to know:</p>
<ul>
<li>Overriding existing elements, rather than modifying them</li>
<li>The four global elements that affect (almost) every other theme
element</li>
<li>Complete vs. incomplete elements</li>
</ul>
<div id="overriding-elements" class="section level3">
<h3>Overriding elements</h3>
<p>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:</p>
<div class="sourceCode" id="cb24"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb24-1"><a href="#cb24-1" tabindex="-1"></a><span class="fu">theme_grey</span>()<span class="sc">$</span>legend.key</span>
<span id="cb24-2"><a href="#cb24-2" tabindex="-1"></a><span class="co">#&gt; NULL</span></span>
<span id="cb24-3"><a href="#cb24-3" tabindex="-1"></a></span>
<span id="cb24-4"><a href="#cb24-4" tabindex="-1"></a>new_theme <span class="ot">&lt;-</span> <span class="fu">theme_grey</span>() <span class="sc">+</span> <span class="fu">theme</span>(<span class="at">legend.key =</span> <span class="fu">element_rect</span>(<span class="at">colour =</span> <span class="st">&quot;red&quot;</span>))</span>
<span id="cb24-5"><a href="#cb24-5" tabindex="-1"></a>new_theme<span class="sc">$</span>legend.key</span>
<span id="cb24-6"><a href="#cb24-6" tabindex="-1"></a><span class="co">#&gt; List of 5</span></span>
<span id="cb24-7"><a href="#cb24-7" tabindex="-1"></a><span class="co">#&gt; $ fill : NULL</span></span>
<span id="cb24-8"><a href="#cb24-8" tabindex="-1"></a><span class="co">#&gt; $ colour : chr &quot;red&quot;</span></span>
<span id="cb24-9"><a href="#cb24-9" tabindex="-1"></a><span class="co">#&gt; $ linewidth : NULL</span></span>
<span id="cb24-10"><a href="#cb24-10" tabindex="-1"></a><span class="co">#&gt; $ linetype : NULL</span></span>
<span id="cb24-11"><a href="#cb24-11" tabindex="-1"></a><span class="co">#&gt; $ inherit.blank: logi FALSE</span></span>
<span id="cb24-12"><a href="#cb24-12" tabindex="-1"></a><span class="co">#&gt; - attr(*, &quot;class&quot;)= chr [1:2] &quot;element_rect&quot; &quot;element&quot;</span></span></code></pre></div>
<p>To override it completely, use <code>%+replace%</code> instead of
<code>+</code>:</p>
<div class="sourceCode" id="cb25"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb25-1"><a href="#cb25-1" tabindex="-1"></a>new_theme <span class="ot">&lt;-</span> <span class="fu">theme_grey</span>() <span class="sc">%+replace%</span> <span class="fu">theme</span>(<span class="at">legend.key =</span> <span class="fu">element_rect</span>(<span class="at">colour =</span> <span class="st">&quot;red&quot;</span>))</span>
<span id="cb25-2"><a href="#cb25-2" tabindex="-1"></a>new_theme<span class="sc">$</span>legend.key</span>
<span id="cb25-3"><a href="#cb25-3" tabindex="-1"></a><span class="co">#&gt; List of 5</span></span>
<span id="cb25-4"><a href="#cb25-4" tabindex="-1"></a><span class="co">#&gt; $ fill : NULL</span></span>
<span id="cb25-5"><a href="#cb25-5" tabindex="-1"></a><span class="co">#&gt; $ colour : chr &quot;red&quot;</span></span>
<span id="cb25-6"><a href="#cb25-6" tabindex="-1"></a><span class="co">#&gt; $ linewidth : NULL</span></span>
<span id="cb25-7"><a href="#cb25-7" tabindex="-1"></a><span class="co">#&gt; $ linetype : NULL</span></span>
<span id="cb25-8"><a href="#cb25-8" tabindex="-1"></a><span class="co">#&gt; $ inherit.blank: logi FALSE</span></span>
<span id="cb25-9"><a href="#cb25-9" tabindex="-1"></a><span class="co">#&gt; - attr(*, &quot;class&quot;)= chr [1:2] &quot;element_rect&quot; &quot;element&quot;</span></span></code></pre></div>
</div>
<div id="global-elements" class="section level3">
<h3>Global elements</h3>
<p>There are four elements that affect the global appearance of the
plot:</p>
<table>
<colgroup>
<col width="23%" />
<col width="33%" />
<col width="42%" />
</colgroup>
<thead>
<tr class="header">
<th>Element</th>
<th>Theme function</th>
<th>Description</th>
</tr>
</thead>
<tbody>
<tr class="odd">
<td>line</td>
<td><code>element_line()</code></td>
<td>all line elements</td>
</tr>
<tr class="even">
<td>rect</td>
<td><code>element_rect()</code></td>
<td>all rectangular elements</td>
</tr>
<tr class="odd">
<td>text</td>
<td><code>element_text()</code></td>
<td>all text</td>
</tr>
<tr class="even">
<td>title</td>
<td><code>element_text()</code></td>
<td>all text in title elements (plot, axes &amp; legend)</td>
</tr>
</tbody>
</table>
<p>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).</p>
<div class="sourceCode" id="cb26"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb26-1"><a href="#cb26-1" tabindex="-1"></a>df <span class="ot">&lt;-</span> <span class="fu">data.frame</span>(<span class="at">x =</span> <span class="dv">1</span><span class="sc">:</span><span class="dv">3</span>, <span class="at">y =</span> <span class="dv">1</span><span class="sc">:</span><span class="dv">3</span>)</span>
<span id="cb26-2"><a href="#cb26-2" tabindex="-1"></a>base <span class="ot">&lt;-</span> <span class="fu">ggplot</span>(df, <span class="fu">aes</span>(x, y)) <span class="sc">+</span> </span>
<span id="cb26-3"><a href="#cb26-3" tabindex="-1"></a> <span class="fu">geom_point</span>() <span class="sc">+</span> </span>
<span id="cb26-4"><a href="#cb26-4" tabindex="-1"></a> <span class="fu">theme_minimal</span>()</span>
<span id="cb26-5"><a href="#cb26-5" tabindex="-1"></a></span>
<span id="cb26-6"><a href="#cb26-6" tabindex="-1"></a>base</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7d0LsB5lfT/w5yQnN0IuxGBKYbhoBSkYLBawgwLt2EEGbS2jVECgFMRSe4FalEtHLtYpDDMFREdtLYxcLEXaykVxaCsOEYeKClKUUgTSQCEBcr8n55z883v9v+ec9+wm5OXN82b3vJ+dOTm7z7v77LOfZy/fd999T/q2bB2SgQABAgQIECBAgECXBCZ0aT1WQ4AAAQIECBAgQKAhIIDaEQgQIECAAAECBLoqIIB2ldvKCBAgQIAAAQIEBFD7AAECBAgQIECAQFcFBNCuclsZAQIECBAgQICAAGofIECAAAECBAgQ6KqAALqD3IODg2nNmjUpfhtaBdavX99aYKohEPvLpk2baIwRCJOBgYExpSY3bNiQ1q1bB2KMwNDQUNq4ceOYUpObN29uXJP8JcXivuCaVDSJ/SSuSbHfVGUQQHewJyJ4rl69OsXJ0NAq4GBv9WhOxcHuwtnUGPkdJ0Bv5EY8mmNxHAmgTY2R33HOjXBuaBWI4yiuSQJoq0tMuSYVTWI/if2lSm/+BdBiPykhQIAAAQIECBDIKCCAZsRVNQECBAgQIECAQFFAAC2aKCFAgAABAgQIEMgoIIBmxFU1AQIECBAgQIBAUUAALZooIUCAAAECBAgQyCgggGbEVTUBAgQIECBAgEBRQAAtmighQIAAAQIECBDIKCCAZsRVNQECBAgQIECAQFFAAC2aKCFAgAABAgQIEMgoIIBmxFU1AQIECBAgQIBAUUAALZooIUCAAAECBAgQyCgggGbEVTUBAgQIECBAgEBRQAAtmighQIAAAQIECBDIKCCAZsRVNQECBAgQIECAQFFAAC2aKCFAgAABAgQIEMgoIIBmxFU1AQIECBAgQIBAUUAALZooIUCAAAECBAgQyCgggGbEVTUBAgQIECBAgEBRQAAtmighQIAAAQIECBDIKCCAZsRVNQECBAgQIECAQFFAAC2aKCFAgAABAgQIEMgoIIBmxFU1AQIECBAgQIBAUaBrAfTll19O3/72t9Nzzz1XbMWokqeeeirdf//96dVXXx1VapQAAQIECBAgQGC8CHQlgN57773pwgsvTC+88EL6q7/6q/TNb36z1O/aa69N11xzTXr00UfT2WefnRYtWlQ6n0ICBAgQIECAAIEdE4gbe9ddd1268cYbd2yBLszVn3sdW7ZsadzRvOKKK9L++++fDjvssHTDDTekE088sWXVCxcuTAsWLEh33nlnmjBhQrr99tvTbbfdli6++OKW+UwQIECAAAECBAjsmMAf//Efp5tuuilt3rw5TZw4MX3iE59Iq1atSpMnT96xCjLNlT2A9vX1pc997nON5sfGP/TQQ40gOnZ7nn322TR//vxG+IzXDj/88G3eKW0uG+F2aGioOZn1d3M9g4ODw23MusIaVR79EC6GogCbokkcS/Fjn2m1iX3F/tJqElOxn3ApuoTJaJ/iHL1bYn8Z6fvvfOc76Ytf/OJwQRxPETwvueSSdPXVVw+X5xiJ/Bc3FLc1ZA+gzRVH2j7ttNPS+vXr09///d83i4d/v/TSS2nWrFnD0zNnzkxLly4dni4b2bBhQ1qxYkXZS9nKli9fnq3uOlccz/gaigJr165N8WMgsKMCjqVyqbh2GIoCvi9RNIkSx9EvXOKm36RJkxp3P5tSmzZtSg888EB2oxkzZqTdd9+9udrC764F0AiUd999d3rwwQfTxz72sXTXXXeladOmDTcobguPviMyMDDQ8vrwjKNGIsXPnj17VEm+0WjPmjVrGpj9/V1jy7dBO7HmpstOrHJcVLVy5co0ZcqUNHXq1HGxPTtrIzZu3Nj4GMhx1Coab1TiznCctA0jAmESNxt22223kUJjKULEunXrGjdu4k6TYUTANWnEYr/99mtch+IT6OYQdyX33/pIZO78FMF3e0P2JBUHyY9//OP0zne+M8VBcuyxx6YvfOEL6ac//Wn69V//9eG27bnnnunxxx8fnl62bFnaa6+9hqfLRiK0jg6xZfPsrLLYjtipI0y8FurOWmdd6ok7E93qh7qYRDsjgEbIYtPaaxEowiXCuWFEIEJWDPaXEZMYizf/O3JDonWp8T/V/Ag+rknb+5hz/EsUt9A1acTkrLPOSldeeWXjk7jYZ5o3+26++eZdfq7Z9ofzI+3vaCzC2pe+9KX0gx/8oFFP/Jml+Gg9UnkM8eWjOPEeccQR6YknnkjPP/9842Rzzz33pCOPPLIxj38IECBAgAABAgTaF4g/f/npT3+6cSPwgx/8YIpHHqdPn95+RTt5ib6tifgXTzLv5IpHV/fYY481Qmi8i427Hqecckp617ve1ZjlhBNOSFdddVXj2/Hx55riG/Jz5sxpBNS//uu/btwpGV3XrhqPO6ARnOfOnesO6JhOiLvV0WeGVoHFixc3DnIfqba6xEfN7oC2msRUPF8ejyHFOcYwIhDXjdhnRn9HYOTV3h2Lj9/jU5Z58+a5AzpmN3BNGgOydTI+eVqyZEnjY/eqfMrSlQDapNiR5zLiOYV4
<div class="sourceCode" id="cb27"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb27-1"><a href="#cb27-1" tabindex="-1"></a>base <span class="sc">+</span> <span class="fu">theme</span>(<span class="at">text =</span> <span class="fu">element_text</span>(<span class="at">colour =</span> <span class="st">&quot;red&quot;</span>))</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7d0JsGVVfT/6dYeeaHqgbewQKIYYQRPSGBKQVxghr8xTCpP4eIb3B0QegviIGSCGyJCSweT/h6IqgENpEgMlg39CSCKDYpFEfbRYKCrKQwlBoAMGuoGe5+47vPs7vnPvPXfv2/Tx9Dq99z2fXXX77r3O3muv/Vl7+J599rndNzo2JAMBAgQIECBAgACBLgn0d2k9VkOAAAECBAgQIECgISCA2hEIECBAgAABAgS6KiCAdpXbyggQIECAAAECBARQ+wABAgQIECBAgEBXBQTQrnJbGQECBAgQIECAgABqHyBAgAABAgQIEOiqgAC6h9zDw8Np8+bNKX4bWgW2bdvWWmCqIRD7y86dO2lMEQiToaGhKaUmt2/fnrZu3QpiisDIyEjasWPHlFKTu3btalyT/CXF4r7gmlQ0if0krkmx31RlEED3sCcieG7atCnFydDQKuBgb/VoTsXB7sLZ1Jj4HSdAb+QmPJpjcRwJoE2Nid9xzo1wbmgViOMorkkCaKtLTLkmFU1iP4n9pUpv/gXQYj8pIUCAAAECBAgQyCgggGbEVTUBAgQIECBAgEBRQAAtmighQIAAAQIECBDIKCCAZsRVNQECBAgQIECAQFFAAC2aKCFAgAABAgQIEMgoIIBmxFU1AQIECBAgQIBAUUAALZooIUCAAAECBAgQyCgggGbEVTUBAgQIECBAgEBRQAAtmighQIAAAQIECBDIKCCAZsRVNQECBAgQIECAQFFAAC2aKCFAgAABAgQIEMgoIIBmxFU1AQIECBAgQIBAUUAALZooIUCAAAECBAgQyCgggGbEVTUBAgQIECBAgEBRQAAtmighQIAAAQIECBDIKCCAZsRVNQECBAgQIECAQFFAAC2aKCFAgAABAgQIEMgoIIBmxFU1AQIECBAgQIBAUUAALZooIUCAAAECBAgQyCgggGbEVTUBAgQIECBAgEBRQAAtmighQIAAAQIECBDIKCCAZsRVNQECBAgQIECAQFGgawH05ZdfTl/5ylfSc889V2zFpJKnnnoqPfjgg+nVV1+dVGqUAAECBAgQIEBgpgh0JYDef//96ZJLLkk/+clP0p//+Z+nL33pS6V+N9xwQ7r++uvTY489ls4777z0/PPPl86nkAABAgQIECBAYM8E4sbejTfemG6++eY9W6ALcw3mXsfo6GjjjubVV1+dDj/88HTMMcekT37yk+nUU09tWfXKlSvTihUr0t133536+/vTnXfeme6444502WWXtcxnggABAgQIECBAYM8Efv/3fz/dcsstadeuXWlgYCB95CMfSRs3bkyzZ8/eswoyzZU9gPb19aVPfOITjebHxj/88MONIDp1e5599tm0fPnyRviM14499thp75Q2l41wOzIy0pzM+ru5nuHh4fE2Zl1hjSqPfggXQ1GATdEkjqX4sc+02sS+Yn9pNYmp2E+4FF3CZLJPcY7eLbG/TPT9V7/61fSZz3xmvCCOpwiel19+ebruuuvGy3OMRP6LG4rTDdkDaHPFkbbPOuustG3btvS3f/u3zeLx3y+99FJatGjR+PTChQvTmjVrxqfLRrZv357Wr19f9lK2snXr1mWru84VxzO+hqLAli1bUvwYCOypgGOpXCquHYaigO9LFE2ixHH0U5e46Tdr1qzG3c+m1M6dO9PXvva17EYLFixI+++/f3O1hd9dC6ARKO+999700EMPpQ996EPpnnvuSfPmzRtvUNwWnnxHZGhoqOX18RknjUSKX7x48aSSfKPRns2bNzcwBwe7xpZvg/ZizU2XvVjljKhqw4YNac6cOWnu3LkzYnv21kbs2LGj8TGQ46hVNN6oxJ3hOGkbJgTCJG427LfffhOFxlKEiK1btzZu3MSdJsOEgGvShMVhhx3WuA7FJ9DNIe5KHj72SGTu/BTBd3dD9iQVB8n3vve9dMIJJ6Q4SE466aT06U9/Ov3whz9Mv/7rvz7etgMPPDA9/vjj49Nr165NBx100Ph02UiE1skhtmyevVUW2xE7dYSJ10LdW+usSz1xZ6Jb/VAXk2hnBNAIWWxaey0CRbhEODdMCETIisH+MmESY/Hmf09uSLQuNfOnmh/BxzVpdx9zznyJ4ha6Jk2YnHvuuemaa65pfBIX+0zzZt+tt966z8810384P9H+jsYirH32s59N3/72txv1xJ9Zio/WI5XHEF8+ihPvcccdl5544on0wgsvNE429913Xzr++OMb8/iHAAECBAgQIECgfYH485cf+9jHGjcC3/ve96Z45HH+/PntV7SXl+gbS8Q/fZJ5L1c8ubrvf//7jRAa72LjrscZZ5yR3va2tzVmOeWUU9K1117b+HZ8/Lmm+Ib8kiVLGgH1L/7iLxp3SibXta/G4w5oBOelS5e6AzqlE+JudfSZoVVg1apVjYPcR6qtLvFRszugrSYxFc+Xx2NIcY4xTAjEdSP2mcnfEZh4tXfH4uP3+JRl2bJl7oBO2Q1ck6aAjE3GJ0+rV69ufOxelU9ZuhJAmxR78lxG
<p>You should generally start creating a theme by modifying these
values.</p>
</div>
<div id="complete-vs-incomplete" class="section level3">
<h3>Complete vs incomplete</h3>
<p>It is useful to understand the difference between complete and
incomplete theme objects. A <em>complete</em> theme object is one
produced by calling a theme function with the attribute
<code>complete = TRUE</code>.</p>
<p>Theme functions <code>theme_grey()</code> and <code>theme_bw()</code>
are examples of complete theme functions. Calls to <code>theme()</code>
produce <em>incomplete</em> 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.</p>
<p>Complete and incomplete themes behave somewhat differently when added
to a ggplot object:</p>
<ul>
<li><p>Adding an incomplete theme augments the current theme object,
replacing only those properties of elements defined in the call to
<code>theme()</code>.</p></li>
<li><p>Adding a complete theme wipes away the existing theme and applies
the new theme.</p></li>
</ul>
</div>
</div>
<div id="creating-a-new-faceting" class="section level2">
<h2>Creating a new faceting</h2>
<p>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 using
<a href="https://cran.r-project.org/package=gtable">gtable</a> and <a href="https://cran.r-project.org/package=grid">grid</a> 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.</p>
<p>The <code>Facet</code> class in ggplot2 is very powerful as it takes
on responsibility of a wide range of tasks. The main tasks of a
<code>Facet</code> object are:</p>
<ul>
<li><p>Define a layout; that is, a partitioning of the data into
different plot areas (panels) as well as which panels share position
scales.</p></li>
<li><p>Map plot data into the correct panels, potentially duplicating
data if it should exist in multiple panels (e.g. margins in
<code>facet_grid()</code>).</p></li>
<li><p>Assemble all panels into a final gtable, adding axes, strips and
decorations in the process.</p></li>
</ul>
<p>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:</p>
<ul>
<li><p>Initialization and training of positional scales for each
panel.</p></li>
<li><p>Decoration in front of and behind each panel.</p></li>
<li><p>Drawing of axis labels</p></li>
</ul>
<p>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 up
<code>facet_duplicate()</code> 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.</p>
<div id="creating-a-layout-specification" class="section level3">
<h3>Creating a layout specification</h3>
<p>A layout in the context of facets is a <code>data.frame</code> 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 columns <code>PANEL</code>, <code>SCALE_X</code>, and
<code>SCALE_Y</code>, but will often contain more to help assign data to
the correct panel (<code>facet_grid()</code> will e.g. also return the
faceting variables associated with each panel). Let’s make a function
that defines a duplicate layout:</p>
<div class="sourceCode" id="cb28"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb28-1"><a href="#cb28-1" tabindex="-1"></a>layout <span class="ot">&lt;-</span> <span class="cf">function</span>(data, params) {</span>
<span id="cb28-2"><a href="#cb28-2" tabindex="-1"></a> <span class="fu">data.frame</span>(<span class="at">PANEL =</span> <span class="fu">c</span>(1L, 2L), <span class="at">SCALE_X =</span> 1L, <span class="at">SCALE_Y =</span> 1L)</span>
<span id="cb28-3"><a href="#cb28-3" tabindex="-1"></a>}</span></code></pre></div>
<p>This is quite simple as the faceting should just define two panels
irrespectively of the input data and parameters.</p>
</div>
<div id="mapping-data-into-panels" class="section level3">
<h3>Mapping data into panels</h3>
<p>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 a <code>PANEL</code> column to the layer data identifying which
panel it belongs to.</p>
<div class="sourceCode" id="cb29"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb29-1"><a href="#cb29-1" tabindex="-1"></a>mapping <span class="ot">&lt;-</span> <span class="cf">function</span>(data, layout, params) {</span>
<span id="cb29-2"><a href="#cb29-2" tabindex="-1"></a> <span class="cf">if</span> (<span class="fu">is.null</span>(data) <span class="sc">||</span> <span class="fu">nrow</span>(data) <span class="sc">==</span> <span class="dv">0</span>) {</span>
<span id="cb29-3"><a href="#cb29-3" tabindex="-1"></a> <span class="fu">return</span>(<span class="fu">cbind</span>(data, <span class="at">PANEL =</span> <span class="fu">integer</span>(<span class="dv">0</span>)))</span>
<span id="cb29-4"><a href="#cb29-4" tabindex="-1"></a> }</span>
<span id="cb29-5"><a href="#cb29-5" tabindex="-1"></a> <span class="fu">rbind</span>(</span>
<span id="cb29-6"><a href="#cb29-6" tabindex="-1"></a> <span class="fu">cbind</span>(data, <span class="at">PANEL =</span> 1L),</span>
<span id="cb29-7"><a href="#cb29-7" tabindex="-1"></a> <span class="fu">cbind</span>(data, <span class="at">PANEL =</span> 2L)</span>
<span id="cb29-8"><a href="#cb29-8" tabindex="-1"></a> )</span>
<span id="cb29-9"><a href="#cb29-9" tabindex="-1"></a>}</span></code></pre></div>
<p>here we first investigate whether we have gotten an empty
<code>data.frame</code> and if not we duplicate the data and assign the
original data to the first panel and the new data to the second
panel.</p>
</div>
<div id="laying-out-the-panels" class="section level3">
<h3>Laying out the panels</h3>
<p>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.</p>
<div class="sourceCode" id="cb30"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb30-1"><a href="#cb30-1" tabindex="-1"></a>render <span class="ot">&lt;-</span> <span class="cf">function</span>(panels, layout, x_scales, y_scales, ranges, coord, data,</span>
<span id="cb30-2"><a href="#cb30-2" tabindex="-1"></a> theme, params) {</span>
<span id="cb30-3"><a href="#cb30-3" tabindex="-1"></a> <span class="co"># Place panels according to settings</span></span>
<span id="cb30-4"><a href="#cb30-4" tabindex="-1"></a> <span class="cf">if</span> (params<span class="sc">$</span>horizontal) {</span>
<span id="cb30-5"><a href="#cb30-5" tabindex="-1"></a> <span class="co"># Put panels in matrix and convert to a gtable</span></span>
<span id="cb30-6"><a href="#cb30-6" tabindex="-1"></a> panels <span class="ot">&lt;-</span> <span class="fu">matrix</span>(panels, <span class="at">ncol =</span> <span class="dv">2</span>)</span>
<span id="cb30-7"><a href="#cb30-7" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_matrix</span>(<span class="st">&quot;layout&quot;</span>, panels, </span>
<span id="cb30-8"><a href="#cb30-8" tabindex="-1"></a> <span class="at">widths =</span> <span class="fu">unit</span>(<span class="fu">c</span>(<span class="dv">1</span>, <span class="dv">1</span>), <span class="st">&quot;null&quot;</span>), <span class="at">heights =</span> <span class="fu">unit</span>(<span class="dv">1</span>, <span class="st">&quot;null&quot;</span>), <span class="at">clip =</span> <span class="st">&quot;on&quot;</span>)</span>
<span id="cb30-9"><a href="#cb30-9" tabindex="-1"></a> <span class="co"># Add spacing according to theme</span></span>
<span id="cb30-10"><a href="#cb30-10" tabindex="-1"></a> panel_spacing <span class="ot">&lt;-</span> <span class="cf">if</span> (<span class="fu">is.null</span>(theme<span class="sc">$</span>panel.spacing.x)) {</span>
<span id="cb30-11"><a href="#cb30-11" tabindex="-1"></a> theme<span class="sc">$</span>panel.spacing</span>
<span id="cb30-12"><a href="#cb30-12" tabindex="-1"></a> } <span class="cf">else</span> {</span>
<span id="cb30-13"><a href="#cb30-13" tabindex="-1"></a> theme<span class="sc">$</span>panel.spacing.x</span>
<span id="cb30-14"><a href="#cb30-14" tabindex="-1"></a> }</span>
<span id="cb30-15"><a href="#cb30-15" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_col_space</span>(panel_table, panel_spacing)</span>
<span id="cb30-16"><a href="#cb30-16" tabindex="-1"></a> } <span class="cf">else</span> {</span>
<span id="cb30-17"><a href="#cb30-17" tabindex="-1"></a> panels <span class="ot">&lt;-</span> <span class="fu">matrix</span>(panels, <span class="at">ncol =</span> <span class="dv">1</span>)</span>
<span id="cb30-18"><a href="#cb30-18" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_matrix</span>(<span class="st">&quot;layout&quot;</span>, panels, </span>
<span id="cb30-19"><a href="#cb30-19" tabindex="-1"></a> <span class="at">widths =</span> <span class="fu">unit</span>(<span class="dv">1</span>, <span class="st">&quot;null&quot;</span>), <span class="at">heights =</span> <span class="fu">unit</span>(<span class="fu">c</span>(<span class="dv">1</span>, <span class="dv">1</span>), <span class="st">&quot;null&quot;</span>), <span class="at">clip =</span> <span class="st">&quot;on&quot;</span>)</span>
<span id="cb30-20"><a href="#cb30-20" tabindex="-1"></a> panel_spacing <span class="ot">&lt;-</span> <span class="cf">if</span> (<span class="fu">is.null</span>(theme<span class="sc">$</span>panel.spacing.y)) {</span>
<span id="cb30-21"><a href="#cb30-21" tabindex="-1"></a> theme<span class="sc">$</span>panel.spacing</span>
<span id="cb30-22"><a href="#cb30-22" tabindex="-1"></a> } <span class="cf">else</span> {</span>
<span id="cb30-23"><a href="#cb30-23" tabindex="-1"></a> theme<span class="sc">$</span>panel.spacing.y</span>
<span id="cb30-24"><a href="#cb30-24" tabindex="-1"></a> }</span>
<span id="cb30-25"><a href="#cb30-25" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_row_space</span>(panel_table, panel_spacing)</span>
<span id="cb30-26"><a href="#cb30-26" tabindex="-1"></a> }</span>
<span id="cb30-27"><a href="#cb30-27" tabindex="-1"></a> <span class="co"># Name panel grobs so they can be found later</span></span>
<span id="cb30-28"><a href="#cb30-28" tabindex="-1"></a> panel_table<span class="sc">$</span>layout<span class="sc">$</span>name <span class="ot">&lt;-</span> <span class="fu">paste0</span>(<span class="st">&quot;panel-&quot;</span>, <span class="fu">c</span>(<span class="dv">1</span>, <span class="dv">2</span>))</span>
<span id="cb30-29"><a href="#cb30-29" tabindex="-1"></a> </span>
<span id="cb30-30"><a href="#cb30-30" tabindex="-1"></a> <span class="co"># Construct the axes</span></span>
<span id="cb30-31"><a href="#cb30-31" tabindex="-1"></a> axes <span class="ot">&lt;-</span> <span class="fu">render_axes</span>(ranges[<span class="dv">1</span>], ranges[<span class="dv">1</span>], coord, theme, </span>
<span id="cb30-32"><a href="#cb30-32" tabindex="-1"></a> <span class="at">transpose =</span> <span class="cn">TRUE</span>)</span>
<span id="cb30-33"><a href="#cb30-33" tabindex="-1"></a></span>
<span id="cb30-34"><a href="#cb30-34" tabindex="-1"></a> <span class="co"># Add axes around each panel</span></span>
<span id="cb30-35"><a href="#cb30-35" tabindex="-1"></a> panel_pos_h <span class="ot">&lt;-</span> <span class="fu">panel_cols</span>(panel_table)<span class="sc">$</span>l</span>
<span id="cb30-36"><a href="#cb30-36" tabindex="-1"></a> panel_pos_v <span class="ot">&lt;-</span> <span class="fu">panel_rows</span>(panel_table)<span class="sc">$</span>t</span>
<span id="cb30-37"><a href="#cb30-37" tabindex="-1"></a> axis_width_l <span class="ot">&lt;-</span> <span class="fu">unit</span>(grid<span class="sc">::</span><span class="fu">convertWidth</span>(</span>
<span id="cb30-38"><a href="#cb30-38" tabindex="-1"></a> grid<span class="sc">::</span><span class="fu">grobWidth</span>(axes<span class="sc">$</span>y<span class="sc">$</span>left[[<span class="dv">1</span>]]), <span class="st">&quot;cm&quot;</span>, <span class="cn">TRUE</span>), <span class="st">&quot;cm&quot;</span>)</span>
<span id="cb30-39"><a href="#cb30-39" tabindex="-1"></a> axis_width_r <span class="ot">&lt;-</span> <span class="fu">unit</span>(grid<span class="sc">::</span><span class="fu">convertWidth</span>(</span>
<span id="cb30-40"><a href="#cb30-40" tabindex="-1"></a> grid<span class="sc">::</span><span class="fu">grobWidth</span>(axes<span class="sc">$</span>y<span class="sc">$</span>right[[<span class="dv">1</span>]]), <span class="st">&quot;cm&quot;</span>, <span class="cn">TRUE</span>), <span class="st">&quot;cm&quot;</span>)</span>
<span id="cb30-41"><a href="#cb30-41" tabindex="-1"></a> <span class="do">## We do it reverse so we don&#39;t change the position of panels when we add axes</span></span>
<span id="cb30-42"><a href="#cb30-42" tabindex="-1"></a> <span class="cf">for</span> (i <span class="cf">in</span> <span class="fu">rev</span>(panel_pos_h)) {</span>
<span id="cb30-43"><a href="#cb30-43" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_cols</span>(panel_table, axis_width_r, i)</span>
<span id="cb30-44"><a href="#cb30-44" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_grob</span>(panel_table, </span>
<span id="cb30-45"><a href="#cb30-45" tabindex="-1"></a> <span class="fu">rep</span>(axes<span class="sc">$</span>y<span class="sc">$</span>right, <span class="fu">length</span>(panel_pos_v)), <span class="at">t =</span> panel_pos_v, <span class="at">l =</span> i <span class="sc">+</span> <span class="dv">1</span>, </span>
<span id="cb30-46"><a href="#cb30-46" tabindex="-1"></a> <span class="at">clip =</span> <span class="st">&quot;off&quot;</span>)</span>
<span id="cb30-47"><a href="#cb30-47" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_cols</span>(panel_table, axis_width_l, i <span class="sc">-</span> <span class="dv">1</span>)</span>
<span id="cb30-48"><a href="#cb30-48" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_grob</span>(panel_table, </span>
<span id="cb30-49"><a href="#cb30-49" tabindex="-1"></a> <span class="fu">rep</span>(axes<span class="sc">$</span>y<span class="sc">$</span>left, <span class="fu">length</span>(panel_pos_v)), <span class="at">t =</span> panel_pos_v, <span class="at">l =</span> i, </span>
<span id="cb30-50"><a href="#cb30-50" tabindex="-1"></a> <span class="at">clip =</span> <span class="st">&quot;off&quot;</span>)</span>
<span id="cb30-51"><a href="#cb30-51" tabindex="-1"></a> }</span>
<span id="cb30-52"><a href="#cb30-52" tabindex="-1"></a> <span class="do">## Recalculate as gtable has changed</span></span>
<span id="cb30-53"><a href="#cb30-53" tabindex="-1"></a> panel_pos_h <span class="ot">&lt;-</span> <span class="fu">panel_cols</span>(panel_table)<span class="sc">$</span>l</span>
<span id="cb30-54"><a href="#cb30-54" tabindex="-1"></a> panel_pos_v <span class="ot">&lt;-</span> <span class="fu">panel_rows</span>(panel_table)<span class="sc">$</span>t</span>
<span id="cb30-55"><a href="#cb30-55" tabindex="-1"></a> axis_height_t <span class="ot">&lt;-</span> <span class="fu">unit</span>(grid<span class="sc">::</span><span class="fu">convertHeight</span>(</span>
<span id="cb30-56"><a href="#cb30-56" tabindex="-1"></a> grid<span class="sc">::</span><span class="fu">grobHeight</span>(axes<span class="sc">$</span>x<span class="sc">$</span>top[[<span class="dv">1</span>]]), <span class="st">&quot;cm&quot;</span>, <span class="cn">TRUE</span>), <span class="st">&quot;cm&quot;</span>)</span>
<span id="cb30-57"><a href="#cb30-57" tabindex="-1"></a> axis_height_b <span class="ot">&lt;-</span> <span class="fu">unit</span>(grid<span class="sc">::</span><span class="fu">convertHeight</span>(</span>
<span id="cb30-58"><a href="#cb30-58" tabindex="-1"></a> grid<span class="sc">::</span><span class="fu">grobHeight</span>(axes<span class="sc">$</span>x<span class="sc">$</span>bottom[[<span class="dv">1</span>]]), <span class="st">&quot;cm&quot;</span>, <span class="cn">TRUE</span>), <span class="st">&quot;cm&quot;</span>)</span>
<span id="cb30-59"><a href="#cb30-59" tabindex="-1"></a> <span class="cf">for</span> (i <span class="cf">in</span> <span class="fu">rev</span>(panel_pos_v)) {</span>
<span id="cb30-60"><a href="#cb30-60" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_rows</span>(panel_table, axis_height_b, i)</span>
<span id="cb30-61"><a href="#cb30-61" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_grob</span>(panel_table, </span>
<span id="cb30-62"><a href="#cb30-62" tabindex="-1"></a> <span class="fu">rep</span>(axes<span class="sc">$</span>x<span class="sc">$</span>bottom, <span class="fu">length</span>(panel_pos_h)), <span class="at">t =</span> i <span class="sc">+</span> <span class="dv">1</span>, <span class="at">l =</span> panel_pos_h, </span>
<span id="cb30-63"><a href="#cb30-63" tabindex="-1"></a> <span class="at">clip =</span> <span class="st">&quot;off&quot;</span>)</span>
<span id="cb30-64"><a href="#cb30-64" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_rows</span>(panel_table, axis_height_t, i <span class="sc">-</span> <span class="dv">1</span>)</span>
<span id="cb30-65"><a href="#cb30-65" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_grob</span>(panel_table, </span>
<span id="cb30-66"><a href="#cb30-66" tabindex="-1"></a> <span class="fu">rep</span>(axes<span class="sc">$</span>x<span class="sc">$</span>top, <span class="fu">length</span>(panel_pos_h)), <span class="at">t =</span> i, <span class="at">l =</span> panel_pos_h, </span>
<span id="cb30-67"><a href="#cb30-67" tabindex="-1"></a> <span class="at">clip =</span> <span class="st">&quot;off&quot;</span>)</span>
<span id="cb30-68"><a href="#cb30-68" tabindex="-1"></a> }</span>
<span id="cb30-69"><a href="#cb30-69" tabindex="-1"></a> panel_table</span>
<span id="cb30-70"><a href="#cb30-70" tabindex="-1"></a>}</span></code></pre></div>
</div>
<div id="assembling-the-facet-class" class="section level3">
<h3>Assembling the Facet class</h3>
<p>Usually all methods are defined within the class definition in the
same way as is done for <code>Geom</code> and <code>Stat</code>. 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</p>
<div class="sourceCode" id="cb31"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb31-1"><a href="#cb31-1" tabindex="-1"></a><span class="co"># Constructor: shrink is required to govern whether scales are trained on </span></span>
<span id="cb31-2"><a href="#cb31-2" tabindex="-1"></a><span class="co"># Stat-transformed data or not.</span></span>
<span id="cb31-3"><a href="#cb31-3" tabindex="-1"></a>facet_duplicate <span class="ot">&lt;-</span> <span class="cf">function</span>(<span class="at">horizontal =</span> <span class="cn">TRUE</span>, <span class="at">shrink =</span> <span class="cn">TRUE</span>) {</span>
<span id="cb31-4"><a href="#cb31-4" tabindex="-1"></a> <span class="fu">ggproto</span>(<span class="cn">NULL</span>, FacetDuplicate,</span>
<span id="cb31-5"><a href="#cb31-5" tabindex="-1"></a> <span class="at">shrink =</span> shrink,</span>
<span id="cb31-6"><a href="#cb31-6" tabindex="-1"></a> <span class="at">params =</span> <span class="fu">list</span>(</span>
<span id="cb31-7"><a href="#cb31-7" tabindex="-1"></a> <span class="at">horizontal =</span> horizontal</span>
<span id="cb31-8"><a href="#cb31-8" tabindex="-1"></a> )</span>
<span id="cb31-9"><a href="#cb31-9" tabindex="-1"></a> )</span>
<span id="cb31-10"><a href="#cb31-10" tabindex="-1"></a>}</span>
<span id="cb31-11"><a href="#cb31-11" tabindex="-1"></a></span>
<span id="cb31-12"><a href="#cb31-12" tabindex="-1"></a>FacetDuplicate <span class="ot">&lt;-</span> <span class="fu">ggproto</span>(<span class="st">&quot;FacetDuplicate&quot;</span>, Facet,</span>
<span id="cb31-13"><a href="#cb31-13" tabindex="-1"></a> <span class="at">compute_layout =</span> layout,</span>
<span id="cb31-14"><a href="#cb31-14" tabindex="-1"></a> <span class="at">map_data =</span> mapping,</span>
<span id="cb31-15"><a href="#cb31-15" tabindex="-1"></a> <span class="at">draw_panels =</span> render</span>
<span id="cb31-16"><a href="#cb31-16" tabindex="-1"></a>)</span></code></pre></div>
<p>Now with everything assembled, lets test it out:</p>
<div class="sourceCode" id="cb32"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb32-1"><a href="#cb32-1" tabindex="-1"></a>p <span class="ot">&lt;-</span> <span class="fu">ggplot</span>(mtcars, <span class="fu">aes</span>(<span class="at">x =</span> hp, <span class="at">y =</span> mpg)) <span class="sc">+</span> <span class="fu">geom_point</span>()</span>
<span id="cb32-2"><a href="#cb32-2" tabindex="-1"></a>p</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7d0JmF1leTjwd7InkJ1IwpZEWQ0NioILIBQtpEIVFCwEFRGkSKuCImipQkRpKVVEoYIilEcpSi2CsousglRElrI0rAFkS8i+r/PPd/zPOJM7d2bu3HvuNr/zPJPc851z3+/7ft9d3nvWltaNU5gIECBAgAABAgQIVElgQJXqUQ0BAgQIECBAgACBTEAC6oVAgAABAgQIECBQVQEJaFW5VUaAAAECBAgQICAB9RogQIAAAQIECBCoqsCgatU2d+7c+MMf/hA77bRTTJ06tb3aF154IV5++eX2+fHjx8cOO+zQPu8BAQIECBAgQIBAcwlUJQG97rrr4r/+679in332iR/96Ecxc+bMOOiggzLJSy65JF577bUYM2ZMNj99+nQJaHO9xvSGAAECBAgQINBJIPcENF3l6ZZbbolZs2bFlClTYrfddovvfve77QnoU089Feecc05st912nRpWbGbx4sWxfv36YovLLh8yZEisWbOm7DgClC8wePDgaGlpMR7lU1YkQhqPtWvXViSWIOUJDBgwINJn1apVq8oL5NkVEUjjkT6r8vxuqkhD+0mQYcOGZZ9VxqO2A54+ozbffPOijcg9AU1vyu985ztZA9KX1z333BNTNiaiaVqxYkUsWLAg5s2bF3fddVfst99+sc0222TL2v65884749Zbb22bjU9+8pOx5ZZbts9X+kECSx8mptoLpLFIrx/jUfuxSC1I4zFw4MD6aEw/b0Uah6FDh/ZzhfrpfvqMSn/r1q2rn0b145YMHz48Bg0aZDxq/Bro6QdA7gloW/+XLFkSRx11VKxcuTJ+8IMfZMXPPPNMrF69Ou6///5IL5iTTjopjjnmmPato2mltHv+oYceaguTbQ1LW2LymtKHSJ7x82p3M8ZtSzyNR32MrvdGfYxDakX6YZYm742Moeb/pPFo+6t5YzQgE0g/0treJ0hqI9DTfY5aqnknpNSYtKXzG9/4Rlx77bXZh+fSpUtj7NixmU7aOnrppZfGD3/4w6JaaWtpnr8yU1sWLlxYtH4LqieQjgtOHyLz58+vXqVqKiowevToSD8ke/pQKRrAgooJpF2M6bMq/UDfsGFDxeIK1DeBtDU6fValvXqm2gtMnDgx+6wyHrUdi/S+GDduXNFG5L6vOR1Ped9992UNSL9G9t133+yEo8ceeywWLVrUKdlLx4H6QC06VhYQIECAAAECBJpCIPcENO0iuuiii+J3v/tdBjZ79uxsi9bkyZMjnVB08sknZ7vl01aVdLZ8SlDbdr02hbBOECBAgAABAgQIdBLI/RjQtNUzHduZktDvf//72YHz6Yz4CRMmZH8f+tCH4vjjj892q48aNSrOOuusTg00Q4AAAQIECBAg0FwCVT0GdNmyZV2ekp+OYUrLUgLa0+QY0J6Emme5Y0DraywdA1o/4+EY0PoZi9QSx4DW13g4BrQ+xqPmx4B2ZCh2Pai0y703yWfHWB4TIECAAAECBAg0pkDux4A2JotWEyBAgAABAgQI5CUgAc1LVlwCBAgQIECAAIEuBSSgXbIoJECAAAECBAgQyEtAApqXrLgECBAgQIAAAQJdCkhAu2RRSIAAAQIECBAgkJeABDQvWXEJECBAgAABAgS6FJCAdsmikAABAgQIECBAIC8BCWhesuISIECAAAECBAh0KSAB7ZJFIQECBAgQIECAQF4CEtC8ZMUlQIAAAQIECBDoUkAC2iWLQgIECBAgQIAAgbwEJKB5yYpLgAABAgQIECDQpYAEtEsWhQQIECBAgAABAnkJSEDzkhWXAAECBAgQIECgSwEJaJcsCgkQIECAAAECBPISkIDmJSsuAQIECBAgQIBAlwKDuixVWDWB1atXx49//ONYunRpvOtd74p3vOMdVatbRQQIECBAgACBWghIQGuh/v/rXLduXbz73e+OJUuWREpE0/xpp50Wn/vc52rYKlUTIECAAAECBPIVsAs+X99uo//DP/xDvP7667F8+fIs+Uwrf+c734lHHnmk2+dZSIAAAQIECBBoZAEJaA1H77HHHou1a9d2asHAgQPj8ccf71RmhgABAgQIECDQTAIS0BqO5qRJk6KlpaVTC5YtWxYTJkzoVGaGAAECBAgQINBMAhLQGo7mv/7rv0Zra2t7Ejp48OCYPn16vPe9761hq1RNgAABAgQIEMhXwElI+fp2G33KlCnZ7vZTTjkl5s+fH3/1V38VJ554YrfPsZAAAQIECBAg0OgCEtAaj+CYMWPikksuqXErVE+AAAECBAgQqJ6AXfDVs1YTAQIECBAgQIDARgEJqJcBAQIECBAgQIBAVQUkoFXlVhkBAgQIECBAgIAE1GuAAAECBAgQIECgqgIS0Kpyq4wAAQIECBAgQEAC6jVAgAABAgQIECBQVQEJaFW5VUaAAAECBAgQICAB9RogQIAAAQIECBCoqoAEtKrcKiNAgAABAgQIEJCAeg0QIECAAAECBAhUVUACWlVulREgQIAAAQIECEhAvQYIECBAgAABAgSq
<div class="sourceCode" id="cb33"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb33-1"><a href="#cb33-1" tabindex="-1"></a>p <span class="sc">+</span> <span class="fu">facet_duplicate</span>()</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7N0HnBT1/f/xz3EHHL2DFBWMCLGgEAuKBAsY/2ps2BAUVIIm2MVCxB+CJSHYUDT2bqJYIgYViYBoVERFRQURUCkKgvRy9Pvn/U123bvdu9u9Lbff2df38YDbnZn9zvf7nNnvfuY735nJK/5PMhICCCCAAAIIIIAAAhkSqJah9bAaBBBAAAEEEEAAAQScAAEoOwICCCCAAAIIIIBARgUIQDPKzcoQQAABBBBAAAEECEDZBxBAAAEEEEAAAQQyKlCQqbUtX77cZs6caR06dLB27dqFV7to0SL74Ycfwu+bNGli7du3D7/nBQIIIBA0gS+//NKWLVtmv/rVr6xhw4bh6n3yySe2ZcuW8Pu99trLGjduHH7PCwQQQCAoAnmZuAp+woQJ9vzzz1v37t1t6tSpdvbZZ9vxxx/vDP/v//7Pfvzxx3Aj3KlTJ+vbt29QfKkHAgggUEJgyJAhVlhYaC1atLB///vfdvvtt1ubNm1s+/btduyxx7qgNPSBfv362X777Rd6y18EEEAgMAJp7wHVXZ4mTZpkI0aMsLZt29r+++9v99xzTzgAnTdvno0aNcp22223uFDXrl1rO3bsiGvZ6tWr27Zt2+JaNtsWqlatmtWoUcP1hvh4pyyVPy8vL+5tlW3+ChAUEOifj0n7ztatW30suul7q33Hx/Kr3I0aNSrT/dtvv3Vt0m233eaW2bRpk7355ps2YMAA++6771wgqvYw3rRq1ap4F3XtiY+mqmBBQYHl5+eX6B2Ou+JZsKDKr98tH9ty7dM1a9b09rdI5de+42tbLnvtOz6WX79DdevWLfMbmPYAVBv/7rvvdgVQMPjuu+9a2/8EokpqfNWArlixwt5++2074ogjXAPsZv7vv2nTprkGOjTt/PPPdz0Hoffl/VXlteP5mBTAKQiSn4+Nlsqvfz5+abS/1KpVywUKvpZf+778fUyhsvtY/p07d5ZLruFHY8aMccusWbPGPvvsM/vd737n3utgXD2hEydOdD/2vXr1stq1a5fI79FHHzUFsUr169e3wYMHl5hf3puQa3nLZOs8HZSoLVd76GNS+dWW+NqW67dI38eK9u9s3Da+B6CyVwDqY2daRZ2FaQ9AQzvkunXr3Kn1oqIie+ihh9zkBQsWuIb2ww8/dD/4l19+uZ133nnh3lEtpNPzn376aSgb1yuiL3M8SV+YeJeNJ79MLhNqaHXk7GNS+UP/fCy/yuzzD57P+77Krn3Hx+9uvAGGzgqpp7Njx47WrVs39xX5+uuvbe7cue4skYJMtZOPP/64NW3aNPwVUpD6xRdfuPcaL5+IEftEmDHjL0L28e4fGS9gOSuM/C3ytfw+/xap7KH9p5zNlJWzKtpfMjIGNCSjwqin85ZbbrHx48e7xnP9+vXhU1bqHdUR/iOPPBL6SNRf9ZbG2yvVoEEDU/4+HrWp210XH+jirYqOIqKQsmCCelv047hx48YsKE3iRdD4vA0bNnhbfp0GXr16deIVz4JP6Hurfeenn37KgtIkXoSWLVvG9SGdAdLZIf0dOXKk+6sPhno9b7rpJnfBpsaBlpWWLl1a1qyo6T7vE/Xq1XNnhNT++5hUfnW+xPvblU111HdRB0H6PvrYC6dOHPUiqj33MTVr1sw2b97sYhnfyh+KY8oqd9rP0WnM0fTp0936Fcn36NHDXXCkq0B1CiryR1LjQNXj6WPAWBYw0xFAAIGQgNo39XIqKdA85ZRT7KOPPnLvv//++xJjHNUeJhJgukz4DwEEEPBEIO0BqI6e7r//fpsxY4YjUeO7cuVK23333U0XFF1xxRXuyFC9o7paXgGquptJCCCAQNAE1Nt53XXXuR4N1U13Bdlzzz1dNXV2SG2lkpabMmWKHXnkke49/yGAAAJBE0j7AEP1empspxrWBx980F1Npyvi1a2sf6eeeqoNGjTInZrQoHqddiIhgAACQRTQRUi9e/d2bZ7GGOu9AlKl008/3Y0L1Th4nWrWRUhdunQJIgN1QgABBCyjY0A1BiPWJfk65a55CkArSowBrUgoO+YzBrRqt4PP4/1yYQyo2jyN6wqN94zcW9T7qeBU46cqSomcovd5n2AMaEV7QvrmMwY0fbbx5BzkMaBp7wGNBI4VfGq+TrnHE3xG5sVrBBBAwFcBtXmxgk/Vp6zpvtaVciOAAAKxBBhsGUuFaQgggAACCCCAAAJpEyAATRstGSOAAAIIIIAAAgjEEiAAjaXCNAQQQAABBBBAAIG0CRCApo2WjBFAAAEEEEAAAQRiCRCAxlJhGgIIIIAAAggggEDaBAhA00ZLxggggAACCCCAAAKxBAhAY6kwDQEEEEAAAQQQQCBtAgSgaaMlYwQQQAABBBBAAIFYAgSgsVSYhgACCCCAAAIIIJA2AQLQtNGSMQIIIIAAAggggEAsAQLQWCpMQwABBBBAAAEEEEibAAFo2mjJGAEEEEAAAQQQQCCWAAFoLBWmIYAAAggggAACCKRNgAA0bbRkjAACCCCAAAIIIBBLgAA0
</div>
<div id="doing-more-with-facets" class="section level3">
<h3>Doing more with facets</h3>
<p>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:</p>
<div class="sourceCode" id="cb34"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb34-1"><a href="#cb34-1" tabindex="-1"></a><span class="fu">library</span>(scales)</span>
<span id="cb34-2"><a href="#cb34-2" tabindex="-1"></a></span>
<span id="cb34-3"><a href="#cb34-3" tabindex="-1"></a>facet_trans <span class="ot">&lt;-</span> <span class="cf">function</span>(trans, <span class="at">horizontal =</span> <span class="cn">TRUE</span>, <span class="at">shrink =</span> <span class="cn">TRUE</span>) {</span>
<span id="cb34-4"><a href="#cb34-4" tabindex="-1"></a> <span class="fu">ggproto</span>(<span class="cn">NULL</span>, FacetTrans,</span>
<span id="cb34-5"><a href="#cb34-5" tabindex="-1"></a> <span class="at">shrink =</span> shrink,</span>
<span id="cb34-6"><a href="#cb34-6" tabindex="-1"></a> <span class="at">params =</span> <span class="fu">list</span>(</span>
<span id="cb34-7"><a href="#cb34-7" tabindex="-1"></a> <span class="at">trans =</span> scales<span class="sc">::</span><span class="fu">as.transform</span>(trans),</span>
<span id="cb34-8"><a href="#cb34-8" tabindex="-1"></a> <span class="at">horizontal =</span> horizontal</span>
<span id="cb34-9"><a href="#cb34-9" tabindex="-1"></a> )</span>
<span id="cb34-10"><a href="#cb34-10" tabindex="-1"></a> )</span>
<span id="cb34-11"><a href="#cb34-11" tabindex="-1"></a>}</span>
<span id="cb34-12"><a href="#cb34-12" tabindex="-1"></a></span>
<span id="cb34-13"><a href="#cb34-13" tabindex="-1"></a>FacetTrans <span class="ot">&lt;-</span> <span class="fu">ggproto</span>(<span class="st">&quot;FacetTrans&quot;</span>, Facet,</span>
<span id="cb34-14"><a href="#cb34-14" tabindex="-1"></a> <span class="co"># Almost as before but we want different y-scales for each panel</span></span>
<span id="cb34-15"><a href="#cb34-15" tabindex="-1"></a> <span class="at">compute_layout =</span> <span class="cf">function</span>(data, params) {</span>
<span id="cb34-16"><a href="#cb34-16" tabindex="-1"></a> <span class="fu">data.frame</span>(<span class="at">PANEL =</span> <span class="fu">c</span>(1L, 2L), <span class="at">SCALE_X =</span> 1L, <span class="at">SCALE_Y =</span> <span class="fu">c</span>(1L, 2L))</span>
<span id="cb34-17"><a href="#cb34-17" tabindex="-1"></a> },</span>
<span id="cb34-18"><a href="#cb34-18" tabindex="-1"></a> <span class="co"># Same as before</span></span>
<span id="cb34-19"><a href="#cb34-19" tabindex="-1"></a> <span class="at">map_data =</span> <span class="cf">function</span>(data, layout, params) {</span>
<span id="cb34-20"><a href="#cb34-20" tabindex="-1"></a> <span class="cf">if</span> (<span class="fu">is.null</span>(data) <span class="sc">||</span> <span class="fu">nrow</span>(data) <span class="sc">==</span> <span class="dv">0</span>) {</span>
<span id="cb34-21"><a href="#cb34-21" tabindex="-1"></a> <span class="fu">return</span>(<span class="fu">cbind</span>(data, <span class="at">PANEL =</span> <span class="fu">integer</span>(<span class="dv">0</span>)))</span>
<span id="cb34-22"><a href="#cb34-22" tabindex="-1"></a> }</span>
<span id="cb34-23"><a href="#cb34-23" tabindex="-1"></a> <span class="fu">rbind</span>(</span>
<span id="cb34-24"><a href="#cb34-24" tabindex="-1"></a> <span class="fu">cbind</span>(data, <span class="at">PANEL =</span> 1L),</span>
<span id="cb34-25"><a href="#cb34-25" tabindex="-1"></a> <span class="fu">cbind</span>(data, <span class="at">PANEL =</span> 2L)</span>
<span id="cb34-26"><a href="#cb34-26" tabindex="-1"></a> )</span>
<span id="cb34-27"><a href="#cb34-27" tabindex="-1"></a> },</span>
<span id="cb34-28"><a href="#cb34-28" tabindex="-1"></a> <span class="co"># This is new. We create a new scale with the defined transformation</span></span>
<span id="cb34-29"><a href="#cb34-29" tabindex="-1"></a> <span class="at">init_scales =</span> <span class="cf">function</span>(layout, <span class="at">x_scale =</span> <span class="cn">NULL</span>, <span class="at">y_scale =</span> <span class="cn">NULL</span>, params) {</span>
<span id="cb34-30"><a href="#cb34-30" tabindex="-1"></a> scales <span class="ot">&lt;-</span> <span class="fu">list</span>()</span>
<span id="cb34-31"><a href="#cb34-31" tabindex="-1"></a> <span class="cf">if</span> (<span class="sc">!</span><span class="fu">is.null</span>(x_scale)) {</span>
<span id="cb34-32"><a href="#cb34-32" tabindex="-1"></a> scales<span class="sc">$</span>x <span class="ot">&lt;-</span> <span class="fu">lapply</span>(<span class="fu">seq_len</span>(<span class="fu">max</span>(layout<span class="sc">$</span>SCALE_X)), <span class="cf">function</span>(i) x_scale<span class="sc">$</span><span class="fu">clone</span>())</span>
<span id="cb34-33"><a href="#cb34-33" tabindex="-1"></a> }</span>
<span id="cb34-34"><a href="#cb34-34" tabindex="-1"></a> <span class="cf">if</span> (<span class="sc">!</span><span class="fu">is.null</span>(y_scale)) {</span>
<span id="cb34-35"><a href="#cb34-35" tabindex="-1"></a> y_scale_orig <span class="ot">&lt;-</span> y_scale<span class="sc">$</span><span class="fu">clone</span>()</span>
<span id="cb34-36"><a href="#cb34-36" tabindex="-1"></a> y_scale_new <span class="ot">&lt;-</span> y_scale<span class="sc">$</span><span class="fu">clone</span>()</span>
<span id="cb34-37"><a href="#cb34-37" tabindex="-1"></a> y_scale_new<span class="sc">$</span>trans <span class="ot">&lt;-</span> params<span class="sc">$</span>trans</span>
<span id="cb34-38"><a href="#cb34-38" tabindex="-1"></a> <span class="co"># Make sure that oob values are kept</span></span>
<span id="cb34-39"><a href="#cb34-39" tabindex="-1"></a> y_scale_new<span class="sc">$</span>oob <span class="ot">&lt;-</span> <span class="cf">function</span>(x, ...) x</span>
<span id="cb34-40"><a href="#cb34-40" tabindex="-1"></a> scales<span class="sc">$</span>y <span class="ot">&lt;-</span> <span class="fu">list</span>(y_scale_orig, y_scale_new)</span>
<span id="cb34-41"><a href="#cb34-41" tabindex="-1"></a> }</span>
<span id="cb34-42"><a href="#cb34-42" tabindex="-1"></a> scales</span>
<span id="cb34-43"><a href="#cb34-43" tabindex="-1"></a> },</span>
<span id="cb34-44"><a href="#cb34-44" tabindex="-1"></a> <span class="co"># We must make sure that the second scale is trained on transformed data</span></span>
<span id="cb34-45"><a href="#cb34-45" tabindex="-1"></a> <span class="at">train_scales =</span> <span class="cf">function</span>(x_scales, y_scales, layout, data, params) {</span>
<span id="cb34-46"><a href="#cb34-46" tabindex="-1"></a> <span class="co"># Transform data for second panel prior to scale training</span></span>
<span id="cb34-47"><a href="#cb34-47" tabindex="-1"></a> <span class="cf">if</span> (<span class="sc">!</span><span class="fu">is.null</span>(y_scales)) {</span>
<span id="cb34-48"><a href="#cb34-48" tabindex="-1"></a> data <span class="ot">&lt;-</span> <span class="fu">lapply</span>(data, <span class="cf">function</span>(layer_data) {</span>
<span id="cb34-49"><a href="#cb34-49" tabindex="-1"></a> match_id <span class="ot">&lt;-</span> <span class="fu">match</span>(layer_data<span class="sc">$</span>PANEL, layout<span class="sc">$</span>PANEL)</span>
<span id="cb34-50"><a href="#cb34-50" tabindex="-1"></a> y_vars <span class="ot">&lt;-</span> <span class="fu">intersect</span>(y_scales[[<span class="dv">1</span>]]<span class="sc">$</span>aesthetics, <span class="fu">names</span>(layer_data))</span>
<span id="cb34-51"><a href="#cb34-51" tabindex="-1"></a> trans_scale <span class="ot">&lt;-</span> layer_data<span class="sc">$</span>PANEL <span class="sc">==</span> 2L</span>
<span id="cb34-52"><a href="#cb34-52" tabindex="-1"></a> <span class="cf">for</span> (i <span class="cf">in</span> y_vars) {</span>
<span id="cb34-53"><a href="#cb34-53" tabindex="-1"></a> layer_data[trans_scale, i] <span class="ot">&lt;-</span> y_scales[[<span class="dv">2</span>]]<span class="sc">$</span><span class="fu">transform</span>(layer_data[trans_scale, i])</span>
<span id="cb34-54"><a href="#cb34-54" tabindex="-1"></a> }</span>
<span id="cb34-55"><a href="#cb34-55" tabindex="-1"></a> layer_data</span>
<span id="cb34-56"><a href="#cb34-56" tabindex="-1"></a> })</span>
<span id="cb34-57"><a href="#cb34-57" tabindex="-1"></a> }</span>
<span id="cb34-58"><a href="#cb34-58" tabindex="-1"></a> Facet<span class="sc">$</span><span class="fu">train_scales</span>(x_scales, y_scales, layout, data, params)</span>
<span id="cb34-59"><a href="#cb34-59" tabindex="-1"></a> },</span>
<span id="cb34-60"><a href="#cb34-60" tabindex="-1"></a> <span class="co"># this is where we actually modify the data. It cannot be done in $map_data as that function</span></span>
<span id="cb34-61"><a href="#cb34-61" tabindex="-1"></a> <span class="co"># doesn&#39;t have access to the scales</span></span>
<span id="cb34-62"><a href="#cb34-62" tabindex="-1"></a> <span class="at">finish_data =</span> <span class="cf">function</span>(data, layout, x_scales, y_scales, params) {</span>
<span id="cb34-63"><a href="#cb34-63" tabindex="-1"></a> match_id <span class="ot">&lt;-</span> <span class="fu">match</span>(data<span class="sc">$</span>PANEL, layout<span class="sc">$</span>PANEL)</span>
<span id="cb34-64"><a href="#cb34-64" tabindex="-1"></a> y_vars <span class="ot">&lt;-</span> <span class="fu">intersect</span>(y_scales[[<span class="dv">1</span>]]<span class="sc">$</span>aesthetics, <span class="fu">names</span>(data))</span>
<span id="cb34-65"><a href="#cb34-65" tabindex="-1"></a> trans_scale <span class="ot">&lt;-</span> data<span class="sc">$</span>PANEL <span class="sc">==</span> 2L</span>
<span id="cb34-66"><a href="#cb34-66" tabindex="-1"></a> <span class="cf">for</span> (i <span class="cf">in</span> y_vars) {</span>
<span id="cb34-67"><a href="#cb34-67" tabindex="-1"></a> data[trans_scale, i] <span class="ot">&lt;-</span> y_scales[[<span class="dv">2</span>]]<span class="sc">$</span><span class="fu">transform</span>(data[trans_scale, i])</span>
<span id="cb34-68"><a href="#cb34-68" tabindex="-1"></a> }</span>
<span id="cb34-69"><a href="#cb34-69" tabindex="-1"></a> data</span>
<span id="cb34-70"><a href="#cb34-70" tabindex="-1"></a> },</span>
<span id="cb34-71"><a href="#cb34-71" tabindex="-1"></a> <span class="co"># A few changes from before to accommodate that axes are now not duplicate of each other</span></span>
<span id="cb34-72"><a href="#cb34-72" tabindex="-1"></a> <span class="co"># We also add a panel strip to annotate the different panels</span></span>
<span id="cb34-73"><a href="#cb34-73" tabindex="-1"></a> <span class="at">draw_panels =</span> <span class="cf">function</span>(panels, layout, x_scales, y_scales, ranges, coord,</span>
<span id="cb34-74"><a href="#cb34-74" tabindex="-1"></a> data, theme, params) {</span>
<span id="cb34-75"><a href="#cb34-75" tabindex="-1"></a> <span class="co"># Place panels according to settings</span></span>
<span id="cb34-76"><a href="#cb34-76" tabindex="-1"></a> <span class="cf">if</span> (params<span class="sc">$</span>horizontal) {</span>
<span id="cb34-77"><a href="#cb34-77" tabindex="-1"></a> <span class="co"># Put panels in matrix and convert to a gtable</span></span>
<span id="cb34-78"><a href="#cb34-78" tabindex="-1"></a> panels <span class="ot">&lt;-</span> <span class="fu">matrix</span>(panels, <span class="at">ncol =</span> <span class="dv">2</span>)</span>
<span id="cb34-79"><a href="#cb34-79" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_matrix</span>(<span class="st">&quot;layout&quot;</span>, panels, </span>
<span id="cb34-80"><a href="#cb34-80" tabindex="-1"></a> <span class="at">widths =</span> <span class="fu">unit</span>(<span class="fu">c</span>(<span class="dv">1</span>, <span class="dv">1</span>), <span class="st">&quot;null&quot;</span>), <span class="at">heights =</span> <span class="fu">unit</span>(<span class="dv">1</span>, <span class="st">&quot;null&quot;</span>), <span class="at">clip =</span> <span class="st">&quot;on&quot;</span>)</span>
<span id="cb34-81"><a href="#cb34-81" tabindex="-1"></a> <span class="co"># Add spacing according to theme</span></span>
<span id="cb34-82"><a href="#cb34-82" tabindex="-1"></a> panel_spacing <span class="ot">&lt;-</span> <span class="cf">if</span> (<span class="fu">is.null</span>(theme<span class="sc">$</span>panel.spacing.x)) {</span>
<span id="cb34-83"><a href="#cb34-83" tabindex="-1"></a> theme<span class="sc">$</span>panel.spacing</span>
<span id="cb34-84"><a href="#cb34-84" tabindex="-1"></a> } <span class="cf">else</span> {</span>
<span id="cb34-85"><a href="#cb34-85" tabindex="-1"></a> theme<span class="sc">$</span>panel.spacing.x</span>
<span id="cb34-86"><a href="#cb34-86" tabindex="-1"></a> }</span>
<span id="cb34-87"><a href="#cb34-87" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_col_space</span>(panel_table, panel_spacing)</span>
<span id="cb34-88"><a href="#cb34-88" tabindex="-1"></a> } <span class="cf">else</span> {</span>
<span id="cb34-89"><a href="#cb34-89" tabindex="-1"></a> panels <span class="ot">&lt;-</span> <span class="fu">matrix</span>(panels, <span class="at">ncol =</span> <span class="dv">1</span>)</span>
<span id="cb34-90"><a href="#cb34-90" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_matrix</span>(<span class="st">&quot;layout&quot;</span>, panels, </span>
<span id="cb34-91"><a href="#cb34-91" tabindex="-1"></a> <span class="at">widths =</span> <span class="fu">unit</span>(<span class="dv">1</span>, <span class="st">&quot;null&quot;</span>), <span class="at">heights =</span> <span class="fu">unit</span>(<span class="fu">c</span>(<span class="dv">1</span>, <span class="dv">1</span>), <span class="st">&quot;null&quot;</span>), <span class="at">clip =</span> <span class="st">&quot;on&quot;</span>)</span>
<span id="cb34-92"><a href="#cb34-92" tabindex="-1"></a> panel_spacing <span class="ot">&lt;-</span> <span class="cf">if</span> (<span class="fu">is.null</span>(theme<span class="sc">$</span>panel.spacing.y)) {</span>
<span id="cb34-93"><a href="#cb34-93" tabindex="-1"></a> theme<span class="sc">$</span>panel.spacing</span>
<span id="cb34-94"><a href="#cb34-94" tabindex="-1"></a> } <span class="cf">else</span> {</span>
<span id="cb34-95"><a href="#cb34-95" tabindex="-1"></a> theme<span class="sc">$</span>panel.spacing.y</span>
<span id="cb34-96"><a href="#cb34-96" tabindex="-1"></a> }</span>
<span id="cb34-97"><a href="#cb34-97" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_row_space</span>(panel_table, panel_spacing)</span>
<span id="cb34-98"><a href="#cb34-98" tabindex="-1"></a> }</span>
<span id="cb34-99"><a href="#cb34-99" tabindex="-1"></a> <span class="co"># Name panel grobs so they can be found later</span></span>
<span id="cb34-100"><a href="#cb34-100" tabindex="-1"></a> panel_table<span class="sc">$</span>layout<span class="sc">$</span>name <span class="ot">&lt;-</span> <span class="fu">paste0</span>(<span class="st">&quot;panel-&quot;</span>, <span class="fu">c</span>(<span class="dv">1</span>, <span class="dv">2</span>))</span>
<span id="cb34-101"><a href="#cb34-101" tabindex="-1"></a> </span>
<span id="cb34-102"><a href="#cb34-102" tabindex="-1"></a> <span class="co"># Construct the axes</span></span>
<span id="cb34-103"><a href="#cb34-103" tabindex="-1"></a> axes <span class="ot">&lt;-</span> <span class="fu">render_axes</span>(ranges[<span class="dv">1</span>], ranges, coord, theme, </span>
<span id="cb34-104"><a href="#cb34-104" tabindex="-1"></a> <span class="at">transpose =</span> <span class="cn">TRUE</span>)</span>
<span id="cb34-105"><a href="#cb34-105" tabindex="-1"></a> </span>
<span id="cb34-106"><a href="#cb34-106" tabindex="-1"></a> <span class="co"># Add axes around each panel</span></span>
<span id="cb34-107"><a href="#cb34-107" tabindex="-1"></a> grobWidths <span class="ot">&lt;-</span> <span class="cf">function</span>(x) {</span>
<span id="cb34-108"><a href="#cb34-108" tabindex="-1"></a> <span class="fu">unit</span>(<span class="fu">vapply</span>(x, <span class="cf">function</span>(x) {</span>
<span id="cb34-109"><a href="#cb34-109" tabindex="-1"></a> grid<span class="sc">::</span><span class="fu">convertWidth</span>(</span>
<span id="cb34-110"><a href="#cb34-110" tabindex="-1"></a> grid<span class="sc">::</span><span class="fu">grobWidth</span>(x), <span class="st">&quot;cm&quot;</span>, <span class="cn">TRUE</span>)</span>
<span id="cb34-111"><a href="#cb34-111" tabindex="-1"></a> }, <span class="fu">numeric</span>(<span class="dv">1</span>)), <span class="st">&quot;cm&quot;</span>)</span>
<span id="cb34-112"><a href="#cb34-112" tabindex="-1"></a> }</span>
<span id="cb34-113"><a href="#cb34-113" tabindex="-1"></a> panel_pos_h <span class="ot">&lt;-</span> <span class="fu">panel_cols</span>(panel_table)<span class="sc">$</span>l</span>
<span id="cb34-114"><a href="#cb34-114" tabindex="-1"></a> panel_pos_v <span class="ot">&lt;-</span> <span class="fu">panel_rows</span>(panel_table)<span class="sc">$</span>t</span>
<span id="cb34-115"><a href="#cb34-115" tabindex="-1"></a> axis_width_l <span class="ot">&lt;-</span> <span class="fu">grobWidths</span>(axes<span class="sc">$</span>y<span class="sc">$</span>left)</span>
<span id="cb34-116"><a href="#cb34-116" tabindex="-1"></a> axis_width_r <span class="ot">&lt;-</span> <span class="fu">grobWidths</span>(axes<span class="sc">$</span>y<span class="sc">$</span>right)</span>
<span id="cb34-117"><a href="#cb34-117" tabindex="-1"></a> <span class="do">## We do it reverse so we don&#39;t change the position of panels when we add axes</span></span>
<span id="cb34-118"><a href="#cb34-118" tabindex="-1"></a> <span class="cf">if</span> (params<span class="sc">$</span>horizontal) {</span>
<span id="cb34-119"><a href="#cb34-119" tabindex="-1"></a> <span class="cf">for</span> (i <span class="cf">in</span> <span class="fu">rev</span>(<span class="fu">seq_along</span>(panel_pos_h))) {</span>
<span id="cb34-120"><a href="#cb34-120" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_cols</span>(panel_table, axis_width_r[i], panel_pos_h[i])</span>
<span id="cb34-121"><a href="#cb34-121" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_grob</span>(panel_table,</span>
<span id="cb34-122"><a href="#cb34-122" tabindex="-1"></a> axes<span class="sc">$</span>y<span class="sc">$</span>right[i], <span class="at">t =</span> panel_pos_v, <span class="at">l =</span> panel_pos_h[i] <span class="sc">+</span> <span class="dv">1</span>,</span>
<span id="cb34-123"><a href="#cb34-123" tabindex="-1"></a> <span class="at">clip =</span> <span class="st">&quot;off&quot;</span>)</span>
<span id="cb34-124"><a href="#cb34-124" tabindex="-1"></a></span>
<span id="cb34-125"><a href="#cb34-125" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_cols</span>(panel_table, axis_width_l[i], panel_pos_h[i] <span class="sc">-</span> <span class="dv">1</span>)</span>
<span id="cb34-126"><a href="#cb34-126" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_grob</span>(panel_table,</span>
<span id="cb34-127"><a href="#cb34-127" tabindex="-1"></a> axes<span class="sc">$</span>y<span class="sc">$</span>left[i], <span class="at">t =</span> panel_pos_v, <span class="at">l =</span> panel_pos_h[i],</span>
<span id="cb34-128"><a href="#cb34-128" tabindex="-1"></a> <span class="at">clip =</span> <span class="st">&quot;off&quot;</span>)</span>
<span id="cb34-129"><a href="#cb34-129" tabindex="-1"></a> }</span>
<span id="cb34-130"><a href="#cb34-130" tabindex="-1"></a> } <span class="cf">else</span> {</span>
<span id="cb34-131"><a href="#cb34-131" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_cols</span>(panel_table, axis_width_r[<span class="dv">1</span>], panel_pos_h)</span>
<span id="cb34-132"><a href="#cb34-132" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_grob</span>(panel_table,</span>
<span id="cb34-133"><a href="#cb34-133" tabindex="-1"></a> axes<span class="sc">$</span>y<span class="sc">$</span>right, <span class="at">t =</span> panel_pos_v, <span class="at">l =</span> panel_pos_h <span class="sc">+</span> <span class="dv">1</span>,</span>
<span id="cb34-134"><a href="#cb34-134" tabindex="-1"></a> <span class="at">clip =</span> <span class="st">&quot;off&quot;</span>)</span>
<span id="cb34-135"><a href="#cb34-135" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_cols</span>(panel_table, axis_width_l[<span class="dv">1</span>], panel_pos_h <span class="sc">-</span> <span class="dv">1</span>)</span>
<span id="cb34-136"><a href="#cb34-136" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_grob</span>(panel_table,</span>
<span id="cb34-137"><a href="#cb34-137" tabindex="-1"></a> axes<span class="sc">$</span>y<span class="sc">$</span>left, <span class="at">t =</span> panel_pos_v, <span class="at">l =</span> panel_pos_h,</span>
<span id="cb34-138"><a href="#cb34-138" tabindex="-1"></a> <span class="at">clip =</span> <span class="st">&quot;off&quot;</span>)</span>
<span id="cb34-139"><a href="#cb34-139" tabindex="-1"></a> }</span>
<span id="cb34-140"><a href="#cb34-140" tabindex="-1"></a></span>
<span id="cb34-141"><a href="#cb34-141" tabindex="-1"></a> <span class="do">## Recalculate as gtable has changed</span></span>
<span id="cb34-142"><a href="#cb34-142" tabindex="-1"></a> panel_pos_h <span class="ot">&lt;-</span> <span class="fu">panel_cols</span>(panel_table)<span class="sc">$</span>l</span>
<span id="cb34-143"><a href="#cb34-143" tabindex="-1"></a> panel_pos_v <span class="ot">&lt;-</span> <span class="fu">panel_rows</span>(panel_table)<span class="sc">$</span>t</span>
<span id="cb34-144"><a href="#cb34-144" tabindex="-1"></a> axis_height_t <span class="ot">&lt;-</span> <span class="fu">unit</span>(grid<span class="sc">::</span><span class="fu">convertHeight</span>(</span>
<span id="cb34-145"><a href="#cb34-145" tabindex="-1"></a> grid<span class="sc">::</span><span class="fu">grobHeight</span>(axes<span class="sc">$</span>x<span class="sc">$</span>top[[<span class="dv">1</span>]]), <span class="st">&quot;cm&quot;</span>, <span class="cn">TRUE</span>), <span class="st">&quot;cm&quot;</span>)</span>
<span id="cb34-146"><a href="#cb34-146" tabindex="-1"></a> axis_height_b <span class="ot">&lt;-</span> <span class="fu">unit</span>(grid<span class="sc">::</span><span class="fu">convertHeight</span>(</span>
<span id="cb34-147"><a href="#cb34-147" tabindex="-1"></a> grid<span class="sc">::</span><span class="fu">grobHeight</span>(axes<span class="sc">$</span>x<span class="sc">$</span>bottom[[<span class="dv">1</span>]]), <span class="st">&quot;cm&quot;</span>, <span class="cn">TRUE</span>), <span class="st">&quot;cm&quot;</span>)</span>
<span id="cb34-148"><a href="#cb34-148" tabindex="-1"></a> <span class="cf">for</span> (i <span class="cf">in</span> <span class="fu">rev</span>(panel_pos_v)) {</span>
<span id="cb34-149"><a href="#cb34-149" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_rows</span>(panel_table, axis_height_b, i)</span>
<span id="cb34-150"><a href="#cb34-150" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_grob</span>(panel_table, </span>
<span id="cb34-151"><a href="#cb34-151" tabindex="-1"></a> <span class="fu">rep</span>(axes<span class="sc">$</span>x<span class="sc">$</span>bottom, <span class="fu">length</span>(panel_pos_h)), <span class="at">t =</span> i <span class="sc">+</span> <span class="dv">1</span>, <span class="at">l =</span> panel_pos_h, </span>
<span id="cb34-152"><a href="#cb34-152" tabindex="-1"></a> <span class="at">clip =</span> <span class="st">&quot;off&quot;</span>)</span>
<span id="cb34-153"><a href="#cb34-153" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_rows</span>(panel_table, axis_height_t, i <span class="sc">-</span> <span class="dv">1</span>)</span>
<span id="cb34-154"><a href="#cb34-154" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_grob</span>(panel_table, </span>
<span id="cb34-155"><a href="#cb34-155" tabindex="-1"></a> <span class="fu">rep</span>(axes<span class="sc">$</span>x<span class="sc">$</span>top, <span class="fu">length</span>(panel_pos_h)), <span class="at">t =</span> i, <span class="at">l =</span> panel_pos_h, </span>
<span id="cb34-156"><a href="#cb34-156" tabindex="-1"></a> <span class="at">clip =</span> <span class="st">&quot;off&quot;</span>)</span>
<span id="cb34-157"><a href="#cb34-157" tabindex="-1"></a> }</span>
<span id="cb34-158"><a href="#cb34-158" tabindex="-1"></a> </span>
<span id="cb34-159"><a href="#cb34-159" tabindex="-1"></a> <span class="co"># Add strips</span></span>
<span id="cb34-160"><a href="#cb34-160" tabindex="-1"></a> strips <span class="ot">&lt;-</span> <span class="fu">render_strips</span>(</span>
<span id="cb34-161"><a href="#cb34-161" tabindex="-1"></a> <span class="at">x =</span> <span class="fu">data.frame</span>(<span class="at">name =</span> <span class="fu">c</span>(<span class="st">&quot;Original&quot;</span>, <span class="fu">paste0</span>(<span class="st">&quot;Transformed (&quot;</span>, params<span class="sc">$</span>trans<span class="sc">$</span>name, <span class="st">&quot;)&quot;</span>))),</span>
<span id="cb34-162"><a href="#cb34-162" tabindex="-1"></a> <span class="at">labeller =</span> label_value, <span class="at">theme =</span> theme)</span>
<span id="cb34-163"><a href="#cb34-163" tabindex="-1"></a> </span>
<span id="cb34-164"><a href="#cb34-164" tabindex="-1"></a> panel_pos_h <span class="ot">&lt;-</span> <span class="fu">panel_cols</span>(panel_table)<span class="sc">$</span>l</span>
<span id="cb34-165"><a href="#cb34-165" tabindex="-1"></a> panel_pos_v <span class="ot">&lt;-</span> <span class="fu">panel_rows</span>(panel_table)<span class="sc">$</span>t</span>
<span id="cb34-166"><a href="#cb34-166" tabindex="-1"></a> strip_height <span class="ot">&lt;-</span> <span class="fu">unit</span>(grid<span class="sc">::</span><span class="fu">convertHeight</span>(</span>
<span id="cb34-167"><a href="#cb34-167" tabindex="-1"></a> grid<span class="sc">::</span><span class="fu">grobHeight</span>(strips<span class="sc">$</span>x<span class="sc">$</span>top[[<span class="dv">1</span>]]), <span class="st">&quot;cm&quot;</span>, <span class="cn">TRUE</span>), <span class="st">&quot;cm&quot;</span>)</span>
<span id="cb34-168"><a href="#cb34-168" tabindex="-1"></a> <span class="cf">for</span> (i <span class="cf">in</span> <span class="fu">rev</span>(<span class="fu">seq_along</span>(panel_pos_v))) {</span>
<span id="cb34-169"><a href="#cb34-169" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_rows</span>(panel_table, strip_height, panel_pos_v[i] <span class="sc">-</span> <span class="dv">1</span>)</span>
<span id="cb34-170"><a href="#cb34-170" tabindex="-1"></a> <span class="cf">if</span> (params<span class="sc">$</span>horizontal) {</span>
<span id="cb34-171"><a href="#cb34-171" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_grob</span>(panel_table, strips<span class="sc">$</span>x<span class="sc">$</span>top, </span>
<span id="cb34-172"><a href="#cb34-172" tabindex="-1"></a> <span class="at">t =</span> panel_pos_v[i], <span class="at">l =</span> panel_pos_h, <span class="at">clip =</span> <span class="st">&quot;off&quot;</span>)</span>
<span id="cb34-173"><a href="#cb34-173" tabindex="-1"></a> } <span class="cf">else</span> {</span>
<span id="cb34-174"><a href="#cb34-174" tabindex="-1"></a> panel_table <span class="ot">&lt;-</span> gtable<span class="sc">::</span><span class="fu">gtable_add_grob</span>(panel_table, strips<span class="sc">$</span>x<span class="sc">$</span>top[i], </span>
<span id="cb34-175"><a href="#cb34-175" tabindex="-1"></a> <span class="at">t =</span> panel_pos_v[i], <span class="at">l =</span> panel_pos_h, <span class="at">clip =</span> <span class="st">&quot;off&quot;</span>)</span>
<span id="cb34-176"><a href="#cb34-176" tabindex="-1"></a> }</span>
<span id="cb34-177"><a href="#cb34-177" tabindex="-1"></a> }</span>
<span id="cb34-178"><a href="#cb34-178" tabindex="-1"></a> </span>
<span id="cb34-179"><a href="#cb34-179" tabindex="-1"></a> </span>
<span id="cb34-180"><a href="#cb34-180" tabindex="-1"></a> panel_table</span>
<span id="cb34-181"><a href="#cb34-181" tabindex="-1"></a> }</span>
<span id="cb34-182"><a href="#cb34-182" tabindex="-1"></a>)</span></code></pre></div>
<p>As is very apparent, the <code>draw_panel</code> 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.</p>
<p>Enough talk - lets see if our new and powerful faceting extension
works:</p>
<div class="sourceCode" id="cb35"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb35-1"><a href="#cb35-1" tabindex="-1"></a><span class="fu">ggplot</span>(mtcars, <span class="fu">aes</span>(<span class="at">x =</span> hp, <span class="at">y =</span> mpg)) <span class="sc">+</span> <span class="fu">geom_point</span>() <span class="sc">+</span> <span class="fu">facet_trans</span>(<span class="st">&#39;sqrt&#39;</span>)</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7N0JvFXz/v/xT9NpnksioiKkUEoomZL5SsYIkbhChcQ19DP0N4/XkAzpGjOTIST3ypihi5IKkRRKmufO+d/393fX/u1zzj777H32cNZ379f38TidvYa91vf7XLt1Pvu7vkOVov8kIyGAAAIIIIAAAgggkCWBqlk6D6dBAAEEEEAAAQQQQMAJEIDyQUAAAQQQQAABBBDIqgABaFa5ORkCCCCAAAIIIIAAASifAQQQQAABBBBAAIGsChCAZpWbkyGAAAIIIIAAAggQgPIZQAABBBBAAAEEEMiqQPWsni0NJ/vyyy/TcBQOgQACCGRGYLfddsvMgWMclfthDBRWIYBAaATi3Q+pAQ3NZSIjCCCAAAIIIIBAfggQgObHdaaUCCCAAAIIIIBAaAQIQENzKcgIAggggAACCCCQHwIEoPlxnSklAggggAACCCAQGgEC0NBcCjKCAAIIIIAAAgjkhwABaH5cZ0qJAAIIIIAAAgiERsC7YZhCI0dGKl3giy++sNmzZ1uDBg2sc+fO1rJlyzLz9M4771j37t2tbt26Ke1T1pv/+OMP+/bbb23fffctaxfWI4BADgts2rTJJk2aFLOErVu3to4dO8bclq6V06ZNs2+++cYOOeQQ22qrrdJ12KSO8/nnn7v7cKzzr1271j744AM7+OCDkzpmWTuvX7/eatasadOnT7ctttjCtt5667J2ZX1IBagBDemFIVtlC2zYsMGuuuoqGzNmjOmm/+OPP9rw4cPtqaeeKvNN7777rq1Zs6bM7dqQyD5lHWDBggVxz1/W+1iPAAK5IVBYWGjfffed+/nwww/t4Ycfjiz//vvvGS3kDz/8YKNHj7batWu7oCyjJ4tz8FdeecVVCsTa5dlnn7VmzZrF2pT0OgWdd911l3vfNttsY48++mjSx+ANlS9ADWjlXwNykKTAhAkTbN26dXb//fdbtWrV3LtPPPFEGzJkiLVq1cp69uxpy5cvd7WduvHr2/iIESOsXr16kTMpYGzSpIlVqVLFHaOgoCCyz+bNm03f1nUz1366aUbXnGrbokWLXM1rum6okYzxAgEEvBTQPWTYsGEu75988oktXrw4sqyVum/ofrVkyRJXY1e9enXTvebXX381Ba+6T2l7efeflStXumNvueWWVqdOHbf/999/b23btrVDDz3UGjZs6PLw559/2saNG9253Ir//FPyvqhl7f/bb7+5+52eJulLvZZL1ihq32XLlrl7bHDfDY4b3CeD5ZK/ly5dal999ZWddtppkU26h+pcQbmDDcq3PJQv1XLq3http3vuTz/9ZKtWrbLVq1e7+7McdPxOnToFh+G3BwIEoB5cJLJYXOD111+3kSNHRoJPbdVNqW/fvjZ16lQXgA4aNMjatGljc+bMsWuvvdbVDtx2223uhq3aUgWj+kPQtGlTd9M+6qij7JxzzjHto5vs3//+d3dj1w1ZN3fVuHbp0sVeffVVV9O5/fbbRx6563gkBBBAIJ6AakTnz5/vakUPOuggO+KII9y9qXnz5qYATcHWPffcYz///HOZ9x81JRo3bpy7t6n50eDBg61du3b2/PPPm75s33fffXb22WfbLbfc4oJNBY26V1133XXuflnyvnj99de7pgFqQjR37lwbMGCAvf322+4+qaBPT5kUbD700EOueYG+4CuwvvHGG001jwoWg/upyqAgPFZ66aWXrFu3bpFNys/ChQvdl3gFuzfddJO1aNHC3X81u5e+/KuCQMe75pprXG1yYKdmTmrupLKp3Apq99tvP3dfJgCNEHvxggDUi8tEJgMB1XzqBqgbYcmkGgAFp0HaZ5993I1StZxBUq1pjx49TDdifXs++eSTg03FfutRmm662223nanGVcdVO1O1cdLNXd/aVXOhG/bQoUOLvZcFBBBAIJaAajcVNBUVFdnEiRPt+OOPt8MOO8ztet5557n2jPoyHev+oy/AamOqoFMBl75cz5o1y9S+VPchfTm+/PLL3Zdt1V4qqNP5LrnkEnfcPffc052n5H1x1113tWOOOcb0+FwBsB6Vq/bxwgsvtJkzZ9q2225rCnyffPJJFxC+8cYbLu/K7wMPPGA6nvKkgPCkk06KVWxXnn79+rltqsFVDfFzzz1ntWrVcvdWVQbMmzfPFHwqwK5atapdffXVxY4VbTd58mRTm9egRlVBuMxIfgnQBtSv65X3ua1Ro4a7aenRUsmktqHB4ydt07fh6OBT69RIXwGokh7t6KYeK+nbuIJPJd3M1X5Ux7r44ovdTVI3atUC6A+JHiOREEAAgfIE1BFJ9xEFWHrq0rhxYxdwXXnllfbLL7+Y7mFKse4/Wt+nTx+7+eab3RMgBZ+qSS2ZtF4BqpJqL9UkacqUKZHdSt4Xg85R6sS5ww47RO6hejqkwPD99983NRe488473bkV+OlJk+59qonca6+93LF17+3QoUPkPNEv1E5fNb1K9evXt65du9opp5zijteoUSP3Ph1L92PlWUZ777139CFcTW1gV2zD
</div>
</div>
<div id="extending-existing-facet-function" class="section level2">
<h2>Extending existing facet function</h2>
<p>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 subclass
<code>facet_wrap()</code> to make a <code>facet_bootstrap()</code> class
that splits the input data into a number of panels at random.</p>
<div class="sourceCode" id="cb36"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb36-1"><a href="#cb36-1" tabindex="-1"></a>facet_bootstrap <span class="ot">&lt;-</span> <span class="cf">function</span>(<span class="at">n =</span> <span class="dv">9</span>, <span class="at">prop =</span> <span class="fl">0.2</span>, <span class="at">nrow =</span> <span class="cn">NULL</span>, <span class="at">ncol =</span> <span class="cn">NULL</span>, </span>
<span id="cb36-2"><a href="#cb36-2" tabindex="-1"></a> <span class="at">scales =</span> <span class="st">&quot;fixed&quot;</span>, <span class="at">shrink =</span> <span class="cn">TRUE</span>, <span class="at">strip.position =</span> <span class="st">&quot;top&quot;</span>) {</span>
<span id="cb36-3"><a href="#cb36-3" tabindex="-1"></a> </span>
<span id="cb36-4"><a href="#cb36-4" tabindex="-1"></a> facet <span class="ot">&lt;-</span> <span class="fu">facet_wrap</span>(<span class="sc">~</span>.bootstrap, <span class="at">nrow =</span> nrow, <span class="at">ncol =</span> ncol, <span class="at">scales =</span> scales, </span>
<span id="cb36-5"><a href="#cb36-5" tabindex="-1"></a> <span class="at">shrink =</span> shrink, <span class="at">strip.position =</span> strip.position)</span>
<span id="cb36-6"><a href="#cb36-6" tabindex="-1"></a> facet<span class="sc">$</span>params<span class="sc">$</span>n <span class="ot">&lt;-</span> n</span>
<span id="cb36-7"><a href="#cb36-7" tabindex="-1"></a> facet<span class="sc">$</span>params<span class="sc">$</span>prop <span class="ot">&lt;-</span> prop</span>
<span id="cb36-8"><a href="#cb36-8" tabindex="-1"></a> <span class="fu">ggproto</span>(<span class="cn">NULL</span>, FacetBootstrap,</span>
<span id="cb36-9"><a href="#cb36-9" tabindex="-1"></a> <span class="at">shrink =</span> shrink,</span>
<span id="cb36-10"><a href="#cb36-10" tabindex="-1"></a> <span class="at">params =</span> facet<span class="sc">$</span>params</span>
<span id="cb36-11"><a href="#cb36-11" tabindex="-1"></a> )</span>
<span id="cb36-12"><a href="#cb36-12" tabindex="-1"></a>}</span>
<span id="cb36-13"><a href="#cb36-13" tabindex="-1"></a></span>
<span id="cb36-14"><a href="#cb36-14" tabindex="-1"></a>FacetBootstrap <span class="ot">&lt;-</span> <span class="fu">ggproto</span>(<span class="st">&quot;FacetBootstrap&quot;</span>, FacetWrap,</span>
<span id="cb36-15"><a href="#cb36-15" tabindex="-1"></a> <span class="at">compute_layout =</span> <span class="cf">function</span>(data, params) {</span>
<span id="cb36-16"><a href="#cb36-16" tabindex="-1"></a> id <span class="ot">&lt;-</span> <span class="fu">seq_len</span>(params<span class="sc">$</span>n)</span>
<span id="cb36-17"><a href="#cb36-17" tabindex="-1"></a></span>
<span id="cb36-18"><a href="#cb36-18" tabindex="-1"></a> dims <span class="ot">&lt;-</span> <span class="fu">wrap_dims</span>(params<span class="sc">$</span>n, params<span class="sc">$</span>nrow, params<span class="sc">$</span>ncol)</span>
<span id="cb36-19"><a href="#cb36-19" tabindex="-1"></a> layout <span class="ot">&lt;-</span> <span class="fu">data.frame</span>(<span class="at">PANEL =</span> <span class="fu">factor</span>(id))</span>
<span id="cb36-20"><a href="#cb36-20" tabindex="-1"></a></span>
<span id="cb36-21"><a href="#cb36-21" tabindex="-1"></a> <span class="cf">if</span> (params<span class="sc">$</span>as.table) {</span>
<span id="cb36-22"><a href="#cb36-22" tabindex="-1"></a> layout<span class="sc">$</span>ROW <span class="ot">&lt;-</span> <span class="fu">as.integer</span>((id <span class="sc">-</span> 1L) <span class="sc">%/%</span> dims[<span class="dv">2</span>] <span class="sc">+</span> 1L)</span>
<span id="cb36-23"><a href="#cb36-23" tabindex="-1"></a> } <span class="cf">else</span> {</span>
<span id="cb36-24"><a href="#cb36-24" tabindex="-1"></a> layout<span class="sc">$</span>ROW <span class="ot">&lt;-</span> <span class="fu">as.integer</span>(dims[<span class="dv">1</span>] <span class="sc">-</span> (id <span class="sc">-</span> 1L) <span class="sc">%/%</span> dims[<span class="dv">2</span>])</span>
<span id="cb36-25"><a href="#cb36-25" tabindex="-1"></a> }</span>
<span id="cb36-26"><a href="#cb36-26" tabindex="-1"></a> layout<span class="sc">$</span>COL <span class="ot">&lt;-</span> <span class="fu">as.integer</span>((id <span class="sc">-</span> 1L) <span class="sc">%%</span> dims[<span class="dv">2</span>] <span class="sc">+</span> 1L)</span>
<span id="cb36-27"><a href="#cb36-27" tabindex="-1"></a></span>
<span id="cb36-28"><a href="#cb36-28" tabindex="-1"></a> layout <span class="ot">&lt;-</span> layout[<span class="fu">order</span>(layout<span class="sc">$</span>PANEL), , drop <span class="ot">=</span> <span class="cn">FALSE</span>]</span>
<span id="cb36-29"><a href="#cb36-29" tabindex="-1"></a> <span class="fu">rownames</span>(layout) <span class="ot">&lt;-</span> <span class="cn">NULL</span></span>
<span id="cb36-30"><a href="#cb36-30" tabindex="-1"></a></span>
<span id="cb36-31"><a href="#cb36-31" tabindex="-1"></a> <span class="co"># Add scale identification</span></span>
<span id="cb36-32"><a href="#cb36-32" tabindex="-1"></a> layout<span class="sc">$</span>SCALE_X <span class="ot">&lt;-</span> <span class="cf">if</span> (params<span class="sc">$</span>free<span class="sc">$</span>x) id <span class="cf">else</span> 1L</span>
<span id="cb36-33"><a href="#cb36-33" tabindex="-1"></a> layout<span class="sc">$</span>SCALE_Y <span class="ot">&lt;-</span> <span class="cf">if</span> (params<span class="sc">$</span>free<span class="sc">$</span>y) id <span class="cf">else</span> 1L</span>
<span id="cb36-34"><a href="#cb36-34" tabindex="-1"></a></span>
<span id="cb36-35"><a href="#cb36-35" tabindex="-1"></a> <span class="fu">cbind</span>(layout, <span class="at">.bootstrap =</span> id)</span>
<span id="cb36-36"><a href="#cb36-36" tabindex="-1"></a> },</span>
<span id="cb36-37"><a href="#cb36-37" tabindex="-1"></a> <span class="at">map_data =</span> <span class="cf">function</span>(data, layout, params) {</span>
<span id="cb36-38"><a href="#cb36-38" tabindex="-1"></a> <span class="cf">if</span> (<span class="fu">is.null</span>(data) <span class="sc">||</span> <span class="fu">nrow</span>(data) <span class="sc">==</span> <span class="dv">0</span>) {</span>
<span id="cb36-39"><a href="#cb36-39" tabindex="-1"></a> <span class="fu">return</span>(<span class="fu">cbind</span>(data, <span class="at">PANEL =</span> <span class="fu">integer</span>(<span class="dv">0</span>)))</span>
<span id="cb36-40"><a href="#cb36-40" tabindex="-1"></a> }</span>
<span id="cb36-41"><a href="#cb36-41" tabindex="-1"></a> n_samples <span class="ot">&lt;-</span> <span class="fu">round</span>(<span class="fu">nrow</span>(data) <span class="sc">*</span> params<span class="sc">$</span>prop)</span>
<span id="cb36-42"><a href="#cb36-42" tabindex="-1"></a> new_data <span class="ot">&lt;-</span> <span class="fu">lapply</span>(<span class="fu">seq_len</span>(params<span class="sc">$</span>n), <span class="cf">function</span>(i) {</span>
<span id="cb36-43"><a href="#cb36-43" tabindex="-1"></a> <span class="fu">cbind</span>(data[<span class="fu">sample</span>(<span class="fu">nrow</span>(data), n_samples), , <span class="at">drop =</span> <span class="cn">FALSE</span>], <span class="at">PANEL =</span> i)</span>
<span id="cb36-44"><a href="#cb36-44" tabindex="-1"></a> })</span>
<span id="cb36-45"><a href="#cb36-45" tabindex="-1"></a> <span class="fu">do.call</span>(rbind, new_data)</span>
<span id="cb36-46"><a href="#cb36-46" tabindex="-1"></a> }</span>
<span id="cb36-47"><a href="#cb36-47" tabindex="-1"></a>)</span>
<span id="cb36-48"><a href="#cb36-48" tabindex="-1"></a></span>
<span id="cb36-49"><a href="#cb36-49" tabindex="-1"></a><span class="fu">ggplot</span>(diamonds, <span class="fu">aes</span>(carat, price)) <span class="sc">+</span> </span>
<span id="cb36-50"><a href="#cb36-50" tabindex="-1"></a> <span class="fu">geom_point</span>(<span class="at">alpha =</span> <span class="fl">0.1</span>) <span class="sc">+</span> </span>
<span id="cb36-51"><a href="#cb36-51" tabindex="-1"></a> <span class="fu">facet_bootstrap</span>(<span class="at">n =</span> <span class="dv">9</span>, <span class="at">prop =</span> <span class="fl">0.05</span>)</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7N1rrG1XVQfwXXzhC18oigqn9qFQLn3QFmqDVkMBUz4ICdSQ+GiKxOAX9QNJQQkJjdEQA37RL0R8BAMJ2vAoQRNsbUFKS+stjz4A5YLKS5SHoiAint+C/2Xe1b3W3vvstc/Z554xknXW2mvNOeZcY43/+I8559r7nPHlXZmVlAXKAmWBskBZoCxQFigLlAX2yQIP2qd2qpmyQFmgLFAWKAuUBcoCZYGyQGeBSkDLEcoCZYGyQFmgLFAWKAuUBfbVApWA7qu5q7GyQFmgLFAWKAuUBcoCZYFKQMsHygJlgbJAWaAsUBYoC5QF9tUClYDuq7mrsbJAWaAsUBYoC5QFygJlgUpAywfKAmWBskBZoCxQFigLlAX21QJfv6+tbWFjH/zgB7ewV9WlssD+W+DMM88cbPRTn/rU7NOf/vTg9bpQFjgqFnjQgx40e+QjHzl4ux/96Ednn//85wev14WywFGxwLd8y7fMHvawhw3e7pFPQD/72c8OGqculAXKAl+xwBe+8IVZYaW8oSwwm0lAx+Rzn/vczFZSFigLjFtgHEnjdetqWaAsUBYoC5QFygJlgbJAWWBlC1QCurLJqkJZoCxQFigLlAXKAmWBssA6FqgEdB3rVd2yQFmgLFAWKAuUBcoCZYGVLVAJ6MomqwplgbJAWaAsUBYoC5QFygLrWKAS0HWsV3XLAmWBskBZoCxQFigLlAVWtkAloCubrCpMbYH7779/9qEPfWhqtaWvLHDaWOCLX/zi7Pbbb5+9+93vnn35y18+be6rbqQsMLUF/ATWrbfeOrvzzjtnX/rSl6ZWX/omtEAloBMas1StbgGJ53XXXTe77777Vq9cNcoCR8ACH//4x2e/8Au/MLvttttmN9544+yaa66Z+VmskrJAWeBUC3zyk5/s8HHPPffMbrjhhtlv/dZvnVqgPm2VBY7874Bu1dM4Yp154xvfOPuzP/uz2UMe8pAjdud1u2WB5S3wl3/5l7Of+Zmf6ZJQtV7ykpfM/uZv/qY7t7yWKlkWOP0tcNNNN81+9md/dnb11Vd3s5/PfOYzZx/+8Idnj3jEI07/mz+Ed1gJ6CF8aKdLlx/84AfP/vAP/3D2B3/wB7MzzjjjdLmtuo+ywKQWuPbaa0/Bx2c+85nZf//3f0/aRikrC5wOFpBwRo4fP94loQ996ENzqvZbZoFKQLfsgRyl7jzpSU86ebv1XttJU9RBWeAUC3zjN37jyc8333zz7CMf+cjsyU9+8slzdVAWKAucaoHrr79+Biu//Mu/PPPvIEu20wL1Duh2PpfqVVmgLFAWOMUC3v98xSteMfud3/md2bd927edcq0+lAXKAl+zwG/+5m/O/vRP/7R7Z/qWW2752oU62ioLVAK6VY+jOlMWKAuUBR5ogT//8z+f/cVf/MXs937v9+p9tgeap86UBToL3HvvvbN///d/744f/vCHz574xCd234Yv82ynBSoB3c7nUr0qC5QFygKdBf7qr/6qW078/d///dnDHvawskpZoCwwYIF3vvOds1e+8pXdVT/H5KfLzjrrrIHSdfqgLVDvgB70E6j2ywJlgbLAiAX+5E/+ZPaJT3xi9oxnPONkKd/0/dVf/dWTn+ugLFAWmM2e/vSnd6sEv/Irv9J9Aenyyy+fXXXVVWWaLbXAGbtf/jjSv2p89913b+mjqW6VBfbXAueff/5ggx/72Mdmfo+ypCxw1C3woAc9aHbs2LFBM3zgAx+Yfe5znxu8Xhc2bwG/EvFN3/RNM8+q5OAs4CcWzzzzzMEO1AzooGnqQlmgLFAWKAuUBcoCh80C3/zN33zYunwk+1vDgyP52OumywJlgbJAWaAsUBYoCxycBSoBPTjbV8tlgbJAWaAsUBYoC5QFjqQFKgE9ko+9brosUBYoC5QFygJlgbLAwVmgEtCDs321XBYoC5QFygJlgbJAWeBIWuDIfwmp/Td3R9ID6qbLAktY4Ou+7utmhZUlDFVFTnsLLPpm9Td8wzcUVk57L6gbXMYCX//14ynm+NVlWjjkZb7zO79zI3fwXd/1XbNPfepTG9Gtz4Jg/uPD1I1ssu/f933fN/uv//qv2X/+539O3e0ZZ/ftx//4j/+YXLcETN//7d/+bfY///M/k+v3/4q/9KUvzb7whS9sRPd3fMd3zD760Y/uWfeDH/zg2WHEih9u95M4h83f+PL3fu/3btTf/vd//3djvryuv405Kj/89Kc/PVZkz9fohnU4H5Izzjhj6FJ33r9J3cRgjU/A4aZ8ufxt/mPdJB8u42/ze7Xc2U32HR/6uasxvvVTWGNSS/Bj1qlrZYGyQFmgLFAWKAuUBcoCk1ugEtDJTVoKywJlgbJAWaAsUBYoC5QFxixQCeiYdepaWaAsUBYoC5QFygJlgbLA5BaoBHRyk5bCMQv4z69H/L+/jpmnrpUFygJlgbJAWeBIWODIfwnpSDzlFW7Sl2A++clPdi8Wf/u3f3v3Qv4K1QeL/t///V/3Yv9nP/vZ2Sc+8YnuRXov
<p>What we are doing above is to intercept the
<code>compute_layout</code> and <code>map_data</code> methods and
instead of dividing the data by a variable we randomly assigns rows to a
panel based on the sampling parameters (<code>n</code> determines the
number of panels, <code>prop</code> determines the proportion of data in
each panel). It is important here that the layout returned by
<code>compute_layout</code> is a valid layout for <code>FacetWrap</code>
as we are counting on the <code>draw_panel</code> method from
<code>FacetWrap</code> 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.</p>
<div id="exercises-2" class="section level3">
<h3>Exercises</h3>
<ol style="list-style-type: decimal">
<li>Rewrite FacetTrans to take a vector of transformations and create an
additional panel for each transformation.</li>
<li>Based on the FacetWrap implementation rewrite FacetTrans to take the
strip.placement theme setting into account.</li>
<li>Think about which caveats there are in FacetBootstrap specifically
related to adding multiple layers with the same data.</li>
</ol>
</div>
</div>
<div id="creating-new-guides" class="section level2">
<h2>Creating new guides</h2>
<p>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 a
<code>key</code> dataframe. For existing guides, you can glance at what
a key contains by using the <code>get_guide_data()</code> 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 <code>.value</code> column and how they
should be labelled in the <code>.label</code> column. Sometimes, the
aesthetic is used in computations. To avoid interpreting the values and
labels as aesthetics, it is customary to prefix these with
<code>.</code>.</p>
<div class="sourceCode" id="cb37"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb37-1"><a href="#cb37-1" tabindex="-1"></a>p <span class="ot">&lt;-</span> <span class="fu">ggplot</span>(mpg, <span class="fu">aes</span>(displ, hwy, <span class="at">colour =</span> drv)) <span class="sc">+</span></span>
<span id="cb37-2"><a href="#cb37-2" tabindex="-1"></a> <span class="fu">geom_point</span>() <span class="sc">+</span></span>
<span id="cb37-3"><a href="#cb37-3" tabindex="-1"></a> <span class="fu">scale_colour_discrete</span>(</span>
<span id="cb37-4"><a href="#cb37-4" tabindex="-1"></a> <span class="at">labels =</span> <span class="fu">c</span>(<span class="st">&quot;4-wheel drive&quot;</span>, <span class="st">&quot;front wheel drive&quot;</span>, <span class="st">&quot;rear wheel drive&quot;</span>)</span>
<span id="cb37-5"><a href="#cb37-5" tabindex="-1"></a> )</span>
<span id="cb37-6"><a href="#cb37-6" tabindex="-1"></a></span>
<span id="cb37-7"><a href="#cb37-7" tabindex="-1"></a><span class="fu">get_guide_data</span>(p, <span class="st">&quot;colour&quot;</span>)</span>
<span id="cb37-8"><a href="#cb37-8" tabindex="-1"></a><span class="co">#&gt; colour .value .label</span></span>
<span id="cb37-9"><a href="#cb37-9" tabindex="-1"></a><span class="co">#&gt; 1 #F8766D 4 4-wheel drive</span></span>
<span id="cb37-10"><a href="#cb37-10" tabindex="-1"></a><span class="co">#&gt; 2 #00BA38 f front wheel drive</span></span>
<span id="cb37-11"><a href="#cb37-11" tabindex="-1"></a><span class="co">#&gt; 3 #619CFF r rear wheel drive</span></span></code></pre></div>
<div id="overriding-scale-extraction" class="section level3">
<h3>Overriding scale extraction</h3>
<p>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’s <code>key</code>. We can begin by making a custom ggproto class
that inherits from the axis guide. An important extension point is the
<code>extract_key()</code> 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.</p>
<div class="sourceCode" id="cb38"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb38-1"><a href="#cb38-1" tabindex="-1"></a>GuideKey <span class="ot">&lt;-</span> <span class="fu">ggproto</span>(</span>
<span id="cb38-2"><a href="#cb38-2" tabindex="-1"></a> <span class="st">&quot;Guide&quot;</span>, GuideAxis,</span>
<span id="cb38-3"><a href="#cb38-3" tabindex="-1"></a> </span>
<span id="cb38-4"><a href="#cb38-4" tabindex="-1"></a> <span class="co"># Some parameters are required, so it is easiest to copy the base Guide&#39;s</span></span>
<span id="cb38-5"><a href="#cb38-5" tabindex="-1"></a> <span class="co"># parameters into our new parameters.</span></span>
<span id="cb38-6"><a href="#cb38-6" tabindex="-1"></a> <span class="co"># We add a new &#39;key&#39; parameter for our own guide.</span></span>
<span id="cb38-7"><a href="#cb38-7" tabindex="-1"></a> <span class="at">params =</span> <span class="fu">c</span>(GuideAxis<span class="sc">$</span>params, <span class="fu">list</span>(<span class="at">key =</span> <span class="cn">NULL</span>)),</span>
<span id="cb38-8"><a href="#cb38-8" tabindex="-1"></a> </span>
<span id="cb38-9"><a href="#cb38-9" tabindex="-1"></a> <span class="co"># It is important for guides to have a mapped aesthetic with the correct name</span></span>
<span id="cb38-10"><a href="#cb38-10" tabindex="-1"></a> <span class="at">extract_key =</span> <span class="cf">function</span>(scale, aesthetic, key, ...) {</span>
<span id="cb38-11"><a href="#cb38-11" tabindex="-1"></a> key<span class="sc">$</span>aesthetic <span class="ot">&lt;-</span> scale<span class="sc">$</span><span class="fu">map</span>(key<span class="sc">$</span>aesthetic)</span>
<span id="cb38-12"><a href="#cb38-12" tabindex="-1"></a> <span class="fu">names</span>(key)[<span class="fu">names</span>(key) <span class="sc">==</span> <span class="st">&quot;aesthetic&quot;</span>] <span class="ot">&lt;-</span> aesthetic</span>
<span id="cb38-13"><a href="#cb38-13" tabindex="-1"></a> key</span>
<span id="cb38-14"><a href="#cb38-14" tabindex="-1"></a> }</span>
<span id="cb38-15"><a href="#cb38-15" tabindex="-1"></a>)</span></code></pre></div>
</div>
<div id="guide-constructors" class="section level3">
<h3>Guide constructors</h3>
<p>Now we can make a guide constructor that creates a custom key to pass
along on. The <code>new_guide()</code> function instantiates a new guide
with the given parameters. This function automatically rejects any
parameters that are not in the class’ <code>params</code> field, so it
is important to declare these.</p>
<div class="sourceCode" id="cb39"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb39-1"><a href="#cb39-1" tabindex="-1"></a>guide_key <span class="ot">&lt;-</span> <span class="cf">function</span>(</span>
<span id="cb39-2"><a href="#cb39-2" tabindex="-1"></a> aesthetic, <span class="at">value =</span> aesthetic, <span class="at">label =</span> <span class="fu">as.character</span>(aesthetic),</span>
<span id="cb39-3"><a href="#cb39-3" tabindex="-1"></a> ...,</span>
<span id="cb39-4"><a href="#cb39-4" tabindex="-1"></a> <span class="co"># Standard guide arguments</span></span>
<span id="cb39-5"><a href="#cb39-5" tabindex="-1"></a> <span class="at">theme =</span> <span class="cn">NULL</span>, <span class="at">title =</span> <span class="fu">waiver</span>(), <span class="at">order =</span> <span class="dv">0</span>, <span class="at">position =</span> <span class="fu">waiver</span>()</span>
<span id="cb39-6"><a href="#cb39-6" tabindex="-1"></a>) {</span>
<span id="cb39-7"><a href="#cb39-7" tabindex="-1"></a> </span>
<span id="cb39-8"><a href="#cb39-8" tabindex="-1"></a> key <span class="ot">&lt;-</span> <span class="fu">data.frame</span>(aesthetic, <span class="at">.value =</span> value, <span class="at">.label =</span> label, ...)</span>
<span id="cb39-9"><a href="#cb39-9" tabindex="-1"></a> </span>
<span id="cb39-10"><a href="#cb39-10" tabindex="-1"></a> <span class="fu">new_guide</span>(</span>
<span id="cb39-11"><a href="#cb39-11" tabindex="-1"></a> <span class="co"># Arguments passed on to the GuideKey$params field</span></span>
<span id="cb39-12"><a href="#cb39-12" tabindex="-1"></a> <span class="at">key =</span> key, <span class="at">theme =</span> theme, <span class="at">title =</span> title, <span class="at">order =</span> order, <span class="at">position =</span> position,</span>
<span id="cb39-13"><a href="#cb39-13" tabindex="-1"></a> <span class="co"># Declare which aesthetics are supported</span></span>
<span id="cb39-14"><a href="#cb39-14" tabindex="-1"></a> <span class="at">available_aes =</span> <span class="fu">c</span>(<span class="st">&quot;x&quot;</span>, <span class="st">&quot;y&quot;</span>),</span>
<span id="cb39-15"><a href="#cb39-15" tabindex="-1"></a> <span class="co"># Set the guide class</span></span>
<span id="cb39-16"><a href="#cb39-16" tabindex="-1"></a> <span class="at">super =</span> GuideKey</span>
<span id="cb39-17"><a href="#cb39-17" tabindex="-1"></a> )</span>
<span id="cb39-18"><a href="#cb39-18" tabindex="-1"></a>}</span></code></pre></div>
<p>Our new guide can now be used inside the <code>guides()</code>
function or as the <code>guide</code> argument in a position scale.</p>
<div class="sourceCode" id="cb40"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb40-1"><a href="#cb40-1" tabindex="-1"></a><span class="fu">ggplot</span>(mpg, <span class="fu">aes</span>(displ, hwy)) <span class="sc">+</span></span>
<span id="cb40-2"><a href="#cb40-2" tabindex="-1"></a> <span class="fu">geom_point</span>() <span class="sc">+</span></span>
<span id="cb40-3"><a href="#cb40-3" tabindex="-1"></a> <span class="fu">scale_x_continuous</span>(</span>
<span id="cb40-4"><a href="#cb40-4" tabindex="-1"></a> <span class="at">guide =</span> <span class="fu">guide_key</span>(<span class="at">aesthetic =</span> <span class="dv">2</span><span class="sc">:</span><span class="dv">6</span> <span class="sc">+</span> <span class="fl">0.5</span>)</span>
<span id="cb40-5"><a href="#cb40-5" tabindex="-1"></a> )</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7N0JvFXz/v/xz6nT6TQPGkhJNAi3SDKGTBWFuCUldKO4hsg8ZCZDyJBZZr8I11TcQpdILm6ESArRQPNcpzP873vd/972dM7Z4zprr/36Ph519vrutb7f9X1+11r7s9ewv3ll/01GQgABBBBAAAEEEEDAJYFqLtVDNQgggAACCCCAAAIIOAIEoGwICCCAAAIIIIAAAq4KEIC6yk1lCCCAAAIIIIAAAgSgbAMIIIAAAggggAACrgoQgLrKTWUIIIAAAggggAACBKBsAwgggAACCCCAAAKuCuS7WlsaKlu7dq2VlJSkVFL16tVNvz5VWlqaUjleWTg/P9/Upq1bt3pllVJej4KCAisqKkq5HK8UUFhY6LTHT9uc9kO//IpbjRo1LC8vz1fbnNq0bds2r+wCKa2H+qZmzZrsQykpZnZh9qHM+qZaemAfUpzg1nFbn+N169Ytd9WzLgBVUFJcXFxug+J5o3bt2k7w6ZeATZ2sg/O6deviaX5WzKM+Wr9+fVasa2UrWa1aNWvcuLHzBcEv25w+bBSA+iXA0RcEtckv25y2Se1DGzZsqGzzzIr39QW7UaNGtnnzZt98SdAxe8uWLSmfUPFKB2p7U5Djl31Ix20dF/yyD+n4pj7atGmTZ47bXIL3yt7LeiCAAAIIIIAAAjkiQACaIx1NMxFAAAEEEEAAAa8IEIB6pSdYDwQQQAABBBBAIEcECEBzpKNpJgIIIIAAAggg4BUBAlCv9ATrgQACCCCAAAII5IgAAWiOdDTNRAABBBBAAAEEvCJAAOqVnmA9EEAAAQQQQACBHBEgAM2RjqaZCCCAAAIIIICAVwSy7ofo9aPr+pdK0vIakUY/buyHpB+Y1Y/m6kdm/ZLUN35pj36cWUk/PK1+8kPSNqd26a8fkkYTYx/ybk8G9hv9MLj6yg9J7ahVq5ZvRuTTMVvHBD8dt9VHfmlPIN4JDLrhhX0o6/bkdAz/p41K5aQ6opIXOlDroGBaQ2v5pT1qk5/aEwhA/bTNKfD0U3u0DynI8dM+pDb5pT2BANRv25z6R/3khxQY3tEv25yO237ahwLbmPpH+5EbKRD0lldXVgagqW7ggQDUL2ON68yadn6/tEcbq3Z8v7Qn8OGp7dYvbdJVBA3D6ZehOHUmym/7kJ/aE/gg0/bml31IZ6LUHreCgfKCgHTl65itoM0v/aPjtp8+h0K/ILh13FZsUlHyx/XAilrIewgggAACCCCAAAKeEiAA9VR3sDIIIIAAAggggID/BQhA/d/HtBABBBBAAAEEEPCUAAGop7qDlUEAAQQQQAABBPwvQADq/z6mhQgggAACCCCAgKcECEA91R2sDAIIIIAAAggg4H8BAlD/9zEtRAABBBBAAAEEPCVAAOqp7mBlEEAAAQQQQAAB/wsQgPq/j2khAggggAACCCDgKQECUE91ByuDAAIIIIAAAgj4X4AA1P99TAsRQAABBBBAAAFPCRCAeqo7WBkEEEAAAQQQQMD/AgSgHu3jJ5980vr372/Dhw+3oqIij64lq4UAAggggAACCCQukJ/4IiyRaYEBAwbYRx99FKzmrbfesi+//NKaNWsWzOMFAggggAACCCCQrQKcAfVYz73yyithwWdg9Y4//vjAS/4igAACCCCAAAJZLUAA6rHu++STT2Ku0eLFi2Pmk4kAAggggAACCGSbAAGox3psxx13jLlGBQUFMfPJRAABBBBAAAEEsk2AANRjPXbRRRdZvXr1otZq8uTJUXlkIIAAAggggAAC2ShAAOrBXps3b54deeSRTiC6/fbb26uvvmodOnTw4JqySggggAACCCCAQOICPAWfuJkrSzzzzDOu1EMlCCCAAAIIIICA2wKcAXVbnPoQQAABBBBAAIEcFyAAzfENgOYjgAACCCCAAAJuCxCAui1OfQgggAACCCCAQI4LEIDm+AZA8xFAAAEEEEAAAbcFCEDdFqc+BBBAAAEEEEAgxwUIQHN8A6D5CCCAAAIIIICA2wIEoG6LUx8CCCCAAAIIIJDjAgSgOb4B0HwEEEAAAQQQQMBtAQJQt8WpDwEEEEAAAQQQyHEBAtAc3wBoPgIIIIAAAggg4LYAAajb4tSHAAIIIIAAAgjkuAABaI5vADQfAQQQQAABBBBwW4AA1G1x6kMAAQQQQAABBHJcgAA0xzcAmo8AAggggAACCLgtQADqtjj1IYAAAggggAACOS5AAJrjGwDNRwABBBBAAAEE3BYgAHVbnPoQQAABBBBAAIEcFyAAzfENgOYjgAACCCCAAAJuCxCAui1OfQgggAACCCCAQI4LEIDm+AZA8xFAAAEEEEAAAbcFCEDdFqc+BBBAAAEEEEAgxwUIQHN8A6D5CCCAAAIIIICA2wIEoG6LUx8CCCCAAAIIIJDjAgSgOb4B0HwEEEAAAQQQQMBtAQJQt8WpDwEEEEAAAQQQyHEBAtAc3wBoPgIIIIAAAggg4LYAAajb4tSHAAIIIIAAAgjkuAABaI5vADQfAQQQQAABBBBwW4AA
</div>
<div id="custom-drawings" class="section level3">
<h3>Custom drawings</h3>
<p>If we are feeling more adventurous, we can also alter they way guides
are drawn. The majority of drawing code is in the
<code>Guide$build_*()</code> methods, which is all orchestrated by the
<code>Guide$draw()</code> method. For derived guides, such as the custom
key guide we’re extending here, overriding a
<code>Guide$build_*()</code> method should be sufficient. If you are
writing a completely novel guide that does not resemble the structure of
any existing guide, overriding the <code>Guide$draw()</code> method
might be wise.</p>
<p>In this example, we are changing the way the labels are drawn, so we
should edit the <code>Guide$build_labels()</code> method. We’ll edit the
method so that the labels are drawn with a <code>colour</code> set in
the key. In addition to the <code>key</code> and <code>params</code>
variable we’ve seen before, we now also have an <code>elements</code>
variable, which is a list of precomputed theme elements. We can use the
<code>elements$text</code> 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’s
<code>position</code> parameter.</p>
<div class="sourceCode" id="cb41"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb41-1"><a href="#cb41-1" tabindex="-1"></a><span class="co"># Same as before</span></span>
<span id="cb41-2"><a href="#cb41-2" tabindex="-1"></a>GuideKey <span class="ot">&lt;-</span> <span class="fu">ggproto</span>(</span>
<span id="cb41-3"><a href="#cb41-3" tabindex="-1"></a> <span class="st">&quot;Guide&quot;</span>, GuideAxis,</span>
<span id="cb41-4"><a href="#cb41-4" tabindex="-1"></a> <span class="at">params =</span> <span class="fu">c</span>(GuideAxis<span class="sc">$</span>params, <span class="fu">list</span>(<span class="at">key =</span> <span class="cn">NULL</span>)),</span>
<span id="cb41-5"><a href="#cb41-5" tabindex="-1"></a> <span class="at">extract_key =</span> <span class="cf">function</span>(scale, aesthetic, key, ...) {</span>
<span id="cb41-6"><a href="#cb41-6" tabindex="-1"></a> key<span class="sc">$</span>aesthetic <span class="ot">&lt;-</span> scale<span class="sc">$</span><span class="fu">map</span>(key<span class="sc">$</span>aesthetic)</span>
<span id="cb41-7"><a href="#cb41-7" tabindex="-1"></a> <span class="fu">names</span>(key)[<span class="fu">names</span>(key) <span class="sc">==</span> <span class="st">&quot;aesthetic&quot;</span>] <span class="ot">&lt;-</span> aesthetic</span>
<span id="cb41-8"><a href="#cb41-8" tabindex="-1"></a> key</span>
<span id="cb41-9"><a href="#cb41-9" tabindex="-1"></a> },</span>
<span id="cb41-10"><a href="#cb41-10" tabindex="-1"></a> </span>
<span id="cb41-11"><a href="#cb41-11" tabindex="-1"></a> <span class="co"># New method to draw labels</span></span>
<span id="cb41-12"><a href="#cb41-12" tabindex="-1"></a> <span class="at">build_labels =</span> <span class="cf">function</span>(key, elements, params) {</span>
<span id="cb41-13"><a href="#cb41-13" tabindex="-1"></a> position <span class="ot">&lt;-</span> params<span class="sc">$</span>position</span>
<span id="cb41-14"><a href="#cb41-14" tabindex="-1"></a> <span class="co"># Downstream code expects a list of labels</span></span>
<span id="cb41-15"><a href="#cb41-15" tabindex="-1"></a> <span class="fu">list</span>(<span class="fu">element_grob</span>(</span>
<span id="cb41-16"><a href="#cb41-16" tabindex="-1"></a> elements<span class="sc">$</span>text,</span>
<span id="cb41-17"><a href="#cb41-17" tabindex="-1"></a> <span class="at">label =</span> key<span class="sc">$</span>.label,</span>
<span id="cb41-18"><a href="#cb41-18" tabindex="-1"></a> <span class="at">x =</span> <span class="cf">switch</span>(position, <span class="at">left =</span> <span class="dv">1</span>, <span class="at">right =</span> <span class="dv">0</span>, key<span class="sc">$</span>x),</span>
<span id="cb41-19"><a href="#cb41-19" tabindex="-1"></a> <span class="at">y =</span> <span class="cf">switch</span>(position, <span class="at">top =</span> <span class="dv">0</span>, <span class="at">bottom =</span> <span class="dv">1</span>, key<span class="sc">$</span>y),</span>
<span id="cb41-20"><a href="#cb41-20" tabindex="-1"></a> <span class="at">margin_x =</span> position <span class="sc">%in%</span> <span class="fu">c</span>(<span class="st">&quot;left&quot;</span>, <span class="st">&quot;right&quot;</span>),</span>
<span id="cb41-21"><a href="#cb41-21" tabindex="-1"></a> <span class="at">margin_y =</span> position <span class="sc">%in%</span> <span class="fu">c</span>(<span class="st">&quot;top&quot;</span>, <span class="st">&quot;bottom&quot;</span>),</span>
<span id="cb41-22"><a href="#cb41-22" tabindex="-1"></a> <span class="at">colour =</span> key<span class="sc">$</span>colour</span>
<span id="cb41-23"><a href="#cb41-23" tabindex="-1"></a> ))</span>
<span id="cb41-24"><a href="#cb41-24" tabindex="-1"></a> }</span>
<span id="cb41-25"><a href="#cb41-25" tabindex="-1"></a>)</span></code></pre></div>
<p>Because we are incorporating the <code>...</code> argument to
<code>guide_key()</code> in the key, adding a <code>colour</code> column
to the key is straightforward. We can check that are guide looks correct
in the different positions around the panel.</p>
<div class="sourceCode" id="cb42"><pre class="sourceCode r"><code class="sourceCode r"><span id="cb42-1"><a href="#cb42-1" tabindex="-1"></a><span class="fu">ggplot</span>(mpg, <span class="fu">aes</span>(displ, hwy)) <span class="sc">+</span></span>
<span id="cb42-2"><a href="#cb42-2" tabindex="-1"></a> <span class="fu">geom_point</span>() <span class="sc">+</span></span>
<span id="cb42-3"><a href="#cb42-3" tabindex="-1"></a> <span class="fu">guides</span>(</span>
<span id="cb42-4"><a href="#cb42-4" tabindex="-1"></a> <span class="at">x =</span> <span class="fu">guide_key</span>(</span>
<span id="cb42-5"><a href="#cb42-5" tabindex="-1"></a> <span class="at">aesthetic =</span> <span class="dv">2</span><span class="sc">:</span><span class="dv">6</span> <span class="sc">+</span> <span class="fl">0.5</span>,</span>
<span id="cb42-6"><a href="#cb42-6" tabindex="-1"></a> <span class="at">colour =</span> <span class="fu">c</span>(<span class="st">&quot;red&quot;</span>, <span class="st">&quot;grey&quot;</span>, <span class="st">&quot;red&quot;</span>, <span class="st">&quot;grey&quot;</span>, <span class="st">&quot;red&quot;</span>)</span>
<span id="cb42-7"><a href="#cb42-7" tabindex="-1"></a> ),</span>
<span id="cb42-8"><a href="#cb42-8" tabindex="-1"></a> <span class="at">x.sec =</span> <span class="fu">guide_key</span>(</span>
<span id="cb42-9"><a href="#cb42-9" tabindex="-1"></a> <span class="at">aesthetic =</span> <span class="fu">c</span>(<span class="dv">2</span>, <span class="dv">4</span>, <span class="dv">6</span>), </span>
<span id="cb42-10"><a href="#cb42-10" tabindex="-1"></a> <span class="at">colour =</span> <span class="fu">c</span>(<span class="st">&quot;tomato&quot;</span>, <span class="st">&quot;limegreen&quot;</span>, <span class="st">&quot;dodgerblue&quot;</span>)</span>
<span id="cb42-11"><a href="#cb42-11" tabindex="-1"></a> )</span>
<span id="cb42-12"><a href="#cb42-12" tabindex="-1"></a> )</span></code></pre></div>
<p><img src="data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAqAAAAKgCAYAAABEPM/FAAAEDmlDQ1BrQ0dDb2xvclNwYWNlR2VuZXJpY1JHQgAAOI2NVV1oHFUUPpu5syskzoPUpqaSDv41lLRsUtGE2uj+ZbNt3CyTbLRBkMns3Z1pJjPj/KRpKT4UQRDBqOCT4P9bwSchaqvtiy2itFCiBIMo+ND6R6HSFwnruTOzu5O4a73L3PnmnO9+595z7t4LkLgsW5beJQIsGq4t5dPis8fmxMQ6dMF90A190C0rjpUqlSYBG+PCv9rt7yDG3tf2t/f/Z+uuUEcBiN2F2Kw4yiLiZQD+FcWyXYAEQfvICddi+AnEO2ycIOISw7UAVxieD/Cyz5mRMohfRSwoqoz+xNuIB+cj9loEB3Pw2448NaitKSLLRck2q5pOI9O9g/t/tkXda8Tbg0+PszB9FN8DuPaXKnKW4YcQn1Xk3HSIry5ps8UQ/2W5aQnxIwBdu7yFcgrxPsRjVXu8HOh0qao30cArp9SZZxDfg3h1wTzKxu5E/LUxX5wKdX5SnAzmDx4A4OIqLbB69yMesE1pKojLjVdoNsfyiPi45hZmAn3uLWdpOtfQOaVmikEs7ovj8hFWpz7EV6mel0L9Xy23FMYlPYZenAx0yDB1/PX6dledmQjikjkXCxqMJS9WtfFCyH9XtSekEF+2dH+P4tzITduTygGfv58a5VCTH5PtXD7EFZiNyUDBhHnsFTBgE0SQIA9pfFtgo6cKGuhooeilaKH41eDs38Ip+f4At1Rq/sjr6NEwQqb/I/DQqsLvaFUjvAx+eWirddAJZnAj1DFJL0mSg/gcIpPkMBkhoyCSJ8lTZIxk0TpKDjXHliJzZPO50dR5ASNSnzeLvIvod0HG/mdkmOC0z8VKnzcQ2M/Yz2vKldduXjp9bleLu0ZWn7vWc+l0JGcaai10yNrUnXLP/8Jf59ewX+c3Wgz+B34Df+vbVrc16zTMVgp9um9bxEfzPU5kPqUtVWxhs6OiWTVW+gIfywB9uXi7CGcGW/zk98k/kmvJ95IfJn/j3uQ+4c5zn3Kfcd+AyF3gLnJfcl9xH3OfR2rUee80a+6vo7EK5mmXUdyfQlrYLTwoZIU9wsPCZEtP6BWGhAlhL3p2N6sTjRdduwbHsG9kq32sgBepc+xurLPW4T9URpYGJ3ym4+8zA05u44QjST8ZIoVtu3qE7fWmdn5LPdqvgcZz8Ww8BWJ8X3w0PhQ/wnCDGd+LvlHs8dRy6bLLDuKMaZ20tZrqisPJ5ONiCq8yKhYM5cCgKOu66Lsc0aYOtZdo5QCwezI4wm9J/v0X23mlZXOfBjj8Jzv3WrY5D+CsA9D7aMs2gGfjve8ArD6mePZSeCfEYt8CONWDw8FXTxrPqx/r9Vt4biXeANh8vV7/+/16ffMD1N8AuKD/A/8leAvFY9bLAAAAOGVYSWZNTQAqAAAACAABh2kABAAAAAEAAAAaAAAAAAACoAIABAAAAAEAAAKgoAMABAAAAAEAAAKgAAAAAMw48TsAAEAASURBVHgB7N0JvFXj/vjx76nTOQ2nUYNKA4pUmgiJiChkKOFXIUL4X2Qu3Iu43LoqKdOla8hU5iTda4oiGdKgJKUilNN4qlOdzvTvu+5rbXs87WGttdda+/O8XnX2fvZaz/B+1l77u9ewn6zyfUlICCCAAAIIIIAAAgg4JFDJoXqoBgEEEEAAAQQQQAABQ4AAlA0BAQQQQAABBBBAwFEBAlBHuakMAQQQQAABBBBAgACUbQABBBBAAAEEEEDAUQECUEe5qQwBBBBAAAEEEECAAJRtAAEEEEAAAQQQQMBRAQJQR7mpDAEEEEAAAQQQQIAAlG0AAQQQQAABBBBAwFEBAlBHuakMAQQQQAABBBBAIBsCbwuUFxeLLP5GpGo1kXYdJSsry9sdovUIpElgeeEyo+YjarRLUwuoFgFvCuze9zE0d5VIpX0fPz1aieQQWXhzIB1uNUdAHQa3srry/PVSdtUAKf/6cyn/73Qpu+b/pLxoj5VVUBYCGSGwtXiLXPfDMJm79ZOM6C+dRMAqgcIikXOeEHl/+f/+9ZwgsmdfQEpCYH8CfE/Zn5CLXy+f/qpknX62VBp0pdHKstF/lfJP39+Xd46LW03TEHCfwH2r/yb1q9R3X8NoEQIuF3jpa5EOTUXG9v9fQx/+SGTJbyLHtHR5w2le2gUIQNM+BMk3IOuya/et/Ocp9/Lt2yRr9+7kC2RNBDJQ4M38V+WAKgdI86otMrD3dBmB1AQ++VHkkmNFZu/7W1omMrznvlPxnFtNDTVD1mYz8fBAZ1XJkawqVYwelM39UGT9r5LV6ywP94imI+CswC97fpZpG16SW1qMdLZiakPAJwIbtos8OVdk2gKRl/cdDT3pYZFde33SObphqwABqK28zhRe9p/pUv7c41LpvgmSVSPPmUqpBQGPC5SUl8jfVo2Quw4eJdUqV/d4b2g+AukRKNl31LNd431B6ECRZy4RObyRyMyl6WkLtXpLgFPw3hqviNaWvfq8lH88Syr943HJanhgxOtkIIBAdIHVu1bJ0p1L5JrlQ40F9pbvNS5oyd+bL389ZFT0lchFAIEQgca1Rbo0/zOrfRORRb+KXNDlzzweIRBNgAA0mopH8so+nCnl+069Vxr7lGTl1fJIq2kmAu4QOKxGG1lw3PeBxjz88z+lRuUaMuygvwTyeIAAAhULnNlOZPpikf4dRYr3HQ3977631DUnVrwOryKgAgSgHt4Oyl+aLLJxg5QN7BPoRVbfAVLp6psDz3mAAAIIIICAXQIDjxZZuO5/134WlYj0aiNy7r5glITA/gSyyvel/S3E6wgggAACCCCAQCwB/T1Q/SH6ajmxliAfgVABAtBQD54hgAACCCCAAAII2CzAXfA2AztR/KOPPioDBgxwoirqQMCXAg8++KAMHfq/m5F82UE6hYDNAiNHjpThw4fbXAvF+0mAa0B9MJo7d+6ULVu2+KAndAGB9Ajs2LFDtm7dmp7KqRUBHwhs375ddu3a5YOe0AWnBDgC6pQ09SCAAAIIIIAAAggYAhwB9cGG0KJFC+nYkdsOfTCUdCFNAocccohkZ7M7TBM/1fpA4LDDDpM9e/b4oCd0wSkBz92EtHHjRikp2fdbDymk6tWrS2lpqRQV7bttzwepZs2aUrVqVVEbv6S6dev65pRopX0TIzdq1Mjoj1920Hl5ecb7p7i42BebXO3ataXKvmltN23a5Iv+aCf89B6qXLmyNGzYUDZv3ix79/pjnsdatWpJYWGh8Vnkh41Ot7esrCzfXA6m+239bC0oKPDD8Bj7t/r16xv7OKf227m5uVKvXr2YfpyCj0nDCwgggAACCCCAAAJ2CBCA2qFKmQgggAACCCCAAAIxBQhAY9LwAgIIIIAAAggggIAdAgSgdqhSJgIIIIAAAggggEBMAQLQmDS8gAACCCCAAAIIIGCHAAGoHaqUiQACCCCAAAIIIBBTgAA0Jg0vIIAAAggggAACCNghQABqhyplIoAAAggggAACCMQU8NzUHzpbif4ocSpJy9AfmfVLUg/9AWD90Ve/JB0fv/RHx0aT/tB5eXm5L4ZItzntj1/eR7yH3L1ZmtuZbnPm+8ndLd5/63Sby8nJkbKysv0v7IEldIz89DmkfdEx8svnkDnTm5P7bfN9G2vz9VwAur8OxepocL5Zhm5cfkjmG98v/dExMd/8fhgf8wNTx8kvY+Snvpjbm5+2ObNPftretE/aH798iTO3N3P/oP3zctJ+mH3ycj/MtvutP26MezwXgOo0bKlOxakbmJ+m4tSdsv7btWuX+d7x/F/91umX/ugbX6fd06lf/TIVp/ZJ++PUlG52b9DmkTW/bHPq5af3kO7fdFpEff/4ZSpOPSK1e/du30zFqdubBm1+eQ/pPk7HyC/90X2cTqGs7yGn9tv7O3rsn/PQdn9CUT4CCCCAAAIIIICAJQIEoJYwUggCCCCAAAIIIIBAvAIEoPFKsRwCCCCAAAIIIICAJQIEoJYwUggCCCCAAAIIIIBAvAIEoPFK
</div>
<div id="exercises-3" class="section level3">
<h3>Exercises</h3>
<ul>
<li>Extend <code>guide_key()</code> to also pass on <code>family</code>,
<code>face</code> and <code>size</code> aesthetics from the key to the
labels.</li>
<li>Override the <code>GuideKey$build_ticks()</code> method to also pass
on <code>colour</code> and <code>linewidth</code> settings to the tick
marks. Looking at <code>Guide$build_ticks()</code> is a good starting
point.</li>
<li>Compare <code>GuideKey$extract_key()</code> to
<code>Guide$extract_key()</code>. What steps have been skimmed over in
the example?</li>
</ul>
</div>
</div>
<!-- code folding -->
<!-- dynamically load mathjax for compatibility with self-contained -->
<script>
(function () {
var script = document.createElement("script");
script.type = "text/javascript";
script.src = "https://mathjax.rstudio.com/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML";
document.getElementsByTagName("head")[0].appendChild(script);
})();
</script>
</body>
</html>
Reference in New Issue Copy Permalink