<p><div><div><div><div data-width="100" data-show-faces="false" data-send="true" data-layout="button_count" data-height="21" data-href="https://www.r-bloggers.com/data-driven-christmas-card-animation-with-voronoi-tiles/"></div></div><div></div></div><div></div></div>
<div>
(This article was first published on <strong><a href="http://www.data-imaginist.com/2016/Data-driven-x-mas-card/"> Data Imaginist - R posts</a></strong>, and kindly contributed to <a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers)</a> </div>
<p>I recently published a bit of self-promotion in the form of an animation based<br>
on the new <code>geom_voronoi_tile()</code> and <code>geom_voronoi_segment()</code> functions in<br>
<code>ggforce</code>:</p>
<blockquote data-lang="en" class="twitter-tweet"><p dir="ltr" lang="en">Selfpromoting fun with geom_voronoi_* in <a target="_blank" rel="nofollow" href="https://twitter.com/hashtag/ggforce?src=hash">#ggforce</a> <a target="_blank" rel="nofollow" href="https://twitter.com/hashtag/ggplot2?src=hash">#ggplot2</a> <a target="_blank" rel="nofollow" href="https://twitter.com/hashtag/tweenr?src=hash">#tweenr</a> <a target="_blank" rel="nofollow" href="https://t.co/CcFCJ8UDyy">pic.twitter.com/CcFCJ8UDyy</a></p>
<p>— Thomas Lin Pedersen (@thomasp85) <a target="_blank" rel="nofollow" href="https://twitter.com/thomasp85/status/809896220906897408">December 16, 2016</a></p></blockquote>
<p></p>
<p>This prompted someone to ask for the source code and I off-handedly said I would<br>
make a blog post about. So here we are, but I’m not going to show you how I made<br>
that animation (sorry). Instead I’m going to show you how to make your very own<br>
animated Christmas card using <code>ggplot2</code>, <code>ggforce</code>, and <code>tweenr</code> (as well as<br>
<code>mgcv</code> and <code>deldir</code> for some computations).</p>
<p>Let’s set the scene: we are going to do a cyclic animation switching between a<br>
heart, the word “merry”, and the word “x-mas”. Each shape will be made up of<br>
voronoi tiles with the colour of the tile defining the shape. The shapes has<br>
been created in Illustrator and exported to a json representation using a<br>
<a target="_blank" rel="nofollow" href="https://github.com/elcontraption/illustrator-point-exporter">script</a>.</p>
<p>Let’s start by importing the shapes and do a sanity check:</p>
<figure>
<pre><code data-lang="r"><span>library</span><span>(</span><span>jsonlite</span><span>)</span><span>
</span><span>library</span><span>(</span><span>ggplot2</span><span>)</span><span>
</span><span>greet</span><span> </span><span>&lt;-</span><span> </span><span>fromJSON</span><span>(</span><span>readLines</span><span>(</span><span>'http://www.data-imaginist.com/assets/data/x-mas.json'</span><span>))</span><span>
</span><span>layer_names</span><span> </span><span>&lt;-</span><span> </span><span>greet</span><span>$</span><span>layers</span><span>$</span><span>name</span><span>
</span><span>heart</span><span> </span><span>&lt;-</span><span> </span><span>greet</span><span>$</span><span>layers</span><span>$</span><span>paths</span><span>[[</span><span>which</span><span>(</span><span>layer_names</span><span> </span><span>==</span><span> </span><span>'Heart'</span><span>)]]</span><span>$</span><span>points</span><span>
</span><span>merry</span><span> </span><span>&lt;-</span><span> </span><span>greet</span><span>$</span><span>layers</span><span>$</span><span>paths</span><span>[[</span><span>which</span><span>(</span><span>layer_names</span><span> </span><span>==</span><span> </span><span>'Merry'</span><span>)]]</span><span>$</span><span>points</span><span>
</span><span>x_mas</span><span> </span><span>&lt;-</span><span> </span><span>greet</span><span>$</span><span>layers</span><span>$</span><span>paths</span><span>[[</span><span>which</span><span>(</span><span>layer_names</span><span> </span><span>==</span><span> </span><span>'X-MAS'</span><span>)]]</span><span>$</span><span>points</span><span>
</span><span>range</span><span> </span><span>&lt;-</span><span> </span><span>greet</span><span>$</span><span>layers</span><span>$</span><span>paths</span><span>[[</span><span>which</span><span>(</span><span>layer_names</span><span> </span><span>==</span><span> </span><span>'back'</span><span>)]]</span><span>$</span><span>points</span><span>[[</span><span>1</span><span>]]</span><span>
</span><span>ggplot</span><span>(</span><span>as.data.frame</span><span>(</span><span>heart</span><span>[[</span><span>1</span><span>]]))</span><span> </span><span>+</span><span> </span><span>geom_polygon</span><span>(</span><span>aes</span><span>(</span><span>V</span><span>1</span><span>,</span><span> </span><span>V</span><span>2</span><span>))</span></code></pre>
</figure>
<p><img alt="center" src="https://i0.wp.com/www.data-imaginist.com/assets/images/2016-12-21-Data-driven-x-mas-card/unnamed-chunk-2-1.png?w=456" data-recalc-dims="1"></p>
<p>That seems sort-of right. The shape is on its head since Illustrator measures<br>
its coordinates from the top-left corner and down and not from the bottom-left<br>
corner and up. Well simply use <code>scale_y_reverse()</code> later to circumvent this.</p>
<p>Now that we have our shapes it is time to draw them with points. To do this<br>
we’ll sample 25.000 points within the plot area and check which ones falls into<br>
the different shapes. There are many ways to test whether a point lies inside a<br>
shape – I’ll use the <code>in.out()</code> function from the <code>mgcv</code> package.</p>
<figure>
<pre><code data-lang="r"><span>library</span><span>(</span><span>mgcv</span><span>)</span><span>
</span><span>heart_points</span><span> </span><span>&lt;-</span><span> </span><span>data.frame</span><span>(</span><span>
</span><span>x</span><span> </span><span>=</span><span> </span><span>runif</span><span>(</span><span>25000</span><span>,</span><span> </span><span>min</span><span> </span><span>=</span><span> </span><span>min</span><span>(</span><span>range</span><span>[,</span><span>1</span><span>]),</span><span> </span><span>max</span><span> </span><span>=</span><span> </span><span>max</span><span>(</span><span>range</span><span>[,</span><span> </span><span>1</span><span>])),</span><span>
</span><span>y</span><span> </span><span>=</span><span> </span><span>runif</span><span>(</span><span>25000</span><span>,</span><span> </span><span>min</span><span> </span><span>=</span><span> </span><span>min</span><span>(</span><span>range</span><span>[,</span><span>2</span><span>]),</span><span> </span><span>max</span><span> </span><span>=</span><span> </span><span>max</span><span>(</span><span>range</span><span>[,</span><span> </span><span>2</span><span>])),</span><span>
</span><span>colour</span><span> </span><span>=</span><span> </span><span>'green'</span><span>,</span><span>
</span><span>stringsAsFactors</span><span> </span><span>=</span><span> </span><span>FALSE</span><span>
</span><span>)</span><span>
</span><span>heart_points</span><span>$</span><span>colour</span><span>[</span><span>
</span><span>in.out</span><span>(</span><span>
</span><span>do.call</span><span>(</span><span>rbind</span><span>,</span><span> </span><span>lapply</span><span>(</span><span>heart</span><span>,</span><span> </span><span>rbind</span><span>,</span><span> </span><span>c</span><span>(</span><span>NA</span><span>,</span><span> </span><span>NA</span><span>))),</span><span> </span><span>cbind</span><span>(</span><span>heart_points</span><span>$</span><span>x</span><span>,</span><span> </span><span>heart_points</span><span>$</span><span>y</span><span>)</span><span>
</span><span>)</span><span>
</span><span>]</span><span> </span><span>&lt;-</span><span> </span><span>'red'</span><span>
</span><span>merry_points</span><span> </span><span>&lt;-</span><span> </span><span>data.frame</span><span>(</span><span>
</span><span>x</span><span> </span><span>=</span><span> </span><span>runif</span><span>(</span><span>25000</span><span>,</span><span> </span><span>min</span><span> </span><span>=</span><span> </span><span>min</span><span>(</span><span>range</span><span>[,</span><span>1</span><span>]),</span><span> </span><span>max</span><span> </span><span>=</span><span> </span><span>max</span><span>(</span><span>range</span><span>[,</span><span> </span><span>1</span><span>])),</span><span>
</span><span>y</span><span> </span><span>=</span><span> </span><span>runif</span><span>(</span><span>25000</span><span>,</span><span> </span><span>min</span><span> </span><span>=</span><span> </span><span>min</span><span>(</span><span>range</span><span>[,</span><span>2</span><span>]),</span><span> </span><span>max</span><span> </span><span>=</span><span> </span><span>max</span><span>(</span><span>range</span><span>[,</span><span> </span><span>2</span><span>])),</span><span>
</span><span>colour</span><span> </span><span>=</span><span> </span><span>'red'</span><span>,</span><span>
</span><span>stringsAsFactors</span><span> </span><span>=</span><span> </span><span>FALSE</span><span>
</span><span>)</span><span>
</span><span>merry_points</span><span>$</span><span>colour</span><span>[</span><span>
</span><span>in.out</span><span>(</span><span>
</span><span>do.call</span><span>(</span><span>rbind</span><span>,</span><span> </span><span>lapply</span><span>(</span><span>merry</span><span>,</span><span> </span><span>rbind</span><span>,</span><span> </span><span>c</span><span>(</span><span>NA</span><span>,</span><span> </span><span>NA</span><span>))),</span><span> </span><span>cbind</span><span>(</span><span>merry_points</span><span>$</span><span>x</span><span>,</span><span> </span><span>merry_points</span><span>$</span><span>y</span><span>)</span><span>
</span><span>)</span><span>
</span><span>]</span><span> </span><span>&lt;-</span><span> </span><span>'green'</span><span>
</span><span>xmas_points</span><span> </span><span>&lt;-</span><span> </span><span>data.frame</span><span>(</span><span>
</span><span>x</span><span> </span><span>=</span><span> </span><span>runif</span><span>(</span><span>25000</span><span>,</span><span> </span><span>min</span><span> </span><span>=</span><span> </span><span>min</span><span>(</span><span>range</span><span>[,</span><span>1</span><span>]),</span><span> </span><span>max</span><span> </span><span>=</span><span> </span><span>max</span><span>(</span><span>range</span><span>[,</span><span> </span><span>1</span><span>])),</span><span>
</span><span>y</span><span> </span><span>=</span><span> </span><span>runif</span><span>(</span><span>25000</span><span>,</span><span> </span><span>min</span><span> </span><span>=</span><span> </span><span>min</span><span>(</span><span>range</span><span>[,</span><span>2</span><span>]),</span><span> </span><span>max</span><span> </span><span>=</span><span> </span><span>max</span><span>(</span><span>range</span><span>[,</span><span> </span><span>2</span><span>])),</span><span>
</span><span>colour</span><span> </span><span>=</span><span> </span><span>'red'</span><span>,</span><span>
</span><span>stringsAsFactors</span><span> </span><span>=</span><span> </span><span>FALSE</span><span>
</span><span>)</span><span>
</span><span>xmas_points</span><span>$</span><span>colour</span><span>[</span><span>
</span><span>in.out</span><span>(</span><span>
</span><span>do.call</span><span>(</span><span>rbind</span><span>,</span><span> </span><span>lapply</span><span>(</span><span>x_mas</span><span>,</span><span> </span><span>rbind</span><span>,</span><span> </span><span>c</span><span>(</span><span>NA</span><span>,</span><span> </span><span>NA</span><span>))),</span><span> </span><span>cbind</span><span>(</span><span>xmas_points</span><span>$</span><span>x</span><span>,</span><span> </span><span>xmas_points</span><span>$</span><span>y</span><span>)</span><span>
</span><span>)</span><span>
</span><span>]</span><span> </span><span>&lt;-</span><span> </span><span>'green'</span><span>
</span><span>ggplot</span><span>(</span><span>merry_points</span><span>)</span><span> </span><span>+</span><span> </span><span>geom_point</span><span>(</span><span>aes</span><span>(</span><span>x</span><span>,</span><span> </span><span>y</span><span>,</span><span> </span><span>colour</span><span> </span><span>=</span><span> </span><span>colour</span><span>))</span></code></pre>
</figure>
<p><img alt="center" src="https://i0.wp.com/www.data-imaginist.com/assets/images/2016-12-21-Data-driven-x-mas-card/unnamed-chunk-3-1.png?w=456" data-recalc-dims="1"></p>
<p>We could call this a day and continue with all those points, but we wont. First,<br>
because voronoi tessellation (as implemented in <code>deldir</code>) does not scale well to<br>
these number of points, and second, because the tiles would be so small that<br>
they are almost indistinguishable from each other.</p>
<p>To fix this we are going to remove a lot of the points that do not help in<br>
defining the shapes. In order to determine which points are safe to remove we<br>
are going to calculate the delaunay triangulation (the “inverse” of a voronoi<br>
tesselation) and find out which points only have neighbors of the same colour.<br>
We are going to remove as many random point so well end up with 1.000 points of<br>
each colour:</p>
<figure>
<pre><code data-lang="r"><span>library</span><span>(</span><span>deldir</span><span>)</span><span>
</span><span>library</span><span>(</span><span>ggforce</span><span>)</span><span>
</span><span>heart_vor</span><span> </span><span>&lt;-</span><span> </span><span>deldir</span><span>(</span><span>heart_points</span><span>$</span><span>x</span><span>,</span><span> </span><span>heart_points</span><span>$</span><span>y</span><span>)</span><span>
</span><span>heart_con</span><span> </span><span>&lt;-</span><span> </span><span>split</span><span>(</span><span>c</span><span>(</span><span>heart_points</span><span>$</span><span>colour</span><span>[</span><span>heart_vor</span><span>$</span><span>delsgs</span><span>$</span><span>ind2</span><span>],</span><span> </span><span>heart_points</span><span>$</span><span>colour</span><span>[</span><span>heart_vor</span><span>$</span><span>delsgs</span><span>$</span><span>ind1</span><span>]),</span><span> </span><span>c</span><span>(</span><span>heart_vor</span><span>$</span><span>delsgs</span><span>$</span><span>ind1</span><span>,</span><span> </span><span>heart_vor</span><span>$</span><span>delsgs</span><span>$</span><span>ind2</span><span>))</span><span>
</span><span>heart_boring</span><span> </span><span>&lt;-</span><span> </span><span>lengths</span><span>(</span><span>lapply</span><span>(</span><span>heart_con</span><span>,</span><span> </span><span>unique</span><span>))</span><span> </span><span>==</span><span> </span><span>1</span><span>
</span><span>heart_remove</span><span> </span><span>&lt;-</span><span> </span><span>c</span><span>(</span><span>
</span><span>sample</span><span>(</span><span>which</span><span>(</span><span>heart_boring</span><span> </span><span>&amp;</span><span> </span><span>heart_points</span><span>$</span><span>colour</span><span> </span><span>==</span><span> </span><span>'red'</span><span>),</span><span> </span><span>sum</span><span>(</span><span>heart_boring</span><span> </span><span>&amp;</span><span> </span><span>heart_points</span><span>$</span><span>colour</span><span> </span><span>==</span><span> </span><span>'red'</span><span>)</span><span> </span><span>-</span><span> </span><span>(</span><span>1000</span><span> </span><span>-</span><span> </span><span>sum</span><span>(</span><span>!</span><span>heart_boring</span><span> </span><span>&amp;</span><span> </span><span>heart_points</span><span>$</span><span>colour</span><span> </span><span>==</span><span> </span><span>'red'</span><span>))),</span><span>
</span><span>sample</span><span>(</span><span>which</span><span>(</span><span>heart_boring</span><span> </span><span>&amp;</span><span> </span><span>heart_points</span><span>$</span><span>colour</span><span> </span><span>==</span><span> </span><span>'green'</span><span>),</span><span> </span><span>sum</span><span>(</span><span>heart_boring</span><span> </span><span>&amp;</span><span> </span><span>heart_points</span><span>$</span><span>colour</span><span> </span><span>==</span><span> </span><span>'green'</span><span>)</span><span> </span><span>-</span><span> </span><span>(</span><span>1000</span><span> </span><span>-</span><span> </span><span>sum</span><span>(</span><span>!</span><span>heart_boring</span><span> </span><span>&amp;</span><span> </span><span>heart_points</span><span>$</span><span>colour</span><span> </span><span>==</span><span> </span><span>'green'</span><span>)))</span><span>
</span><span>)</span><span>
</span><span>heart_points</span><span> </span><span>&lt;-</span><span> </span><span>heart_points</span><span>[</span><span>-</span><span>heart_remove</span><span>,</span><span> </span><span>]</span><span>
</span><span>merry_vor</span><span> </span><span>&lt;-</span><span> </span><span>deldir</span><span>(</span><span>merry_points</span><span>$</span><span>x</span><span>,</span><span> </span><span>merry_points</span><span>$</span><span>y</span><span>)</span><span>
</span><span>merry_con</span><span> </span><span>&lt;-</span><span> </span><span>split</span><span>(</span><span>c</span><span>(</span><span>merry_points</span><span>$</span><span>colour</span><span>[</span><span>merry_vor</span><span>$</span><span>delsgs</span><span>$</span><span>ind2</span><span>],</span><span> </span><span>merry_points</span><span>$</span><span>colour</span><span>[</span><span>merry_vor</span><span>$</span><span>delsgs</span><span>$</span><span>ind1</span><span>]),</span><span> </span><span>c</span><span>(</span><span>merry_vor</span><span>$</span><span>delsgs</span><span>$</span><span>ind1</span><span>,</span><span> </span><span>merry_vor</span><span>$</span><span>delsgs</span><span>$</span><span>ind2</span><span>))</span><span>
</span><span>merry_boring</span><span> </span><span>&lt;-</span><span> </span><span>lengths</span><span>(</span><span>lapply</span><span>(</span><span>merry_con</span><span>,</span><span> </span><span>unique</span><span>))</span><span> </span><span>==</span><span> </span><span>1</span><span>
</span><span>merry_remove</span><span> </span><span>&lt;-</span><span> </span><span>c</span><span>(</span><span>
</span><span>sample</span><span>(</span><span>which</span><span>(</span><span>merry_boring</span><span> </span><span>&amp;</span><span> </span><span>merry_points</span><span>$</span><span>colour</span><span> </span><span>==</span><span> </span><span>'red'</span><span>),</span><span> </span><span>sum</span><span>(</span><span>merry_boring</span><span> </span><span>&amp;</span><span> </span><span>merry_points</span><span>$</span><span>colour</span><span> </span><span>==</span><span> </span><span>'red'</span><span>)</span><span> </span><span>-</span><span> </span><span>(</span><span>1000</span><span> </span><span>-</span><span> </span><span>sum</span><span>(</span><span>!</span><span>merry_boring</span><span> </span><span>&amp;</span><span> </span><span>merry_points</span><span>$</span><span>colour</span><span> </span><span>==</span><span> </span><span>'red'</span><span>))),</span><span>
</span><span>sample</span><span>(</span><span>which</span><span>(</span><span>merry_boring</span><span> </span><span>&amp;</span><span> </span><span>merry_points</span><span>$</span><span>colour</span><span> </span><span>==</span><span> </span><span>'green'</span><span>),</span><span> </span><span>sum</span><span>(</span><span>merry_boring</span><span> </span><span>&amp;</span><span> </span><span>merry_points</span><span>$</span><span>colour</span><span> </span><span>==</span><span> </span><span>'green'</span><span>)</span><span> </span><span>-</span><span> </span><span>(</span><span>1000</span><span> </span><span>-</span><span> </span><span>sum</span><span>(</span><span>!</span><span>merry_boring</span><span> </span><span>&amp;</span><span> </span><span>merry_points</span><span>$</span><span>colour</span><span> </span><span>==</span><span> </span><span>'green'</span><span>)))</span><span>
</span><span>)</span><span>
</span><span>merry_points</span><span> </span><span>&lt;-</span><span> </span><span>merry_points</span><span>[</span><span>-</span><span>merry_remove</span><span>,</span><span> </span><span>]</span><span>
</span><span>xmas_vor</span><span> </span><span>&lt;-</span><span> </span><span>deldir</span><span>(</span><span>xmas_points</span><span>$</span><span>x</span><span>,</span><span> </span><span>xmas_points</span><span>$</span><span>y</span><span>)</span><span>
</span><span>xmas_con</span><span> </span><span>&lt;-</span><span> </span><span>split</span><span>(</span><span>c</span><span>(</span><span>xmas_points</span><span>$</span><span>colour</span><span>[</span><span>xmas_vor</span><span>$</span><span>delsgs</span><span>$</span><span>ind2</span><span>],</span><span> </span><span>xmas_points</span><span>$</span><span>colour</span><span>[</span><span>xmas_vor</span><span>$</span><span>delsgs</span><span>$</span><span>ind1</span><span>]),</span><span> </span><span>c</span><span>(</span><span>xmas_vor</span><span>$</span><span>delsgs</span><span>$</span><span>ind1</span><span>,</span><span> </span><span>xmas_vor</span><span>$</span><span>delsgs</span><span>$</span><span>ind2</span><span>))</span><span>
</span><span>xmas_boring</span><span> </span><span>&lt;-</span><span> </span><span>lengths</span><span>(</span><span>lapply</span><span>(</span><span>xmas_con</span><span>,</span><span> </span><span>unique</span><span>))</span><span> </span><span>==</span><span> </span><span>1</span><span>
</span><span>xmas_remove</span><span> </span><span>&lt;-</span><span> </span><span>c</span><span>(</span><span>
</span><span>sample</span><span>(</span><span>which</span><span>(</span><span>xmas_boring</span><span> </span><span>&amp;</span><span> </span><span>xmas_points</span><span>$</span><span>colour</span><span> </span><span>==</span><span> </span><span>'red'</span><span>),</span><span> </span><span>sum</span><span>(</span><span>xmas_boring</span><span> </span><span>&amp;</span><span> </span><span>xmas_points</span><span>$</span><span>colour</span><span> </span><span>==</span><span> </span><span>'red'</span><span>)</span><span> </span><span>-</span><span> </span><span>(</span><span>1000</span><span> </span><span>-</span><span> </span><span>sum</span><span>(</span><span>!</span><span>xmas_boring</span><span> </span><span>&amp;</span><span> </span><span>xmas_points</span><span>$</span><span>colour</span><span> </span><span>==</span><span> </span><span>'red'</span><span>))),</span><span>
</span><span>sample</span><span>(</span><span>which</span><span>(</span><span>xmas_boring</span><span> </span><span>&amp;</span><span> </span><span>xmas_points</span><span>$</span><span>colour</span><span> </span><span>==</span><span> </span><span>'green'</span><span>),</span><span> </span><span>sum</span><span>(</span><span>xmas_boring</span><span> </span><span>&amp;</span><span> </span><span>xmas_points</span><span>$</span><span>colour</span><span> </span><span>==</span><span> </span><span>'green'</span><span>)</span><span> </span><span>-</span><span> </span><span>(</span><span>1000</span><span> </span><span>-</span><span> </span><span>sum</span><span>(</span><span>!</span><span>xmas_boring</span><span> </span><span>&amp;</span><span> </span><span>xmas_points</span><span>$</span><span>colour</span><span> </span><span>==</span><span> </span><span>'green'</span><span>)))</span><span>
</span><span>)</span><span>
</span><span>xmas_points</span><span> </span><span>&lt;-</span><span> </span><span>xmas_points</span><span>[</span><span>-</span><span>xmas_remove</span><span>,</span><span> </span><span>]</span><span>
</span><span>ggplot</span><span>(</span><span>xmas_points</span><span>)</span><span> </span><span>+</span><span> </span><span>geom_voronoi_tile</span><span>(</span><span>aes</span><span>(</span><span>x</span><span>,</span><span> </span><span>y</span><span>,</span><span> </span><span>fill</span><span> </span><span>=</span><span> </span><span>colour</span><span>),</span><span> </span><span>colour</span><span> </span><span>=</span><span> </span><span>'black'</span><span>)</span></code></pre>
</figure>
<p><img alt="center" src="https://i0.wp.com/www.data-imaginist.com/assets/images/2016-12-21-Data-driven-x-mas-card/unnamed-chunk-4-1.png?w=456" data-recalc-dims="1"></p>
<p>Now we’re getting somewhere!</p>
<p>The next step is to match the points from each stage together so we know which<br>
one moves where. For the transition between the heart and the text I’m fine with<br>
it being random, but for the transition between “merry” and “x-mas” I want it to<br>
seem as smooth as possible. This requires that each point in <code>merry_points</code> get<br>
matched to its nearest neighbor of equal colour in the <code>xmas_points</code> data.frame.<br>
As some points might compete for the nearest neighbor some will have to settle<br>
for neighbors a bit farther away. While it might be possible to optimise the<br>
choice of neighbor we are just going to go through each in turn so the points<br>
occuring first in the data.frame will get first pick:</p>
<figure>
<pre><code data-lang="r"><span>heart_points</span><span> </span><span>&lt;-</span><span> </span><span>heart_points</span><span>[</span><span>order</span><span>(</span><span>heart_points</span><span>$</span><span>colour</span><span>),</span><span> </span><span>]</span><span>
</span><span>heart_points</span><span>$</span><span>id</span><span> </span><span>&lt;-</span><span> </span><span>seq_len</span><span>(</span><span>nrow</span><span>(</span><span>heart_points</span><span>))</span><span>
</span><span>merry_points</span><span> </span><span>&lt;-</span><span> </span><span>merry_points</span><span>[</span><span>order</span><span>(</span><span>merry_points</span><span>$</span><span>colour</span><span>),</span><span> </span><span>]</span><span>
</span><span>merry_points</span><span>$</span><span>id</span><span> </span><span>&lt;-</span><span> </span><span>seq_len</span><span>(</span><span>nrow</span><span>(</span><span>merry_points</span><span>))</span><span>
</span><span>xmas_points</span><span> </span><span>&lt;-</span><span> </span><span>xmas_points</span><span>[</span><span>order</span><span>(</span><span>xmas_points</span><span>$</span><span>colour</span><span>),</span><span> </span><span>]</span><span>
</span><span>eu_dist</span><span> </span><span>&lt;-</span><span> </span><span>function</span><span>(</span><span>x</span><span>,</span><span> </span><span>y</span><span>)</span><span> </span><span>{</span><span>
</span><span>ifelse</span><span>(</span><span>
</span><span>merry_points</span><span>$</span><span>colour</span><span>[</span><span>x</span><span>]</span><span> </span><span>!=</span><span> </span><span>xmas_points</span><span>$</span><span>colour</span><span>[</span><span>y</span><span>],</span><span> </span><span>1e5</span><span>,</span><span> </span><span>sqrt</span><span>((</span><span>merry_points</span><span>$</span><span>x</span><span>[</span><span>x</span><span>]</span><span> </span><span>-</span><span> </span><span>xmas_points</span><span>$</span><span>x</span><span>[</span><span>y</span><span>])</span><span>^</span><span>2</span><span> </span><span>+</span><span> </span><span>(</span><span>merry_points</span><span>$</span><span>y</span><span>[</span><span>x</span><span>]</span><span> </span><span>-</span><span> </span><span>xmas_points</span><span>$</span><span>y</span><span>[</span><span>y</span><span>])</span><span>^</span><span>2</span><span>)</span><span>
</span><span>)</span><span>
</span><span>}</span><span>
</span><span>distance</span><span> </span><span>&lt;-</span><span> </span><span>outer</span><span>(</span><span>seq_len</span><span>(</span><span>nrow</span><span>(</span><span>merry_points</span><span>)),</span><span> </span><span>seq_len</span><span>(</span><span>nrow</span><span>(</span><span>merry_points</span><span>)),</span><span> </span><span>eu_dist</span><span>
</span><span>)</span><span>
</span><span>pair</span><span> </span><span>&lt;-</span><span> </span><span>Reduce</span><span>(</span><span>function</span><span>(</span><span>l</span><span>,</span><span> </span><span>r</span><span>)</span><span> </span><span>{</span><span>
</span><span>pair_order</span><span> </span><span>&lt;-</span><span> </span><span>order</span><span>(</span><span>distance</span><span>[</span><span>r</span><span>,</span><span> </span><span>])</span><span>
</span><span>c</span><span>(</span><span>l</span><span>,</span><span> </span><span>pair_order</span><span>[</span><span>which</span><span>(</span><span>!</span><span>pair_order</span><span> </span><span>%in%</span><span> </span><span>l</span><span>)[</span><span>1</span><span>]])</span><span>
</span><span>},</span><span> </span><span>seq_len</span><span>(</span><span>nrow</span><span>(</span><span>merry_points</span><span>)),</span><span> </span><span>init</span><span> </span><span>=</span><span> </span><span>integer</span><span>())</span><span>
</span><span>xmas_points</span><span>$</span><span>id</span><span>[</span><span>pair</span><span>]</span><span> </span><span>&lt;-</span><span> </span><span>seq_len</span><span>(</span><span>nrow</span><span>(</span><span>xmas_points</span><span>))</span><span>
</span><span>xmas_points</span><span> </span><span>&lt;-</span><span> </span><span>xmas_points</span><span>[</span><span>order</span><span>(</span><span>xmas_points</span><span>$</span><span>id</span><span>),</span><span> </span><span>]</span></code></pre>
</figure>
<p>Now each data.frame is lined up so the point encoded in row 1 is the same across<br>
all. The last bit of work we need to do is to interpolate the transition between<br>
each stage. This could be done in one line of code with <code>tweenr</code> using<br>
<code>tween_states()</code> but I dont want all points to start and end their movements at<br>
the same time. Thus we need to do something a bit more custom:</p>
<figure>
<pre><code data-lang="r"><span>library</span><span>(</span><span>tweenr</span><span>)</span><span>
</span><span>tween_points</span><span> </span><span>&lt;-</span><span> </span><span>function</span><span>(</span><span>from</span><span>,</span><span> </span><span>to</span><span>,</span><span> </span><span>length</span><span>,</span><span> </span><span>stagger</span><span>)</span><span> </span><span>{</span><span>
</span><span>leave</span><span> </span><span>&lt;-</span><span> </span><span>sample</span><span>(</span><span>seq_len</span><span>(</span><span>stagger</span><span>),</span><span> </span><span>nrow</span><span>(</span><span>from</span><span>),</span><span> </span><span>replace</span><span> </span><span>=</span><span> </span><span>TRUE</span><span>)</span><span>
</span><span>arive</span><span> </span><span>&lt;-</span><span> </span><span>sample</span><span>(</span><span>seq_len</span><span>(</span><span>stagger</span><span>),</span><span> </span><span>nrow</span><span>(</span><span>from</span><span>),</span><span> </span><span>replace</span><span> </span><span>=</span><span> </span><span>TRUE</span><span>)</span><span>
</span><span>x</span><span> </span><span>&lt;-</span><span> </span><span>tween_t</span><span>(</span><span>Map</span><span>(</span><span>function</span><span>(</span><span>.f</span><span>,</span><span> </span><span>.t</span><span>)</span><span> </span><span>c</span><span>(</span><span>.f</span><span>,</span><span> </span><span>.t</span><span>),</span><span> </span><span>.f</span><span> </span><span>=</span><span> </span><span>from</span><span>$</span><span>x</span><span>,</span><span> </span><span>.t</span><span> </span><span>=</span><span> </span><span>to</span><span>$</span><span>x</span><span>),</span><span> </span><span>length</span><span> </span><span>-</span><span> </span><span>leave</span><span> </span><span>-</span><span> </span><span>arive</span><span>)</span><span>
</span><span>y</span><span> </span><span>&lt;-</span><span> </span><span>tween_t</span><span>(</span><span>Map</span><span>(</span><span>function</span><span>(</span><span>.f</span><span>,</span><span> </span><span>.t</span><span>)</span><span> </span><span>c</span><span>(</span><span>.f</span><span>,</span><span> </span><span>.t</span><span>),</span><span> </span><span>.f</span><span> </span><span>=</span><span> </span><span>from</span><span>$</span><span>y</span><span>,</span><span> </span><span>.t</span><span> </span><span>=</span><span> </span><span>to</span><span>$</span><span>y</span><span>),</span><span> </span><span>length</span><span> </span><span>-</span><span> </span><span>leave</span><span> </span><span>-</span><span> </span><span>arive</span><span>)</span><span>
</span><span>points</span><span> </span><span>&lt;-</span><span> </span><span>Map</span><span>(</span><span>function</span><span>(</span><span>x</span><span>,</span><span> </span><span>y</span><span>,</span><span> </span><span>l</span><span>,</span><span> </span><span>a</span><span>)</span><span> </span><span>{</span><span>
</span><span>data.frame</span><span>(</span><span>x</span><span> </span><span>=</span><span> </span><span>x</span><span>,</span><span> </span><span>y</span><span> </span><span>=</span><span> </span><span>y</span><span>)[</span><span>c</span><span>(</span><span>rep</span><span>(</span><span>1</span><span>,</span><span> </span><span>l</span><span>),</span><span> </span><span>seq_along</span><span>(</span><span>x</span><span>),</span><span> </span><span>rep</span><span>(</span><span>length</span><span>(</span><span>x</span><span>),</span><span> </span><span>a</span><span>)),</span><span> </span><span>]</span><span>
</span><span>},</span><span> </span><span>x</span><span> </span><span>=</span><span> </span><span>x</span><span>,</span><span> </span><span>y</span><span> </span><span>=</span><span> </span><span>y</span><span>,</span><span> </span><span>l</span><span> </span><span>=</span><span> </span><span>leave</span><span>,</span><span> </span><span>a</span><span> </span><span>=</span><span> </span><span>arive</span><span>)</span><span>
</span><span>points</span><span> </span><span>&lt;-</span><span> </span><span>do.call</span><span>(</span><span>rbind</span><span>,</span><span> </span><span>points</span><span>)</span><span>
</span><span>points</span><span>$</span><span>frame</span><span> </span><span>&lt;-</span><span> </span><span>rep</span><span>(</span><span>seq_len</span><span>(</span><span>length</span><span>),</span><span> </span><span>nrow</span><span>(</span><span>from</span><span>))</span><span>
</span><span>cbind</span><span>(</span><span>
</span><span>points</span><span>,</span><span> </span><span>from</span><span>[</span><span>rep</span><span>(</span><span>seq_len</span><span>(</span><span>nrow</span><span>(</span><span>from</span><span>)),</span><span> </span><span>each</span><span> </span><span>=</span><span> </span><span>length</span><span>),</span><span> </span><span>!</span><span>names</span><span>(</span><span>from</span><span>)</span><span> </span><span>%in%</span><span> </span><span>c</span><span>(</span><span>'x'</span><span>,</span><span> </span><span>'y'</span><span>)])</span><span>
</span><span>}</span></code></pre>
</figure>
<p>This function takes two data.frames along with the total transition length and<br>
a <code>stagger</code> value that encodes the maximum offset in time each transition can<br>
have in terms of starting and ending. It then interpolates the <code>x</code> and <code>y</code><br>
columns between the two data.frames, adding a <code>frame</code> column to the end result.</p>
<p>Let’s put it to good use. Our animation will take 12 seconds at a frame rate of<br>
24 fps making a total of 288 frames and 96 frames for each stage along with the<br>
transition to it. We’ll split it up so that each stage is hold for 36 frames,<br>
ending up with 60 frames for each transition. We’ll allow the start and end time<br>
to vary with 20 frames each:</p>
<figure>
<pre><code data-lang="r"><span>n_frames_still</span><span> </span><span>&lt;-</span><span> </span><span>36</span><span>
</span><span>n_frames_trans</span><span> </span><span>&lt;-</span><span> </span><span>60</span><span>
</span><span>n_frames_stagger</span><span> </span><span>&lt;-</span><span> </span><span>20</span><span>
</span><span>n_frames_stage</span><span> </span><span>&lt;-</span><span> </span><span>96</span><span>
</span><span>heart_to_merry</span><span> </span><span>&lt;-</span><span> </span><span>tween_points</span><span>(</span><span>heart_points</span><span>,</span><span> </span><span>merry_points</span><span>,</span><span> </span><span>n_frames_trans</span><span>,</span><span> </span><span>n_frames_stagger</span><span>)</span><span>
</span><span>merry_to_xmas</span><span> </span><span>&lt;-</span><span> </span><span>tween_points</span><span>(</span><span>merry_points</span><span>,</span><span> </span><span>xmas_points</span><span>,</span><span> </span><span>n_frames_trans</span><span>,</span><span> </span><span>n_frames_stagger</span><span>)</span><span>
</span><span>xmas_to_heart</span><span> </span><span>&lt;-</span><span> </span><span>tween_points</span><span>(</span><span>xmas_points</span><span>,</span><span> </span><span>heart_points</span><span>,</span><span> </span><span>n_frames_trans</span><span>,</span><span> </span><span>n_frames_stagger</span><span>)</span></code></pre>
</figure>
<p>In addition to this we need to repeat each stage 36 times and offset the frame<br>
count. In the end we’ll combine everything into one data.frame:</p>
<figure>
<pre><code data-lang="r"><span>heart_still</span><span> </span><span>&lt;-</span><span> </span><span>heart_points</span><span>[</span><span>rep</span><span>(</span><span>seq_len</span><span>(</span><span>nrow</span><span>(</span><span>heart_points</span><span>)),</span><span> </span><span>n_frames_still</span><span>),</span><span> </span><span>]</span><span>
</span><span>heart_still</span><span>$</span><span>frame</span><span> </span><span>&lt;-</span><span> </span><span>rep</span><span>(</span><span>seq_len</span><span>(</span><span>n_frames_still</span><span>),</span><span> </span><span>each</span><span> </span><span>=</span><span> </span><span>nrow</span><span>(</span><span>heart_points</span><span>))</span><span>
</span><span>heart_to_merry</span><span>$</span><span>frame</span><span> </span><span>&lt;-</span><span> </span><span>heart_to_merry</span><span>$</span><span>frame</span><span> </span><span>+</span><span> </span><span>n_frames_still</span><span>
</span><span>merry_still</span><span> </span><span>&lt;-</span><span> </span><span>merry_points</span><span>[</span><span>rep</span><span>(</span><span>seq_len</span><span>(</span><span>nrow</span><span>(</span><span>merry_points</span><span>)),</span><span> </span><span>n_frames_still</span><span>),</span><span> </span><span>]</span><span>
</span><span>merry_still</span><span>$</span><span>frame</span><span> </span><span>&lt;-</span><span> </span><span>rep</span><span>(</span><span>seq_len</span><span>(</span><span>n_frames_still</span><span>),</span><span> </span><span>each</span><span> </span><span>=</span><span> </span><span>nrow</span><span>(</span><span>merry_points</span><span>))</span><span> </span><span>+</span><span> </span><span>n_frames_stage</span><span>
</span><span>merry_to_xmas</span><span>$</span><span>frame</span><span> </span><span>&lt;-</span><span> </span><span>merry_to_xmas</span><span>$</span><span>frame</span><span> </span><span>+</span><span> </span><span>n_frames_stage</span><span> </span><span>+</span><span> </span><span>n_frames_still</span><span>
</span><span>xmas_still</span><span> </span><span>&lt;-</span><span> </span><span>xmas_points</span><span>[</span><span>rep</span><span>(</span><span>seq_len</span><span>(</span><span>nrow</span><span>(</span><span>xmas_points</span><span>)),</span><span> </span><span>n_frames_still</span><span>),</span><span> </span><span>]</span><span>
</span><span>xmas_still</span><span>$</span><span>frame</span><span> </span><span>&lt;-</span><span> </span><span>rep</span><span>(</span><span>seq_len</span><span>(</span><span>n_frames_still</span><span>),</span><span> </span><span>each</span><span> </span><span>=</span><span> </span><span>nrow</span><span>(</span><span>xmas_points</span><span>))</span><span> </span><span>+</span><span> </span><span>2</span><span>*</span><span>n_frames_stage</span><span>
</span><span>xmas_to_heart</span><span>$</span><span>frame</span><span> </span><span>&lt;-</span><span> </span><span>xmas_to_heart</span><span>$</span><span>frame</span><span> </span><span>+</span><span> </span><span>2</span><span>*</span><span>n_frames_stage</span><span> </span><span>+</span><span> </span><span>n_frames_still</span><span>
</span><span>frames</span><span> </span><span>&lt;-</span><span> </span><span>rbind</span><span>(</span><span>
</span><span>heart_still</span><span>,</span><span>
</span><span>heart_to_merry</span><span>,</span><span>
</span><span>merry_still</span><span>,</span><span>
</span><span>merry_to_xmas</span><span>,</span><span>
</span><span>xmas_still</span><span>,</span><span>
</span><span>xmas_to_heart</span><span>
</span><span>)</span></code></pre>
</figure>
<p>We now have everything in place to create our animation – we just need to define<br>
the plotting function (take note that we specify the bounding rectangle as the<br>
range of our data might change between frames):</p>
<figure>
<pre><code data-lang="r"><span>christmas_card</span><span> </span><span>&lt;-</span><span> </span><span>function</span><span>(</span><span>data</span><span>)</span><span> </span><span>{</span><span>
</span><span>bound</span><span> </span><span>&lt;-</span><span> </span><span>c</span><span>(</span><span>range</span><span>(</span><span>range</span><span>[,</span><span>1</span><span>]),</span><span> </span><span>range</span><span>(</span><span>-</span><span>range</span><span>[,</span><span>2</span><span>]))</span><span>
</span><span>ggplot</span><span>(</span><span>data</span><span>,</span><span> </span><span>aes</span><span>(</span><span>x</span><span> </span><span>=</span><span> </span><span>x</span><span>,</span><span> </span><span>y</span><span> </span><span>=</span><span> </span><span>y</span><span>))</span><span> </span><span>+</span><span> </span><span>geom_voronoi_tile</span><span>(</span><span>aes</span><span>(</span><span>fill</span><span> </span><span>=</span><span> </span><span>colour</span><span>),</span><span> </span><span>bound</span><span> </span><span>=</span><span> </span><span>bound</span><span>)</span><span> </span><span>+</span><span> </span><span>geom_voronoi_segment</span><span>(</span><span>alpha</span><span> </span><span>=</span><span> </span><span>0.3</span><span>,</span><span> </span><span>bound</span><span> </span><span>=</span><span> </span><span>bound</span><span>)</span><span> </span><span>+</span><span> </span><span>scale_y_reverse</span><span>()</span><span> </span><span>+</span><span> </span><span>scale_fill_manual</span><span>(</span><span>values</span><span> </span><span>=</span><span> </span><span>c</span><span>(</span><span>'forestgreen'</span><span>,</span><span> </span><span>'firebrick'</span><span>))</span><span> </span><span>+</span><span> </span><span>labs</span><span>(</span><span>caption</span><span> </span><span>=</span><span> </span><span>'www.data-imaginist.com'</span><span>)</span><span> </span><span>+</span><span> </span><span>coord_fixed</span><span>(</span><span>expand</span><span> </span><span>=</span><span> </span><span>FALSE</span><span>)</span><span> </span><span>+</span><span> </span><span>theme_void</span><span>()</span><span> </span><span>+</span><span> </span><span>theme</span><span>(</span><span>legend.position</span><span> </span><span>=</span><span> </span><span>'none'</span><span>)</span><span>
</span><span>}</span><span>
</span><span>plot</span><span>(</span><span>christmas_card</span><span>(</span><span>heart_points</span><span>))</span></code></pre>
</figure>
<p><img alt="center" src="https://i0.wp.com/www.data-imaginist.com/assets/images/2016-12-21-Data-driven-x-mas-card/unnamed-chunk-9-1.png?w=456" data-recalc-dims="1"></p>
<p>Now it is just a matter of looping over each frame and plotting that data.<br>
Normally <code>gganimate</code> would be useful for this but it does not always play nice<br>
when data is heavily transformed by the stat function (as is the case with<br>
<code>geom_voronoi_tile()</code> and <code>geom_voronoi_segment()</code>). We’ll just do it the<br>
oldschool way (if you’re running this yourself wrap the following expression<br>
in <code>animation::saveGIF()</code>):</p>
<figure>
<pre><code data-lang="r"><span>for</span><span> </span><span>(</span><span>i</span><span> </span><span>in</span><span> </span><span>seq_len</span><span>(</span><span>max</span><span>(</span><span>frames</span><span>$</span><span>frame</span><span>)))</span><span> </span><span>{</span><span>
</span><span>data</span><span> </span><span>&lt;-</span><span> </span><span>frames</span><span>[</span><span>frames</span><span>$</span><span>frame</span><span> </span><span>==</span><span> </span><span>i</span><span>,</span><span> </span><span>]</span><span>
</span><span>plot</span><span>(</span><span>christmas_card</span><span>(</span><span>data</span><span>))</span><span>
</span><span>}</span></code></pre>
</figure>
<p><img alt="unnamed-chunk-10" src="https://i1.wp.com/www.data-imaginist.com/assets/images/2016-12-21-Data-driven-x-mas-card/unnamed-chunk-10-.gif?w=456" data-recalc-dims="1"></p>
<p>Merry Christmas!</p>
<p>
<div>
<div>To <strong>leave a comment</strong> for the author, please follow the link and comment on their blog: <strong><a href="http://www.data-imaginist.com/2016/Data-driven-x-mas-card/"> Data Imaginist - R posts</a></strong>.</div>
<hr>
<a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers.com</a> offers <strong><a rel="nofollow" href="https://feedburner.google.com/fb/a/mailverify?uri=RBloggers">daily e-mail updates</a></strong> about <a title="The R Project for Statistical Computing" rel="nofollow" href="https://www.r-project.org/">R</a> news and <a title="R tutorials" rel="nofollow" href="https://www.r-bloggers.com/search/tutorial">tutorials</a> on topics such as: <a title="Data science" rel="nofollow" href="https://www.r-bloggers.com/search/data%20science">Data science</a>, <a title="Big Data" rel="nofollow" href="https://www.r-bloggers.com/search/Big%20Data">Big Data, <a title="R jobs" rel="nofollow" href="https://www.r-users.com/">R jobs</a>, visualization (<a title="ggplot and ggplot2 tutorials" rel="nofollow" href="https://www.r-bloggers.com/search/ggplot2">ggplot2</a>, <a title="Boxplots using lattice and ggplot2 tutorials" rel="nofollow" href="https://www.r-bloggers.com/search/boxplot">Boxplots</a>, <a title="Maps and gis" rel="nofollow" href="https://www.r-bloggers.com/search/map">maps</a>, <a title="Animation in R" rel="nofollow" href="https://www.r-bloggers.com/search/animation">animation</a>), programming (<a title="RStudio IDE for R" rel="nofollow" href="https://www.r-bloggers.com/search/RStudio">RStudio</a>, <a title="Sweave and literate programming" rel="nofollow" href="https://www.r-bloggers.com/search/sweave">Sweave</a>, <a title="LaTeX in R" rel="nofollow" href="https://www.r-bloggers.com/search/LaTeX">LaTeX</a>, <a title="SQL and databases" rel="nofollow" href="https://www.r-bloggers.com/search/SQL">SQL</a>, <a title="Eclipse IDE for R" rel="nofollow" href="https://www.r-bloggers.com/search/eclipse">Eclipse</a>, <a title="git and github, Version Control System" rel="nofollow" href="https://www.r-bloggers.com/search/git">git</a>, <a title="Large data in R using Hadoop" rel="nofollow" href="https://www.r-bloggers.com/search/hadoop">hadoop</a>, <a title="Web Scraping of google, facebook, yahoo, twitter and more using R" rel="nofollow" href="https://www.r-bloggers.com/search/Web+Scraping">Web Scraping</a>) statistics (<a title="Regressions and ANOVA analysis tutorials" rel="nofollow" href="https://www.r-bloggers.com/search/regression">regression</a>, <a title="principal component analysis tutorial" rel="nofollow" href="https://www.r-bloggers.com/search/PCA">PCA</a>, <a title="Time series" rel="nofollow" href="https://www.r-bloggers.com/search/time+series">time series</a>, <a title="finance trading" rel="nofollow" href="https://www.r-bloggers.com/search/trading">trading</a>) and more...
<img height="1" alt="" width="1" src="http://feeds.feedburner.com/~r/RBloggers/~4/KvMxsRtm9Eo"></a></div>