index.xml

<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom" xmlns:dc="http://purl.org/dc/elements/1.1/">
  <channel>
    <title>Tea &amp; Stats</title>
    <link>https://selbydavid.com/</link>
    <description>Tea, statistics and t-statistics: a data science blog by David Selby.</description>
		<atom:author>
			<atom:name>David Selby</atom:name>
			<atom:uri>https://selbydavid.com</atom:uri>
		</atom:author>
		<image>
		    <link>https://selbydavid.com/</link>
		    <title>Tea &amp; Stats</title>
		    <url>https://selbydavid.com/logo.png</url>
		</image>
    <generator>Hugo -- gohugo.io</generator>
    <language>en-GB</language>
    <lastBuildDate>Thu, 13 Mar 2025 15:00:00 +0100</lastBuildDate>
    <atom:link href="https://selbydavid.com/" rel="self" type="application/rss+xml" />
    
    
    
    
    <item>
      <title>Learning to Denglisch</title>
      <link>https://selbydavid.com/2025/03/13/denglisch/</link>
      <pubDate>Thu, 13 Mar 2025 15:00:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2025/03/13/denglisch/</guid>
      <description>&lt;p&gt;At the railway station, a lost-looking US soldier asked me if I spoke English.
Do I? At times it feels like it, but the Germans keep me guessing.&lt;/p&gt;
&lt;p&gt;Since moving to Germany, I have been continually tested on the true meanings of English words.
Here are a few examples.&lt;/p&gt;
&lt;h2 id=&#34;denglisch&#34;&gt;Denglisch&lt;/h2&gt;
&lt;p&gt;It turns out I&amp;rsquo;d been using these words wrong all along.&lt;/p&gt;
&lt;table&gt;
&lt;thead&gt;
&lt;tr&gt;
&lt;th&gt;Denglisch&lt;/th&gt;
&lt;th&gt;German meaning&lt;/th&gt;
&lt;th&gt;to Anglophones&lt;/th&gt;
&lt;/tr&gt;
&lt;/thead&gt;
&lt;tbody&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;der Body&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;a babygrow or bodysuit&lt;/td&gt;
&lt;td&gt;a corpse&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;die Bodybag&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;a messenger bag&lt;/td&gt;
&lt;td&gt;a bag for corpses&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;das Public Viewing&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;an open-air screening&lt;/td&gt;
&lt;td&gt;showing a corpse at a wake&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;das Shooting&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;a photoshoot&lt;/td&gt;
&lt;td&gt;somebody getting shot&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;der Beamer&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;a projector&lt;/td&gt;
&lt;td&gt;a BMW&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;das Gymnasium&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;a grammar school&lt;/td&gt;
&lt;td&gt;a gym&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;Homeoffice&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;remote working from home&lt;/td&gt;
&lt;td&gt;the interior ministry&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;das Handy&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;a mobile phone&lt;/td&gt;
&lt;td&gt;useful&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;der Smoking&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;a dinner jacket&lt;/td&gt;
&lt;td&gt;a smoking jacket&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;der Oldtimer&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;classic car&lt;/td&gt;
&lt;td&gt;old person&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;das Notebook&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;a laptop computer&lt;/td&gt;
&lt;td&gt;a notepad&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;die Mail&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;an Email&lt;/td&gt;
&lt;td&gt;snail mail&lt;/td&gt;
&lt;/tr&gt;
&lt;/tbody&gt;
&lt;/table&gt;
&lt;p&gt;&lt;img src=&#34;https://images.unsplash.com/photo-1535016120720-40c646be5580?q=80&amp;amp;w=1740&amp;amp;auto=format&amp;amp;fit=crop&amp;amp;ixlib=rb-4.0.3&amp;amp;ixid=M3wxMjA3fDB8MHxwaG90by1wYWdlfHx8fGVufDB8fHx8fA%3D%3D&#34; alt=&#34;Ein Beamer&#34; title=&#34;ein Beamer&#34;&gt;&lt;/p&gt;
&lt;h2 id=&#34;scheinanglizismus&#34;&gt;Scheinanglizismus&lt;/h2&gt;
&lt;p&gt;I am grateful to German speakers for teaching me these words, which I would never have learnt otherwise.&lt;/p&gt;
&lt;table&gt;
&lt;thead&gt;
&lt;tr&gt;
&lt;th&gt;Pseudo-anglicism&lt;/th&gt;
&lt;th&gt;German definition&lt;/th&gt;
&lt;/tr&gt;
&lt;/thead&gt;
&lt;tbody&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;Fully&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;a full-suspension mountain bike&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;Highboard&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;a tall sideboard, a drinks cabinet&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;Jobticket&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;a subsidized transport pass&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;Kicker&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;table football&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;Lowboard&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;a low sideboard, a media cabinet&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;Partnerlook&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;a couple wearing matching outfits&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;Pullunder&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;a sleeveless cardigan or sweater vest (US)&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;eine suggestive Frage&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;I don&amp;rsquo;t live here, I&amp;rsquo;m just visiting&lt;/td&gt;
&lt;/tr&gt;
&lt;tr&gt;
&lt;td&gt;&lt;em&gt;Wellness&lt;/em&gt;&lt;/td&gt;
&lt;td&gt;a spa&lt;/td&gt;
&lt;/tr&gt;
&lt;/tbody&gt;
&lt;/table&gt;
&lt;p&gt;&lt;img src=&#34;https://images.unsplash.com/photo-1608531428470-4471739c4359?q=80&amp;amp;w=1727&amp;amp;auto=format&amp;amp;fit=crop&amp;amp;ixlib=rb-4.0.3&amp;amp;ixid=M3wxMjA3fDB8MHxwaG90by1wYWdlfHx8fGVufDB8fHx8fA%3D%3D&#34; alt=&#34;Ein Fully&#34; title=&#34;ein Fully&#34;&gt;&lt;/p&gt;
&lt;!--
## Miscellaneous

- I&#39;d probably say *rucksack* over *backpack*.
- A *dachshund* is *ein Dackel*.
- Nobody every says *auf wiedersehen*.
- 
--&gt;
&lt;p&gt;I might update this list as I encounter more.&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Turning over a new leaf</title>
      <link>https://selbydavid.com/2025/03/04/overleaf/</link>
      <pubDate>Tue, 04 Mar 2025 15:00:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2025/03/04/overleaf/</guid>
      <description>&lt;p&gt;&lt;a href=&#34;https://www.overleaf.com/&#34;&gt;Overleaf&lt;/a&gt;, formerly known as Share$\LaTeX$, is the go-to collaborative document editor for many researchers, who have taken advantage of its free tier.
It&amp;rsquo;s a web-based editor that compiles $\LaTeX$ documents in real time, with several word-processor-like features like commenting, tracked changes and a GUI.
However, the company has made collaboration a paid feature, meaning you either need to pay for a premium membership or find an alternative if you want to continue editing academic papers with your colleagues in real time.&lt;/p&gt;
&lt;p&gt;Despite having enjoyed access to an institutional subscription to Overleaf Premium for some time, I find this a great opportunity to explore alternatives.&lt;/p&gt;
&lt;h2 id=&#34;collaborative-markdown-editing&#34;&gt;Collaborative Markdown editing&lt;/h2&gt;
&lt;p&gt;If you have read &lt;a href=&#34;https://selbydavid.com/&#34;&gt;other posts on this blog&lt;/a&gt;, you&amp;rsquo;ll be aware that I am a fan of literate programming using Markdown. This blog, many of &lt;a href=&#34;https://scholar.google.com/citations?user=e7e8nfUAAAAJ&amp;amp;hl=en&#34;&gt;my papers&lt;/a&gt; and &lt;a href=&#34;http://webcat.warwick.ac.uk/record=b3690782&#34;&gt;my PhD thesis&lt;/a&gt; are all written in R Markdown, which integrates text and generation of plots and tables for truly reproducible writing.
&lt;a href=&#34;https://quarto.org/&#34;&gt;Quarto&lt;/a&gt;, R Markdown&amp;rsquo;s less R-centric spiritual successor, integrates a few popular extensions to provide better native support for things like equation cross-referencing and writing books.&lt;/p&gt;
&lt;p&gt;One of the biggest weaknesses of (R) Markdown is its lack of a simple collaborative editing feature to rival Overleaf. Although &lt;a href=&#34;https://www.overleaf.com/learn/latex/Knitr&#34;&gt;Overleaf does support &lt;strong&gt;knitr&lt;/strong&gt;&lt;/a&gt;, you still have to write in $\LaTeX$ syntax, which is less intuitive than Markdown and offers fewer output formats.
Some niche solutions exist, such as &lt;a href=&#34;https://bookdown.org/yihui/rmarkdown-cookbook/google-drive.html&#34;&gt;&lt;strong&gt;trackdown&lt;/strong&gt;&lt;/a&gt;, which lets you do tracked changes via Google Drive, &lt;del&gt;RStudio&lt;/del&gt; &lt;a href=&#34;https://posit.cloud/&#34;&gt;Posit Cloud&lt;/a&gt;, which has a free tier allowing one shared space with up to five collaborators, and one or two experimental online R Markdown editors that I can no longer find.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://sharelatex-wiki-cdn-671420.c.cdn77.org/learn-scripts/images/3/39/KnitrDemo3.png&#34; alt=&#34;Knitr in Overleaf&#34; title=&#34;knitr in Overleaf&#34;&gt;&lt;/p&gt;
&lt;p&gt;The &amp;lsquo;proper&amp;rsquo; solution is of course to use a shared Git repository, but although this is apparently even how &lt;a href=&#34;https://github.com/overleaf/overleaf/issues/10&#34;&gt;Overleaf works behind the scenes&lt;/a&gt;, it&amp;rsquo;s not quite as instant or accessible as editing a Word or Overleaf document online, and it doesn&amp;rsquo;t run your code or render the output automatically.&lt;/p&gt;
&lt;h2 id=&#34;visual-studio-code-live-share&#34;&gt;Visual Studio Code Live Share&lt;/h2&gt;
&lt;p&gt;However, &lt;a href=&#34;https://code.visualstudio.com/&#34;&gt;Visual Studio Code&lt;/a&gt; has a few handy features that makes it a promising alternative.
As well as being able to &lt;a href=&#34;https://code.visualstudio.com/docs/remote/wsl&#34;&gt;edit files on WSL&lt;/a&gt; and &lt;a href=&#34;https://code.visualstudio.com/docs/remote/ssh&#34;&gt;on remote servers&lt;/a&gt;, there are countless extensions for &lt;a href=&#34;https://code.visualstudio.com/docs/languages/r&#34;&gt;linting R code&lt;/a&gt;, &lt;a href=&#34;https://marketplace.visualstudio.com/items?itemName=mechatroner.rainbow-csv&#34;&gt;highlighting columns in CSV files&lt;/a&gt; and &lt;a href=&#34;https://code.visualstudio.com/docs/copilot/overview&#34;&gt;AI integration with GitHub Copilot&lt;/a&gt;.
Obviously you can therefore write your R Markdown and Quarto documents in VS Code, just as you might have done using RStudio.
But the real killer feature is the &lt;a href=&#34;https://visualstudio.microsoft.com/services/live-share/&#34;&gt;Live Share extension&lt;/a&gt;, which lets you share a workspace with others, who can edit the same files in real time, with syntax highlighting and code completion.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://visualstudio.microsoft.com/wp-content/uploads/2023/01/v2-Edit-Comp_FINAL-optimized750-1.gif&#34; alt=&#34;Visual Studio Live Share&#34; title=&#34;Visual Studio Live Share&#34;&gt;&lt;/p&gt;
&lt;p&gt;This means collaborators can edit the same document in real time, with one author hosting the live session and nobody else needing to install all the same dependencies or have access to datasets on their own machines.
When the host saves the document at the end of the session, it can then be committed to Git or your shared repository as normal, without conflicts.
And rather than the Google Docs and Overleaf chat functions, which I don&amp;rsquo;t believe anybody on the history of this Earth has ever used, you can communicate using your usual medium, be it Teams, Slack, WhatsApp etc.&lt;/p&gt;
&lt;h2 id=&#34;github-actions&#34;&gt;GitHub Actions&lt;/h2&gt;
&lt;p&gt;The obvious limitation here is that at least one user has to be hosting a Live Share session from a computer with all relevant dependencies for rendering the document.
The other half of the solution is &lt;a href=&#34;https://github.com/features/actions&#34;&gt;GitHub Actions&lt;/a&gt; (or your favourite equivalent continuous integration tool).
On committing to your repository, a script will run on a virtual machine to compile the document and save the results as an &amp;lsquo;artifact&amp;rsquo;.
This can then be downloaded like a software release or committed back into a branch of the repository.
It is not quite instantaneous, and can require a bit a TLC to keep it running, but means you can edit text and commit from anywhere.&lt;/p&gt;
&lt;p&gt;&lt;a href=&#34;https://github.com/quarto-dev/quarto-actions&#34;&gt;Quarto provides several GitHub Actions&lt;/a&gt; for rendering and publishing projects, and &lt;a href=&#34;https://github.com/r-lib/actions/blob/v2-branch/examples/render-rmarkdown.yaml&#34;&gt;the same are available for R Markdown&lt;/a&gt;.&lt;/p&gt;
&lt;h2 id=&#34;putting-it-all-together&#34;&gt;Putting it all together&lt;/h2&gt;
&lt;p&gt;&lt;em&gt;Coming soon: along with a bonus post on reproducible collaborative poster presentations.&lt;/em&gt;&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>World Cup 2022 results</title>
      <link>https://selbydavid.com/2023/02/07/world-cup-2022-results/</link>
      <pubDate>Tue, 07 Feb 2023 23:00:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2023/02/07/world-cup-2022-results/</guid>
      <description>&lt;p&gt;There is a widespread critique that too many pundits fail to make measurable predictions.&lt;/p&gt;
&lt;p&gt;For example, Philip Tetlock takes aim at what he calls &lt;a href=&#34;https://goodjudgment.com/vague-verbiage-forecasting/&#34;&gt;&lt;em&gt;vague verbiage&lt;/em&gt;&lt;/a&gt;, the use of vaguely probabilistic phrases such as &amp;ldquo;it&amp;rsquo;s a real possibility&amp;rdquo; or &amp;ldquo;there&amp;rsquo;s a fair chance&amp;rdquo;.
We&amp;rsquo;d like to think that with respect to the World Cup we escaped the crowd of vague-verbiageurs and &lt;a href=&#34;https://selbydavid.com/world-cup-2022&#34;&gt;nailed our colours to the mast&lt;/a&gt;.
There&amp;rsquo;s very little point in making predictions if you are not going to be held accountable for them. That reckoning could be from the market in the form of actually betting based on your predictions, but we are not really gambling types.&lt;/p&gt;
&lt;p&gt;So, instead, in what follows, we present our review of those predictions.&lt;/p&gt;
&lt;p&gt;The aim of our model was to use publicly accessible data available pre-tournament to predict the outcome of all possible matches. We chose to use betting market data as, to a first approximation, this represented the knowledge and analysis of a lot of highly informed and capable people.
Betting market odds were available for all group games, outright winner, and for reaching the final, and it was these data that we used, giving us a total of 159 data points to work with.
We will use the (negative) log-loss metric to consider performance, where the lower your score, the better you did.
This is defined as
$$ \text{log loss}= -\sum_k \log(p_k), $$
where $p_k$ is the probability that we assigned to the outcome that was observed in match $k$.
It is a commonly used measure for judging predictions, with &lt;a href=&#34;https://arxiv.org/pdf/1502.06254.pdf&#34;&gt;some appealing features&lt;/a&gt; and is the one that was used in that original RSS Euro 2020 prediction competition that inspired us to come up with the model in the first place.
We will compare the log-loss from the probabilities derived from our model with those derived from the market odds immediately prior to each match.
For group stage matches and 90-minute KO-round matches we source those from &lt;a href=&#34;https://www.oddsportal.com/soccer/world/world-championship/results/&#34;&gt;here&lt;/a&gt;, and for the knock-out round outcomes (in the form of the odds for each team progressing to the next round) from &lt;a href=&#34;https://www.oddschecker.com&#34;&gt;oddschecker.com&lt;/a&gt; (recorded manually at the time).
We&amp;rsquo;ll discuss a main competing alternative to the log-loss measure later in this article.&lt;/p&gt;
&lt;h3 id=&#34;group-stage&#34;&gt;Group stage&lt;/h3&gt;
&lt;p&gt;Since we took the group game odds directly from the market, our model was not really applied to these matches.
Nevertheless it might be interesting to see how we performed.
Effectively this is a test of pre-tournament against pre-match odds. The two figures below present the cumulative and game-by-game log-loss comparisons.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2023/eval_group_stage_cumulative.png&#34; alt=&#34;Pre-tournament odds (&amp;ldquo;our_neg_log-loss&amp;rdquo;) vs. pre-match odds (&amp;ldquo;market_neg_log-loss&amp;rdquo;) measured in log loss. Cumulative log-loss over the course of the group stage.&#34;&gt;&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2023/eval_group_stage_by_game.png&#34; alt=&#34;Log-loss by game. The largest losses are incurred in only three games which are highlighted by the dotted lines. These correspond to the matches (from left to right): Tunisia beating France, Cameroon beating Brazil and South Korea beating Portugal.&#34;&gt;&lt;/p&gt;
&lt;p&gt;The performance tracks each other very closely with some divergence occuring towards the end of the group stage.
This seems very natural.
Betting odds capture the information available at the time and there is more relevant information that becomes available as more matches are observed.&lt;/p&gt;
&lt;p&gt;One obvious version of new information would be that having seen each team play a couple of matches, we have a better sense of their tournament ability.
But, in fact, there appears to be little effect from this.
The divergence between pre-tournament and pre-match odds can be ascribed here to a single factor&amp;mdash;asymmetrically dead rubbers.&lt;/p&gt;
&lt;p&gt;As can be seen below, the difference is explained by just three matches.
They were Tunisia&amp;ndash;France, Cameroon&amp;ndash;Brazil, South Korea&amp;ndash;Portugal, which all ended in upsets and are indicated by the dotted lines in the plot above.&lt;/p&gt;
&lt;p&gt;These were precisely the matches where the favourite had already won both of their group matches so far and qualified for the next round, likely as group winners, before the final group match.
We might then reasonably expect them to rest some of their key players and generally not be so motivated.
On the other hand, the other team were super-motivated both by the possibility of a qualifying spot and of being able to topple a favourite and thus take something positive from the World Cup.
The immediate pre-match odds took account of this when compared to the pre-tournament odds.&lt;/p&gt;
&lt;h3 id=&#34;knock-out-stage&#34;&gt;Knock-out stage&lt;/h3&gt;
&lt;p&gt;Turning to the more interesting part, how did we do on the knock-out stage matches? As a reminder, our initial predictions for the knock-out stage that we made in &lt;a href=&#34;https://selbydavid.com/2022/11/20/world-cup-2022&#34;&gt;our original blog post&lt;/a&gt; are shown below (based on running 10,000 simulations of the World Cup with the probabilities determined by our model).&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2023/knockout_stage_original.png&#34; alt=&#34;The original predictions we made in our initial blog post based on simulating the tournament with the probabilities calculated by our model 10,000 times.&#34;&gt;&lt;/p&gt;
&lt;p&gt;For comparison, we also present the actual outcomes of the knock-out stage together with the probabilities our model assigned to them.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2023/Knockout_stage_semi_finals_actual_2.png&#34; alt=&#34;The actual outcomes of the knock-out stages with the probabilities as predicted by our model.&#34;&gt;&lt;/p&gt;
&lt;p&gt;The overall performance of our model in terms of cumulative log-loss is summarised in the plot below. Dotted lines mark the end of the Round of 16, quarter-finals and semi-finals respectively.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2023/eval_ko_cumulative.png&#34; alt=&#34;Cumulative log-loss. Comparison between our method (&amp;ldquo;c_our_log_loss&amp;rdquo;) and market odds (&amp;ldquo;c_market_log_loss&amp;rdquo;). Dotted lines mark the end of the Round of 16, quarter-finals and semi-finals respectively.&#34;&gt;&lt;/p&gt;
&lt;p&gt;Coming into the quarter-final weekend we felt pretty good; we had correctly predicted six of the eight quarter-finalists and six of the eight group winners. In the round of sixteen, we correctly predicted seven of the eight match outcomes, with the one we got wrong being Morocco&amp;rsquo;s victory over Spain on penalties. This is a notable success compared to &lt;a href=&#34;https://www.youtube.com/watch?v=KjISuZ5o06Q&#34;&gt;other attention-grabbing predictions&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;Then, as the plot above shows, it began to unravel a little with the victories of Morocco over Portugal and Croatia over Brazil. But then we made some ground back in the semi-finals and even more with Argentina&amp;rsquo;s victory over France in the final.&lt;/p&gt;
&lt;p&gt;In the end the market odds bested us by just 0.04. The median of our absolute match-level log-loss differences in the KO-stage was 0.16, so it seems not unfair to claim 0.04 as noise, and that our model based solely on pre-tournament data matched the performance of pre-match odds in prediction terms.&lt;/p&gt;
&lt;h3 id=&#34;an-alternative-metric&#34;&gt;An alternative metric&lt;/h3&gt;
&lt;p&gt;That is a decent result given how much more information those pre-match odds included compared to our pre-tournament data. But we&amp;rsquo;re not content with a draw; we think we (might) deserve the win on this one.&lt;/p&gt;
&lt;p&gt;One of the joys of football is the propensity for upsets. One of the authors of this post knows this well as a Coventry City fan. Two years after winning the FA Cup in 1987 (in probably the greatest ever FA Cup final match - there will never be a goal quite like &lt;a href=&#34;https://www.youtube.com/watch?v=1Q5-ANGlhuM&#34;&gt;Keith Houchen&amp;rsquo;s diving header&lt;/a&gt;), Coventry, at the time in fifth place in the top league of English football, went on to &lt;a href=&#34;ttps://en.wikipedia.org/wiki/Sutton_United_2-1_Coventry_City_(1989)&#34;&gt;lose to Sutton United&lt;/a&gt;, a non-league team languishing in 13th place in the Vauxhall conference, 100 places below them. These events, while rare enough to be intriguing, are more common in football than in other high-profile sports.&lt;/p&gt;
&lt;p&gt;High-scoring sports such as rugby union, basketball or cricket, exercise a type of score Central Limit Theorem where a lesser-favoured team may be able to score and even win portions of a game but over the entire match the aggregate scoring ability will tend towards the mean with a reduced variance. In contrast, football matches often have only a few goals. The randomness of the form of a striker or goalkeeper on a particular day or the bounce of the ball can therefore have a larger impact. Over many matches these more arbitrary elements will balance out, so that shocks over a league season are much rarer (though &lt;a href=&#34;https://www.eurosport.com/football/premier-league/2015-2016/leicester-city-s-premier-league-title-win-the-greatest-underdog-story-of-all_sto5521114/story.shtml&#34;&gt;Leicester&lt;/a&gt;!).&lt;/p&gt;
&lt;p&gt;This might suggest that there could be a better measure for a match than goals, in the sense that it would be more reflective of a team&amp;rsquo;s performance and would be a better predictor of future performance. This is indeed one of the claims made for the &lt;a href=&#34;https://www.goal.com/en-gb/news/what-is-xg-football-how-statistic-calculated/h42z0iiv8mdg1ub10iisg1dju&#34;&gt;expected goals (xG) metric&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;If we are prepared to believe this, and there seems to be some evidence for the &lt;a href=&#34;https://www.americansocceranalysis.com/home/2022/7/19/the-replication-project-is-xg-the-best-predictor-of-future-results&#34;&gt;claim&lt;/a&gt;, then it would be reasonable to measure predictions against the xG outcome of a match i.e. where the winner is the team that achieved the highest xG, since this is a better reflection of actual performance, stripped of the arbitrariness of goals.&lt;/p&gt;
&lt;p&gt;For this purpose we take our xG outcomes from &lt;a href=&#34;https://twitter.com/xGPhilosophy&#34;&gt;@xGPhilosophy&lt;/a&gt; on Twitter. If we re-run the log-loss measure with outcomes based on xG, what do we find? We win, and clearly! We beat the market by 1.15, with the median absolute match-level log-loss difference now being 0.10.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2023/eval_xG_cumulative.png&#34; alt=&#34;Cumulative log-loss over the course of the knock-out stage for xG outcomes. Dotted lines mark the end of the Round of 16, quarter-finals and semi-finals respectively.&#34;&gt;&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2023/eval_xG_by_game.png&#34; alt=&#34;Log-loss by game for xG outcomes. The solid vertical line corresponds to the match France - Poland, which France won 3-1 in reality, but Poland won 1.81-1.22 on xG.&#34;&gt;&lt;/p&gt;
&lt;p&gt;We suspect that a number of readers at this point might be a bit sceptical. You buy the argument about goals being a bit arbitrary, but some of the things that contribute towards the difference between xG and goals&amp;mdash;striker or goalkeeper proficiency, for example&amp;mdash;are important parts of the game.&lt;/p&gt;
&lt;p&gt;Sceptics might also reasonably point out that our xG outperformance would be wiped out with the reversal of a single match: Poland-France, which Poland won 1.81-1.22 on xG, but France won 3-1 in reality (solid vertical line in the plot above). On the other hand, the argument that xG is more predictive of future performance seems quite persuasive, and this is the only one of the fifteen matches that could have reversed the finding with some other match reversals working in our favour.&lt;/p&gt;
&lt;p&gt;Overall, we share the concerns, and wouldn&amp;rsquo;t claim that xG is the right way to look at it and goals the wrong way, but rather that they both have merit and given we drew on goals and won on xG, it would seem that there might be something being captured in our crude model that is working.&lt;/p&gt;
&lt;p&gt;Ultimately, if the claim that xG is a better long-term predictor than goals is correct, and our outperformance based on xG is meaningful, then if you examined enough tournaments you would expect our method to work based on goals too. We have only analysed two tournaments, so can&amp;rsquo;t really comment on this, but they do not contradict the claim.&lt;/p&gt;
&lt;h3 id=&#34;lets-talk-about-money&#34;&gt;Let&amp;rsquo;s talk about money&lt;/h3&gt;
&lt;p&gt;Before speculating on what it might be that causes the model to work, it is worth addressing the measure used here. Log-loss is a reasonable way to measure predictions, but is more of academic interest (meant literally and perjoratively).&lt;/p&gt;
&lt;p&gt;In the real world, when looking at betting odds, people care more about whether they can make money.&lt;/p&gt;
&lt;p&gt;In order to turn predictions into money one needs a betting scheme, a method by which one turns those predictions into bets. Then, one can then measure the success of predictions by the profit or loss they generate under the betting scheme.&lt;/p&gt;
&lt;p&gt;A good place to start with a betting scheme is to consider the expected return from a bet, given your predictions. In the knock-out stage matches, we were predicting the probability of reaching the next round i.e. it was a binary outcome, either Team 1 progressed or Team 2. If $p_i$ is the probability that Team $i$ progresses then $p_2 = 1 - p_1$. Our expected return in pounds from betting £1 on Team $i$ is then,&lt;/p&gt;
&lt;p&gt;$$ \mathbb{E}[\text{return}]=p_i (o_i - 1) - (1-p_i) = p_io_i - 1, $$&lt;/p&gt;
&lt;p&gt;where $o_i$ are the European odds for Team $i$ winning.&lt;sup id=&#34;fnref:1&#34;&gt;&lt;a href=&#34;#fn:1&#34; class=&#34;footnote-ref&#34; role=&#34;doc-noteref&#34;&gt;1&lt;/a&gt;&lt;/sup&gt; For each match, we can calculate the expected return from backing either Team 1 or Team 2 in this way. Note that there may not be a positive expected-return bet from backing either team if the market is sufficiently wide and our predictions are sufficiently well-calibrated to the market.&lt;sup id=&#34;fnref:2&#34;&gt;&lt;a href=&#34;#fn:2&#34; class=&#34;footnote-ref&#34; role=&#34;doc-noteref&#34;&gt;2&lt;/a&gt;&lt;/sup&gt;&lt;/p&gt;
&lt;p&gt;A typical betting scheme would be to bet an amount, £1 say, whenever the expected return is above a specified threshold. One might argue that this threshold should be zero&amp;mdash;you should bet whenever you think you are going to win&amp;mdash;but often people are a bit more cautious. Models have noise and you want to identify the real opportunities.&lt;/p&gt;
&lt;p&gt;Also betting has operational costs, the time taken to post money with bookmakers and make the bet. So often this threshold is set above zero (see, for example, &lt;a href=&#34;https://arxiv.org/vc/arxiv/papers/1710/1710.02824v1.pdf&#34;&gt;this paper&lt;/a&gt;, which is very much in the spirit of our model, in using market odds as its data, and effectively takes a threshold of approximately 5%).&lt;/p&gt;
&lt;p&gt;The figure below shows the return, calculated as net return divided by total money wagered for different thresholds, based on both goals and xG outcomes for confidence thresholds for which at least five bets would have been placed&lt;sup id=&#34;fnref:3&#34;&gt;&lt;a href=&#34;#fn:3&#34; class=&#34;footnote-ref&#34; role=&#34;doc-noteref&#34;&gt;3&lt;/a&gt;&lt;/sup&gt;.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2023/betting_returns_truncated.png&#34; alt=&#34;Betting returns as function of confidence threshold. A bet is placed if the expected return of wagering £1 exceeds the threshold. Including thresholds for which at least five bets are placed.&#34;&gt;&lt;/p&gt;
&lt;p&gt;The next plot show the number of bets placed as a function of the confidence threshold.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2023/number_bets_taken_truncated.png&#34; alt=&#34;The number of bets placed as a function of confidence threshold.&#34;&gt;&lt;/p&gt;
&lt;p&gt;Using xG is even more tenuous here&amp;mdash;good luck finding a bookie who will pay out based on xG&amp;mdash;but if the argument is correct that xG is a better future predictor of outcomes then it may give a better indicator of expected performance of the betting scheme. The maximum possible return from this strategy for actual outcomes is 12.9% of the capital wagered, which is realized when using a confidence threshold between 0.07 and 0.1.&lt;/p&gt;
&lt;p&gt;While picking a threshold somewhere in the range between, say, 0.05 and 0.1 might have made for a reasonable heuristic, these optimal betting returns are obviously based on hindsight.&lt;/p&gt;
&lt;p&gt;Another more serious concern is that while there look to be some tempting returns here, we have by this point travelled well-down Gelman&amp;rsquo;s &lt;a href=&#34;http://www.stat.columbia.edu/~gelman/research/unpublished/p_hacking.pdf&#34;&gt;garden of forking paths&lt;/a&gt; and based our argument on very little data, even more so when the betting scheme filters so we are only looking at a handful of matches.&lt;/p&gt;
&lt;h3 id=&#34;why-does-the-model-work&#34;&gt;Why does the model work?&lt;/h3&gt;
&lt;p&gt;Whichever way you cut the data and admitting it&amp;rsquo;s limitations given just the fifteen data points, the model does seem to work well against pre-match odds, which begs the question &amp;ldquo;why?&amp;rdquo;&lt;/p&gt;
&lt;p&gt;Often when doing data analysis one finds a pattern and is interested in determining whether it is real or just a happenstance of the data. One natural consideration is whether there are good substantive reasons for why the pattern would exist.&lt;/p&gt;
&lt;p&gt;In our case, we seem to have found that a crude model based on much less information can perform comparably with, perhaps even better than, the wisdom of the market. What could account for such a phenomenon?&lt;/p&gt;
&lt;p&gt;In our last post, we discussed how our model had the effect of extremising the strength of teams, so that, for example, the probability of winning the tournament was increased for the strongest teams and decreased for weaker ones when compared to betting market odds as shown in plot below.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2023/winning_probabilities.png&#34; alt=&#34;Probabilities of winning the tournament as predicted by pre-tournament market odds (x-axis) vs. winning probabilities predicted by our model based on 10,000 simulation runs (y-axis).&#34;&gt;&lt;/p&gt;
&lt;p&gt;For the purpose of predicting individual matches, this meant that in most cases the estimated probability of a favourite winning was greater under our model than under the market odds, see the next plot.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2023/favourites_extremising.png&#34; alt=&#34;KO stage probabilities of the favourite team winning as implied by pre-match market odds (x-axis) vs. probability of winning as predicted by our model (y-axis). The first-named team is always the favourite.&#34;&gt;&lt;/p&gt;
&lt;p&gt;The most obvious explanation then would be the so-called &amp;ldquo;favourite-longshot bias&amp;rdquo; (FLB), for which there is an academic literature stretching back decades. Somewhat confusingly the term ``favourite-longshot bias&amp;quot; seems to be applied both to situations where backing favourites produces better returns than from backing long-shots and the exact opposite.&lt;/p&gt;
&lt;p&gt;As a group of cyncical statisticians, we can&amp;rsquo;t help sniffing the whiff of publication bias. On the other hand, &lt;a href=&#34;https://www.mdpi.com/2227-9091/9/1/22&#34;&gt;this recent review article&lt;/a&gt; suggests that the findings for situations like ours, where there are two competitors and there is a binary outcome, are more consistently for better returns from backing a favourite. It offers a number of possible reasons, as do &lt;a href=&#34;https://web.econ.ku.dk/sorensen/papers/FLBsurvey.pdf&#34;&gt;other well-cited articles here&lt;/a&gt; and &lt;a href=&#34;https://www.nber.org/system/files/working_papers/w15923/w15923.pdf&#34;&gt;here&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;Perhaps the most appealing explanations recognise that the activity of betting, and therefore the betting market, is not driven solely by a rational evaluation of the chances of different teams.&lt;/p&gt;
&lt;!-- As the daughter of one the authors of this blogpost put it &#34;it&#39;s more fun when it&#39;s a surprise, isn&#39;t it?&#39;&#39;
Whether this is the case or not, there do at least seem to be plausible explanations along these lines.
However, this does not seem to be the whole explanation. --&gt;
&lt;p&gt;The figure below shows the results of a betting scheme where we back the favourite if the betting market implied probability of it winning are greater than a certain percentage.
It seems not especially persuasive for a favourite-based betting scheme, and not at all similar to the betting outcomes observed under our model, so it doesn&amp;rsquo;t seem like a very satisfactory explanation for the success of the model, such as it is.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2023/opportunistic_threshold_betting.png&#34; alt=&#34;Returns for the favourites betting scheme: A bet is placed on the favourite if their probability of winning as implied by market odds exceeds a certain threshold (x-axis). Showing results for which at least five bets are placed.&#34;&gt;&lt;/p&gt;
&lt;p&gt;The next plot shows the number of bets placed when backing the favourite as function of the market implied winning probability.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2023/number_bets_taken_opportunistic_threshold_betting.png&#34; alt=&#34;Number of bets placed under the favourites betting scheme as a function of market winning probability of the favourite.&#34;&gt;&lt;/p&gt;
&lt;p&gt;In conclusion, we&amp;rsquo;re not really sure what to make of this. Any conclusions based on so few matches, especially when filtered in the betting schemes, are likely to be unreliable at best.
But the results we got here are consistent with what we saw at Euro 2020, so we still think there might be something to the method. We look forward to wheeling it out again at Euro 2024 and exploring some updated methods and analysis.&lt;/p&gt;
&lt;section class=&#34;footnotes&#34; role=&#34;doc-endnotes&#34;&gt;
&lt;hr&gt;
&lt;ol&gt;
&lt;li id=&#34;fn:1&#34; role=&#34;doc-endnote&#34;&gt;
&lt;p&gt;for example, if the European odds are 1.6, equivalent to 5/8 in UK odds, then if you wager £1 you will get £1.60 back. &lt;a href=&#34;#fnref:1&#34; class=&#34;footnote-backref&#34; role=&#34;doc-backlink&#34;&gt;&amp;#x21a9;&amp;#xfe0e;&lt;/a&gt;&lt;/p&gt;
&lt;/li&gt;
&lt;li id=&#34;fn:2&#34; role=&#34;doc-endnote&#34;&gt;
&lt;p&gt;The market being wide here refers to the gap between the price one could back or lay the same team. In a perfect market they would be the same. In practice market-makers need to make a profit and so they generally are not. &lt;a href=&#34;#fnref:2&#34; class=&#34;footnote-backref&#34; role=&#34;doc-backlink&#34;&gt;&amp;#x21a9;&amp;#xfe0e;&lt;/a&gt;&lt;/p&gt;
&lt;/li&gt;
&lt;li id=&#34;fn:3&#34; role=&#34;doc-endnote&#34;&gt;
&lt;p&gt;We find it hard to make any claims beyond that point due to only considering very few data points. For example, for thresholds larger than 0.35 we would only be betting on a single game: France-Poland; betting on Poland due to phenomenal returns if the bet works out. Return of wagering £1 on Poland and Poland winning would be £6, with an expected return of £1.44. Poland beat France on xG, but lost in reality. C&amp;rsquo;est la vie. &lt;a href=&#34;#fnref:3&#34; class=&#34;footnote-backref&#34; role=&#34;doc-backlink&#34;&gt;&amp;#x21a9;&amp;#xfe0e;&lt;/a&gt;&lt;/p&gt;
&lt;/li&gt;
&lt;/ol&gt;
&lt;/section&gt;
</description>
    </item>
    
    <item>
      <title>World Cup 2022 predictions</title>
      <link>https://selbydavid.com/2022/11/20/world-cup-2022/</link>
      <pubDate>Sun, 20 Nov 2022 22:15:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2022/11/20/world-cup-2022/</guid>
      <description>&lt;p&gt;Sports prediction has exploded in the last couple of decades with entire &lt;a href=&#34;https://libguides.northwestern.edu/c.php?g=403355&amp;amp;p=2745062&#34;&gt;journals&lt;/a&gt;, &lt;a href=&#34;https://medium.com/sports-data-science/the-complete-list-of-sports-analytics-conferences-5935846f98c0&#34;&gt;conferences&lt;/a&gt; and books devoted to it.&lt;/p&gt;
&lt;p&gt;Much of this focuses on utilising ever-greater amounts of data, with soccer, for example, now providing sub-second ball and player tracking data.&lt;/p&gt;
&lt;p&gt;But sometimes it is nice to try to do more with less.&lt;/p&gt;
&lt;p&gt;Here we (&lt;strong&gt;Ian Hamilton&lt;/strong&gt;, &lt;strong&gt;Stefan Stein&lt;/strong&gt; and &lt;strong&gt;David Selby&lt;/strong&gt;) describe a method that we applied to predict the results (indeed all possible match outcomes) of the Euro 2020 football tournament, that took just 120 data points and two linear regressions, yet managed to beat the market over the course of the tournament (based on the accumulated log-loss of match outcomes against predictions taken from the market odds immediately prior to the match).&lt;/p&gt;
&lt;p&gt;All data analysts know the well-worn phrase: &amp;ldquo;garbage in, garbage out&amp;rdquo;.
The corollary to this though is that when you have good data then it is easier to make good inferences.
When one is considering predictions, what data would one most want?&lt;/p&gt;
&lt;p&gt;One great form of data would be to have the predictions of a bunch of sophisticated data analysts and to be able to take some kind of conviction-weighted poll of those predictions.
Fortunately (at least in some economists&#39; imaginations) that is exactly what a market provides (we&amp;rsquo;re not entirely convinced by this, a point to which we will return). 
Betting markets on major tournaments are highly liquid and their prices readily accessible.
They therefore provide excellent data for us to work from. But our aim here is to predict the outcome of all possible matches including those that might occur in the later rounds based on what we know pre-tournament.&lt;/p&gt;
&lt;p&gt;There are, of course, no available odds to those KO matches pre-tournament because no-one knows what they will be.
So how can we use what we do know to construct those probabilities?&lt;/p&gt;
&lt;p&gt;We begin by taking a foundational model in Sports statistics (and the model that formed the basis of the PhDs of two of the authors of this blog post).
First described by &lt;a href=&#34;https://doi.org/10.1007/BF01180541&#34; title=&#34;Die Berechnung der Turnier-Ergebnisse als ein Maximumproblem der Wahrscheinlichkeitsrechnung&#34;&gt;Ernst Zermelo in 1929&lt;/a&gt;, he made the crucial error of publishing the relevant article in German, allowing two upstart Americans to &lt;a href=&#34;https://doi.org/10.2307/2334029&#34;&gt;nab the glory nearly a quarter of a century later&lt;/a&gt; and have the model named after them.
Thus it is known now as the &lt;a href=&#34;https://en.wikipedia.org/wiki/Bradley%E2%80%93Terry_model&#34;&gt;Bradley&amp;ndash;Terry model&lt;/a&gt;.
It expresses the probability that a team $i$ beats a team $j$ as
$$
p_{ij} = \frac{\pi_i}{\pi_i + \pi_j},
$$
where $\pi_i$ is the &amp;lsquo;strength&amp;rsquo; of $i$. It can also be represented as a generalised linear model
$$
\text{logit}(p_{ij}) = \lambda_i - \lambda_j,
$$
where $\lambda_i = \log (\pi_i)$.&lt;/p&gt;
&lt;p&gt;The Bradley&amp;ndash;Terry model has some appealing statistical features, such as being the unique model for which the number of wins for each team is a sufficient statistic for the strength parameters (consistent with round robin ranking), and being the entropy and likelihood maximising model subject to the (highly plausible) constraint that the expected number of wins for a team given the matches observed is equal to the actual wins observed.
As &lt;a href=&#34;https://doi.org/10.1080/00029890.1984.11971405&#34; title=&#34;A supplement to &#39;A Mathematician&#39;s Guide to Popular Sports&#39;&#34;&gt;Stob (1984)&lt;/a&gt; put it, &amp;ldquo;What sort of a claim is it that a team solely on the basis of the results should have expected to win more games than they did?&amp;rdquo;
This might be seen as failing to appreciate the bias present from finite observations.
Nevertheless, it reflects the intuitive appeal of the condition.&lt;/p&gt;
&lt;p&gt;Typically the Bradley&amp;ndash;Terry model is applied to a set of results, for the purpose of prediction or ranking.
Strength parameters can be estimated for each team by maximum likelihood estimation, using the likelihood function
$$
L(\boldsymbol{\lambda}) = \prod_{i&amp;lt;j}\binom{m_{ij}}{c_{ij}}p_{ij}^{c_{ij}}(1-p_{ij})^{m_{ij}-c_{ij}},
$$
where $c_{ij}$ is the number of times $i$ beats $j$ and $m_{ij}= c_{ij}+c_{ji}$ is the number of matches between $i$ and $j$.&lt;/p&gt;
&lt;p&gt;We could apply that method here based on historic performances, but:&lt;/p&gt;
&lt;ol&gt;
&lt;li&gt;there are not enough recent useful results to estimate strengths reliably;&lt;/li&gt;
&lt;li&gt;market prices are likely to be more informative;&lt;/li&gt;
&lt;li&gt;this doesn&amp;rsquo;t account for draws.&lt;/li&gt;
&lt;/ol&gt;
&lt;p&gt;Addressing the last of these first, the model was extended to account for draws by &lt;a href=&#34;https://doi.org/10.2307/2283595&#34; title=&#34;On Extending the Bradley-Terry Model to Accommodate Ties in Paired Comparison Experiments&#34;&gt;Davidson (1970)&lt;/a&gt;, and later &lt;a href=&#34;https://alt3.uk/&#34;&gt;by David Firth&lt;/a&gt; to take account of the standard football point scheme of three for a win, one for a draw, to give,
$$
\mathbb{P}(i \text{ beats } j) = \frac{\pi_i}{\pi_i + \pi_j + \nu(\pi_i \pi_j)^{\frac{1}{3}}},
$$
$$
\mathbb{P}(i \text{ draws with } j) = \frac{\nu(\pi_i \pi_j)^{\frac{1}{3}}}{\pi_i + \pi_j + \nu(\pi_i \pi_j)^{\frac{1}{3}}}.
$$&lt;/p&gt;
&lt;p&gt;Note that even with draws,
$$ \frac{p_{ij}}{p_{ji}} = \frac{\pi_i}{\pi_j} \quad \text{ or } \quad \text{logit}(p_{ij})= \lambda_i - \lambda_j. $$&lt;/p&gt;
&lt;p&gt;In the present situation, we can estimate the intra-group log-strengths $r_i=\log s_i$ by linear regression:
$$ \log \left(\frac{p_{ij}}{p_{ji}}\right) = r_i - r_j, $$
since $p_{ij}$ are known from market odds.&lt;/p&gt;
&lt;p&gt;So now we have an estimate for the strength of a team relative to other teams in its group, but to be able to predict any possible match we need to know the strength of a team relative to all other teams.
In order to do this, we make some assumptions:&lt;/p&gt;
&lt;ol&gt;
&lt;li&gt;Team $i$&amp;rsquo;s overall strength $\pi_i$ is a scaling of its intra-group strength $s_i$ by a factor dependent on its group $\gamma_{G(i)}$ 
$$ \pi_i = \gamma_{G(i)} s_i \quad \text{ or equivalently   } \quad \lambda_i = \log\gamma_{G(i)} + r_i $$&lt;/li&gt;
&lt;li&gt;The strength of every team&amp;rsquo;s unknown final opponent is the same
$$ p_{io} = \mathbb{P}(i \text{ winning tournament} \mid i \text{ reaches final}) 
= \frac{\pi_i}{\pi_i + \pi_o}, $$
where $\pi_o$ is the strength of the unknown final opponent.&lt;/li&gt;
&lt;/ol&gt;
&lt;p&gt;We can calculate $p_{io}$ from market odds since
$$ p_{io}
= \frac{\mathbb{P}(i \text{ winning tournament})}{\mathbb{P}(i \text{ reaches final})} $$
and both these odds &amp;mdash; outright winner and reaching the final &amp;mdash; are available pre-tournament. Then we have that
$$ \log \left(\frac{p_{io}}{p_{oi}}\right) = \lambda_i - \lambda_o = \log\gamma_{G(i)} + r_i - \lambda_o, $$
and we can estimate $\log\gamma_{G(i)}$ and $\lambda_o$ through linear regression.&lt;/p&gt;
&lt;p&gt;One thing to look out for here is that some of these odds are very large and not well-calibrated.
For example, according to &lt;a href=&#34;https://oddschecker.com&#34;&gt;oddschecker.com&lt;/a&gt; the odds of Qatar winning the tournament are 500/1 and the odds of them reaching the final are 500/1, so conditional on them reaching the final the market says they have a 100% chance of winning!
This is clearly nonsense, and is due to the fact that for the more unlikely winning teams, these odds are not well-calibrated and so should be discarded.
Exactly which ones to discard is a matter of judgement.
For Euro 2022 we arbitrarily excluded teams where the outright win odds were greater than 100/1.&lt;/p&gt;
&lt;p&gt;For the World Cup we graphed $\log \left(\mathbb{P} \left[i \text{ winning tournament} \mid i \text{ reaches final} \right] \right)$ against $\log\left (\mathbb{P}\left[i \text{ winning tournament}\right] \right)$ and excluded at the point where a consistent relationship seemed to start to break down.
For the World Cup we have included up to and including Denmark, the tenth ranked team, with a probability of winning the tournament of 30/1.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2022/probs_plot.png&#34; alt=&#34;Conditional probabilities of winning the tournament&#34;&gt;&lt;/p&gt;
&lt;p&gt;Now we can calculate the strengths of each team
$$ \pi_i = \gamma_{G(i)} s_i, $$
and apply these through the Bradley-Terry model to predict the KO match results by applying
$$ p_{ij} = \frac{\pi_i}{\pi_i + \pi_j}. $$&lt;/p&gt;
&lt;p&gt;Using this method, we have determined a strength parameter for each team that can then be used to simulate the outcome of each match.
We were keen to produce a route-to-the-final map, like the one in &lt;a href=&#34;https://www.youtube.com/watch?v=KjISuZ5o06Q&#34;&gt;the presentation that inspired us to write this post&lt;/a&gt; (well worth a watch).&lt;/p&gt;
&lt;p&gt;To get a better idea of how these probabilities play out, we simulated 10,000 runs of the World Cup with them.
Here are the empirical probabilities of winning the tournament.
Our method only gives match outcomes (win, lose, draw), so where teams were tied on points in a group, we used a procedure whereby with 50% probability the tied teams were ranked in order of their strength parameters and with 50% probability they were ranked randomly.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2022/probability_of_winning_truncated.png&#34; alt=&#34;Empirical probabilities of winning the tournament&#34;&gt;&lt;/p&gt;
&lt;p&gt;Brazil is clearly the favourite with a 37.9% chance of taking home the Cup, followed by Argentina, with a 24.8% chance
Both of them are far ahead of the third-ranked (France, 6.2%) and fourth-ranked (England, 5.8%) teams.&lt;/p&gt;
&lt;p&gt;Looking at the results of the simulation runs, we also extracted the &amp;ldquo;dominant path&amp;rdquo; most likely to lead to Brazil&amp;rsquo;s victory.
Without further ado, here are our headline predictions:&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2022/knockout_stage.png&#34; alt=&#34;Headline predictions&#34;&gt;&lt;/p&gt;
&lt;p&gt;As with any model, there are limitations.
It is obviously (and unapologetically) a bit crude. For example, we are calibrating the strengths based on data for the 90-minute match results and applying them to the outcomes of KO matches, potentially after extra-time or penalties for example.
We are also trusting betting odds to represent neutral value with the marginal price-maker being an informed individual, but betting is often a pursuit of the heart as much as the head and the notably different betting proclivity in different countries might suggest that some teams odds are likely to be skewed by this more than others.&lt;/p&gt;
&lt;p&gt;But given these limitations, it is perhaps remarkable that when applied to Euro 2020 it outperformed the market (if taking the odds immediately prior to each match). Three possible explanations are:&lt;/p&gt;
&lt;ol&gt;
&lt;li&gt;betting markets overweight in-tournament performance in their odds creation. In most football prediction, analysts have huge amounts of data off which to work with clubs playing dozens of competitive matches each season. In the international arena, teams play fewer matches against opposition of more varied quality and in more varied situations of competitiveness (qualifying matches vs friendlies vs tournament etc.), so perhaps their methods are not so well-calibrated to this sparser data scenario;&lt;/li&gt;
&lt;li&gt;the equal strength final opposition assumption is a strong one that boosts the probability of well-favoured teams winning, and it happened to be that well-favoured teams did well in Euro 2020;&lt;/li&gt;
&lt;li&gt;England&amp;rsquo;s (surprising?) run to the final meant that the pre-tournament odds that (perhaps) featured a lot of heart-based backing (in possibly the biggest sports betting market in Europe) were supportive of the success of our scheme.&lt;/li&gt;
&lt;/ol&gt;
&lt;p&gt;We would be inclined to think that some combination of the last two of these explanations are most likely, but another piece of evidence comes from other predictions for that tournament.&lt;/p&gt;
&lt;p&gt;Our prediction work was done as part of the  &lt;a href=&#34;https://github.com/mberk/rss-euro-2020-prediction-competition&#34;&gt;RSS Euro 2020 prediction competition&lt;/a&gt;.
We came second, but the winner had a &lt;a href=&#34;https://journals.plos.org/plosone/article/authors?id=10.1371/journal.pone.0268511&#34;&gt;completely different method based on previous match outcomes&lt;/a&gt; and produced very similar performance to us, also beating the market, with the same being true of the third-placed entrant, who took a different approach again.&lt;/p&gt;
&lt;p&gt;It&amp;rsquo;s possible that all our approaches overly-favoured favourites and that was how we came to be ranked highest.
Alternatively, perhaps markets do over-react to in-tournament performance compared to pre-tournament assessments.&lt;/p&gt;
&lt;p&gt;For more information and the full table of outcome predictions, check out the &lt;a href=&#34;https://github.com/stefan-stein/world-cup-2022&#34;&gt;GitHub repository&lt;/a&gt;.&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Indexing from zero in R</title>
      <link>https://selbydavid.com/2021/12/06/indexing/</link>
      <pubDate>Mon, 06 Dec 2021 10:00:00 +0000</pubDate>
      
      <guid>https://selbydavid.com/2021/12/06/indexing/</guid>
      <description>&lt;p&gt;Everybody knows that R is an inferior programming language, because vector
indices start from 1, whereas in &lt;em&gt;real&lt;/em&gt; programming languages like C and Python,
&lt;a href=&#34;https://en.wikipedia.org/wiki/Zero-based_numbering&#34;&gt;array indexing begins from 0&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;Sometimes this can be quite annoying if a problem&amp;mdash;be it a mathematical
algorithm or a &lt;a href=&#34;https://selbydavid.com/2021/12/01/advent-2021/&#34;&gt;coding challenge&lt;/a&gt;&amp;mdash;calls for zero-based indexing.
You find yourself having to add &lt;code&gt;+ 1&lt;/code&gt; to all your indices and it&amp;rsquo;s easy to
introduce bugs or mix up values with their positions.&lt;/p&gt;
&lt;p&gt;Help is at hand.
I have worked out how to break R so utterly that it starts counting from zero
instead of from one.
Someone on Stack Overflow said &lt;strong&gt;&lt;a href=&#34;https://stackoverflow.com/a/25308710&#34;&gt;“just don&amp;rsquo;t do it!”&lt;/a&gt;&lt;/strong&gt; so naturally I&amp;rsquo;ve gone ahead and &lt;em&gt;done it&lt;/em&gt;.&lt;/p&gt;
&lt;p&gt;What&amp;rsquo;s the first letter of the alphabet?
In a normal R session, you get:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;x &amp;lt;- letters
x[1]

#&amp;gt; [1] &amp;quot;a&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;But with my enhanced version, you get the &lt;em&gt;real&lt;/em&gt; answer:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;x &amp;lt;- index_from_0(letters)
x[1]

#&amp;gt; &amp;quot;b&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Where&amp;rsquo;s the &amp;ldquo;a&amp;rdquo; then? In the zeroth position, of course:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;x[0]

#&amp;gt; &amp;quot;a&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;It works for replacing elements, and for matrices as well:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;m &amp;lt;- index_from_0(matrix(0, 2, 2))
m[0, 1] &amp;lt;- 42
m[1] &amp;lt;- 7
m

#&amp;gt;      [,1] [,2]
#&amp;gt; [1,]    0   42
#&amp;gt; [2,]    7    0
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;This is made possible with some abuse of S3 objects to redefine the &lt;code&gt;`[`&lt;/code&gt;
and &lt;code&gt;`[&amp;lt;-`&lt;/code&gt; operators such that different methods are used every time you
subset a vector assigned the special class &lt;code&gt;index0&lt;/code&gt;.&lt;/p&gt;
&lt;p&gt;Want to try it yourself? Download the R package &lt;a href=&#34;https://cran.r-project.org/package=index0&#34;&gt;&lt;strong&gt;index0&lt;/strong&gt; from CRAN&lt;/a&gt;:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;install.packages(&#39;index0&#39;)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Or view the source code &lt;a href=&#34;https://github.com/Selbosh/index0&#34;&gt;on GitHub&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;I&amp;rsquo;m sure you&amp;rsquo;ll agree this will be very useful.&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Advent of Code 2021</title>
      <link>https://selbydavid.com/2021/12/01/advent-2021/</link>
      <pubDate>Wed, 01 Dec 2021 09:00:00 +0000</pubDate>
      
      <guid>https://selbydavid.com/2021/12/01/advent-2021/</guid>
      <description>
&lt;script src=&#34;https://selbydavid.com/rmarkdown-libs/header-attrs/header-attrs.js&#34;&gt;&lt;/script&gt;


&lt;p&gt;It’s that time of year again.
And not just for &lt;a href=&#34;https://selbydavid.com/2016/12/07/santa/&#34;&gt;Secret Santa&lt;/a&gt;—it’s time for the &lt;a href=&#34;https://adventofcode.com/&#34;&gt;Advent of Code&lt;/a&gt;, a series of programming
puzzles in the lead-up to Christmas.&lt;/p&gt;
&lt;p&gt;I’m doing the 2021 challenge in R—in the form of an open-source &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021&#34;&gt;R package&lt;/a&gt;, to demonstrate a &lt;a href=&#34;https://personalpages.manchester.ac.uk/staff/david.selby/rthritis/2021-11-19-unittesting/&#34;&gt;test-driven&lt;/a&gt; workflow.&lt;/p&gt;
&lt;div style=&#34;text-align:center;&#34;&gt;
&lt;div class=&#34;github-card&#34; data-github=&#34;Selbosh/adventofcode2021&#34; data-width=&#34;400&#34; data-height=&#34;&#34; data-theme=&#34;default&#34; style=&#34;display:block; margin:0 auto;&#34;&gt;

&lt;/div&gt;
&lt;/div&gt;
&lt;script src=&#34;//cdn.jsdelivr.net/github-cards/latest/widget.js&#34;&gt;&lt;/script&gt;
&lt;p&gt;Each puzzle description typically comes with a few simple examples of inputs and outputs.
We can use these to define expectations for unit tests with the &lt;a href=&#34;https://testthat.r-lib.org/&#34;&gt;&lt;strong&gt;testthat&lt;/strong&gt;&lt;/a&gt; package.
Once a function passes the unit tests, it should be ready to try with the main puzzle input.&lt;/p&gt;
&lt;p&gt;Check my &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021&#34;&gt;&lt;strong&gt;adventofcode2021&lt;/strong&gt;&lt;/a&gt; repository on GitHub for the latest.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;remotes::install_github(&amp;#39;Selbosh/adventofcode2021&amp;#39;)&lt;/code&gt;&lt;/pre&gt;
&lt;ol style=&#34;list-style-type: decimal&#34;&gt;
&lt;li&gt;&lt;a href=&#34;#day1&#34;&gt;Sonar Sweep&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day2&#34;&gt;Dive!&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day3&#34;&gt;Binary Diagnostic&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day4&#34;&gt;Giant Squid&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day5&#34;&gt;Hydrothermal Venture&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day6&#34;&gt;Lanternfish&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day7&#34;&gt;The Treachery of Whales&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day8&#34;&gt;Seven Segment Search&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day9&#34;&gt;Smoke Basin&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day10&#34;&gt;Syntax Scoring&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day11&#34;&gt;Dumbo Octopus&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day12&#34;&gt;Passage Pathing&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day13&#34;&gt;Transparent Origami&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day14&#34;&gt;Extended Polymerization&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day15&#34;&gt;Chiton&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day16&#34;&gt;Packet Decoder&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day17&#34;&gt;Trick Shot&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day18&#34;&gt;Snailfish&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day19&#34;&gt;Beacon Scanner&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day20&#34;&gt;Trench Map&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day21&#34;&gt;Dirac Dice&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day22&#34;&gt;Reactor Reboot&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day23&#34;&gt;Amphipod&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day24&#34;&gt;Arithmetic Logic Unit&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day25&#34;&gt;Sea Cucumber&lt;/a&gt;&lt;/li&gt;
&lt;/ol&gt;
&lt;div id=&#34;day1&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 1 - &lt;a href=&#34;https://adventofcode.com/2021/day/1&#34;&gt;Sonar Sweep&lt;/a&gt;&lt;/h2&gt;
&lt;div id=&#34;increases&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Increases&lt;/h3&gt;
&lt;p&gt;To count the number of times elements are increasing in a vector it’s as simple as&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;depths &amp;lt;- c(199, 200, 208, 210, 200, 207, 240, 269, 260, 263)
sum(diff(depths) &amp;gt; 0)&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;## [1] 7&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;for which I defined a function called &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021/blob/main/R/day01.R#L91-L93&#34;&gt;&lt;code&gt;increases&lt;/code&gt;&lt;/a&gt;.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;rolling-sum&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Rolling sum&lt;/h3&gt;
&lt;p&gt;For part two, we first want to calculate the three-depth moving sum, then we count the increases as in part one.
There are plenty of solutions in external R packages for getting lagged (and leading) vectors, for instance &lt;code&gt;dplyr::lag()&lt;/code&gt; and &lt;code&gt;dplyr::lead()&lt;/code&gt;:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;depths + dplyr::lead(depths) + dplyr::lead(depths, 2)&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;##  [1] 607 618 618 617 647 716 769 792  NA  NA&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Or you could even calculate the rolling sum using a pre-made solution in &lt;strong&gt;zoo&lt;/strong&gt; (Z’s Ordered Observations, a time-series analysis package).&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;zoo::rollsum(depths, 3)&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;## [1] 607 618 618 617 647 716 769 792&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;To avoid loading any external packages at this stage, I defined my own base R function called &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021/blob/main/R/day01.R#L99-L101&#34;&gt;&lt;code&gt;rolling_sum()&lt;/code&gt;&lt;/a&gt;, which uses &lt;code&gt;tail&lt;/code&gt; and &lt;code&gt;head&lt;/code&gt; with negative lengths to omit the first and last elements of the vector:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;head(depths, -2) + head(tail(depths, -1), -1) + tail(depths, -2)&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;## [1] 607 618 618 617 647 716 769 792&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;As &lt;a href=&#34;https://twitter.com/schochastics/status/1466062839077027845&#34;&gt;David Schoch points out&lt;/a&gt;, you can just use the &lt;code&gt;lag&lt;/code&gt; argument of &lt;code&gt;diff&lt;/code&gt; to make this entire puzzle into a one-liner:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;sapply(c(1, 3), \(lag) sum(diff(depths, lag) &amp;gt; 0))&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;## [1] 7 5&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;/div&gt;
&lt;div id=&#34;day2&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 2 - &lt;a href=&#34;https://adventofcode.com/2021/day/2&#34;&gt;Dive!&lt;/a&gt;&lt;/h2&gt;
&lt;div id=&#34;depth-sum&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Depth sum&lt;/h3&gt;
&lt;p&gt;Read in the input as a two-column data frame using &lt;code&gt;read.table()&lt;/code&gt;.
I gave mine nice column names, &lt;code&gt;cmd&lt;/code&gt; and &lt;code&gt;value&lt;/code&gt;, but this isn’t essential.&lt;/p&gt;
&lt;p&gt;Then take advantage of the fact that &lt;code&gt;TRUE == 1&lt;/code&gt; and &lt;code&gt;FALSE == 0&lt;/code&gt; to make a mathematical &lt;code&gt;ifelse&lt;/code&gt;-type statement for the horizontal and vertical movements.
In my R package, this is implemented as a function called &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021/blob/main/R/day02.R#L70-L76&#34;&gt;&lt;code&gt;dive()&lt;/code&gt;&lt;/a&gt;:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;x &amp;lt;- (cmd == &amp;#39;forward&amp;#39;) * value
y &amp;lt;- ((cmd == &amp;#39;down&amp;#39;) - (cmd == &amp;#39;up&amp;#39;)) * value
sum(x) * sum(y)&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;div id=&#34;cumulative-depth-sum&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Cumulative depth sum&lt;/h3&gt;
&lt;p&gt;Part two is much like part one, but now &lt;code&gt;y&lt;/code&gt; represents (change in) aim, and (change in) depth is derived from that.
Don’t forget the function &lt;code&gt;cumsum()&lt;/code&gt;, which can save you writing a loop!
Here is the body of my function &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021/blob/main/R/day02.R#L80-L87&#34;&gt;&lt;code&gt;dive2()&lt;/code&gt;&lt;/a&gt;:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;x &amp;lt;- (cmd == &amp;#39;forward&amp;#39;) * value
y &amp;lt;- ((cmd == &amp;#39;down&amp;#39;) - (cmd == &amp;#39;up&amp;#39;)) * value
depth &amp;lt;- cumsum(y) * x
sum(x) * sum(depth)&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;/div&gt;
&lt;div id=&#34;day3&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 3 - &lt;a href=&#34;https://adventofcode.com/2021/day/2&#34;&gt;Binary Diagnostic&lt;/a&gt;&lt;/h2&gt;
&lt;div id=&#34;power-consumption&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Power consumption&lt;/h3&gt;
&lt;p&gt;There are a few different ways you could approach part one, but my approach was first to read in the data as a data frame of binary integers using the function &lt;code&gt;read.fwf()&lt;/code&gt;.
Then, find the most common value in each column using the base function &lt;code&gt;colMeans()&lt;/code&gt; and rounding the result.&lt;/p&gt;
&lt;p&gt;According to the instructions, in the event of a tie you should take 1 to be the most common digit.
Although this is familiar to real life—0.5 rounds up to 1—computers &lt;a href=&#34;https://en.wikipedia.org/wiki/Rounding#Round_half_to_even&#34;&gt;don’t work this way&lt;/a&gt;: R rounds to even instead (see &lt;code&gt;?round&lt;/code&gt;).
Because zero is even, that means &lt;code&gt;round(0.5)&lt;/code&gt; yields 0.
To get around this, add 1 before rounding, then subtract it again.&lt;/p&gt;
&lt;p&gt;My function &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021/blob/main/R/day03.R#L78-L81&#34;&gt;&lt;code&gt;power_consumption()&lt;/code&gt;&lt;/a&gt;, which once again takes advantage of &lt;code&gt;TRUE&lt;/code&gt; being equivalent to 1 and &lt;code&gt;FALSE&lt;/code&gt; to 0:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;common &amp;lt;- round(colMeans(x) + 1) - 1
binary_to_int(common) * binary_to_int(!common)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;To convert a vector of binary digits to decimal, I use the following &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021/blob/main/R/day03.R#L104-L106&#34;&gt;utility function&lt;/a&gt;:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;binary_to_int &amp;lt;- function(x) {
  sum(x * 2 ^ rev(seq_along(x) - 1))
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;However, if using a string representation then there’s a handy function in base R called &lt;code&gt;strtoi()&lt;/code&gt; that you could also use for this (&lt;a href=&#34;https://twitter.com/_Riinu_/status/1466681283887648769&#34;&gt;thanks to Riinu Pius for that tip&lt;/a&gt;).&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;life-support&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Life support&lt;/h3&gt;
&lt;p&gt;Part two finds the common digits in a successively decreasing set of binary numbers.
A loop is appropriate here, since we can halt once there is only one number left.
As this loop will only run (at most) 12 times in total, it shouldn’t be too slow in R.&lt;/p&gt;
&lt;p&gt;Function &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021/blob/main/R/day03.R#L85-L98&#34;&gt;&lt;code&gt;life_support()&lt;/code&gt;&lt;/a&gt;:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;life_support &amp;lt;- function(x) {
  oxygen &amp;lt;- co2 &amp;lt;- x
  for (j in 1:ncol(x)) {
    if (nrow(oxygen) &amp;gt; 1) {
      common &amp;lt;- most_common(oxygen)
      oxygen &amp;lt;- oxygen[oxygen[, j] == common[j], ]
    }
    if (nrow(co2) &amp;gt; 1) {
      common &amp;lt;- most_common(co2)
      co2 &amp;lt;- co2[co2[, j] != common[j], ]
    }
  }
  binary_to_int(oxygen) * binary_to_int(co2)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;There might be cleverer ways of doing this.&lt;/p&gt;
&lt;/div&gt;
&lt;/div&gt;
&lt;div id=&#34;day4&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 4 - &lt;a href=&#34;https://adventofcode.com/2021/day/4&#34;&gt;Giant Squid&lt;/a&gt;&lt;/h2&gt;
&lt;div id=&#34;bingo&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Bingo&lt;/h3&gt;
&lt;p&gt;This is one of those problems where half the battle is working out which data structure to use.
I wrote a function &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021/blob/main/R/day04.R#L80-L84&#34;&gt;&lt;code&gt;read_draws()&lt;/code&gt;&lt;/a&gt; that reads in the first line of the file to get the drawn numbers, then separately reads in the remainder of the file to get the bingo cards stacked as a data frame.
Later we take advantage of the fact that the bingo cards are square to split the data frame into a list of matrices.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;read_draws &amp;lt;- function(file) {
  draws &amp;lt;- scan(file, sep = &amp;#39;,&amp;#39;, nlines = 1, quiet = TRUE)
  cards &amp;lt;- read.table(file, skip = 1)
  list(draws = draws, cards = cards)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;As numbers are called out, I replace them in the dataset with &lt;code&gt;NA&lt;/code&gt;s.
Then the helper &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021/blob/main/R/day04.R#L86-L91&#34;&gt;&lt;code&gt;score_card()&lt;/code&gt;&lt;/a&gt; counts the number of &lt;code&gt;NA&lt;/code&gt;s in each row and column.
If there are not enough, we return zero, else we calculate the score.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;score_card &amp;lt;- function(mat, draw) {
  marked &amp;lt;- is.na(mat)
  if (all(c(rowMeans(marked), colMeans(marked)) != 1))
    return(0)
  sum(mat, na.rm = TRUE) * draw
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then we put it all together, looping through the draws, replacing numbers with &lt;code&gt;NA&lt;/code&gt; and halting as soon as someone wins.
Function &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021/blob/main/R/day04.R#L98-L111&#34;&gt;&lt;code&gt;play_bingo()&lt;/code&gt;&lt;/a&gt; is defined as follows, using just base R commands:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;play_bingo &amp;lt;- function(draws, cards) {
  size &amp;lt;- ncol(cards)
  ncards &amp;lt;- nrow(cards) / size
  ids &amp;lt;- rep(1:ncards, each = size)

  for (d in draws) {
    cards[cards == d] &amp;lt;- NA
    score &amp;lt;- sapply(split(cards, ids), score_card, draw = d)
    if (any(score &amp;gt; 0))
      return(score[score &amp;gt; 0])
  }
}&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;div id=&#34;last-caller&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Last caller&lt;/h3&gt;
&lt;p&gt;Part two is very similar, but we throw away each winning bingo card as we go to avoid redundant computation, eventually returning the score when there is only one left.
Here is function &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021/blob/main/R/day04.R#L115-L131&#34;&gt;&lt;code&gt;play_bingo2()&lt;/code&gt;&lt;/a&gt;, which uses the same two utility functions:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;play_bingo2 &amp;lt;- function(draws, cards) {
  size &amp;lt;- ncol(cards)

  for (d in draws) {
    ncards &amp;lt;- nrow(cards) / size
    ids &amp;lt;- rep(1:ncards, each = size)
    cards[cards == d] &amp;lt;- NA
    score &amp;lt;- sapply(split(cards, ids), score_card, draw = d)
    if (any(score &amp;gt; 0)) {
      if (ncards == 1)
        return(score[score &amp;gt; 0])
      cards &amp;lt;- cards[ids %in% which(score == 0), ]
    }
  }
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Further optimizations are possible.
For example: as written, we calculate every intermediate winner’s score, but we only really need to do it for the first (part 1) and last (part 2) winners.&lt;/p&gt;
&lt;p&gt;Also, we could draw more than one number at a time, as we know that nobody’s going to win until at least the fifth draw (for 5×5 cards) and from there, increment according to the minimum number of unmarked numbers on any row or column.&lt;/p&gt;
&lt;p&gt;I didn’t bother implementing either of these, as it already runs quickly enough.&lt;/p&gt;
&lt;/div&gt;
&lt;/div&gt;
&lt;div id=&#34;day5&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 5 - &lt;a href=&#34;https://adventofcode.com/2021/day/5&#34;&gt;Hydrothermal Venture&lt;/a&gt;&lt;/h2&gt;
&lt;p&gt;For a while I tried to think about clever mathematical ways to solve the system of inequalities, but this gets complicated when working on a grid, and where some segments are collinear.
In the end it worked out quicker to what seems like a ‘brute force’ approach:
generate all the points on the line segments and then simply count how many times they appear.&lt;/p&gt;
&lt;p&gt;This is a problem that really lends itself to use of &lt;strong&gt;tidyr&lt;/strong&gt; functions like &lt;a href=&#34;https://tidyr.tidyverse.org/reference/separate.html&#34;&gt;&lt;code&gt;separate()&lt;/code&gt;&lt;/a&gt; and &lt;a href=&#34;https://tidyr.tidyverse.org/reference/nest.html&#34;&gt;&lt;code&gt;unnest()&lt;/code&gt;&lt;/a&gt;, so naturally I made life harder for myself by doing it in base R, instead.&lt;/p&gt;
&lt;p&gt;First, read in the coordinates as a data frame with four columns, &lt;code&gt;x1&lt;/code&gt;, &lt;code&gt;y1&lt;/code&gt;, &lt;code&gt;x2&lt;/code&gt; and &lt;code&gt;y2&lt;/code&gt;.
The &lt;em&gt;nice&lt;/em&gt; way to do this is with &lt;code&gt;tidyr::separate()&lt;/code&gt; but &lt;code&gt;strsplit()&lt;/code&gt; works just fine too.
Here is my parsing function, &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021/blob/main/R/day05.R#L77-L82&#34;&gt;&lt;code&gt;read_segments()&lt;/code&gt;&lt;/a&gt;:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;read_segments &amp;lt;- function(x) {
  lines &amp;lt;- do.call(rbind, strsplit(readLines(x), &amp;#39;( -&amp;gt; |,)&amp;#39;))
  storage.mode(lines) &amp;lt;- &amp;#39;numeric&amp;#39;
  colnames(lines) &amp;lt;- c(&amp;#39;x1&amp;#39;, &amp;#39;y1&amp;#39;, &amp;#39;x2&amp;#39;, &amp;#39;y2&amp;#39;)
  as.data.frame(lines)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;This is one of the few puzzles where the solution to part two is essentially contained in part one.
Depending on how you implement your home-rolled &lt;code&gt;unnest&lt;/code&gt;-like function, it could just be a case of filtering out the diagonal lines in part one.
I make liberal use of &lt;code&gt;mapply&lt;/code&gt; for looping over two vectors at once.&lt;/p&gt;
&lt;p&gt;In the penultimate line, we take advantage of vector broadcasting, which handles all the horizontal and vertical lines where you have multiple coordinates on one axis paired with a single coordinate on the other.
For the diagonal lines, there is a 1:1 relationship so the coordinates just bind together in pairs.
Finally, we work out how to count the rows, without using &lt;code&gt;dplyr::count()&lt;/code&gt;.
If you convert to a data frame, then &lt;code&gt;table()&lt;/code&gt; does this for you.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;count_intersections &amp;lt;- function(lines, part2 = FALSE) {
  if (!part2)
    lines &amp;lt;- subset(lines, x1 == x2 | y1 == y2)
  x &amp;lt;- mapply(seq, lines$x1, lines$x2)
  y &amp;lt;- mapply(seq, lines$y1, lines$y2)
  xy &amp;lt;- do.call(rbind, mapply(cbind, x, y))
  sum(table(as.data.frame(xy)) &amp;gt; 1)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;I’m fairly pleased to get the main solution down to &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021/blob/main/R/day05.R#L89-L96&#34;&gt;essentially four lines of code&lt;/a&gt;, though I’m certain that there are more computationally efficient ways of tackling this problem—if you value computer time more than your own time.&lt;/p&gt;
&lt;p&gt;For the tidyverse approach, see &lt;a href=&#34;https://twitter.com/drob/status/1467361848525787138&#34;&gt;David Robinson’s solution&lt;/a&gt;.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;day6&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 6 - &lt;a href=&#34;https://adventofcode.com/2021/day/6&#34;&gt;Lanternfish&lt;/a&gt;&lt;/h2&gt;
&lt;p&gt;In this problem, we have many fish with internal timers.
As the instructions suggest, we will have exponential growth, so it’s not a good idea to keep track of each individual fish as you’ll soon run out of memory.
On the other hand, there are only nine possible states for any given fish to be in: the number of days until they next reproduce.
So we can store a vector that simply tallies the number of fish in each state.&lt;/p&gt;
&lt;p&gt;On each day, we can shuffle the fish along the vector, decreasing the number of days for each group of fish by 1, and adding new cohorts of fish at day 6, to represent parent fish resetting their timers, and at day 8 to represent the newly hatched lanternfish.
My short function &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021/blob/main/R/day06.R#L72-L77&#34;&gt;&lt;code&gt;lanternfish()&lt;/code&gt;&lt;/a&gt;:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;lanternfish &amp;lt;- function(x, days = 80) {
  fish &amp;lt;- as.double(table(factor(x, levels = 0:8)))
  for (i in 1:days)
    fish &amp;lt;- c(fish[2:7], fish[8] + fish[1], fish[9], fish[1])
  sum(fish)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Because R indexes from 1 rather than 0, the element &lt;code&gt;fish[1]&lt;/code&gt; represents the number of fish with 0 days left, &lt;code&gt;fish[2]&lt;/code&gt; represents the number with 1 day left, and so on.
If you find this confusing, you can index from zero instead, thanks to the new &lt;a href=&#34;https://github.com/Selbosh/index0&#34;&gt;&lt;strong&gt;index0&lt;/strong&gt; package&lt;/a&gt;:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;lanternfish0 &amp;lt;- function(x, days = 80) {
  fish &amp;lt;- as.double(table(factor(x, levels = 0:8)))
  for (i in 1:days) {
    fish &amp;lt;- index0::index_from_0(fish)
    fish &amp;lt;- c(fish[1:6], fish[7] + fish[0], fish[8], fish[0])
   }
  sum(fish)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;There is a slightly different way to perform the updates.
&lt;a href=&#34;https://twitter.com/drob/status/1467727330663534594&#34;&gt;David Robinson suggested&lt;/a&gt; an approach based on linear algebra.
Here we apply the same procedure as above, but via matrix multiplication.
It takes about the same time to run.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;lanternfish &amp;lt;- function(x, days = 80) {
  fish &amp;lt;- table(factor(x, levels = 0:8))
  mat &amp;lt;- matrix(0, 9, 9)
  mat[cbind(2:9, 1:8)] &amp;lt;- 1 # decrease timer for fish w/ 1-8 days left
  mat[1, c(7, 9)] &amp;lt;- 1      # add &amp;#39;new&amp;#39; fish with 6 &amp;amp; 8 days left
  for (i in 1:days)
    fish &amp;lt;- fish %*% mat
  sum(fish)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Day 6 is another puzzle where the solutions for parts one and two are essentially the same.
The only thing to be careful of on part two is that you don’t run into integer overflow.
If you do, make sure the numbers you’re adding together are of type &lt;code&gt;double&lt;/code&gt;.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;day7&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 7 - &lt;a href=&#34;https://adventofcode.com/2021/day/7&#34;&gt;The Treachery of Whales&lt;/a&gt;&lt;/h2&gt;
&lt;div id=&#34;median&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Median&lt;/h3&gt;
&lt;p&gt;While it’s possible to brute-force this puzzle by simply calculating the fuel requirement at every single point (within the range of the inputs), you can do it about 200× faster by treating it as an optimization problem.&lt;/p&gt;
&lt;p&gt;The total fuel required for any potential position is&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;x &amp;lt;- scan(&amp;#39;input.txt&amp;#39;, sep = &amp;#39;,&amp;#39;)
f &amp;lt;- function(pos) sum(abs(x - pos))&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;where &lt;code&gt;x&lt;/code&gt; are the initial locations of the crabs.
Then run it through &lt;code&gt;optimize()&lt;/code&gt;, and round to the nearest integer position:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;sol &amp;lt;- optimize(f, range(x))$minimum
f(round(sol))&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;However, there is an even faster analytical solution!&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;sol &amp;lt;- median(x)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Thanks to &lt;a href=&#34;https://twitter.com/claire_little1&#34;&gt;Claire Little&lt;/a&gt; for pointing this out.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;mean&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Mean&lt;/h3&gt;
&lt;p&gt;Part two just has a slightly different function to optimize.
Using the formula for the sum of an &lt;a href=&#34;https://en.wikipedia.org/wiki/Arithmetic_progression&#34;&gt;arithmetic progression&lt;/a&gt;:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;f2 &amp;lt;- function(pos) {
  n &amp;lt;- abs(x - pos)
  sum(n / 2 * (1 + n))
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then we can simply minimize this function as before.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;sol &amp;lt;- optimize(f2, range(x))$minimum
f2(round(sol))&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;However, there’s a shortcut for this part as well!
Calculate the mean of the initial positions, and work out which of the two nearest integers gives the minimum result:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;min(
  f2(floor(mean(x))),
  f2(ceiling(mean(x)))
)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Thanks to &lt;a href=&#34;https://twitter.com/jonatanpallesen/status/1468165025575624704&#34;&gt;Jonatan Pallesen&lt;/a&gt;.
This is about 5 times faster than my optimizer.&lt;/p&gt;
&lt;p&gt;And here is what the functions look like for my input dataset:&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/post/2021-12-01-advent_files/figure-html/day7-1.png&#34; width=&#34;576&#34; /&gt;&lt;/p&gt;
&lt;/div&gt;
&lt;/div&gt;
&lt;div id=&#34;day8&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 8 - &lt;a href=&#34;https://adventofcode.com/2021/day/8&#34;&gt;Seven Segment Search&lt;/a&gt;&lt;/h2&gt;
&lt;div id=&#34;unique-digits&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Unique digits&lt;/h3&gt;
&lt;p&gt;Read in the data and then the first part is just a one-liner:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;input &amp;lt;- do.call(rbind, strsplit(readLines(input_file(8)), &amp;#39;[^a-z]+&amp;#39;))

count_unique &amp;lt;- function(x) {
  sum(nchar(x[, -(1:10)]) %in% c(2, 3, 4, 7))
}&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;div id=&#34;segment-matching&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Segment matching&lt;/h3&gt;
&lt;p&gt;I &lt;em&gt;really&lt;/em&gt; wanted to solve part two using graph theory, by representing the puzzle as a maximum bipartite matching problem.
However, I couldn’t quite get this to work.
My final solution is instead just a lot of leg work.&lt;/p&gt;
&lt;p&gt;Essentially you solve the problem by hand and then encode the process programmatically.
Recognize that some digits have segments in common, or not in common, and use this to eliminate the possibilities.
I stored the solutions in a named vector, which I was able to use to look up the digits found so far.&lt;/p&gt;
&lt;p&gt;The function &lt;code&gt;setdiff()&lt;/code&gt; comes in useful.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;contains &amp;lt;- function(strings, letters) {
  vapply(strsplit(strings, &amp;#39;&amp;#39;),
         function(s) all(strsplit(letters, &amp;#39;&amp;#39;)[[1]] %in% s),
         logical(1))
}

output_value &amp;lt;- function(vec) {
  segments &amp;lt;- c(&amp;#39;abcefg&amp;#39;, &amp;#39;cf&amp;#39;, &amp;#39;acdeg&amp;#39;, &amp;#39;acdfg&amp;#39;, &amp;#39;bcdf&amp;#39;,
                &amp;#39;abdfg&amp;#39;, &amp;#39;abdefg&amp;#39;, &amp;#39;acf&amp;#39;, &amp;#39;abcdefg&amp;#39;, &amp;#39;abcdfg&amp;#39;)
  nchars &amp;lt;- setNames(nchar(segments), 0:9)

  # Sort the strings
  vec &amp;lt;- sapply(strsplit(vec, &amp;#39;&amp;#39;), function(d) paste(sort(d), collapse = &amp;#39;&amp;#39;))
  sgn &amp;lt;- head(vec, 10)
  out &amp;lt;- tail(vec, 4)

  # Store the known values
  digits &amp;lt;- setNames(character(10), 0:9)
  unique &amp;lt;- c(&amp;#39;1&amp;#39;, &amp;#39;4&amp;#39;, &amp;#39;7&amp;#39;, &amp;#39;8&amp;#39;)
  digits[unique] &amp;lt;- sgn[match(nchars[unique], nchar(sgn))]

  # Remaining digits have 5 or 6 segments:
  sgn &amp;lt;- setdiff(sgn, digits)
  digits[&amp;#39;3&amp;#39;] &amp;lt;- sgn[nchar(sgn) == 5 &amp;amp; contains(sgn, digits[&amp;#39;1&amp;#39;])]
  digits[&amp;#39;6&amp;#39;] &amp;lt;- sgn[nchar(sgn) == 6 &amp;amp; !contains(sgn, digits[&amp;#39;1&amp;#39;])]
  sgn &amp;lt;- setdiff(sgn, digits)
  digits[&amp;#39;0&amp;#39;] &amp;lt;- sgn[nchar(sgn) == 6 &amp;amp; !contains(sgn, digits[&amp;#39;4&amp;#39;])]
  sgn &amp;lt;- setdiff(sgn, digits)
  digits[&amp;#39;9&amp;#39;] &amp;lt;- sgn[nchar(sgn) == 6]
  sgn &amp;lt;- setdiff(sgn, digits)
  digits[&amp;#39;2&amp;#39;] &amp;lt;- sgn[
    contains(sgn, do.call(setdiff,
                          unname(strsplit(digits[c(&amp;#39;8&amp;#39;, &amp;#39;6&amp;#39;)], &amp;#39;&amp;#39;))))
  ]
  digits[&amp;#39;5&amp;#39;] &amp;lt;- setdiff(sgn, digits)

  # Combine four output digits:
  as.numeric(paste(match(out, digits) - 1, collapse = &amp;#39;&amp;#39;))
}&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;/div&gt;
&lt;div id=&#34;day9&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 9 - &lt;a href=&#34;https://adventofcode.com/2021/day/9&#34;&gt;Smoke Basin&lt;/a&gt;&lt;/h2&gt;
&lt;div id=&#34;lowest-points&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Lowest points&lt;/h3&gt;
&lt;p&gt;You can find all the lowest points with a one-liner:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;lowest &amp;lt;- function(h) {
  h &amp;lt; cbind(h, Inf)[, -1] &amp;amp;          # right
    h &amp;lt; rbind(h, Inf)[-1, ] &amp;amp;        # down
    h &amp;lt; cbind(Inf, h[, -ncol(h)]) &amp;amp;  # left
    h &amp;lt; rbind(Inf, h[-nrow(h), ])    # up
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then do &lt;code&gt;sum(h[lowest(h)])&lt;/code&gt; to get the result, where &lt;code&gt;h&lt;/code&gt; is a numeric matrix of the input data.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;basins&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Basins&lt;/h3&gt;
&lt;p&gt;The second part is harder and doesn’t immediately lead from the first.
Initially I thought of replacing each lowest point with &lt;code&gt;Inf&lt;/code&gt;, then finding the new lowest points and repeating the process until all the basins are found.
However, the basins are simply all points where the height is &lt;code&gt;&amp;lt; 9&lt;/code&gt;, so you can find the basins in a single step.&lt;/p&gt;
&lt;p&gt;The tricky part is labelling them separately, so you can count up their respective sizes.&lt;/p&gt;
&lt;p&gt;The boring way of doing this is just to loop over the indices and label the points that neighbour already-labelled ones (starting with the lowest points as the initial labels), doing several passes until everything (except the 9s) is labelled.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;basins &amp;lt;- function(h) {
  l &amp;lt;- lowest(h)
  h[] &amp;lt;- ifelse(h &amp;lt; 9, NA, Inf)
  h[l] &amp;lt;- 1:sum(l)
  while (anyNA(h)) {
    for (i in 1:nrow(h)) for (j in 1:ncol(h)) {
      if (is.na(h[i, j])) {
        nbrs &amp;lt;- h[cbind(c(max(i - 1, 1), min(i + 1, nrow(h)), i, i),
                        c(j, j, max(j - 1, 1), min(j + 1, ncol(h))))]
        if (any(is.finite(nbrs)))
          h[i, j] &amp;lt;- nbrs[is.finite(nbrs)][1]
      }
    }
  }
  sizes &amp;lt;- table(h[is.finite(h)])
  head(sort(sizes, decreasing = TRUE), 3)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;To vectorize this in the same way as part one, we define a new binary (infix) operator &lt;code&gt;%c%&lt;/code&gt;, analogous to &lt;code&gt;dplyr::coalesce()&lt;/code&gt;.
What this does is replace an &lt;code&gt;NA&lt;/code&gt; value (a basin not yet assigned a label) with its finite neighbour, while leaving &lt;code&gt;Inf&lt;/code&gt;s (marking basin edges) alone.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;&amp;quot;%c%&amp;quot; &amp;lt;- function(x, y) {
  ifelse(is.infinite(x), x,
         ifelse(!is.na(x), x,
                ifelse(!is.infinite(y), y, x)))
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then the new function for part two is as follows.
It is five times faster to run than the nested loop above.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;basins2 &amp;lt;- function(h) {
  l &amp;lt;- lowest(h)
  h[] &amp;lt;- ifelse(h &amp;lt; 9, NA, Inf)
  h[l] &amp;lt;- 1:sum(l)
  while(anyNA(h)) {
    h &amp;lt;- h %c%
      cbind(h, NA)[, -1] %c%        # right
      rbind(h, NA)[-1, ] %c%        # down
      cbind(NA, h[, -ncol(h)]) %c%  # left
      rbind(NA, h[-nrow(h), ])      # up
  }
  sizes &amp;lt;- table(h[is.finite(h)])
  head(sort(sizes, decreasing = TRUE), 3)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;You can also &lt;a href=&#34;https://twitter.com/rappa753/status/1468876602016735233&#34;&gt;formulate this as an image analysis problem&lt;/a&gt;, effectively treating each basin as an area of similar colour to select, or you can &lt;a href=&#34;https://twitter.com/babeheim/status/1468898580408811525&#34;&gt;treat it as a network theory problem and apply the &lt;strong&gt;igraph&lt;/strong&gt; package&lt;/a&gt; to find graph components.&lt;/p&gt;
&lt;/div&gt;
&lt;/div&gt;
&lt;div id=&#34;day10&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 10 - &lt;a href=&#34;https://adventofcode.com/2021/day/10&#34;&gt;Syntax Scoring&lt;/a&gt;&lt;/h2&gt;
&lt;div id=&#34;corrupt-characters&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Corrupt characters&lt;/h3&gt;
&lt;p&gt;Whilst it’s probably possible to do the first part with some very fancy &lt;a href=&#34;https://www.php.net/manual/en/regexp.reference.recursive.php&#34;&gt;recursive regular expressions&lt;/a&gt;, I don’t know how to use them.&lt;/p&gt;
&lt;p&gt;Instead, my method of finding unmatched brackets is simply to search for empty pairs of brackets and successively strip them from the string.
Keep doing this until the strings stop changing.
Then, get the first closing bracket (if any), using &lt;code&gt;regmatches()&lt;/code&gt;.
These are the illegal characters.&lt;/p&gt;
&lt;p&gt;My function &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021/blob/main/R/day10.R#L122-L128&#34;&gt;&lt;code&gt;syntax_score()&lt;/code&gt;&lt;/a&gt; is implemented as follows:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;lines &amp;lt;- readLines(&amp;#39;input.txt&amp;#39;)
old &amp;lt;- &amp;#39;&amp;#39;
while (!identical(old, lines -&amp;gt; old))
  lines &amp;lt;- gsub(r&amp;#39;(\(\)|&amp;lt;&amp;gt;|\{\}|\[\])&amp;#39;, &amp;#39;&amp;#39;, lines)
illegals &amp;lt;- regmatches(lines, regexpr(r&amp;#39;(\)|&amp;gt;|\}|\])&amp;#39;, lines))&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;The syntax score is calculated using a named vector as a lookup table.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;illegal_score &amp;lt;- c(&amp;#39;)&amp;#39; = 3, &amp;#39;]&amp;#39; = 57, &amp;#39;}&amp;#39; = 1197, &amp;#39;&amp;gt;&amp;#39; = 25137)
sum(illegal_score[illegals])&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;div id=&#34;autocomplete&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Autocomplete&lt;/h3&gt;
&lt;p&gt;Part two starts the same, but instead of extracting the illegal characters we just throw away those lines that contain them.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;illegals &amp;lt;- grep(r&amp;#39;(\)|&amp;gt;|\}|\])&amp;#39;, lines)
chars &amp;lt;- strsplit(lines[-illegals], &amp;#39;&amp;#39;)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;From here, we can calculate the scores using a &lt;code&gt;Reduce&lt;/code&gt; operation (from right to left) with another lookup table.
The final answer is the median score.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;complete_score &amp;lt;- c(&amp;#39;(&amp;#39; = 1, &amp;#39;[&amp;#39; = 2, &amp;#39;{&amp;#39; = 3, &amp;#39;&amp;lt;&amp;#39; = 4)
scores &amp;lt;- sapply(chars, Reduce, init = 0, right = TRUE,
                 f = \(c, s) 5 * s + complete_score[c])
median(scores)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;The function &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021/blob/main/R/day10.R#L132-L141&#34;&gt;&lt;code&gt;autocomplete()&lt;/code&gt;&lt;/a&gt; wraps it all together.&lt;/p&gt;
&lt;/div&gt;
&lt;/div&gt;
&lt;div id=&#34;day11&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 11 - &lt;a href=&#34;https://adventofcode.com/2021/day/11&#34;&gt;Dumbo Octopus&lt;/a&gt;&lt;/h2&gt;
&lt;div id=&#34;convoluted-octopuses&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Convoluted octopuses&lt;/h3&gt;
&lt;p&gt;The process of updating the energy levels can be described using a &lt;a href=&#34;https://en.wikipedia.org/wiki/Kernel_(image_processing)&#34;&gt;&lt;em&gt;convolution matrix&lt;/em&gt;&lt;/a&gt;.
It’s easy—&lt;a href=&#34;https://selbydavid.com/2020/12/06/advent-2020/#day11&#34;&gt;like on Day 11 last year&lt;/a&gt;—to use a ready-made solution from an image analysis package for this, namely &lt;code&gt;OpenImageR::convolution()&lt;/code&gt;.&lt;/p&gt;
&lt;p&gt;The convolution matrix, or &lt;em&gt;kernel&lt;/em&gt; is
&lt;span class=&#34;math display&#34;&gt;\[\begin{bmatrix}1  &amp;amp;  1  &amp;amp;  1 \\1  &amp;amp;   0  &amp;amp;  1 \\1  &amp;amp;  1  &amp;amp;  1\end{bmatrix},\]&lt;/span&gt;
to be applied on an indicator matrix of ‘flashing’ octopuses, and then added to the result.
In R,&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;kernel &amp;lt;- matrix(1:9 != 5, 3, 3)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;So we define a function, &lt;code&gt;step1()&lt;/code&gt;, that applies a single step of the energy level updating process.
Since each octopus can only flash once in a given step, we keep track of those that have already flashed, as well as those currently flashing.
A short &lt;code&gt;while()&lt;/code&gt; loop repeats until no more octopuses flash.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;step1 &amp;lt;- function(x) {
  x &amp;lt;- x + 1
  flashing &amp;lt;- flashed &amp;lt;- x == 10
  while (any(flashing)) {
    x &amp;lt;- x + OpenImageR::convolution(flashing, kernel)
    flashing &amp;lt;- x &amp;gt; 9 &amp;amp; !flashed
    flashed &amp;lt;- flashing | flashed
  }
  x[x &amp;gt; 9] &amp;lt;- 0
  x
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;However, there is a base R alternative to &lt;code&gt;OpenImageR::convolution()&lt;/code&gt; that you can substitute in, for negligible speed penalty (despite that package being written in C).&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;add_neighbours &amp;lt;- function(x) {
  I &amp;lt;- nrow(x)
  J &amp;lt;- ncol(x)
  cbind(x[, -1], 0) +  # Right
  rbind(x[-1, ], 0) +  # Down
  cbind(0, x[, -J]) +  # Left
  rbind(0, x[-I, ]) +  # Up
  rbind(cbind(x[-1, -1], 0), 0) + # SE
  rbind(0, cbind(x[-I, -1], 0)) + # NE
  rbind(cbind(0, x[-1, -J]), 0) + # SW
  rbind(0, cbind(0, x[-I, -J]))   # NW
}&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;div id=&#34;counting-flashes&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Counting flashes&lt;/h3&gt;
&lt;p&gt;We then solve both parts one and two with a single function that repeatedly applies the updating step and counts the flashes (number of zeros) each time.&lt;/p&gt;
&lt;p&gt;By default, it simply completes &lt;code&gt;iter&lt;/code&gt; steps and then returns cumulative total number of flashes.&lt;/p&gt;
&lt;p&gt;In &lt;code&gt;part2&lt;/code&gt; mode, the function will terminate early if it encounters a step where all the octopuses are flashing and return the iteration number, otherwise it will generate a warning.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;count_flashes &amp;lt;- function(x, iter = 100, part2 = FALSE) {
  count &amp;lt;- 0
  for (i in 1:iter) {
    x &amp;lt;- step1(x)
    nflashes &amp;lt;- sum(x == 0)
    if (part2 &amp;amp; nflashes == prod(dim(x)))
      return(i)
    count &amp;lt;- count + nflashes
  }
  if (part2)
    warning(&amp;#39;No synchronization detected in &amp;#39;, iter, &amp;#39; steps&amp;#39;)
  count
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;The whole thing runs in about 20 milliseconds on my input dataset, or 60 milliseconds using the base R convolution function.&lt;/p&gt;
&lt;/div&gt;
&lt;/div&gt;
&lt;div id=&#34;day12&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 12 - &lt;a href=&#34;Passage%20Pathing&#34;&gt;Passage Pathing&lt;/a&gt;&lt;/h2&gt;
&lt;div id=&#34;counting-paths&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Counting paths&lt;/h3&gt;
&lt;p&gt;Today’s puzzle is very obviously a graph theory problem, so it would seem intuitive to break out &lt;strong&gt;igraph&lt;/strong&gt; for this.
However, the functions in that package are mainly designed for finding the &lt;em&gt;shortest&lt;/em&gt; paths from A to B, not a complete list of all possible paths.&lt;/p&gt;
&lt;p&gt;Therefore, it’s easier (as far as I can tell) to solve this with your own data structure and a recursive function or two.&lt;/p&gt;
&lt;p&gt;&lt;a href=&#34;https://twitter.com/antoine_fabri/status/1469989831522541574&#34;&gt;Antoine Fabri&lt;/a&gt; suggested a rather neat solution of describing the graph with a named list, where the names of the elements describe a node, and the vector contained therein list the other nodes reachable from that point.&lt;/p&gt;
&lt;p&gt;We can read in the data as follows:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;read_edges &amp;lt;- function(file) {
  edges &amp;lt;- read.table(file, sep = &amp;#39;-&amp;#39;, col.names = c(&amp;#39;from&amp;#39;, &amp;#39;to&amp;#39;))
  edges &amp;lt;- rbind(edges, setNames(edges, rev(colnames(edges))))
  edges &amp;lt;- edges[edges$to != &amp;#39;start&amp;#39;, ]
  split(edges$to, edges$from)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then we solve part one with a recursive function that, starting from &lt;code&gt;start&lt;/code&gt;, traverses a path all the way to &lt;code&gt;end&lt;/code&gt; and increments a counter.
To avoid revisiting small caves, we discard any edges to vertices with lowercase names, with the aid of &lt;code&gt;tolower()&lt;/code&gt;.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;count_paths &amp;lt;- function(edgelist, node = &amp;#39;start&amp;#39;) {
  if (node == &amp;#39;end&amp;#39;)
    return(1)
  if (!length(edgelist[[node]]))
    return(0)
  if (node == tolower(node))
    edgelist &amp;lt;- lapply(edgelist, \(v) v[node != v])
  sum(vapply(edgelist[[node]], count_paths, e = edgelist,
             FUN.VALUE = numeric(1)))
}&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;div id=&#34;revisiting-caves&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Revisiting caves&lt;/h3&gt;
&lt;p&gt;Part two is just a slight adaptation.
This time we can’t simply delete small caves as soon as we visit them, so we need to keep track of those visited so far, while keeping the graph intact.
Once we find ourselves on a node that we have already visited, it means we are visiting it for the second time, so at this point we can delete all the visited nodes and switch over to the function from part one.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;count_paths2 &amp;lt;- function(edgelist, node = &amp;#39;start&amp;#39;, visited = NULL) {
  if (node == &amp;#39;end&amp;#39;)
    return(1)
  if (node == tolower(node)) {
    if (node %in% visited) {
      edgelist &amp;lt;- lapply(edgelist, \(v) v[!v %in% visited])
      return(count_paths(edgelist, node))
    }
    visited &amp;lt;- union(visited, node)
  }
  if (!length(edgelist[[node]]))
    return(0)
  sum(vapply(edgelist[[node]], count_paths2, e = edgelist, visited,
             FUN.VALUE = numeric(1)))
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;R is quite slow at recursion, so this second function takes about 6 seconds to run on my full input data.
It may be possible to optimize this further, but that might require the use of &lt;strong&gt;igraph&lt;/strong&gt;, which is written in C, rather than a base R solution.&lt;/p&gt;
&lt;/div&gt;
&lt;/div&gt;
&lt;div id=&#34;day13&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 13 - &lt;a href=&#34;https://adventofcode.com/2021/day/13&#34;&gt;Transparent Origami&lt;/a&gt;&lt;/h2&gt;
&lt;div id=&#34;folding-paper&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Folding paper&lt;/h3&gt;
&lt;p&gt;The hardest bit about this puzzle is reading in the data, since we have two different data structures in the same file.&lt;/p&gt;
&lt;p&gt;The neatest way of doing this is to find the separator (a blank line) in the middle of the file, then read through the parts of the file before and after this separately.
Since there’s only one file to read, you could of course just inspect it in a text editor and find out this line number by hand.
But here’s a programmatic method.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;n &amp;lt;- which(readLines(&amp;#39;input.txt&amp;#39;) == &amp;#39;&amp;#39;)
paper &amp;lt;- read.table(&amp;#39;input.txt&amp;#39;, sep = &amp;#39;,&amp;#39;, nrows = n - 1,
                    col.names = c(&amp;#39;x&amp;#39;, &amp;#39;y&amp;#39;))
folds &amp;lt;- read.table(&amp;#39;input.txt&amp;#39;, sep = &amp;#39;=&amp;#39;, skip = n)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Next, we need a function that’ll fold the paper in half once.
My initial solution, which works perfectly well, is to convert the &lt;code&gt;x&lt;/code&gt; and &lt;code&gt;y&lt;/code&gt; coordinates to a matrix representation, then simply update the matrix using subset operations.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;mat &amp;lt;- with(paper, matrix(0, max(x) + 1, max(y) + 1))
mat[data.matrix(paper) + 1] &amp;lt;- 1&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Watch out for R’s &lt;a href=&#34;https://selbydavid.com/2021/12/06/indexing/&#34;&gt;one-based indexing&lt;/a&gt;.
We want to fold along the coordinate &lt;code&gt;f&lt;/code&gt;, which is at index &lt;code&gt;f + 1&lt;/code&gt;, and so the indices either side are &lt;code&gt;f&lt;/code&gt; and &lt;code&gt;f + 2&lt;/code&gt;.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;fold_once &amp;lt;- function(x, dir, f) {
  if (dir == &amp;#39;fold along y&amp;#39;) {
    x[, 1:f] | x[, ncol(x):(f + 2)]
  } else {
    x[1:f, ] | x[nrow(x):(f + 2), ]
  }
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;At this point you might notice that the paper is always being folded exactly in half every time.
So the value after the &lt;code&gt;=&lt;/code&gt; in the input is actually redundant; it’s always the middle of the matrix.
For instance, in the example data, the matrix has dimension 15×11 and we fold along &lt;span class=&#34;math inline&#34;&gt;\(y=7\)&lt;/span&gt; (i.e. index 8), which is half of 15.
The next instruction &lt;span class=&#34;math inline&#34;&gt;\(x=5\)&lt;/span&gt; (index 6) is half of the other dimension.&lt;/p&gt;
&lt;p&gt;From here, loop over the directions and then plot the final matrix using &lt;code&gt;image()&lt;/code&gt;.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;tidy-origami&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Tidy origami&lt;/h3&gt;
&lt;p&gt;Why do they give us the values to &lt;code&gt;fold along&lt;/code&gt; if it’s always the middle value?
Because it’s not actually very efficient to store these sparse coordinates in a matrix.
Instead, recognize, as pointed out by &lt;a href=&#34;https://twitter.com/_Riinu_/status/1470320577340755972&#34;&gt;Riinu Pius&lt;/a&gt; and &lt;a href=&#34;https://twitter.com/antoine_fabri/status/1470294716000485376&#34;&gt;Antoine Fabri&lt;/a&gt;, that you can just keep the coordinates in a long format and fold them as follows:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;fold_once &amp;lt;- function(x, d, f) {
  x[, d] &amp;lt;- ifelse(x[, d] &amp;gt;= f, 2 * f - x[, d], x[, d])
  x[!duplicated(x), ]
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then loop over all the instructions with:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;fold_paper &amp;lt;- function(x, folds, n = nrow(folds)) {
  for (i in 1:n)
    x &amp;lt;- fold_once(x, folds[i, 1], folds[i, 2])
  x
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;And finally you can plot the result using &lt;strong&gt;ggplot2&lt;/strong&gt;.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;library(adventofcode2021)
input &amp;lt;- read_origami(input_file(13))
input$n &amp;lt;- nrow(input[[2]])
folded &amp;lt;- do.call(fold_paper, input)

library(ggplot2)
ggplot(folded) +
  aes(x, y) +
  geom_tile(fill = &amp;#39;#f5c966&amp;#39;) +
  coord_fixed() +
  scale_y_reverse() +
  theme_void()&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/post/2021-12-01-advent_files/figure-html/day13-1.png&#34; width=&#34;576&#34; /&gt;&lt;/p&gt;
&lt;/div&gt;
&lt;/div&gt;
&lt;div id=&#34;day14&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 14 - &lt;a href=&#34;https://adventofcode.com/2021/day/14&#34;&gt;Extended Polymerization&lt;/a&gt;&lt;/h2&gt;
&lt;div id=&#34;inserting-letters&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Inserting letters&lt;/h3&gt;
&lt;p&gt;The initial approach to this problem is to perform the insertions and build up an ever-lengthening string.
There might be a way to do this using regular expressions, but I used an approach based on table joins.&lt;/p&gt;
&lt;p&gt;First, read in the data:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;template &amp;lt;- strsplit(readLines(&amp;#39;input.txt&amp;#39;, n = 1), &amp;#39;&amp;#39;)[[1]]
template &amp;lt;- data.frame(first = head(template, -1),
                       second = tail(template, -1))
rules &amp;lt;- read.table(&amp;#39;input.txt&amp;#39;, skip = 1)
rules &amp;lt;- data.frame(first  = substr(rules[, 1], 1, 1),
                    second = substr(rules[, 1], 2, 2),
                    insert = rules[, 3])&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;This should give you two data frames that look something like this:&lt;/p&gt;
&lt;pre&gt;&lt;code&gt;  first second
1     N      N
2     N      C
3     C      B

   first second insert
1      C      H      B
2      H      H      N
3      C      B      H
4      N      H      C
5      H      B      C
6      H      C      B
7      H      N      C
8      N      N      C
9      B      H      H
10     N      C      B
11     N      B      B
12     B      N      B
13     B      B      N
14     B      C      B
15     C      C      N
16     C      N      C&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;From here, the method is straightforward.
Join the &lt;code&gt;template&lt;/code&gt; with the &lt;code&gt;rules&lt;/code&gt; and produce a new &lt;code&gt;template&lt;/code&gt; comprised of the pairs &lt;code&gt;first -&amp;gt; insert&lt;/code&gt; and &lt;code&gt;insert -&amp;gt; second&lt;/code&gt;.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;template &amp;lt;- with(merge(template, rules),
                 data.frame(first = c(first, insert),
                            second = c(insert, second)))&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Repeat this process the required number of times and we will have a data frame containing all the pairs of letters.&lt;/p&gt;
&lt;p&gt;There’s a problem, though: &lt;code&gt;merge()&lt;/code&gt; does not preserve row order, so we’ve lost track of which letters are the first and the last in the sequence.
This means counting up the letters in either column &lt;code&gt;first&lt;/code&gt; or &lt;code&gt;second&lt;/code&gt; is going to undercount by 1.
We could just refer back to the original input, since the first and last letters won’t change.&lt;/p&gt;
&lt;p&gt;However, there’s another neat solution, which takes advantage of the fact that all the middle characters will appear in both columns, but the first and last values, if different, will appear an odd number of times.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;counts &amp;lt;- (table(unlist(template)) + 1) %/% 2&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;From here, the difference between the minimum and maximum counts is given by:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;diff(range(counts))&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;div id=&#34;scalable-insertion&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Scalable insertion&lt;/h3&gt;
&lt;p&gt;The above approach works for part one, but once we increase the iteration count to 40, the data frame or string representation is far too long to store in memory.
It simply doesn’t scale.&lt;/p&gt;
&lt;p&gt;Rather than keep the entire sequence and then count up the letters at the end, we can instead store pair frequencies.
To do this, we can call &lt;code&gt;dplyr::count()&lt;/code&gt; or use a base R approach.&lt;/p&gt;
&lt;p&gt;Add a frequency column to the original data frame:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;template &amp;lt;- data.frame(first  = head(template, -1),
                       second = tail(template, -1),
                       n = 1)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;or if you want to aggregate on initialization, you could use:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;template &amp;lt;- as.data.frame(table(template), stringsAsFactors = FALSE)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then after each round of insertions, &lt;code&gt;aggregate()&lt;/code&gt; the counts:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;data &amp;lt;- with(merge(template, rules),
             data.frame(first = c(first, insert),
                        second = c(insert, second)))
template &amp;lt;- aggregate(n ~ first + second, data, sum)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Finally, the total letter counts are given by:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;tab &amp;lt;- xtabs(n ~ first + second, template)
(rowSums(tab) + colSums(tab) + 1) %/% 2&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;/div&gt;
&lt;div id=&#34;day15&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 15 - &lt;a href=&#34;https://adventofcode.com/2021/day/15&#34;&gt;Chiton&lt;/a&gt;&lt;/h2&gt;
&lt;p&gt;The answer is &lt;a href=&#34;https://en.wikipedia.org/wiki/Dijkstra%27s_algorithm&#34;&gt;Dijkstra’s algorithm&lt;/a&gt;, whether you’re aware of it or not.
That is, the problem is a weighted, directed graph and you’ve been tasked with finding the shortest path between two points.&lt;/p&gt;
&lt;p&gt;You could write your own implementation in R, but it’ll be slow, so I am going to use the off-the-shelf solution in the &lt;strong&gt;igraph&lt;/strong&gt; package.
The hardest task is converting from a matrix into a 2-dimensional lattice graph.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;lattice_from_matrix &amp;lt;- function(m) {
  edges &amp;lt;- data.frame(node1 = c(which(row(m) &amp;lt; nrow(m)),
                                which(col(m) &amp;lt; ncol(m))),
                      node2 = c(which(row(m) &amp;gt; 1),
                                which(col(m) &amp;gt; 1)))
  edges &amp;lt;- rbind(edges, setNames(edges, c(&amp;#39;node2&amp;#39;, &amp;#39;node1&amp;#39;)))
  edges$weight &amp;lt;- m[edges$node2]
  igraph::graph_from_data_frame(edges)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then, just let the algorithm do the work.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;lowest_total_risk &amp;lt;- function(g) {
  as.vector(igraph::distances(g, v = 1, to = igraph::vcount(g),
                              mode = &amp;#39;out&amp;#39;, algorithm = &amp;#39;dijkstra&amp;#39;))
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;For part two, we need to tile the input and then rerun the code again.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;tile_matrix &amp;lt;- function(m, times = 5) {
  m &amp;lt;- Reduce(cbind, lapply(seq_len(times) - 1, &amp;#39;+&amp;#39;, m))
  m &amp;lt;- Reduce(rbind, lapply(seq_len(times) - 1, &amp;#39;+&amp;#39;, m))
  m[m &amp;gt; 9] &amp;lt;- m[m &amp;gt; 9] %% 10 + 1
  m
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;The final search takes about 0.8 seconds, which is faster than any base-R Dijkstra loop would be.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;day16&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 16 - &lt;a href=&#34;https://adventofcode.com/2021/day/15&#34;&gt;Packet Decoder&lt;/a&gt;&lt;/h2&gt;
&lt;div id=&#34;versions&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Versions&lt;/h3&gt;
&lt;p&gt;This puzzle takes a long time to read.
The solution involves recursive functions that read through the packets and subpackets in turn.
My approach takes the bits and throws them away as they are processed, until there are none left (or, for sub-packets, if we have finished parsing the requisite number).&lt;/p&gt;
&lt;p&gt;We are working between bases here, so you want a couple of utility functions to convert to and from integers.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;to_bits &amp;lt;- function(x) {
  ints &amp;lt;- strtoi(strsplit(x, &amp;#39;&amp;#39;)[[1]], 16)
  bits &amp;lt;- sapply(ints, \(n) tail(rev(as.numeric(intToBits(n))), 4))
  as.vector(bits)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Unfortunately, &lt;code&gt;strtoi&lt;/code&gt; is not your friend for the binary-to-integer conversion, because it will almost surely silently introduce integer overflow on your main input data.
Here’s one I prepared earlier that uses floating point numbers so it won’t overflow.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;binary_to_int &amp;lt;- function(x) {
  sum(x * 2 ^ rev(seq_along(x) - 1))
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Now here’s the main recursion.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;packet_versions &amp;lt;- function(bits, depth = 0, rem_subs = Inf, eval = FALSE) {
  acc &amp;lt;- 0
  while (any(bits &amp;gt; 0) &amp;amp; rem_subs &amp;gt; 0) {
    rem_subs &amp;lt;- rem_subs - 1
    version &amp;lt;- binary_to_int(bits[1:3])
    acc &amp;lt;- acc + version
    type &amp;lt;- binary_to_int(bits[4:6])
    bits &amp;lt;- tail(bits, -6)
    if (type == 4) { # literal value
      n_groups &amp;lt;- which.min(bits[seq(1, length(bits), 5)])
      sub &amp;lt;- head(bits, n_groups * 5)
      sub &amp;lt;- sub[(seq_along(sub) - 1) %% 5 &amp;gt; 0]
      # literal_value &amp;lt;- binary_to_int(sub)
      bits &amp;lt;- tail(bits, -n_groups * 5)
      next
    }
    # Operator mode:
    lentype &amp;lt;- bits[1]
    bits &amp;lt;- bits[-1]
    if (lentype == 0) {
      sub_length &amp;lt;- binary_to_int(bits[1:15])
      bits &amp;lt;- tail(bits, -15)
      sub  &amp;lt;- head(bits, sub_length)
      acc &amp;lt;- acc + packet_versions(sub, depth + 1)[[&amp;#39;acc&amp;#39;]]
      bits &amp;lt;- tail(bits, -sub_length)
    } else {
      n_subs &amp;lt;- binary_to_int(bits[1:11])
      bits &amp;lt;- tail(bits, -11)
      sub_result &amp;lt;- packet_versions(bits, depth + 1, n_subs)
      acc &amp;lt;- acc + sub_result[[&amp;#39;acc&amp;#39;]]
      bits &amp;lt;- tail(bits, sub_result[[&amp;#39;length&amp;#39;]])
    }
  }
  if (depth)
    acc &amp;lt;- c(acc = acc, length = length(bits))
  acc
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Be careful with length type ID 1, because you need to save the number of bits you’ve parsed and then send this number back to the main function.
Similarly, it’s a good idea to keep track of how deep in the recursion you are at any given time.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;evaluation&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Evaluation&lt;/h3&gt;
&lt;p&gt;The second part is tricky. I decided to adapt my function from part one to generate syntactically-valid R expressions, so that final step is simply evaluating machine-generated code.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;packet_decode &amp;lt;- function(bits, depth = 0, rem_subs = Inf) {
  acc &amp;lt;- NULL
  while (any(bits &amp;gt; 0) &amp;amp; rem_subs &amp;gt; 0) {
    rem_subs &amp;lt;- rem_subs - 1
    type &amp;lt;- binary_to_int(bits[4:6])
    bits &amp;lt;- tail(bits, -6)
    op &amp;lt;- c(&amp;#39;sum&amp;#39;, &amp;#39;prod&amp;#39;, &amp;#39;min&amp;#39;, &amp;#39;max&amp;#39;, &amp;#39;c&amp;#39;, &amp;#39;`&amp;gt;`&amp;#39;, &amp;#39;`&amp;lt;`&amp;#39;, &amp;#39;`==`&amp;#39;)[type + 1]
    if (type == 4) { # literal value
      n_groups &amp;lt;- which.min(bits[seq(1, length(bits), 5)])
      sub &amp;lt;- head(bits, n_groups * 5)
      sub &amp;lt;- sub[(seq_along(sub) - 1) %% 5 &amp;gt; 0]
      literal_value &amp;lt;- binary_to_int(sub)
      acc$expr &amp;lt;- c(acc$expr, literal_value)
      bits &amp;lt;- tail(bits, -n_groups * 5)
      next
    }
    # Operator mode:
    lentype &amp;lt;- bits[1]
    bits &amp;lt;- bits[-1]
    if (lentype == 0) {
      sub_length &amp;lt;- binary_to_int(bits[1:15])
      bits &amp;lt;- tail(bits, -15)
      sub  &amp;lt;- head(bits, sub_length)
      sub_result &amp;lt;- packet_decode(sub, depth + 1)
      subexpr &amp;lt;- c(op, sub_result[[&amp;#39;expr&amp;#39;]])
      acc$expr &amp;lt;- c(acc$expr, list(subexpr))
      bits &amp;lt;- tail(bits, -sub_length)
    } else {
      n_subs &amp;lt;- binary_to_int(bits[1:11])
      bits &amp;lt;- tail(bits, -11)
      sub_result &amp;lt;- packet_decode(bits, depth + 1, n_subs)
      subexpr &amp;lt;- c(op, sub_result[[&amp;#39;expr&amp;#39;]])
      acc$expr &amp;lt;- c(acc$expr, list(subexpr))
      bits &amp;lt;- tail(bits, sub_result[[&amp;#39;length&amp;#39;]])
    }
  }
  if (depth)
    acc$length &amp;lt;- length(bits)
  acc
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;The structure of the function is essentially the same, and the result is a deeply nested list representing the hierarchical tree of expressions.
From here we want to convert it from a tree into some code, and the function &lt;code&gt;combine_expr&lt;/code&gt; does this for us:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;combine_expr &amp;lt;- function(node, eval = FALSE) {
  if (length(node) == 1)
    return(node)
  expr &amp;lt;- sprintf(&amp;#39;%s(%s)&amp;#39;, node[1], paste(node[-1], collapse = &amp;#39;, &amp;#39;))
  if (!eval)
    return(expr)
  eval(str2expression(expr))
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;However, it will only work on leaves of the tree.
How can we correctly operate on the entire tree and turn it into a single expression?
That requires more recursion.
Annoyingly, the function &lt;code&gt;rapply&lt;/code&gt; doesn’t quite do what’s needed, so we introduce yet another function, called &lt;code&gt;packet_parse&lt;/code&gt;:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;packet_parse &amp;lt;- function(tree, eval = FALSE) {
  if (!is.list(tree))
    return(combine_expr(tree, eval))
  expr &amp;lt;- packet_parse(unlist(lapply(tree, packet_parse, eval), use.names = F))
  if (eval &amp;amp; is.character(expr))
    return(eval(parse(text = expr)))
  expr
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;You can choose to view the expression, or evaluate it.
Here is my final expression generated by &lt;code&gt;packet_parse&lt;/code&gt;:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;sum(prod(425542, `&amp;lt;`(247, 247)), sum(121, 21236), prod(`&amp;gt;`(sum(11, 12, 11), sum(7, 10, 7)), 32566), prod(`&amp;lt;`(sum(8, 7, 15), sum(6, 11, 10)), 4507180), min(prod(prod(sum(prod(max(prod(min(prod(min(prod(max(sum(sum(max(sum(sum(min(prod(prod(130)))))))))))))))))))), 139930778832, prod(`&amp;gt;`(52, 667118), 10), 602147, max(62199), prod(14849899, `&amp;lt;`(11716, 26963)), prod(4083, `&amp;gt;`(135, 135)), prod(135, 217, 224), 73, prod(sum(13, 4, 9), sum(12, 15, 7), sum(13, 10, 9)), min(194), prod(182, 197, 136, 2, 242), prod(226, 142, 34, 124), max(4025, 186042), min(30059, 126119002), min(9, 260, 162), prod(`&amp;lt;`(4, 4), 28699), prod(1945, `==`(1714, 1714)), prod(7, `&amp;lt;`(1545, 108)), sum(12), prod(200, `&amp;gt;`(31050, 655605)), 3154, prod(3, `&amp;lt;`(64896, 116)), 3055, prod(13), min(48082, 226938, 1175, 68077774919), sum(66, 15, 181, 1380642642, 11831587), prod(241, 59), prod(150, `&amp;gt;`(2742, 113)), 37007908601, max(52444, 11, 13008816, 2935), 20723, 8, prod(5, `&amp;gt;`(6241732, 759708)), sum(prod(15, 7, 4), prod(14, 2, 12), prod(13, 6, 6)), sum(2877, 229333, 655820, 1020971), sum(39581, 2, 14), max(982557, 44, 31), 68, prod(`==`(11530, 3492), 41177), prod(`==`(236, 918711093), 3937), max(903466, 228, 6, 25989131, 4028), 229, min(299875, 10969849, 11481, 2281, 13), prod(55300721, `&amp;gt;`(63, 63)), prod(244, `&amp;gt;`(sum(7, 13, 7), sum(12, 5, 14))), prod(4494263, `==`(sum(4, 15, 4), sum(3, 3, 14))), prod(`&amp;lt;`(45, 3307915), 58514), prod(3596530693, `&amp;lt;`(sum(3, 12, 4), sum(9, 11, 2))))&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Which yields the answer &lt;code&gt;184487454837&lt;/code&gt; when evaluated.&lt;/p&gt;
&lt;/div&gt;
&lt;/div&gt;
&lt;div id=&#34;day17&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 17 - &lt;a href=&#34;https://adventofcode.com/2021/day/15&#34;&gt;Trick Shot&lt;/a&gt;&lt;/h2&gt;
&lt;p&gt;A little bit of secondary-school mathematics can help your search for the highest trajectory, and for the total number of trajectories.
Key is that the &lt;span class=&#34;math inline&#34;&gt;\(x\)&lt;/span&gt; and &lt;span class=&#34;math inline&#34;&gt;\(y\)&lt;/span&gt; movements are essentially independent.&lt;/p&gt;
&lt;p&gt;Remember the formula
&lt;span class=&#34;math display&#34;&gt;\[
v = u + at
\]&lt;/span&gt;
gives velocity &lt;span class=&#34;math inline&#34;&gt;\(v\)&lt;/span&gt; at time &lt;span class=&#34;math inline&#34;&gt;\(t\)&lt;/span&gt; for initial velocity &lt;span class=&#34;math inline&#34;&gt;\(u\)&lt;/span&gt; and average acceleration &lt;span class=&#34;math inline&#34;&gt;\(a\)&lt;/span&gt;.
How long does it take to reach the peak?
Rearranging and plugging in values:
&lt;span class=&#34;math display&#34;&gt;\[t = \frac{v - u} a = \frac{0 - u}{-1} = u,\]&lt;/span&gt;
which tells us that the probe launched with vertical velocity &lt;span class=&#34;math inline&#34;&gt;\(u\)&lt;/span&gt; &lt;em&gt;always&lt;/em&gt; reaches its peak at time &lt;span class=&#34;math inline&#34;&gt;\(t = u\)&lt;/span&gt; (except if pointed downwards: then its highest point is the launch position 0).
At that time, the sum of the arithmetic progression is
&lt;span class=&#34;math display&#34;&gt;\[
x = \frac{t}2 \Bigl(2u + (t - 1)a\Bigr) = u^2 + \frac{u - u^2}2 = \frac{u(u+1)}{2},
\]&lt;/span&gt;
for any launch velocity &lt;span class=&#34;math inline&#34;&gt;\(u\)&lt;/span&gt;.
Hence, the peak of the curve is always &lt;span class=&#34;math inline&#34;&gt;\(\max\{0, u_y(u_y + 1) / 2\}\)&lt;/span&gt; where &lt;span class=&#34;math inline&#34;&gt;\(u_y\)&lt;/span&gt; is the vertical component of &lt;span class=&#34;math inline&#34;&gt;\(u\)&lt;/span&gt;.&lt;/p&gt;
&lt;p&gt;Other insights to narrow the search space:&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;&lt;p&gt;At time &lt;span class=&#34;math inline&#34;&gt;\(t\)&lt;/span&gt;, the probe is at position &lt;span class=&#34;math display&#34;&gt;\[x = \frac{t}2\left(2u - 1+t)\right)\]&lt;/span&gt; (using the formula above), so there is no need to loop through successive time points.&lt;/p&gt;&lt;/li&gt;
&lt;li&gt;&lt;p&gt;Rearrange that formula to get the time it takes for a probe with initial velocity &lt;span class=&#34;math inline&#34;&gt;\(u\)&lt;/span&gt; to reach point &lt;span class=&#34;math inline&#34;&gt;\(x\)&lt;/span&gt;: &lt;span class=&#34;math display&#34;&gt;\[t = \frac12\left(\sqrt{4u^2+4u-8x+1} + 2u + 1\right).\]&lt;/span&gt;&lt;/p&gt;&lt;/li&gt;
&lt;li&gt;&lt;p&gt;The maximum horizontal velocity &lt;span class=&#34;math inline&#34;&gt;\(u_x\)&lt;/span&gt; is equal to the right-most edge of the target area. Any faster and the probe will immediately overshoot.&lt;/p&gt;&lt;/li&gt;
&lt;li&gt;&lt;p&gt;It takes &lt;span class=&#34;math inline&#34;&gt;\(t = u_x(u_x+1)/2\)&lt;/span&gt; time points for the probe to be slowed down by drag to zero horizontal velocity. This gives us a lower bound &lt;span class=&#34;math display&#34;&gt;\[u_x &amp;gt; \frac12 \left(\sqrt{8x_1+1} - 1\right),\]&lt;/span&gt; because if the initial velocity is any less than this then the probe will never reach the left edge of the target area.&lt;/p&gt;&lt;/li&gt;
&lt;/ul&gt;
&lt;p&gt;In the end I didn’t use all these facts, because a ‘brute force’ type search over several points seems to be fast enough and less fiddly to get the formulae right.
But it could certainly be faster if using these points.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;search_trajectories &amp;lt;- function(target, trick = TRUE) {
  max_x &amp;lt;- target[&amp;#39;x2&amp;#39;]
  min_x &amp;lt;- ceiling((sqrt(8 * target[&amp;#39;x1&amp;#39;] + 1) - 1) / 2)
  max_y &amp;lt;- -target[&amp;#39;y1&amp;#39;] - 1
  min_y &amp;lt;- target[&amp;#39;y1&amp;#39;]
  n &amp;lt;- 0
  for (y in max_y:min_y) {
    end_time &amp;lt;- time_to_reach(y, target[&amp;#39;y1&amp;#39;]) - y
    y_seq &amp;lt;- -cumsum(-y:end_time)
    if (min(y_seq) &amp;gt; target[&amp;#39;y1&amp;#39;])
      warning(&amp;#39;sequence too short for y = &amp;#39;, y)
    for (x in max_x:min_x) {
      x_seq &amp;lt;- cumsum(x:0)
      if (x &amp;lt; end_time + y) {
        x_seq &amp;lt;- c(x_seq, rep(x_seq[x], end_time + y - x))
      } else x_seq &amp;lt;- head(x_seq, end_time + y + 1)
      if (any(x_seq &amp;gt;= target[&amp;#39;x1&amp;#39;] &amp;amp; x_seq &amp;lt;= target[&amp;#39;x2&amp;#39;] &amp;amp;
              y_seq &amp;gt;= target[&amp;#39;y1&amp;#39;] &amp;amp; y_seq &amp;lt;= target[&amp;#39;y2&amp;#39;])) {
        if (trick)
          return(y * (y + 1) / 2)
        n &amp;lt;- n + 1
      }
    }
  }
  n
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;In principle—though I couldn’t quite get it to work—we could avoid the loops by calculating the times it takes the probe’s &lt;span class=&#34;math inline&#34;&gt;\(y\)&lt;/span&gt;-position to reach the top/bottom of the target area, using the &lt;code&gt;time_to_reach&lt;/code&gt; formula.
Then plug those times into the position formula to see if the &lt;span class=&#34;math inline&#34;&gt;\(x\)&lt;/span&gt;-coordinate is also within the target area at those times.
If so, then it hits the target.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;position &amp;lt;- function(u, t) {
  t / 2 * (2 * u + (t - 1) * -1)
}

time_to_reach &amp;lt;- function(u, x) {
  round(1/2 * (sqrt(4 * u^2 + 4 * u - 8 * x) + 2 * u + 1))
}&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;div id=&#34;day18&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 18 - &lt;a href=&#34;https://adventofcode.com/2021/day/18&#34;&gt;Snailfish&lt;/a&gt;&lt;/h2&gt;
&lt;div id=&#34;reduction&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Reduction&lt;/h3&gt;
&lt;p&gt;I decided (for better or for worse) to convert the square brackets into &lt;code&gt;list(...)&lt;/code&gt; expressions, then parse the input as nested lists.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;read_sf &amp;lt;- function(input) {
    out &amp;lt;- lapply(input, function(string) {
        expr &amp;lt;- gsub(&amp;#39;\\]&amp;#39;, &amp;#39;)&amp;#39;, gsub(&amp;#39;\\[&amp;#39;, &amp;#39;list(&amp;#39;, string))
        eval(parse(text = expr))
    })
    if (length(out) == 1) return(unlist(out, FALSE)) else out
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then we need to perform the reductions on our list structures.
Splitting is easy, but it’s important that we split only the first node we find and then stop.
I used a counter called &lt;code&gt;done&lt;/code&gt; to ensure the &lt;code&gt;rapply&lt;/code&gt; loop terminates early.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;sf_split &amp;lt;- function(lst) {
    done &amp;lt;- FALSE
    rapply(lst, \(n) {
        if (n &amp;lt;= 9 | done) return(n)
        done &amp;lt;&amp;lt;- TRUE
        list(floor(n / 2), ceiling(n / 2))
    }, how = &amp;#39;replace&amp;#39;)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;To explode, it’s a bit trickier because you need several nodes to interact with one another.
I wrote some recursive functions to find the depth of the list, to mark the appropriate node with an &lt;code&gt;NA&lt;/code&gt; and then to replace it.&lt;/p&gt;
&lt;p&gt;I also discovered the &lt;code&gt;relist&lt;/code&gt; function, which makes it possible to flatten a list, do some vector operations (handy for getting the indices just before and after our exploded pair) and then return the data to the original nested structure.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;depths &amp;lt;- function(lst, depth = 0) {
    if (!is.list(lst)) return(depth)
    unlist(sapply(lst, depths, depth + 1))
}

replaceNA &amp;lt;- function(lst, replacement) {
    if (all(is.na(lst))) return(replacement)
    if (!is.list(lst)) return(lst)
    lapply(lst, replaceNA, replacement)
}

sf_explode &amp;lt;- function(lst) {
    i &amp;lt;- which(depths(lst) &amp;gt; 4)
    L &amp;lt;- i[1]; R &amp;lt;- i[2]
    x &amp;lt;- unlist(lst)
    if (L &amp;gt; 1)
        x[L - 1] &amp;lt;- x[L - 1] + x[L]
    if (R &amp;lt; length(x))
        x[R + 1] &amp;lt;- x[R] + x[R + 1]
    x[c(L, R)] &amp;lt;- NA
    replaceNA(relist(x, lst), 0)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then we put it all together as reduce operations.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;sf_reduce &amp;lt;- function(lst) {
    Reduce(\(a, b) list(sf_reduce1(a), b), lst) |&amp;gt; sf_reduce1()
}

sf_reduce1 &amp;lt;- function(lst) {
    if (max(depths(lst)) &amp;gt; 4) lst &amp;lt;- Recall(sf_explode(lst))
    if (any(unlist(lst) &amp;gt; 9)) lst &amp;lt;- Recall(sf_split(lst))
    lst
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;If you try to reduce the whole list in one operation, you’ll definitely get a stack overflow with the larger input datasets.
Thus it’s important to reduce from the left until it’s as simple as possible, then combine it with the next line.&lt;/p&gt;
&lt;p&gt;My code is quite slow; it might be more sensible to rewrite this as a &lt;code&gt;repeat&lt;/code&gt; loop rather than doing all this recursion.&lt;/p&gt;
&lt;p&gt;Finally, calculate the magnitude.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;magnitude &amp;lt;- function(lst) {
    if (!is.list(lst)) return(lst)
    Reduce(\(a, b) 3 * magnitude(a) + 2 * magnitude(b), lst)
}&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;div id=&#34;pairs&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Pairs&lt;/h3&gt;
&lt;p&gt;There might be a clever way of finding the biggest pair but I use brute force:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;combos &amp;lt;- t(combn(length(input), 2))
combos &amp;lt;- rbind(combos, combos[, 2:1])
magnitudes &amp;lt;- apply(combos, 1, \(i) magnitude(sf_reduce(input[i])))
max(magnitudes)&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;/div&gt;
&lt;div id=&#34;day19&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 19 - &lt;a href=&#34;https://adventofcode.com/2021/day/19&#34;&gt;Beacon Scanner&lt;/a&gt;&lt;/h2&gt;
&lt;div id=&#34;transformers&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Transformers&lt;/h3&gt;
&lt;p&gt;This was the hardest problem yet.
There were a few ideas I had about how to solve the problem quickly, possibly without even having to find any of the actual coordinates.
However, I could not work out how to implement them in the end and resorted to the ‘slow’ way: iterating through the scanners one by one and trying the rotations and reflections in turn until they fit into place.&lt;/p&gt;
&lt;p&gt;One key insight is that pairwise Euclidean distances &lt;em&gt;within&lt;/em&gt; a scanner’s beacons are invariant to translations and rotations.
Thus, if we compute within-scanner distance matrix for each one, we know that adjacent scanners must have at least &lt;span class=&#34;math inline&#34;&gt;\(12 * (12 - 1) / 2 = 66\)&lt;/span&gt; distance pairs in common.
This is a good way to set up the initial search strategy.&lt;/p&gt;
&lt;p&gt;&lt;a href=&#34;https://twitter.com/drob/status/1472748122275291137&#34;&gt;David Robinson&lt;/a&gt; offers a neat solution which finds the rotations and reflections mathematically, rather than by trial and error.&lt;/p&gt;
&lt;p&gt;The clever solution, which I suspect I had been looking for but never quite reached, is to think like a statistician should, and &lt;a href=&#34;https://twitter.com/mccorvie/status/1472684849123102720&#34;&gt;find the transformations using linear regression&lt;/a&gt;.
Thanks to Ryan McCorvie.&lt;/p&gt;
&lt;p&gt;Whatever method you go for, read in the data, with judicious handling of &lt;code&gt;NA&lt;/code&gt;s to divide up the scanners.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;read_scanners &amp;lt;- function(file) {
  input &amp;lt;- read.csv(file, header = FALSE, col.names = c(&amp;#39;x&amp;#39;, &amp;#39;y&amp;#39;, &amp;#39;z&amp;#39;))
  input$scanner &amp;lt;- cumsum(is.na(input$z))
  type.convert(na.omit(input), as.is = TRUE)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Here is an initial solution, partly inspired by &lt;a href=&#34;https://twitter.com/ashbaldry_/status/1472566622535798785&#34;&gt;Ashley Baldry&lt;/a&gt;.
Generate copies of every scanner’s beacons in the various orientations.
There are supposed to be 24 different transformations but I ended up with 48.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;orientate_scanners &amp;lt;- function(input) {
  mirror &amp;lt;- expand.grid(x = c(1, -1), y = c(1, -1), z = c(1, -1))
  rotate &amp;lt;- expand.grid(x = 1:3, y = 1:3, z = 1:3)
  rotate &amp;lt;- rotate[apply(rotate, 1, \(x) length(unique(x)) == 3), ]
  lapply(split(input, input$scanner), function(s) {
    s &amp;lt;- as.matrix(s)[, 1:3]
    apply(rotate, 1, \(r) s[, r], simplify = F) |&amp;gt;
      lapply(\(m) apply(mirror, 1, \(r) sweep(m, 2, r, &amp;#39;*&amp;#39;), simplify = F)) |&amp;gt;
      unlist(recursive = F, use.names = F)
  })
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then loop through the scanners and keep rotating them until the &lt;em&gt;between-scanner&lt;/em&gt; distance matrix contains ≥12 common distances, implying that the beacons are in the right orientation and just need translating (by this distance).&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;locate_scanners &amp;lt;- function(input) {
  scanners &amp;lt;- orientate_scanners(input)
  scanner_coords &amp;lt;- rep(0, 3)
  beacons &amp;lt;- scanners[[1]][[1]]
  scanners &amp;lt;- scanners[-1]
  while (length(scanners)) {
    for (scanner in scanners) {
      done &amp;lt;- FALSE
      for (orientation in scanner) {
        dtbl &amp;lt;- table(dist2(orientation, beacons))
        if (any(dtbl &amp;gt;= 12)) {
          done &amp;lt;- TRUE
          break
        }
      }
      if (!done) next
      scanners &amp;lt;- setdiff(scanners, list(scanner))
      trans &amp;lt;- names(dtbl)[dtbl &amp;gt;= 12]
      trans &amp;lt;- scan(textConnection(trans), quiet = TRUE)
      scanner_coords &amp;lt;- rbind(scanner_coords, trans)
      beacons &amp;lt;- unique(rbind(beacons, sweep(orientation, 2, trans, &amp;#39;+&amp;#39;)))
    }
  }
  list(beacons = beacons, scanners = scanner_coords)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;The helper function &lt;code&gt;dist2&lt;/code&gt; stores the multi-dimensional pairwise distances as a string, and the most common one is then parsed back into a 3-vector using &lt;code&gt;scan&lt;/code&gt;.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;dist2 &amp;lt;- function(X, Y) {
  apply(X, 1, \(x) apply(Y, 1, \(y) paste(y - x, collapse = &amp;#39; &amp;#39;)))
}&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;div id=&#34;linear-regression&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Linear regression&lt;/h3&gt;
&lt;p&gt;It’s not particularly satisfactory having a solution that takes over 10 seconds to run for part one, and systematically checking every rotation and reflection seems rather too much like brute force.&lt;/p&gt;
&lt;p&gt;The next day, I refactored Ryan McCorvie’s linear regression solution as follows.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;read_scanners &amp;lt;- function(file) {
  input &amp;lt;- read.csv(file, header = FALSE, col.names = c(&amp;#39;x&amp;#39;, &amp;#39;y&amp;#39;, &amp;#39;z&amp;#39;))
  split(input, cumsum(is.na(input$z))) |&amp;gt;
    lapply(&amp;#39;[&amp;#39;, -1, ) |&amp;gt;
    lapply(type.convert, as.is = TRUE)
}
scanners &amp;lt;- read_scanners(input_file(19))

# Compute pairwise distances among beacons *within* each scanner.
distances &amp;lt;- lapply(scanners, dist)

# How many such distances does each pair of scanners have in common?
similarity &amp;lt;- combn(distances, 2, \(x) Reduce(intersect, x), simplify = F)

# Using this information, which scanners appear to overlap?
overlaps &amp;lt;- lengths(similarity) &amp;gt;= 12 * (12 - 1) / 2

# Just keep those pairs.
similarity &amp;lt;- similarity[overlaps &amp;gt; 0]

# But it helps if we can remember which they are.
pairs &amp;lt;- t(combn(length(scanners), 2)[, overlaps &amp;gt; 0])

# Match up those beacons that two scanners have in common.
match_beacons &amp;lt;- function(s1, s2) {
  m1 &amp;lt;- as.matrix(distances[[s1]])
  m2 &amp;lt;- as.matrix(distances[[s2]])
  matching &amp;lt;- c()
  for (j1 in 1:ncol(m1)) {
    done &amp;lt;- FALSE
    for (j2 in 1:ncol(m2)) {
      if (length(intersect(m1[, j1], m2[, j2])) &amp;gt;= 12) {
        matching &amp;lt;- rbind(matching, cbind(s1 = j1, s2 = j2))
        done &amp;lt;- TRUE
        break
      }
    }
    if (done) next
  }
  matching
}

# For two scanners, how can we orientate the 2nd to match the 1st?
align_scanners &amp;lt;- function(s1, s2) {
  match &amp;lt;- match_beacons(s1, s2)

  # Time for a bit of linear regression!
  LHS &amp;lt;- scanners[[s1]][match[, &amp;#39;s1&amp;#39;], , drop = F]
  RHS &amp;lt;- scanners[[s2]][match[, &amp;#39;s2&amp;#39;], , drop = F]
  lm_x &amp;lt;- lm(LHS$x ~ x + y + z, RHS)
  lm_y &amp;lt;- lm(LHS$y ~ x + y + z, RHS)
  lm_z &amp;lt;- lm(LHS$z ~ x + y + z, RHS)
  
  # The predictions gives the beacon coordinates.
  beacon_coords &amp;lt;- as.data.frame(apply(cbind(
    x = predict(lm_x, scanners[[s2]]),
    y = predict(lm_y, scanners[[s2]]),
    z = predict(lm_z, scanners[[s2]])), 2, round))

  # The model intercept is the translation / the scanner position!
  scanner_coords &amp;lt;- apply(cbind(x = coef(lm_x)[1],
                                y = coef(lm_y)[1],
                                z = coef(lm_z)[1]), 2, round)

  # Globally update
  scanners[[s2]] &amp;lt;&amp;lt;- beacon_coords
  beacons &amp;lt;&amp;lt;- unique(rbind(beacons, beacon_coords))
  scanner_locations &amp;lt;&amp;lt;- rbind(scanner_locations, scanner_coords)
}

# Do the search.
found &amp;lt;- 1
to_find &amp;lt;- 2:length(scanners)
scanner_locations &amp;lt;- c(0, 0, 0)
beacons &amp;lt;- scanners[[1]]
while (length(to_find)) {
  overlaps_with_found &amp;lt;- pairs[xor(pairs[, 1] %in% found,
                                   pairs[, 2] %in% found), , drop = F]
  for (i in 1:nrow(overlaps_with_found)) {
    # Let s1 be the already-aligned scanner.
    s1 &amp;lt;- intersect(overlaps_with_found[i, ], found)
    if (length(s1) &amp;gt; 1) next
    s2 &amp;lt;- setdiff(overlaps_with_found[i, ], s1)
    message(&amp;#39;Joining &amp;#39;, s1, &amp;#39; and &amp;#39;, s2)
    align_scanners(s1, s2)
    found &amp;lt;- c(found, s2)
    to_find &amp;lt;- setdiff(to_find, found)
  }
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;As well as being elegant, it’s also &lt;em&gt;far&lt;/em&gt; quicker than my initial approach.
You can see &lt;a href=&#34;https://github.com/mccorvie/advent-of-code-2021/blob/main/Dec%2019%20Beacon%20Scanner.R&#34;&gt;Ryan’s original code on GitHub&lt;/a&gt;.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;manhattan-distance&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Manhattan distance&lt;/h3&gt;
&lt;p&gt;Part two, assuming you’ve been keeping track of the scanner locations or translations, is a one-liner.
Distance matrices are a built-in feature of R!&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;max(dist(result$scanners, &amp;#39;manhattan&amp;#39;))&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;/div&gt;
&lt;div id=&#34;day20&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 20 - &lt;a href=&#34;https://adventofcode.com/2021/day/20&#34;&gt;Trench Map&lt;/a&gt;&lt;/h2&gt;
&lt;p&gt;My test-driven development strategy was caught out here because there are some key qualities of the test dataset that are not found in any of the examples given in the puzzle description.&lt;/p&gt;
&lt;p&gt;Eric repeatedly emphasizes that the image space is meant to be &lt;em&gt;infinite&lt;/em&gt;, but it’s easy to overlook this and assume it just means the output image will be larger in size than the input image, possibly with coordinate indices below zero.&lt;/p&gt;
&lt;p&gt;Firstly, read in the data.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;read_pixels &amp;lt;- function(file) {
  input &amp;lt;- readLines(file)
  algorithm &amp;lt;- strsplit(input[1], &amp;#39;&amp;#39;)[[1]] == &amp;#39;#&amp;#39;
  img &amp;lt;- do.call(rbind, strsplit(tail(input, -2), &amp;#39;&amp;#39;)) == &amp;#39;#&amp;#39;
  list(image = img, algorithm = algorithm)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;This produces a logical matrix as the input image and a logical vector (of length 512) for the algorithm.
Next, we need a way of finding the codes from each pixel’s neighbours.
Here is my neat vectorized solution.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;binary_neighbours_to_int &amp;lt;- function(x, pad = 0) {
    I &amp;lt;- nrow(x)
    J &amp;lt;- ncol(x)
    . &amp;lt;- pad
    2^8 * rbind(., cbind(., x[-I, -J])) +    # NW
      2^7 * rbind(., x[-I, ]) +              # N
      2^6 * rbind(., cbind(x[-I, -1], .)) +  # NE
      2^5 * cbind(., x[, -J]) +              # W
      2^4 * x +                              # .
      2^3 * cbind(x[, -1], .) +              # E
      2^2 * rbind(cbind(., x[-1, -J]), .) +  # SW
      2^1 * rbind(x[-1, ], .) +              # S
      2^0 * rbind(cbind(x[-1, -1], .), .)    # SE
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Now we need to run the algorithm itself.
At this point you’ll come up against something that’s easy to overlook: the two end bits of the algorithm.
In the example data, &lt;code&gt;algorithm[1]&lt;/code&gt; is equal to zero, so any isolated dark pixels (without any neighbours) that would have a neighbour-sum of zero remain dark.&lt;/p&gt;
&lt;p&gt;However, in the test dataset, we have &lt;code&gt;algorithm[1] = 1&lt;/code&gt;, which means any empty areas are completely filled (on odd iterations).
Combine this with the fact that &lt;code&gt;algorithm[512] = 0&lt;/code&gt;, which switches those pixels off again on every second step.&lt;/p&gt;
&lt;p&gt;In fact, it’s not possible for anybody’s puzzle input to have both end bits equal to 1, because then the number of light pixels would be infinite after every single image enhancement step.&lt;/p&gt;
&lt;p&gt;How do we use this information?
By padding out the image area with the appropriate values—1s or 0s—to model the interaction of the borders of the ‘interesting’ part of the image with the surrounding infinite canvas.
There’s no need to count up the pixels we can’t see (since there are infinitely many of them), but we need to anticipate new ones joining the image as it grows.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;enhance_image &amp;lt;- function(image, algorithm, n = 1) {
  . &amp;lt;- algorithm[1]
  for (i in 1:n) {
    if (algorithm[1]) . &amp;lt;- !.
    image &amp;lt;- b &amp;lt;- binary_neighbours_to_int(
      cbind(., ., rbind(., ., image, ., .), ., .), pad = .)
    image[] &amp;lt;- algorithm[b + 1]
  }
  image
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;The argument &lt;code&gt;pad&lt;/code&gt; (which in the main function is abbreviated to &lt;code&gt;.&lt;/code&gt; for readability) alternates between &lt;code&gt;0&lt;/code&gt; and &lt;code&gt;1&lt;/code&gt; each step, if (and only if) the first bit of &lt;code&gt;algorithm&lt;/code&gt; is equal to 1, which triggers this switching behaviour.&lt;/p&gt;
&lt;p&gt;It might seem like a lot of matrix operations but &lt;code&gt;enhance_image()&lt;/code&gt; completes all 50 steps in less than 200 milliseconds.&lt;/p&gt;
&lt;p&gt;The final answer is just the &lt;code&gt;sum()&lt;/code&gt; of the output image.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;day21&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 21 - &lt;a href=&#34;https://adventofcode.com/2021/day/21&#34;&gt;Dirac Dice&lt;/a&gt;&lt;/h2&gt;
&lt;div id=&#34;deterministic-dice&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Deterministic dice&lt;/h3&gt;
&lt;p&gt;For part one, we simply have to play the game.
Just write a &lt;code&gt;while&lt;/code&gt; or &lt;code&gt;repeat&lt;/code&gt; loop to keep going until someone achieves a score of 1000.
The following code is more verbose than it needs to be:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;deterministic_dice &amp;lt;- function(player1, player2) {
  score1 &amp;lt;- score2 &amp;lt;- nrolls &amp;lt;- 0
  dice &amp;lt;- 1:3
  repeat {
    player1 &amp;lt;- (player1 + sum(dice) - 1) %% 10 + 1
    score1 &amp;lt;- score1 + player1
    nrolls &amp;lt;- nrolls + 3
    if (score1 &amp;gt;= 1000) break

    player2 &amp;lt;- (player2 + sum(dice + 3) - 1) %% 10 + 1
    score2 &amp;lt;- score2 + player2
    nrolls &amp;lt;- nrolls + 3
    if (score2 &amp;gt;= 1000) break

    dice &amp;lt;- (dice + 6 - 1) %% 100 + 1
  }
  prod(nrolls, min(score1, score2))
}&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;div id=&#34;quantum-states&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Quantum states&lt;/h3&gt;
&lt;p&gt;Part two calls for recursion, and with some optimization if you want your code to run in any reasonable time frame.
This means that at every opportunity, if there is room to ignore or delete universes that are redundant, we should do so.&lt;/p&gt;
&lt;p&gt;Each player is still rolling the die three times, but there are only 7 possible unique sums of the values 1, 2 and 3:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;rolls &amp;lt;- table(rowSums(expand.grid(1:3, 1:3, 1:3)))
rolls &amp;lt;- mapply(c, sum = as.numeric(names(rolls)), n = rolls, SIMPLIFY = F)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then, at each set of rolls, we recursively count up the number of wins associated with each player for the sum of those rolls.
We only need one function to do this: for player 2’s wins, we can just swap the players and accumulated scores around and pretend that player 2 is now player 1.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;dirac_dice &amp;lt;- function(player1, player2) {
  count_wins &amp;lt;- memoise::memoise(
    function(player1, player2, score1, score2) {
      Reduce(
        \(wins, roll) {
          player1 &amp;lt;- (player1 + roll[&amp;#39;sum&amp;#39;] - 1) %% 10 + 1
          score1 &amp;lt;- score1 + player1
          if (score1 &amp;gt;= 21) {
            return(wins + c(roll[&amp;#39;n&amp;#39;], 0))
          } else
            wins + roll[&amp;#39;n&amp;#39;] *
            rev(count_wins(player2, player1, score2, score1))
        },
        rolls,
        init = c(w1 = 0, w2 = 0))
    })
  max(count_wins(player1, player2, 0, 0))
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;To avoid revisiting universes, some caching is useful, so we can look up the value of any function call that has already been made.
You could store and look up these results in a named vector, or you could do it the lazy way like I did and use the package &lt;strong&gt;memoise&lt;/strong&gt;, which simply does this for you behind the scenes.&lt;/p&gt;
&lt;p&gt;My code takes about two minutes to run for part two.
Not quick, but R isn’t very fast at recursive function calls.&lt;/p&gt;
&lt;/div&gt;
&lt;/div&gt;
&lt;div id=&#34;day22&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 22 - &lt;a href=&#34;https://adventofcode.com/2021/day/22&#34;&gt;Reactor Reboot&lt;/a&gt;&lt;/h2&gt;
&lt;p&gt;On day 22, it’s pretty obvious from the outset that the ‘obvious’ solution to part one—explicitly keeping track of all the cubes—is not going to work at all when the problem scales up for part two.&lt;/p&gt;
&lt;p&gt;I won’t even bother to show the ‘slow’ method here, and we can focus on the scalable solution.
Rather than look after one row for every cube (or at least every switched-on cube) in the reactor, we need to store the boundaries of the cuboids only, in a similar format to how they are given in the input.&lt;/p&gt;
&lt;p&gt;The tricky part here is that the union or difference of two overlapping cuboids (or more generally, 3-dimensional intervals) cannot, in general be described as two cuboids: the new shape is non-convex.&lt;/p&gt;
&lt;p&gt;What we need to do is partition the two input cuboids into a several smaller non-overlapping ones, and then do the union operation (making sure not to double-count the intersection) or the set-difference operation (subtracting the intersection from the first cuboid).&lt;/p&gt;
&lt;p&gt;For example, consider, in two dimensions, two cuboids &lt;code&gt;A&lt;/code&gt; and &lt;code&gt;B&lt;/code&gt;:&lt;/p&gt;
&lt;pre&gt;&lt;code&gt; ________           ____             ___              ____           ___
| A   __|____      | A1|   ____     |__| } A2        | A1|   ____   |__| A3  ___
|____|__|   |  =   |___|  | B1|  +  |__| } }      =  |___|  | B1|    ___    |__| C
     |____B_|             |___|     |__|   } B2             |___|   |__| B3
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;I decided to use object-orientated programming for this, through the &lt;strong&gt;R6&lt;/strong&gt; package.
This allows me to define a new &lt;code&gt;Cuboid&lt;/code&gt; class, with fields describing the &lt;code&gt;x&lt;/code&gt;, &lt;code&gt;y&lt;/code&gt; and &lt;code&gt;z&lt;/code&gt; ranges, and to write methods to—if an instance of a cuboid is overlapping with another—divide the two into a set of non-overlapping ones to perform the necessary set operations.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;Cuboid &amp;lt;- R6::R6Class(&amp;#39;Cuboid&amp;#39;,
    public = list(
        x = NULL, y = NULL, z = NULL,
        initialize = function(x, y, z) {
            self$x &amp;lt;- x
            self$y &amp;lt;- y
            self$z &amp;lt;- z
        },
        volume = function() {
            (diff(self$x) + 1) *
            (diff(self$y) + 1) *
            (diff(self$z) + 1)
        },
        cubes = function() { # for debugging purposes
            expand.grid(self$x[1]:self$x[2],
                        self$y[1]:self$y[2],
                        self$z[1]:self$z[2])
        },
        is_overlapping = function(that) {
            is_overlapping(self$x, that$x) &amp;amp;&amp;amp;
            is_overlapping(self$y, that$y) &amp;amp;&amp;amp;
            is_overlapping(self$z, that$z)
        },
        remove = function(that) {
            stopifnot(is.R6(that))
            if (!self$is_overlapping(that))
              return(list(self))
            x &amp;lt;- self$x
            y &amp;lt;- self$y
            z &amp;lt;- self$z
            olx &amp;lt;- interval_intersect(x, that$x)
            oly &amp;lt;- interval_intersect(y, that$y)
            setdiff &amp;lt;- list(
                if (that$x[1] &amp;gt; x[1])
                    Cuboid$new(c(x[1], that$x[1] - 1), y, z),
                if (that$y[1] &amp;gt; y[1])
                    Cuboid$new(olx, c(y[1], that$y[1] - 1), z),
                if (that$y[2] &amp;lt; y[2])
                    Cuboid$new(olx, c(that$y[2] + 1, y[2]), z),
                if (that$z[1] &amp;gt; z[1])
                    Cuboid$new(olx, oly, c(z[1], that$z[1] - 1)),
                if (that$z[2] &amp;lt; z[2])
                    Cuboid$new(olx, oly, c(that$z[2] + 1, z[2])),
                if (that$x[2] &amp;lt; x[2])
                    Cuboid$new(c(that$x[2] + 1, x[2]), y, z)
            )
            setdiff[lengths(setdiff) &amp;gt; 0]
        }
    )
)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;We only need a &lt;code&gt;remove()&lt;/code&gt; method, because to get the union of two cuboids &lt;code&gt;A&lt;/code&gt; and &lt;code&gt;B&lt;/code&gt;, we can remove &lt;code&gt;B&lt;/code&gt; from &lt;code&gt;A&lt;/code&gt;, then add &lt;code&gt;B&lt;/code&gt; again and the intersection will only be counted once.&lt;/p&gt;
&lt;p&gt;Then our data import functions are:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;read_cubes &amp;lt;- function(file) {
    input &amp;lt;- gsub(&amp;quot;[xyz]=&amp;quot;, &amp;quot;&amp;quot;, readLines(file))
    input &amp;lt;- strsplit(input, &amp;quot;[ ,]|\\.{2}&amp;quot;)
    out &amp;lt;- type.convert(as.data.frame(do.call(rbind, input)), as.is = TRUE)
    setNames(out, c(&amp;quot;mode&amp;quot;, &amp;quot;x1&amp;quot;, &amp;quot;x2&amp;quot;, &amp;quot;y1&amp;quot;, &amp;quot;y2&amp;quot;, &amp;quot;z1&amp;quot;, &amp;quot;z2&amp;quot;))
}

cuboid_list &amp;lt;- function(reactor) {
    # Generate list of R6 &amp;#39;Cuboid&amp;#39; class objects.
    cuboids &amp;lt;- apply(reactor[, -1], 1, \(i)
        list(set = list(Cuboid$new(i[c(&amp;#39;x1&amp;#39;, &amp;#39;x2&amp;#39;)],
                                   i[c(&amp;#39;y1&amp;#39;, &amp;#39;y2&amp;#39;)],
                                   i[c(&amp;#39;z1&amp;#39;, &amp;#39;z2&amp;#39;)]))),
                                   simplify = FALSE)
    # Label with the modes.
    mapply(c, cuboids, reactor$mode, SIMPLIFY = FALSE)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;And, with the help of a few utilities:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;cuboid_setdiff &amp;lt;- function(set, x) {
  unlist(lapply(set, \(y) y$remove(x)))
}

interval_intersect &amp;lt;- function(a, b) {
    c(max(a[1], b[1]), min(a[2], b[2]))
}

is_overlapping &amp;lt;- function(a, b) {
    a[1] &amp;lt;= b[2] &amp;amp;&amp;amp; a[2] &amp;gt;= b[1]
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;We can then call our main function:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;reboot_reactor &amp;lt;- function(reactor, init = FALSE) {
    if (init)
      reactor &amp;lt;- reactor[abs(reactor$x1) &amp;lt;= 50 &amp;amp;
                         abs(reactor$x2) &amp;lt;= 50, ]
    cuboids &amp;lt;- cuboid_list(reactor)
    rebooted &amp;lt;-
        Reduce(cuboids, f = \(a, b) {
               setdiff &amp;lt;- cuboid_setdiff(a$set, b$set[[1]])
               if (b[[2]] == &amp;#39;off&amp;#39;)
                   return(list(set = setdiff))
               list(set = union(setdiff, b$set))
        })
    sum(sapply(rebooted$set, \(x) x$volume()))
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;This is surprisingly quick, at least by R standards.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;day23&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 23 - &lt;a href=&#34;https://adventofcode.com/2021/day/23&#34;&gt;Amphipod&lt;/a&gt;&lt;/h2&gt;
&lt;p&gt;Day 23 was where everything went a bit off the rails, because many people in the AoC community were able to solve the puzzle by hand without any coding.
However, some starting positions were harder to solve than others, and some people (including me) are simply not very good at puzzles like this.&lt;/p&gt;
&lt;p&gt;At that point it’s slightly dispiriting when, if you look online for hints, you don’t find any because everyone just says they solved theirs by hand.
It also, arguably, departs from a test-driven development paradigm and the idea that solutions are scalable and applicable to any input dataset.&lt;/p&gt;
&lt;p&gt;Long story short: I couldn’t solve mine by hand initially and so had to write some code!&lt;/p&gt;
&lt;p&gt;The complete program is quite long as it includes lots of tedious stuff like defining the distances between all the points on the grid and all the pathways along hallways from one amphipod room to another.
You can &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021/blob/main/R/day23.R&#34;&gt;read it in full on GitHub&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;As yesterday, I employed R6 classes to store the states, and as on the day before, used a form of caching to get rid of previously-visited or suboptimal states.
Specifically, each state describes the positions of all the amphipods, and at each step we explore all the possible states you could go to from here, and their associated costs.&lt;/p&gt;
&lt;p&gt;Here is the main loop:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;min_amphipod_energy &amp;lt;- function(start) {
  states &amp;lt;- list(start)
  best_score &amp;lt;- Inf
  while (length(states)) {
    new_states &amp;lt;- list()
    for (state in states) {
      if (is.finite(best_score))
        message(&amp;#39;Best score: &amp;#39;, best_score)
      for (move in valid_moves(state)) {
        if (move$finished) {
          best_score &amp;lt;- min(best_score, move$score)
        } else if (move$score &amp;lt; best_score) {
          if (move$key %in% names(new_states)) {
            old_score &amp;lt;- new_states[[move$key]]$score
            if (old_score &amp;gt; move$score)
              new_states[[move$key]]$score &amp;lt;- move$score
          } else new_states[[move$key]] &amp;lt;- move
        }
      }
    }
    message(&amp;#39;Exploring &amp;#39;, length(new_states), &amp;#39; new states&amp;#39;)
    states &amp;lt;- new_states
  }
  best_score
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;This relies on my custom &lt;code&gt;State&lt;/code&gt; class:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;State &amp;lt;- R6::R6Class(
  &amp;#39;State&amp;#39;,
  public = list(
    rooms = NULL,     # named vector, A1, A2, B1, B2, C1, C2, D1, D2
    hallways = NULL,  # vector of length 7. Unnamed but order is important.
    score = NULL,
    finished = NULL,
    key = NULL,
    initialize = function(rooms, hallways = NULL, score = 0) {
      self$rooms &amp;lt;- rooms
      self$hallways &amp;lt;- if(!is.null(hallways)) hallways else rep(&amp;#39;.&amp;#39;, 7)
      self$score &amp;lt;- score
      self$finished &amp;lt;- all(self$hallways == &amp;#39;.&amp;#39;) &amp;amp;&amp;amp;
        all(self$rooms == rep(LETTERS[1:4], each = length(rooms) / 4))
      self$key = paste(c(hallways, rooms), collapse = &amp;#39;,&amp;#39;)
    },
    move = function(from, to, from_hallway, score) {
      rooms &amp;lt;- self$rooms
      hallways &amp;lt;- self$hallways
      if (from_hallway) {
        rooms[to] &amp;lt;- hallways[from]
        hallways[from] &amp;lt;- &amp;#39;.&amp;#39;
      } else {
        hallways[to] &amp;lt;- rooms[from]
        rooms[from] &amp;lt;- &amp;#39;.&amp;#39;
      }
      State$new(rooms, hallways, score)
    })
)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;And the bulk of the code is in the method that enumerates all the possible valid moves from any given starting position.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;valid_moves &amp;lt;- function(state) {
  room_depth &amp;lt;- length(state$rooms) / 4
  if (room_depth == 4)
    distance &amp;lt;- distance2
  moves &amp;lt;- NULL
  for (i in seq_along(state$hallways)) {
    amphipod &amp;lt;- state$hallways[i]
    # If this spot is empty, nothing to move.
    if (amphipod == &amp;#39;.&amp;#39;)
      next
    dest &amp;lt;- paste0(amphipod, seq_len(room_depth))
    # If destination room contains other, different amphipods.
    if (any(setdiff(LETTERS[1:4], amphipod) %in% state$rooms[dest]))
      next
    # If any hallway between here and destination is blocked.
    path &amp;lt;- hallway_paths[[i]][[amphipod]]
    if (any(state$hallways[path] != &amp;#39;.&amp;#39;))
      next
    # Move to the deepest available space in destination room.
    dest &amp;lt;- dest[max(which(state$rooms[dest] == &amp;#39;.&amp;#39;))]
    score &amp;lt;- state$score + distance[i, dest] * move_cost[amphipod]
    moves &amp;lt;- c(moves, state$move(from = i,
                                 to = dest,
                                 from_hallway = TRUE,
                                 score = score))
  }
  for (i in seq_along(state$rooms)) {
    amphipod &amp;lt;- state$rooms[i]
    room_cell &amp;lt;- names(amphipod)
    room &amp;lt;- substring(room_cell, 1, 1)
    pos_in_room &amp;lt;- as.integer(substring(room_cell, 2, 2))
    # If this spot is empty, nothing to move.
    if (amphipod == &amp;#39;.&amp;#39;)
      next
    # Can&amp;#39;t leave this room if our exit is blocked by another amphipod.
    if (pos_in_room &amp;gt; 1 &amp;amp;&amp;amp; state$rooms[i - 1] != &amp;#39;.&amp;#39;)
      next
    # No point in leaving destination room except to let other types out.
    if (room == amphipod &amp;amp;&amp;amp;
        all(state$rooms[paste0(room, pos_in_room:room_depth)] == amphipod))
      next
    # Which hallway tile should we move to?
    empty_hallways &amp;lt;- which(state$hallways == &amp;#39;.&amp;#39;)
    for (h in empty_hallways) {
      if (all(hallway_paths[[h]][[room]] %in% empty_hallways)) { # not blocked
        score &amp;lt;- state$score + distance[h, room_cell] * move_cost[amphipod]
        moves &amp;lt;- c(moves, state$move(from = i,
                                     to = h,
                                     from_hallway = FALSE,
                                     score = score))
      }
    }
  }
  moves[order(sapply(moves, \(s) s$score))]
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Final solution runs in about two minutes, for both parts.
The code above works for both, with a slight tweak to the definitions of the starting position and of the &lt;code&gt;distance&lt;/code&gt; matrix for part two.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;day24&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 24 - &lt;a href=&#34;https://adventofcode.com/2021/day/24&#34;&gt;Arithmetic Logic Unit&lt;/a&gt;&lt;/h2&gt;
&lt;p&gt;You can’t brute-force your way out of this one simply by parsing the code into R syntax and evaluating it for all the &lt;span class=&#34;math inline&#34;&gt;\(9^{14}\)&lt;/span&gt; different input permutations.&lt;/p&gt;
&lt;p&gt;This was another puzzle I didn’t really like, because you can’t solve it through test-driven development (except to check the validity of your final answer).
Essentially, the whole puzzle is in the &lt;code&gt;input.txt&lt;/code&gt; file rather than the instructions on the web site.
It’s also not immediately obvious what your input dataset has in common with other people’s, so the definition of a ‘general purpose’ solution becomes quite nebulous.&lt;/p&gt;
&lt;p&gt;Peek at the &lt;code&gt;input.txt&lt;/code&gt; file and work backwards from the bottom.&lt;/p&gt;
&lt;pre&gt;&lt;code&gt;mul y 0
add y w
add y 5
mul y x
add z y&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Here the value &lt;code&gt;+5&lt;/code&gt; on the middle line will probably be different for your input (call it &lt;span class=&#34;math inline&#34;&gt;\(\delta y\)&lt;/span&gt;), but everything else should be about the same.&lt;/p&gt;
&lt;p&gt;For the programme to be valid, the final value assigned to &lt;code&gt;z&lt;/code&gt; must be equal to zero.
We have &lt;span class=&#34;math inline&#34;&gt;\(z_\text{end} \leftarrow z + y = 0\)&lt;/span&gt;.
The line &lt;code&gt;mul y 0&lt;/code&gt; resets &lt;code&gt;y&lt;/code&gt; to zero (irrespective of its previous value) so the final equation can be rewritten as
&lt;span class=&#34;math display&#34;&gt;\[z + (w + 5)x = 0.\]&lt;/span&gt;
Browse through the rest of the programme and you should soon infer the following key points.&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;The code is split into 14 chunks of equal length.&lt;/li&gt;
&lt;li&gt;Each starts with &lt;code&gt;w&lt;/code&gt; being assigned an input value.&lt;/li&gt;
&lt;li&gt;The variable &lt;code&gt;w&lt;/code&gt; is never manipulated apart from this.&lt;/li&gt;
&lt;li&gt;The symbols &lt;code&gt;x&lt;/code&gt; and &lt;code&gt;y&lt;/code&gt; are auxiliary variables.&lt;/li&gt;
&lt;li&gt;The variable &lt;code&gt;z&lt;/code&gt; represents a &lt;a href=&#34;https://en.wikipedia.org/wiki/Stack_(abstract_data_type)&#34;&gt;stack&lt;/a&gt;, which is “popped” every time we see &lt;code&gt;z div 26&lt;/code&gt; and is “pushed” by a value of &lt;code&gt;y&lt;/code&gt; each time we see &lt;code&gt;add z y&lt;/code&gt;. Exactly one of these operations happens per chunk.&lt;/li&gt;
&lt;/ul&gt;
&lt;p&gt;Now, refer to the equation above.
Since &lt;code&gt;w&lt;/code&gt; is equal to an input digit, we have &lt;span class=&#34;math inline&#34;&gt;\(1 \leq w \leq 9\)&lt;/span&gt;, therefore the expression inside the brackets is strictly positive and the equation can &lt;em&gt;only&lt;/em&gt; hold when &lt;span class=&#34;math inline&#34;&gt;\(x = 0\)&lt;/span&gt;.&lt;/p&gt;
&lt;p&gt;So what is &lt;span class=&#34;math inline&#34;&gt;\(x\)&lt;/span&gt;?
Work a bit further back through the code to the start of chunk 14 and we see:&lt;/p&gt;
&lt;pre&gt;&lt;code&gt;inp w
mul x 0    # reset memory of x
add x z
mod x 26   # stack.pop()
div z 26
add x -11  # dx &amp;lt;- -11
eql x w    # stack.pop() - 11 == input
eql x 0    # stack.pop() - 11 != input&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Remember we need &lt;span class=&#34;math inline&#34;&gt;\(x = 0\)&lt;/span&gt; at the final line, so the final expression needs to be &lt;code&gt;FALSE&lt;/code&gt;.
In other words, the penultimate expression must be &lt;code&gt;TRUE&lt;/code&gt;: the top value of the stack, minus 11 (&lt;span class=&#34;math inline&#34;&gt;\(\delta x\)&lt;/span&gt;), is equal to the most recent input value (&lt;code&gt;w&lt;/code&gt;).
&lt;span class=&#34;math display&#34;&gt;\[\text{stack}_1 = w - \delta x\]&lt;/span&gt;&lt;/p&gt;
&lt;p&gt;So what is the top value of the stack?
At the end of the previous (&lt;span class=&#34;math inline&#34;&gt;\(i-1\)&lt;/span&gt;st) chunk:&lt;/p&gt;
&lt;pre&gt;&lt;code&gt;mul y 0    # reset memory of y
add y w    # y &amp;lt;- input
add y 8    # input(i-1) + 8
mul y x    # (x is 0 or 1 at this stage)
add z y    # push input(i-1) + 8 onto the stack&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;The value 8 corresponds to &lt;span class=&#34;math inline&#34;&gt;\(\delta y\)&lt;/span&gt; but for the previous chunk; let’s call it &lt;span class=&#34;math inline&#34;&gt;\(\delta y_{i-1} = 8\)&lt;/span&gt;.
Putting it all together, we get&lt;/p&gt;
&lt;p&gt;&lt;span class=&#34;math display&#34;&gt;\[w_{i-1} + \delta y_{i-1} = w_{i} - \delta x_1.\]&lt;/span&gt;
where &lt;span class=&#34;math inline&#34;&gt;\(i\)&lt;/span&gt; is the current chunk where the stack is being popped, and &lt;span class=&#34;math inline&#34;&gt;\((i-1)\)&lt;/span&gt; represents the last time that something was added to the stack (which could be several chunks before).&lt;/p&gt;
&lt;p&gt;Our code, then, just has to pick input values that satisfy these pairs of equations, for each pair of chunks, while maximizing or minimizing the 14-digit input number.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;read_alu &amp;lt;- function(file) {
    instr &amp;lt;- read.table(file, fill = NA,
                        col.names = c(&amp;#39;op&amp;#39;, &amp;#39;lhs&amp;#39;, &amp;#39;val&amp;#39;), row.names = NULL)
    instr$op &amp;lt;- sub(&amp;#39;mul&amp;#39;, &amp;#39;*&amp;#39;, instr$op)
    instr$op &amp;lt;- sub(&amp;#39;add&amp;#39;, &amp;#39;+&amp;#39;, instr$op)
    instr$op &amp;lt;- sub(&amp;#39;eql&amp;#39;, &amp;#39;==&amp;#39;, instr$op)
    instr$op &amp;lt;- sub(&amp;#39;div&amp;#39;, &amp;#39;%/%&amp;#39;, instr$op)
    instr$op &amp;lt;- sub(&amp;#39;mod&amp;#39;, &amp;#39;%%&amp;#39;, instr$op)
    instr$rhs &amp;lt;- ifelse(instr$op == &amp;#39;inp&amp;#39;, &amp;#39;&amp;#39;, instr$lhs)
    instr$op &amp;lt;- sub(&amp;#39;inp&amp;#39;, &amp;#39;inputs[1]; inputs &amp;lt;- inputs[-1]&amp;#39;, instr$op)
    instr$expr &amp;lt;- with(instr, paste(lhs, &amp;#39;&amp;lt;-&amp;#39;, rhs, op, val))
    instr$chunk &amp;lt;- cumsum(instr$val == &amp;#39;&amp;#39;)
    instr
}

alu_model_number &amp;lt;- function(instructions, minimize = FALSE) {
  digits &amp;lt;- integer(14)
  chunks &amp;lt;- split(instructions, instructions$chunk)
  z_stack &amp;lt;- c()
  for (i in seq_along(chunks)) {
    dx &amp;lt;- as.integer(chunks[[i]]$val[6])  # where x + val
    dy &amp;lt;- as.integer(chunks[[i]]$val[16]) # where y + val (&amp;amp; val != 25)
    pop &amp;lt;- chunks[[i]]$val[5] == 26 # z %% val
    if (!pop) { # &amp;#39;Push&amp;#39; (append) a value onto the stack.
      z_stack &amp;lt;- c(list(c(dy = dy, pushed = i)), z_stack)
    } else { # &amp;#39;Pop&amp;#39; (extract) the last value from the stack.
      dy &amp;lt;- z_stack[[1]][&amp;#39;dy&amp;#39;]
      pushed &amp;lt;- z_stack[[1]][&amp;#39;pushed&amp;#39;]
      z_stack &amp;lt;- z_stack[-1]
      w &amp;lt;- (1:9)[(1:9 + dx + dy) %in% 1:9]
      w &amp;lt;- if (minimize) min(w) else max(w)
      digits[pushed] &amp;lt;- w
      digits[i] &amp;lt;- w + dx + dy
    }
  }
  paste(digits, collapse = &amp;#39;&amp;#39;)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;You can check your working &lt;a href=&#34;https://github.com/Selbosh/adventofcode2021/blob/main/tests/testthat/test-day24.R&#34;&gt;with a unit test&lt;/a&gt; that simply evaluates the ALU code with the input values:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;alu &amp;lt;- read_alu(input_file(24))
model_number &amp;lt;- alu_model_number(alu)
inputs &amp;lt;- as.numeric(strsplit(model_number, &amp;#39;&amp;#39;)[[1]])
w &amp;lt;- x &amp;lt;- y &amp;lt;- z &amp;lt;- 0
eval(str2expression(alu$expr))
expect_equal(z, 0)&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;div id=&#34;day25&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Day 25 - &lt;a href=&#34;https://adventofcode.com/2021/day/25&#34;&gt;Sea Cucumber&lt;/a&gt;&lt;/h2&gt;
&lt;p&gt;We finish on a relatively easy one.
Using a similar style to earlier puzzles, we can find the neighbours in a grid through clever use of &lt;code&gt;rbind()&lt;/code&gt; and &lt;code&gt;cbind()&lt;/code&gt;.
It’s easy to adapt so that one side of the map wraps around to the other.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;move_cucumbers &amp;lt;- function(cucumbers) {
  old &amp;lt;- cucumbers
  i &amp;lt;- 0
  repeat {
    new &amp;lt;- move_cucumbers_once(old)
    i &amp;lt;- i + 1
    if (identical(new, old))
      break
    old &amp;lt;- new
  }
  return(i)
}

move_cucumbers_once &amp;lt;- function(x) {
  # First move west to east.
  next_state &amp;lt;- x
  west  &amp;lt;- cbind(x[, ncol(x)], x[, -ncol(x)])
  east  &amp;lt;- cbind(x[, -1], x[, 1])
  # Create an empty spot as cucumbers leave it.
  next_state[x == &amp;#39;&amp;gt;&amp;#39; &amp;amp; east == &amp;#39;.&amp;#39;] &amp;lt;- &amp;#39;.&amp;#39;
  # Occupy the empty spot as cucumbers enter it.
  next_state[x == &amp;#39;.&amp;#39; &amp;amp; west == &amp;#39;&amp;gt;&amp;#39;] &amp;lt;- &amp;#39;&amp;gt;&amp;#39;

  # Now move north to south.
  x &amp;lt;- next_state
  north &amp;lt;- rbind(x[nrow(x), ], x[-nrow(x), ])
  south &amp;lt;- rbind(x[-1, ], x[1, ])
  next_state[x == &amp;#39;v&amp;#39; &amp;amp; south == &amp;#39;.&amp;#39;] &amp;lt;- &amp;#39;.&amp;#39;
  next_state[x == &amp;#39;.&amp;#39; &amp;amp; north == &amp;#39;v&amp;#39;] &amp;lt;- &amp;#39;v&amp;#39;

  return(next_state)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;There is no part two for day 25: the second star is awarded for completing all of the other stars.&lt;/p&gt;
&lt;/div&gt;
</description>
    </item>
    
    <item>
      <title>There are now 3 different R pipes</title>
      <link>https://selbydavid.com/2021/05/18/pipes/</link>
      <pubDate>Tue, 18 May 2021 13:00:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2021/05/18/pipes/</guid>
      <description>&lt;p&gt;R 4.1.0 has been released and has a couple of handy &lt;a href=&#34;https://cran.r-project.org/bin/windows/base/NEWS.R-4.1.0.html&#34;&gt;new features&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;One is a shorthand syntax for defining functions.
Now, instead of writing, for example&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;triple &amp;lt;- function(x) x * 3
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;you can use the more concise syntax&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;triple &amp;lt;- \(x) x * 3
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;which may come in handy when using anonymous functions in &lt;code&gt;apply&lt;/code&gt;-type calls.&lt;/p&gt;
&lt;p&gt;More interesting, though, is the addition of a native pipe operator to R, given by &lt;code&gt;|&amp;gt;&lt;/code&gt;, i.e. a pipe and a greater-than sign.
As of R 4.1.0, the following are equivalent.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;triple(4)
4 |&amp;gt; triple()
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;This is similar to the functionality previously provided by the &lt;strong&gt;magrittr&lt;/strong&gt; package (often through &lt;strong&gt;dplyr&lt;/strong&gt; and &lt;strong&gt;tidyr&lt;/strong&gt;):&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(magrittr)
4 %&amp;gt;% triple
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;but saves you loading any add-on packages.&lt;/p&gt;
&lt;p&gt;In fact, there already was a pipe of sorts in base R, as &lt;a href=&#34;https://www.youtube.com/watch?v=tphMSLGXuDE&#34;&gt;John Mount points out&lt;/a&gt;: in the form of the &lt;code&gt;-&amp;gt;.;&lt;/code&gt; &amp;lsquo;operator&amp;rsquo; (assign to a variable called &lt;code&gt;.&lt;/code&gt;, then terminate with the rarely-used semicolon):&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;4 -&amp;gt;.; triple(.)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;As a result there are now four different ways of writing the same function call as a one-liner in R version 4.1.0:&lt;/p&gt;
&lt;pre&gt;&lt;code&gt;triple(4)
4 %&amp;gt;% triple
4 -&amp;gt;.; triple(.)
4 |&amp;gt; triple()
&lt;/code&gt;&lt;/pre&gt;
</description>
    </item>
    
    <item>
      <title>The unequalled joy of non-equi joins</title>
      <link>https://selbydavid.com/2021/02/13/joins/</link>
      <pubDate>Sat, 13 Feb 2021 16:00:00 +0000</pubDate>
      
      <guid>https://selbydavid.com/2021/02/13/joins/</guid>
      <description>
&lt;script src=&#34;https://selbydavid.com/rmarkdown-libs/header-attrs/header-attrs.js&#34;&gt;&lt;/script&gt;


&lt;p&gt;A common task in data analysis is to &lt;em&gt;merge&lt;/em&gt; or &lt;em&gt;join&lt;/em&gt; two tables according to shared &lt;em&gt;keys&lt;/em&gt; or values.
The operation is perhaps most commonly associated with relational databases and structured query language (&lt;a href=&#34;https://en.wikipedia.org/wiki/SQL&#34;&gt;SQL&lt;/a&gt;) but it’s just as useful in R with data frames.&lt;/p&gt;
&lt;p&gt;Most joins are &lt;em&gt;equi-joins&lt;/em&gt;, matching rows according to two columns having exactly equal values.
These are easy to perfom in R using the base &lt;code&gt;merge()&lt;/code&gt; function, the various &lt;code&gt;join()&lt;/code&gt; functions in &lt;strong&gt;dplyr&lt;/strong&gt; and the &lt;code&gt;X[i]&lt;/code&gt; syntax of &lt;strong&gt;data.table&lt;/strong&gt;.&lt;/p&gt;
&lt;p&gt;But sometimes we need &lt;em&gt;non-equi joins&lt;/em&gt; or &lt;a href=&#34;https://en.wikipedia.org/wiki/Relational_algebra#Joins_and_join-like_operators&#34;&gt;&lt;span class=&#34;math inline&#34;&gt;\(\theta\)&lt;/span&gt;-joins&lt;/a&gt;, where the matching condition is an interval or a set of inequalities.
Other situations call for a &lt;em&gt;rolling join&lt;/em&gt;, used to link records according to their proximity in a time sequence.&lt;/p&gt;
&lt;p&gt;How do you perform non-equi joins and rolling joins in R?&lt;/p&gt;
&lt;div id=&#34;motivating-example&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Motivating example&lt;/h3&gt;
&lt;p&gt;A famous YouTuber is testing out a new marketing strategy, promoting specific videos on social media.
They collect daily view counts of old videos and want to summarise these counts in the days following each promotion.&lt;/p&gt;
&lt;p&gt;The tables &lt;code&gt;promos&lt;/code&gt; and &lt;code&gt;views&lt;/code&gt; are as follows.
The data span a two-week period, but for certain days and certain videos, the view counts are missing.&lt;/p&gt;
&lt;table&gt;
&lt;thead&gt;
&lt;tr class=&#34;header&#34;&gt;
&lt;th align=&#34;left&#34;&gt;video&lt;/th&gt;
&lt;th align=&#34;left&#34;&gt;promo_date&lt;/th&gt;
&lt;/tr&gt;
&lt;/thead&gt;
&lt;tbody&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;/tr&gt;
&lt;/tbody&gt;
&lt;/table&gt;
&lt;table&gt;
&lt;thead&gt;
&lt;tr class=&#34;header&#34;&gt;
&lt;th align=&#34;left&#34;&gt;video&lt;/th&gt;
&lt;th align=&#34;left&#34;&gt;view_date&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;views&lt;/th&gt;
&lt;/tr&gt;
&lt;/thead&gt;
&lt;tbody&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;992&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-02&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3304&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1417&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-04&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;191&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-05&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2366&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-06&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;7318&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1570&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2051&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-09&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;5958&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-10&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3574&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-11&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6724&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-12&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;12043&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-13&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;481&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-14&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;286&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6270&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-02&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1549&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2376&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-04&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3111&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-05&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6228&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-06&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1852&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;24314&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3329&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-09&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;24980&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-10&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1118&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-11&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6057&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-14&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1400&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1156&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-02&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6435&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2847&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-04&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;15093&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-05&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2488&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-06&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1773&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;8782&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3687&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-11&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1963&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-12&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;9510&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-13&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3891&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-14&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3282&lt;/td&gt;
&lt;/tr&gt;
&lt;/tbody&gt;
&lt;/table&gt;
&lt;p&gt;What are the mean view counts on videos in the three days immediately following promotions for those videos?&lt;/p&gt;
&lt;p&gt;I will show how you might accomplish this task using either non-equi joins or rolling joins in R.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;crossing-filter-with-dplyr&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Crossing + filter with dplyr&lt;/h3&gt;
&lt;p&gt;The package &lt;strong&gt;dplyr&lt;/strong&gt; has no function for joining on anything other than an equality relation.
However, you can get the same results (possibly less efficiently) using an outer join or Cartesian product, followed by a filtering operation.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;library(dplyr)
views %&amp;gt;%
  # Crossing
  full_join(promos) %&amp;gt;%
  # Filter
  filter(view_date &amp;gt;= promo_date,
         view_date &amp;lt;= promo_date + 3) %&amp;gt;%
  # Aggregate
  group_by(video) %&amp;gt;%
  summarise(mean(views), sd(views), `n days` = n())&lt;/code&gt;&lt;/pre&gt;
&lt;table&gt;
&lt;thead&gt;
&lt;tr class=&#34;header&#34;&gt;
&lt;th align=&#34;left&#34;&gt;video&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;mean(views)&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;sd(views)&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;n days&lt;/th&gt;
&lt;/tr&gt;
&lt;/thead&gt;
&lt;tbody&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2382&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1832&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;8&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6131&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;7836&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;8&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;5550&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6377&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;4&lt;/td&gt;
&lt;/tr&gt;
&lt;/tbody&gt;
&lt;/table&gt;
&lt;p&gt;It would also be possible to compare promoted days with non-promoted days for each video, either by creating a binary indicator (instead of a filter) or by rejoining the table with the original dataset after the filter step.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;non-equi-joins-with-sqldf&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Non-equi joins with sqldf&lt;/h3&gt;
&lt;p&gt;The &lt;strong&gt;sqldf&lt;/strong&gt; package lets you query R data frames with SQL, as if you were working with a relational database.
The result of the query is another data frame, and performance is sometimes better than equivalent R functions.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;library(sqldf)
sqldf(&amp;#39;SELECT v.video, view_date, views
       FROM views v
       JOIN promos p
       ON v.video = p.video AND
          view_date BETWEEN promo_date AND promo_date + 3&amp;#39;
      ) %&amp;gt;%
  group_by(video) %&amp;gt;%
  summarise(mean(views), sd(views), `n days` = n())&lt;/code&gt;&lt;/pre&gt;
&lt;table&gt;
&lt;thead&gt;
&lt;tr class=&#34;header&#34;&gt;
&lt;th align=&#34;left&#34;&gt;video&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;mean(views)&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;sd(views)&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;n days&lt;/th&gt;
&lt;/tr&gt;
&lt;/thead&gt;
&lt;tbody&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2382&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1832&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;8&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6131&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;7836&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;8&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;5550&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6377&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;4&lt;/td&gt;
&lt;/tr&gt;
&lt;/tbody&gt;
&lt;/table&gt;
&lt;p&gt;The aggregation step could also be written in SQL, but it makes sense only to use SQL where it is absolutely needed, and to use native R functions for everything else.&lt;/p&gt;
&lt;p&gt;Having access to this functionality is very powerful, but has the obvious disadvantage that you need to learn a bit of SQL to understand the syntax.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;non-equi-joins-with-data.table&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Non-equi joins with data.table&lt;/h3&gt;
&lt;p&gt;The high-performance data manipulation package &lt;strong&gt;data.table&lt;/strong&gt; now (as of &lt;a href=&#34;https://github.com/Rdatatable/data.table/blob/master/NEWS.0.md#new-features&#34;&gt;v1.9.8&lt;/a&gt;) supports non-equi joins.&lt;/p&gt;
&lt;p&gt;Non-equi joins are made possible with the &lt;code&gt;X[i]&lt;/code&gt; merging syntax and the &lt;code&gt;on&lt;/code&gt; argument.
It’s slightly less flexible than the equivalent SQL, because you can’t just write &lt;code&gt;promo_date + 3&lt;/code&gt; in the inequality: instead it needs to be an explicit column in the table.
You also can’t use the infix &lt;code&gt;%between%&lt;/code&gt; operator, so two inequalities have to do instead.
Otherwise the syntax is similar.
Like in SQL, a prefix is used to disambiguate the column names: &lt;a href=&#34;https://stackoverflow.com/a/44343424&#34;&gt;here it’s &lt;code&gt;x.name&lt;/code&gt;&lt;/a&gt;.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;library(data.table)
setDT(views)
setDT(promos)[, promo_end := promo_date + 3]&lt;/code&gt;&lt;/pre&gt;
&lt;table&gt;
&lt;thead&gt;
&lt;tr class=&#34;header&#34;&gt;
&lt;th align=&#34;left&#34;&gt;video&lt;/th&gt;
&lt;th align=&#34;left&#34;&gt;promo_date&lt;/th&gt;
&lt;th align=&#34;left&#34;&gt;promo_end&lt;/th&gt;
&lt;/tr&gt;
&lt;/thead&gt;
&lt;tbody&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-04&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-10&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-06&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-11&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-06&lt;/td&gt;
&lt;/tr&gt;
&lt;/tbody&gt;
&lt;/table&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;views[promos,
      .(video, views, x.view_date),
      # Non equi join:
      on = .(video,
             view_date &amp;gt;= promo_date,
             view_date &amp;lt;= promo_end)
      ][, # Chain into aggregate:
        .(mean = mean(views), sd = sd(views), .N),
        by = video]&lt;/code&gt;&lt;/pre&gt;
&lt;table&gt;
&lt;thead&gt;
&lt;tr class=&#34;header&#34;&gt;
&lt;th align=&#34;left&#34;&gt;video&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;mean&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;sd&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;N&lt;/th&gt;
&lt;/tr&gt;
&lt;/thead&gt;
&lt;tbody&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2382&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1832&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;8&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6131&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;7836&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;8&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;5550&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6377&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;4&lt;/td&gt;
&lt;/tr&gt;
&lt;/tbody&gt;
&lt;/table&gt;
&lt;/div&gt;
&lt;div id=&#34;rolling-joins-with-data.table&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Rolling joins with data.table&lt;/h3&gt;
&lt;p&gt;This particular example, since it involves a time variable, is even simpler using a &lt;em&gt;rolling join&lt;/em&gt;.
The concept is a bit confusing, but essentially it attributes records in one table with the most recent preceding records in the second table.
You can read more about rolling joins in &lt;a href=&#34;https://www.r-bloggers.com/2016/06/understanding-data-table-rolling-joins/&#34;&gt;this blog post by Robert Norberg&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;When performing rolling joins in &lt;strong&gt;data.table&lt;/strong&gt;, one of the joining time columns gets dropped, which can make it hard to identify your records if they don’t have an explicit ID.
To mitigate this, we will copy each date column to the name &lt;code&gt;join_date&lt;/code&gt; and join on that.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;views[, join_date := view_date]
promos[, join_date := promo_date]

setkey(views, video, join_date)
setkey(promos, video, join_date)&lt;/code&gt;&lt;/pre&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;promos[views, roll = TRUE]&lt;/code&gt;&lt;/pre&gt;
&lt;table&gt;
&lt;thead&gt;
&lt;tr class=&#34;header&#34;&gt;
&lt;th align=&#34;left&#34;&gt;video&lt;/th&gt;
&lt;th align=&#34;left&#34;&gt;promo_date&lt;/th&gt;
&lt;th align=&#34;left&#34;&gt;join_date&lt;/th&gt;
&lt;th align=&#34;left&#34;&gt;view_date&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;views&lt;/th&gt;
&lt;/tr&gt;
&lt;/thead&gt;
&lt;tbody&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;992&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-02&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-02&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3304&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1417&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-04&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-04&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;191&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-05&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-05&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2366&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-06&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-06&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;7318&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1570&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2051&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-09&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-09&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;5958&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-10&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-10&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3574&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-11&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-11&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6724&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-12&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-12&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;12043&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-13&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-13&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;481&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-14&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-14&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;286&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6270&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-02&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-02&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1549&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2376&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-04&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-04&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3111&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-05&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-05&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6228&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-06&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-06&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1852&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;24314&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3329&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-09&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-09&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;24980&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-10&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-10&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1118&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-11&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-11&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6057&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-14&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-14&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1400&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1156&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-02&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-02&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6435&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2847&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-04&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-04&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;15093&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-05&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-05&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2488&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-06&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-06&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1773&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;8782&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3687&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-11&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-11&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1963&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-12&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-12&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;9510&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-13&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-13&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3891&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-14&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-14&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3282&lt;/td&gt;
&lt;/tr&gt;
&lt;/tbody&gt;
&lt;/table&gt;
&lt;p&gt;The syntax &lt;code&gt;promos[views, roll=TRUE]&lt;/code&gt; means “which promotion immediately preceded each viewing date?”
Conversely, &lt;code&gt;views[promos, roll=TRUE]&lt;/code&gt; means “which viewing dates immediately preceded each promotion?”&lt;/p&gt;
&lt;p&gt;In this case, we want something &lt;em&gt;close&lt;/em&gt; to the former, but we’re only interested in promos in the past 3 days, whereas by default it’ll extend back into the depths of time looking for the last one, regardless of how long ago.&lt;/p&gt;
&lt;p&gt;By changing &lt;code&gt;roll = TRUE&lt;/code&gt; to &lt;code&gt;roll = 3&lt;/code&gt; the join will fail to match when the &lt;code&gt;join_date&lt;/code&gt; differs by more than three days between the two tables.
If we wanted to go in the opposite direction in time, we could use &lt;code&gt;roll = -Inf&lt;/code&gt; to search forwards in time for future promotions, and &lt;code&gt;roll = -3&lt;/code&gt; for only those in the following three days.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;promos[views, roll = 3]&lt;/code&gt;&lt;/pre&gt;
&lt;table&gt;
&lt;thead&gt;
&lt;tr class=&#34;header&#34;&gt;
&lt;th align=&#34;left&#34;&gt;video&lt;/th&gt;
&lt;th align=&#34;left&#34;&gt;promo_date&lt;/th&gt;
&lt;th align=&#34;left&#34;&gt;join_date&lt;/th&gt;
&lt;th align=&#34;left&#34;&gt;view_date&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;views&lt;/th&gt;
&lt;/tr&gt;
&lt;/thead&gt;
&lt;tbody&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;992&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-02&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-02&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3304&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1417&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-04&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-04&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;191&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-05&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-05&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2366&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-06&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-06&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;7318&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1570&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2051&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-09&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-09&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;5958&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-10&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-10&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3574&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-11&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-11&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6724&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-12&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-12&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;12043&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-13&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-13&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;481&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-14&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-14&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;286&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6270&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-02&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-02&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1549&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2376&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-04&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-04&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3111&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-05&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-05&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6228&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-06&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-06&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1852&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;24314&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3329&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-09&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-09&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;24980&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-10&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-10&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1118&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-11&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-11&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6057&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-14&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-14&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1400&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-01&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1156&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-02&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-02&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6435&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2847&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-04&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-04&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;15093&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-05&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-05&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2488&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-03&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-06&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-06&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1773&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-07&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;8782&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-08&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3687&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-11&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-11&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1963&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-12&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-12&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;9510&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-13&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-13&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3891&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;NA&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-14&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;2020-04-14&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;3282&lt;/td&gt;
&lt;/tr&gt;
&lt;/tbody&gt;
&lt;/table&gt;
&lt;p&gt;Since the default in &lt;strong&gt;data.table&lt;/strong&gt;’s &lt;code&gt;X[i]&lt;/code&gt; merge syntax is &lt;code&gt;nomatch = NA&lt;/code&gt;, we get all of the &lt;code&gt;views&lt;/code&gt; back, with the column &lt;code&gt;promo_date&lt;/code&gt; equal to the date of the last promotion (in the last three days), or &lt;code&gt;NA&lt;/code&gt; if no such promotion was found.
If we set &lt;code&gt;nomatch = 0&lt;/code&gt; then these non-matching values are dropped from the result.&lt;/p&gt;
&lt;p&gt;So the full operation to calculate the summary figures is&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;promos[views, roll = 3, nomatch = 0
       ][j = .(mean = mean(views), sd = sd(views), .N),
         by = video]&lt;/code&gt;&lt;/pre&gt;
&lt;table&gt;
&lt;thead&gt;
&lt;tr class=&#34;header&#34;&gt;
&lt;th align=&#34;left&#34;&gt;video&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;mean&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;sd&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;N&lt;/th&gt;
&lt;/tr&gt;
&lt;/thead&gt;
&lt;tbody&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;A&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;2382&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;1832&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;8&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;B&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6131&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;7836&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;8&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;C&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;5550&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;6377&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;4&lt;/td&gt;
&lt;/tr&gt;
&lt;/tbody&gt;
&lt;/table&gt;
&lt;p&gt;If the intervals needed to be different lengths for each of the campaigns (i.e. not all equal to 3), then you would probably want a non-equi join rather than a rolling join in this case.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;extensions&#34; class=&#34;section level3&#34;&gt;
&lt;h3&gt;Extensions&lt;/h3&gt;
&lt;p&gt;Arguably, for these examples you’d want to compare the view counts in promotional periods with those outside promotional periods.
This does not require a special kind of join; rather you perform the non-equi or rolling join as above and then wrangle the output accordingly.&lt;/p&gt;
&lt;p&gt;If the non-matching rows are filtered out, you need to re-join with the original dataset.
Otherwise, you need to use some sort of indicator variable for whether the viewing date falls within a promotional period or not.&lt;/p&gt;
&lt;p&gt;In &lt;strong&gt;dplyr&lt;/strong&gt;:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;promos %&amp;gt;%
  full_join(views) %&amp;gt;%
  mutate(promo = between(view_date - promo_date, 0, 3)) %&amp;gt;%
  group_by(video, view_date) %&amp;gt;%
  summarise(promo = any(promo),
            views = unique(views)) %&amp;gt;%
  group_by(promo) %&amp;gt;%
  summarise(mean(views), sd(views), n = n())&lt;/code&gt;&lt;/pre&gt;
&lt;table&gt;
&lt;thead&gt;
&lt;tr class=&#34;header&#34;&gt;
&lt;th align=&#34;left&#34;&gt;promo&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;mean(views)&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;sd(views)&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;n&lt;/th&gt;
&lt;/tr&gt;
&lt;/thead&gt;
&lt;tbody&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;FALSE&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;5637&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;5772&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;18&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;TRUE&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;4515&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;5790&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;20&lt;/td&gt;
&lt;/tr&gt;
&lt;/tbody&gt;
&lt;/table&gt;
&lt;p&gt;In &lt;strong&gt;data.table&lt;/strong&gt;:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;promos[views, roll = 3][
         j = .(mean = mean(views), sd = sd(views), .N),
         by = .(promo = !is.na(promo_date))]&lt;/code&gt;&lt;/pre&gt;
&lt;table&gt;
&lt;thead&gt;
&lt;tr class=&#34;header&#34;&gt;
&lt;th align=&#34;left&#34;&gt;promo&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;mean&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;sd&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;N&lt;/th&gt;
&lt;/tr&gt;
&lt;/thead&gt;
&lt;tbody&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;TRUE&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;4515&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;5790&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;20&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;FALSE&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;5637&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;5772&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;18&lt;/td&gt;
&lt;/tr&gt;
&lt;/tbody&gt;
&lt;/table&gt;
&lt;/div&gt;
</description>
    </item>
    
    <item>
      <title>Advent of Code 2020</title>
      <link>https://selbydavid.com/2020/12/06/advent-2020/</link>
      <pubDate>Sun, 06 Dec 2020 17:00:00 +0000</pubDate>
      
      <guid>https://selbydavid.com/2020/12/06/advent-2020/</guid>
      <description>&lt;p&gt;&lt;a href=&#34;https://adventofcode.com/&#34;&gt;Advent of Code&lt;/a&gt; is a series of programming
puzzles you can tackle to hone your coding skills each day in the run-up
to Christmas.&lt;/p&gt;
&lt;p&gt;This year I am attempting it using R, which can make some challenges
easier or harder depending on whether they are more ‘computer sciencey’
or more ‘data sciencey’. Generally it makes parsing datasets easier but
low-level string manipulation more fiddly.&lt;/p&gt;
&lt;p&gt;Here are my solutions so far. Where possible, I’ve tried to strike a
balance between efficiency and readability, and to avoid using the
packages I might usually use (e.g. &lt;code&gt;dplyr&lt;/code&gt;) if I think it makes the
puzzle too easy.&lt;/p&gt;
&lt;p&gt;The input data are different for each participant, so your numerical
results may differ from mine.&lt;/p&gt;
&lt;ol&gt;
&lt;li&gt;&lt;a href=&#34;#day1&#34;&gt;Report repair&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day2&#34;&gt;Password philosophy&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day3&#34;&gt;Toboggan trajectory&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day4&#34;&gt;Passport processing&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day5&#34;&gt;Binary boarding&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day6&#34;&gt;Custom customs&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day7&#34;&gt;Handy haversacks&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day8&#34;&gt;Handheld halting&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day9&#34;&gt;Encoding error&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day10&#34;&gt;Adapter array&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day11&#34;&gt;Seating system&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day12&#34;&gt;Rain risk&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day13&#34;&gt;Shuttle search&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day14&#34;&gt;Docking data&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day15&#34;&gt;Rambunctious recitation&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day16&#34;&gt;Ticket translation&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day17&#34;&gt;Conway cubes&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day18&#34;&gt;Operation order&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day19&#34;&gt;Monster messages&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day20&#34;&gt;Jurassic jigsaw&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day21&#34;&gt;Allergen assessment&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day22&#34;&gt;Crab combat&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day23&#34;&gt;Crab cups&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day24&#34;&gt;Lobby layout&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;#day25&#34;&gt;Combo breaker&lt;/a&gt;&lt;/li&gt;
&lt;/ol&gt;
&lt;p&gt;&lt;a id=&#39;day1&#39;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-1---report-repairhttpsadventofcodecom2020day1&#34;&gt;Day 1 - &lt;a href=&#34;https://adventofcode.com/2020/day/1&#34;&gt;Report repair&lt;/a&gt;&lt;/h1&gt;
&lt;h2 id=&#34;two-numbers&#34;&gt;Two numbers&lt;/h2&gt;
&lt;p&gt;Find the two entries that sum to 2020, then multiply those two numbers
together.&lt;/p&gt;
&lt;p&gt;This can be a one-liner:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;input &amp;lt;- as.integer(readLines(&#39;input01.txt&#39;))
prod(input[(2020 - input) %in% input])
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 468051
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;three-numbers&#34;&gt;Three numbers&lt;/h2&gt;
&lt;p&gt;Find the three entries that sum to 2020, then multiply them together.&lt;/p&gt;
&lt;p&gt;It might be tempting to go for a naïve solution like this:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;prod(combn(input, 3)[, combn(input, 3, sum) == 2020])
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 272611658
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;It gives the right answer but involves a fair amount of unnecessary
computation. It takes more than a second to run. If we assume all the
inputs are non-negative, we can take advantage of this to reduce the
number of operations.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;. &amp;lt;- expand.grid(input, input[(2020 - input) &amp;gt; min(input)])
. &amp;lt;- transform(., Var3 = 2020 - Var1 - Var2)
. &amp;lt;- subset(., Var3 &amp;gt; min(input))
prod(.[which.max(.$Var3 %in% input), ])
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 272611658
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;This is approximately 2000 times faster than the one-liner, and works by
successively discarding values that could only add up to more than 2020.
The &lt;code&gt;.&lt;/code&gt; notation is just so I can write this without using
&lt;code&gt;dplyr&lt;/code&gt;/&lt;code&gt;magrittr&lt;/code&gt;.&lt;/p&gt;
&lt;p&gt;&lt;a id=&#39;day2&#39;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-2---password-philosophyhttpsadventofcodecom2020day2&#34;&gt;Day 2 - &lt;a href=&#34;https://adventofcode.com/2020/day/2&#34;&gt;Password philosophy&lt;/a&gt;&lt;/h1&gt;
&lt;h2 id=&#34;number-of-letters&#34;&gt;Number of letters&lt;/h2&gt;
&lt;p&gt;How many passwords are valid according to the policies?&lt;/p&gt;
&lt;pre&gt;&lt;code&gt;1-3 a: abcde
1-3 b: cdefg
2-9 c: ccccccccc
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;First read in the data. I like data frames and so should you.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;input &amp;lt;- readLines(&#39;input02.txt&#39;)
passwords &amp;lt;- do.call(rbind, strsplit(input, &#39;[- ]|\\: &#39;))
passwords &amp;lt;- setNames(as.data.frame(passwords),
                      c(&#39;min&#39;, &#39;max&#39;, &#39;letter&#39;, &#39;password&#39;))
passwords &amp;lt;- transform(passwords,
                       min = as.integer(min),
                       max = as.integer(max))
head(passwords)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;  min max letter          password
1  14  15      v  vdvvvvvsvvvvvfpv
2   3  11      k  kkqkkfkkvkgfknkx
3   6  10      j        jjjjjjjjjj
4   5  10      s nskdmzwrmpmhsrzts
5  13  15      v   vvvvvvkvvvvjzvv
6  11  13      h    hhhhhbhhhhdhhh
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;String operations are a bit of a pain in base R so it’s easier just to
use a package, like &lt;code&gt;stringi&lt;/code&gt; or &lt;code&gt;stringr&lt;/code&gt; for this.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;with(passwords, {
     n &amp;lt;- stringr::str_count(password, letter)
     sum(n &amp;gt;= min &amp;amp; n &amp;lt;= max)
})
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 625
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;You could also split each password with &lt;code&gt;strsplit&lt;/code&gt; and count the letters
with an &lt;code&gt;sapply&lt;/code&gt;-type loop.&lt;/p&gt;
&lt;h2 id=&#34;position-of-letters&#34;&gt;Position of letters&lt;/h2&gt;
&lt;p&gt;Now the two digits describe two indices in the password, &lt;em&gt;exactly one&lt;/em&gt;
of which must match the given letter.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;with(passwords,
     sum(xor(substr(password, min, min) == letter,
             substr(password, max, max) == letter))
)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 391
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Initially I got caught out here, by misreading the question as ‘at least
one’ and then wondering why an inclusive or (&lt;code&gt;|&lt;/code&gt;) was returning the
incorrect answer.&lt;/p&gt;
&lt;p&gt;&lt;a id=&#39;day3&#39;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-3---toboggan-trajectoryhttpsadventofcodecom2020day3&#34;&gt;Day 3 - &lt;a href=&#34;https://adventofcode.com/2020/day/3&#34;&gt;Toboggan trajectory&lt;/a&gt;&lt;/h1&gt;
&lt;p&gt;The input looks a bit like this:&lt;/p&gt;
&lt;pre&gt;&lt;code&gt;..##.........##.........##.........##.........##.........##.......  ---&amp;gt;
#...#...#..#...#...#..#...#...#..#...#...#..#...#...#..#...#...#..
.#....#..#..#....#..#..#....#..#..#....#..#..#....#..#..#....#..#.
..#.#...#.#..#.#...#.#..#.#...#.#..#.#...#.#..#.#...#.#..#.#...#.#
.#...##..#..#...##..#..#...##..#..#...##..#..#...##..#..#...##..#.
..#.##.......#.##.......#.##.......#.##.......#.##.......#.##.....  ---&amp;gt;
.#.#.#....#.#.#.#....#.#.#.#....#.#.#.#....#.#.#.#....#.#.#.#....#
.#........#.#........#.#........#.#........#.#........#.#........#
#.##...#...#.##...#...#.##...#...#.##...#...#.##...#...#.##...#...
#...##....##...##....##...##....##...##....##...##....##...##....#
.#..#...#.#.#..#...#.#.#..#...#.#.#..#...#.#.#..#...#.#.#..#...#.#  ---&amp;gt;
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;encountering-trees&#34;&gt;Encountering trees&lt;/h2&gt;
&lt;p&gt;Starting at the top-left corner of your map and following a slope of
right 3 and down 1, how many trees would you encounter?&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;input &amp;lt;- readLines(&#39;input03.txt&#39;)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;A complicated-sounding problem but the solution is mainly mathematical.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;positions &amp;lt;- (3 * (seq_along(input) - 1)) %% nchar(input) + 1
sum(substr(input, positions, positions) == &#39;#&#39;)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 268
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;The sequence of positions goes 1, 4, 7, …, and when it reaches the edge
of the map, loops back round to the beginning. Using the modulo operator
we can use the sequence modulo the width of the input map, then add one
because R indexes from one rather than from zero.&lt;/p&gt;
&lt;h2 id=&#34;different-slopes&#34;&gt;Different slopes&lt;/h2&gt;
&lt;p&gt;Simply wrap the above into a function.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;trees &amp;lt;- function(right, down = 1) {
  vertical &amp;lt;- seq(0, length(input) - 1, by = down) + 1
  horizontal &amp;lt;- (right * (seq_along(input) - 1)) %% nchar(input) + 1
  horizontal &amp;lt;- head(horizontal, length(vertical))
  as.double(
    sum(substr(input[vertical], horizontal, horizontal) == &#39;#&#39;)
  )
}
trees(1) * trees(3) * trees(5) * trees(7) * trees(1, 2)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 3093068400
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;The &lt;code&gt;as.double&lt;/code&gt; bit is necessary only because multiplying large integer
outputs together can cause an overflow when the product is larger than
10&lt;sup&gt;9&lt;/sup&gt;.&lt;/p&gt;
&lt;p&gt;&lt;a id=&#39;day4&#39;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-4---passport-processinghttpsadventofcodecom2020day4&#34;&gt;Day 4 - &lt;a href=&#34;https://adventofcode.com/2020/day/4&#34;&gt;Passport processing&lt;/a&gt;&lt;/h1&gt;
&lt;p&gt;The example input is in this ragged format, where keys and values are
separated by colons and records are separated by double newlines. The
first step is to parse this unusual data format.&lt;/p&gt;
&lt;pre&gt;&lt;code&gt;ecl:gry pid:860033327 eyr:2020 hcl:#fffffd
byr:1937 iyr:2017 cid:147 hgt:183cm

iyr:2013 ecl:amb cid:350 eyr:2023 pid:028048884
hcl:#cfa07d byr:1929

hcl:#ae17e1 iyr:2013
eyr:2024
ecl:brn pid:760753108 byr:1931
hgt:179cm

hcl:#cfa07d eyr:2025 pid:166559648
iyr:2011 ecl:brn hgt:59in
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;input &amp;lt;- strsplit(readLines(&#39;input04.txt&#39;), &#39; &#39;)
ids = cumsum(!lengths(input))
pairs &amp;lt;- lapply(strsplit(unlist(input), &#39;:&#39;), setNames, c(&#39;key&#39;, &#39;value&#39;))
passports &amp;lt;- data.frame(id = rep(ids, lengths(input)),
                        do.call(rbind, pairs))
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;missing-fields&#34;&gt;Missing fields&lt;/h2&gt;
&lt;p&gt;Now the data are in a standard format, this is a simple
split-apply-combine operation. I am using the base &lt;code&gt;aggregate&lt;/code&gt; but this
could be done equally well using &lt;code&gt;dplyr&lt;/code&gt; or &lt;code&gt;data.table&lt;/code&gt;.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;required &amp;lt;- c(&#39;byr&#39;, &#39;iyr&#39;, &#39;eyr&#39;, &#39;hgt&#39;, &#39;hcl&#39;, &#39;ecl&#39;, &#39;pid&#39;)
valid &amp;lt;- aggregate(key ~ id, passports,
                   function(x) !length(setdiff(required, x)))
head(valid, 10)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;   id   key
1   0  TRUE
2   1  TRUE
3   2  TRUE
4   3  TRUE
5   4  TRUE
6   5  TRUE
7   6  TRUE
8   7 FALSE
9   8 FALSE
10  9  TRUE
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then the answer is simply&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;sum(valid$key)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 190
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;field-validation&#34;&gt;Field validation&lt;/h2&gt;
&lt;p&gt;Thanks to the way we imported the data, this is quite straightforward.
The rules are:&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;&lt;code&gt;byr&lt;/code&gt; (Birth Year) - four digits; at least 1920 and at most 2002.&lt;/li&gt;
&lt;li&gt;&lt;code&gt;iyr&lt;/code&gt; (Issue Year) - four digits; at least 2010 and at most 2020.&lt;/li&gt;
&lt;li&gt;&lt;code&gt;eyr&lt;/code&gt; (Expiration Year) - four digits; at least 2020 and at
most 2030.&lt;/li&gt;
&lt;li&gt;&lt;code&gt;hgt&lt;/code&gt; (Height) - a number followed by either cm or in:
&lt;ul&gt;
&lt;li&gt;If &lt;code&gt;cm&lt;/code&gt;, the number must be at least 150 and at most 193.&lt;/li&gt;
&lt;li&gt;If &lt;code&gt;in&lt;/code&gt;, the number must be at least 59 and at most 76.&lt;/li&gt;
&lt;/ul&gt;
&lt;/li&gt;
&lt;li&gt;&lt;code&gt;hcl&lt;/code&gt; (Hair Color) - a # followed by exactly six characters &lt;code&gt;0-9&lt;/code&gt;
or &lt;code&gt;a-f&lt;/code&gt;.&lt;/li&gt;
&lt;li&gt;&lt;code&gt;ecl&lt;/code&gt; (Eye Color) - exactly one of: &lt;code&gt;amb&lt;/code&gt; &lt;code&gt;blu&lt;/code&gt; &lt;code&gt;brn&lt;/code&gt; &lt;code&gt;gry&lt;/code&gt; &lt;code&gt;grn&lt;/code&gt;
&lt;code&gt;hzl&lt;/code&gt; &lt;code&gt;oth&lt;/code&gt;.&lt;/li&gt;
&lt;li&gt;&lt;code&gt;pid&lt;/code&gt; (Passport ID) - a nine-digit number, including leading zeroes.&lt;/li&gt;
&lt;li&gt;&lt;code&gt;cid&lt;/code&gt; (Country ID) - ignored, missing or not.&lt;/li&gt;
&lt;/ul&gt;
&lt;p&gt;The data are all different types (integer, double and categorical) so
the first step will be to spread the table to a wider format, with one
row per passport, and one column for each field.&lt;/p&gt;
&lt;p&gt;Here is a &lt;code&gt;dplyr&lt;/code&gt; + &lt;code&gt;tidyr&lt;/code&gt; solution.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(dplyr)
library(tidyr)
passports_wide &amp;lt;- passports %&amp;gt;%
  pivot_wider(names_from = key, values_from = value) %&amp;gt;%
  mutate(byr = as.integer(byr),
         iyr = as.integer(iyr),
         eyr = as.integer(eyr),
         hgt_value = as.numeric(gsub(&#39;cm|in$&#39;, &#39;&#39;, hgt)),
         hgt_unit = gsub(&#39;\\d*&#39;, &#39;&#39;, hgt))
head(passports_wide)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;# A tibble: 6 x 11
     id   iyr cid   pid        eyr hcl     ecl      byr hgt   hgt_value hgt_unit
  &amp;lt;int&amp;gt; &amp;lt;int&amp;gt; &amp;lt;chr&amp;gt; &amp;lt;chr&amp;gt;    &amp;lt;int&amp;gt; &amp;lt;chr&amp;gt;   &amp;lt;chr&amp;gt;  &amp;lt;int&amp;gt; &amp;lt;chr&amp;gt;     &amp;lt;dbl&amp;gt; &amp;lt;chr&amp;gt;   
1     0  1928 150   4761132~  2039 a5ac0f  #25f8~  2027 190         190 &amp;quot;&amp;quot;      
2     1  2013 169   9200769~  2026 #fffffd hzl     1929 168cm       168 &amp;quot;cm&amp;quot;    
3     2  2011 &amp;lt;NA&amp;gt;  3284128~  2023 #6b5442 brn     1948 156cm       156 &amp;quot;cm&amp;quot;    
4     3  2019 279   6749079~  2020 #602927 amb     1950 189cm       189 &amp;quot;cm&amp;quot;    
5     4  2015 &amp;lt;NA&amp;gt;  4736300~  2022 #341e13 hzl     1976 178cm       178 &amp;quot;cm&amp;quot;    
6     5  2020 &amp;lt;NA&amp;gt;  6281139~  2023 #866857 blu     1984 163cm       163 &amp;quot;cm&amp;quot;    
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;From here, we can filter out the invalid entries, using &lt;code&gt;filter&lt;/code&gt; or
&lt;code&gt;subset&lt;/code&gt;.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;passports_wide %&amp;gt;%
  filter(byr &amp;gt;= 1920, byr &amp;lt;= 2002,
         iyr &amp;gt;= 2010, iyr &amp;lt;= 2020,
         eyr &amp;gt;= 2020, eyr &amp;lt;= 2030,
         hgt_value &amp;gt;= 150 &amp;amp; hgt_value &amp;lt;= 193 &amp;amp; hgt_unit == &#39;cm&#39; |
           hgt_value &amp;gt;= 59 &amp;amp; hgt_value &amp;lt;= 76 &amp;amp; hgt_unit == &#39;in&#39;,
         grepl(&#39;^#[0-9a-f]{6}$&#39;, hcl),
         ecl %in% c(&#39;amb&#39;, &#39;blu&#39;, &#39;brn&#39;, &#39;gry&#39;, &#39;grn&#39;, &#39;hzl&#39;, &#39;oth&#39;),
         grepl(&#39;^\\d{9}$&#39;, pid)) -&amp;gt; valid_passports
nrow(valid_passports)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 121
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;You could also use a filtering join, though since most of the fields are
ranges of integer values, you would want to use a &lt;code&gt;data.table&lt;/code&gt;
&lt;em&gt;non-equi-join&lt;/em&gt; rather than a simple &lt;code&gt;semi_join&lt;/code&gt;.&lt;/p&gt;
&lt;p&gt;&lt;a id=&#39;day5&#39;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-5---binary-boardinghttpsadventofcodecom2020day5&#34;&gt;Day 5 - &lt;a href=&#34;https://adventofcode.com/2020/day/5&#34;&gt;Binary boarding&lt;/a&gt;&lt;/h1&gt;
&lt;h2 id=&#34;highest-seat-id&#34;&gt;Highest seat ID&lt;/h2&gt;
&lt;p&gt;This task is easy, as soon as you recognise that it is just converting
numbers from binary to decimal, where &lt;code&gt;F&lt;/code&gt; and &lt;code&gt;L&lt;/code&gt; denote ones and &lt;code&gt;B&lt;/code&gt;
and &lt;code&gt;R&lt;/code&gt; are zeros. The distinction between rows and columns is a red
herring, because you can parse the whole sequence at once.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;input &amp;lt;- readLines(&#39;input05.txt&#39;)
binary &amp;lt;- lapply(strsplit(input, &#39;&#39;), grepl, pattern = &#39;[BR]&#39;)
seat_ids &amp;lt;- sapply(binary, function(x) sum(x * 2^(rev(seq_along(x)) - 1)))
max(seat_ids)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 874
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;finding-an-empty-seat&#34;&gt;Finding an empty seat&lt;/h2&gt;
&lt;p&gt;Get the missing value, which isn’t the minimum or the maximum in the
list.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;setdiff(seq(min(seat_ids), max(seat_ids)),
        seat_ids)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 594
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;&lt;a id=&#39;day6&#39;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-6---custom-customshttpsadventofcodecom2020day6&#34;&gt;Day 6 - &lt;a href=&#34;https://adventofcode.com/2020/day/6&#34;&gt;Custom customs&lt;/a&gt;&lt;/h1&gt;
&lt;h2 id=&#34;questions-with-any-yes&#34;&gt;Questions with any ‘yes’&lt;/h2&gt;
&lt;p&gt;Count the number of unique letters in each group, where a ‘group’ is
series of strings separated from others by a blank line. This is a
&lt;em&gt;union&lt;/em&gt; set operation.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;input &amp;lt;- readLines(&#39;input06.txt&#39;)
group &amp;lt;- cumsum(!nchar(input))

library(dplyr)
responses &amp;lt;- data.frame(group = group[nchar(input) &amp;gt; 0],
                        questions = input[nchar(input) &amp;gt; 0])
union &amp;lt;- aggregate(questions ~ group, responses,
                    function(x) length(unique(unlist(strsplit(x, &#39;&#39;)))))
sum(union$questions)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 6551
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;questions-with-all-yes&#34;&gt;Questions with all ‘yes’&lt;/h2&gt;
&lt;p&gt;Similar, but now an &lt;em&gt;intersection&lt;/em&gt; set operation.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;intersection &amp;lt;- aggregate(questions ~ group, responses,
                          function(x) length(Reduce(intersect, strsplit(x, &#39;&#39;))))
sum(intersection$questions)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 3358
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;The solution to the first part could have used &lt;code&gt;Reduce(union, ...)&lt;/code&gt;,
which would achieve the same result as &lt;code&gt;unique(unlist(...))&lt;/code&gt;.&lt;/p&gt;
&lt;p&gt;Both of these could be made a bit more readable using &lt;code&gt;dplyr&lt;/code&gt; or
&lt;code&gt;data.table&lt;/code&gt; instead. In particular, the base function &lt;code&gt;aggregate&lt;/code&gt;
doesn’t like list-columns as inputs, so the &lt;code&gt;strsplit&lt;/code&gt; can’t be done
before the aggregation. This is not a problem with &lt;code&gt;dplyr::summarise&lt;/code&gt; or
&lt;code&gt;data.table&lt;/code&gt;:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(dplyr)
responses %&amp;gt;%
  mutate(questions = strsplit(questions, &#39;&#39;)) %&amp;gt;%
  group_by(group) %&amp;gt;%
  summarise(count = Reduce(intersect, questions) %&amp;gt;% length) %&amp;gt;%
  pull(count) %&amp;gt;% sum
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 3358
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(data.table)
setDT(responses)[, questions := strsplit(questions, &#39;&#39;)]
responses[, .(count = length(Reduce(intersect, questions))),
          by = group][, sum(count)]
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 3358
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;&lt;a id=&#39;day7&#39;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-7---handy-haversackshttpsadventofcodecom2020day7&#34;&gt;Day 7 - &lt;a href=&#34;https://adventofcode.com/2020/day/7&#34;&gt;Handy haversacks&lt;/a&gt;&lt;/h1&gt;
&lt;h2 id=&#34;number-of-bag-colours&#34;&gt;Number of bag colours&lt;/h2&gt;
&lt;p&gt;Given an input list of rules, how many different colours of bags may
contain at least one &lt;code&gt;shiny gold&lt;/code&gt; bag?&lt;/p&gt;
&lt;p&gt;The first step will be to parse the natural language input, which looks
like this:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;input &amp;lt;- readLines(&#39;input07.txt&#39;)
head(input)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] &amp;quot;mirrored silver bags contain 4 wavy gray bags.&amp;quot;                                                                
[2] &amp;quot;clear tan bags contain 5 bright purple bags, 1 pale black bag, 5 muted lime bags.&amp;quot;                             
[3] &amp;quot;dim crimson bags contain 5 vibrant salmon bags, 2 clear cyan bags, 2 striped lime bags, 5 vibrant violet bags.&amp;quot;
[4] &amp;quot;mirrored beige bags contain 4 pale gold bags, 1 pale aqua bag.&amp;quot;                                                
[5] &amp;quot;pale maroon bags contain 2 dotted orange bags.&amp;quot;                                                                
[6] &amp;quot;dim tan bags contain no other bags.&amp;quot;                                                                           
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;For this first exercise, the numbers of bags within each one are
irrelevant (but we will need them later for part 2). For now, we just
want to reduce it to which colours can contain which others.&lt;/p&gt;
&lt;p&gt;To start, I tidied up the data into a flat data frame. This isn’t
strictly necessary—a named list would work too—but it’s easy to keep
track of everything in a flat data structure.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(tidyr)
rules &amp;lt;- strsplit(input, &#39; contain &#39;) %&amp;gt;%
  lapply(gsub, pattern = &#39;\\.| bags?&#39;, replacement = &#39;&#39;) %&amp;gt;%
  do.call(rbind, .) %&amp;gt;%
  as.data.frame %&amp;gt;%
  setNames(c(&#39;container&#39;, &#39;content&#39;)) %&amp;gt;%
  transform(content = strsplit(content, &#39;, &#39;)) %&amp;gt;%
  unnest_longer(content) %&amp;gt;%
  extract(content, c(&#39;number&#39;, &#39;content&#39;), &#39;(\\d+) (.+)&#39;) %&amp;gt;%
  transform(number = as.numeric(number)) %&amp;gt;%
  transform(number = replace(number, is.na(number), 0))
head(rules)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;        container number        content
1 mirrored silver      4      wavy gray
2       clear tan      5  bright purple
3       clear tan      1     pale black
4       clear tan      5     muted lime
5     dim crimson      5 vibrant salmon
6     dim crimson      2     clear cyan
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;The algorithm is a queue, which works as follows.&lt;/p&gt;
&lt;ol&gt;
&lt;li&gt;Look up which bags can directly contain &lt;code&gt;shiny gold&lt;/code&gt;&lt;/li&gt;
&lt;li&gt;Look up which bags can directly contain the results of 1.&lt;/li&gt;
&lt;li&gt;Repeat until no more bags can contain the result.&lt;/li&gt;
&lt;/ol&gt;
&lt;p&gt;Here’s the loop:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;bag &amp;lt;- &#39;shiny gold&#39;
containers &amp;lt;- NULL

repeat {
  contained_in &amp;lt;- subset(rules, content %in% bag)
  if ( !nrow(contained_in) )
    break
  bag &amp;lt;- setdiff(contained_in$container, containers)
  containers &amp;lt;- union(containers, bag)
}

length(containers)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 259
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;number-of-individual-bags&#34;&gt;Number of individual bags&lt;/h2&gt;
&lt;p&gt;We ignored the numbers of bags in part 1, but we need them, now. How
many individual bags fit inside a single &lt;code&gt;shiny gold&lt;/code&gt; bag?&lt;/p&gt;
&lt;p&gt;To understand recursion, you must first understand recursion. My
function, &lt;code&gt;count_bag&lt;/code&gt;, calls itself. In more loop-friendly languages you
might use a queue for this second part, but I can’t really think of a
concise way to do it using R.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;count_bag &amp;lt;- function(colour, factor = 1) {
  stopifnot(length(colour) == 1)
  
  rule &amp;lt;- subset(rules, container == colour)
  
  if (nrow(rule) == 1 &amp;amp; rule$number[1] == 0) {
    out &amp;lt;- 0
  } else {
    # need to work row-wise or you&#39;ll come unstuck:
    out &amp;lt;- mapply(count_bag, rule$content, rule$number)
  }
  
  factor * (1 + sum(out))
}
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;We remove 1 at the end so as not to include the &lt;code&gt;shiny gold&lt;/code&gt; bag itself:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;count_bag(&#39;shiny gold&#39;, 1) - 1
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 45018
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;&lt;a id=&#39;day8&#39;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-8---handheld-haltinghttpsadventofcodecom2020day8&#34;&gt;Day 8 - &lt;a href=&#34;https://adventofcode.com/2020/day/8&#34;&gt;Handheld halting&lt;/a&gt;&lt;/h1&gt;
&lt;h2 id=&#34;infinite-loop&#34;&gt;Infinite loop&lt;/h2&gt;
&lt;p&gt;Just a simple loop that keeps track of all the places it has been so
far, and terminates the moment it visits a location for the second time.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;input &amp;lt;- read.table(&#39;input08.txt&#39;, col.names = c(&#39;instr&#39;, &#39;value&#39;))

acc &amp;lt;- input$visited &amp;lt;- 0
i &amp;lt;- 1

repeat {
  input$visited[i] &amp;lt;- input$visited[i] + 1
  
  if ( any(input$visited &amp;gt; 1) )
    break
  
  acc &amp;lt;- acc + input$value[i] * (input$instr[i] == &#39;acc&#39;)
  i &amp;lt;- i + (input$instr[i] == &#39;jmp&#39;) * (input$value[i]  - 1) + 1
}

acc
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 1600
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Originally I wrote this with nested &lt;code&gt;if&lt;/code&gt; statements, then changed it to
binary multiplication, for fewer lines of code, at the expense of
readability.&lt;/p&gt;
&lt;p&gt;This puzzle is set up to catch you out. From seeing &lt;code&gt;nop +0&lt;/code&gt; in the
example data you might be tempted to assume that adding the value on
&lt;code&gt;nop&lt;/code&gt; instructions won’t affect the accumulator. But the test input data
have some non-zero &lt;code&gt;nop&lt;/code&gt; values thrown in, that you will surely
encounter:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;head(subset(input, instr == &#39;nop&#39; &amp;amp; value != 0 &amp;amp; visited &amp;gt; 0))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;    instr value visited
2     nop   631       1
11    nop    83       2
71    nop   168       1
73    nop   151       1
96    nop   -25       1
123   nop    -9       1
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Thus you must only jump or add to the accumulator on instructions that
are explicitly &lt;code&gt;jmp&lt;/code&gt; or &lt;code&gt;acc&lt;/code&gt;, respectively.&lt;/p&gt;
&lt;h2 id=&#34;corrupted-code&#34;&gt;Corrupted code&lt;/h2&gt;
&lt;p&gt;From part 1, we already have an algorithm for finding the first
instruction that will lead into an infinite loop. Instead of terminating
at this point, we can assume that last instruction was corrupted, swap
it for the other type, then continue until we find another such
corruption, all the way until the program is able to terminate on its
own.&lt;/p&gt;
&lt;p&gt;That &lt;em&gt;was&lt;/em&gt; the idea, anyway. Then I got fed up and decided to brute
force it, instead. Maybe there is a subtler way, but this appears to
work quickly enough. One thing worth noting is that you only need to
look at those indices already visited in part 1.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;nops_and_jmps &amp;lt;- which(input$instr != &#39;acc&#39; &amp;amp; input$visited)

brute_force &amp;lt;- function() {
  for (nj in nops_and_jmps) {
    modified &amp;lt;- input
    modified$instr[nj] &amp;lt;- setdiff(c(&#39;nop&#39;, &#39;jmp&#39;), input$instr[nj])
    
    acc &amp;lt;- modified$visited &amp;lt;- 0
    i &amp;lt;- 1
    repeat {
      
      if (i == nrow(input) + 1)
        return(acc)
      
      modified$visited[i] &amp;lt;- modified$visited[i] + 1
      
      if ( any(modified$visited &amp;gt; 1) )
        break
      
      acc &amp;lt;- acc + modified$value[i] * (modified$instr[i] == &#39;acc&#39;)
      i &amp;lt;- i + (modified$instr[i] == &#39;jmp&#39;) * (modified$value[i]  - 1) + 1
    }
  }
}

brute_force()
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 1543
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;&lt;a id=&#39;day9&#39;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-9---encoding-errorhttpsadventofcodecom2020day9&#34;&gt;Day 9 - &lt;a href=&#34;https://adventofcode.com/2020/day/9&#34;&gt;Encoding error&lt;/a&gt;&lt;/h1&gt;
&lt;h2 id=&#34;adding-pairs&#34;&gt;Adding pairs&lt;/h2&gt;
&lt;p&gt;Here the question is how to calculate the sums of pairs of values in a
sliding window, ideally without redundantly computing the same sums more
than once.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;find_error &amp;lt;- function(series, N = 25) {
  preamble &amp;lt;- head(series, N)
  t(combn(preamble, 2)) -&amp;gt;.; addmargins(., 2) -&amp;gt;.; as.data.frame(.) -&amp;gt; pairs
  for (x in tail(series, -N)) {
    if (!x %in% pairs$Sum)
      return(x)

    pairs &amp;lt;- subset(pairs, V1 != preamble[1] &amp;amp; V2 != preamble[1])
    pairs &amp;lt;- rbind(pairs, data.frame(V1 = x,
                                     V2 = preamble[-1],
                                     Sum = x + preamble[-1]))
    preamble &amp;lt;- c(preamble[-1], x)
  }
}
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;&lt;a href=&#34;https://www.youtube.com/watch?v=tphMSLGXuDE&#34;&gt;John Mount recently pointed
out&lt;/a&gt; that there is already
a ‘pipe’ of sorts in base R, which you can construct using an operator
of the form &lt;code&gt;-&amp;gt;.;&lt;/code&gt;. I use it on the second line of this function just
because converting &lt;code&gt;combn&lt;/code&gt; output into a long data frame format is a bit
verbose.&lt;/p&gt;
&lt;p&gt;To check our working, run on the example dataset:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;example &amp;lt;- c(35, 20, 15, 25, 47, 40, 62, 55, 65, 95, 102, 117, 150, 182, 127,
             219, 299, 277, 309, 576)
find_error(example, 5)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 127
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;And now with the real input data. As in earlier exercises, we need
floating point numbers, rather than integers, because the large numbers
in the real input can cause an integer overflow.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;input &amp;lt;- as.double(readLines(&#39;input09.txt&#39;))
(invalid &amp;lt;- find_error(input))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 542529149
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;contiguous-set&#34;&gt;Contiguous set&lt;/h2&gt;
&lt;p&gt;To find the longest contiguous set of numbers that add up to the value
above, we first recognise that the values are non-negative, so we can
immediately exclude any elements that are after our target invalid
element.&lt;/p&gt;
&lt;p&gt;My procedure will then go as follows. We first initialize an empty set.
Then, iterating backwards through the series:&lt;/p&gt;
&lt;ol&gt;
&lt;li&gt;Add up all the values in the current set.&lt;/li&gt;
&lt;li&gt;If the sum is greater than the target, delete the last element.&lt;/li&gt;
&lt;li&gt;If the sum is equal to the target, and the current set larger than
our current best set (initially empty), save this as our best so
far.&lt;/li&gt;
&lt;li&gt;Prepend the current set with the next element in the sequence.&lt;/li&gt;
&lt;li&gt;Repeat 1–4 until you reach the beginning of the series.&lt;/li&gt;
&lt;/ol&gt;
&lt;p&gt;In R code form:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;contiguous_set &amp;lt;- function(series, target) {
  series &amp;lt;- head(series, which.max(series == target) - 1)
  best_set &amp;lt;- set &amp;lt;- c()
  for (n in rev(series)) {
    if (sum(set) == target &amp;amp; length(set) &amp;gt;= length(best_set))
      best_set &amp;lt;- set
    
    if (sum(set) &amp;gt; target)
      set &amp;lt;- head(set, -1)
    
    set &amp;lt;- c(n, set)
  }
  
  sum(range(best_set))
}
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;On our example dataset we get:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;contiguous_set(example, 127)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 62
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;And on the test dataset, using the value stored from part 1:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;contiguous_set(input, invalid)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 75678618
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;&lt;a id=&#39;day10&#39;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-10---adapter-arrayhttpsadventofcodecom2020day10&#34;&gt;Day 10 - &lt;a href=&#34;https://adventofcode.com/2020/day/10&#34;&gt;Adapter array&lt;/a&gt;&lt;/h1&gt;
&lt;h2 id=&#34;lagged-differences&#34;&gt;Lagged differences&lt;/h2&gt;
&lt;p&gt;This is pretty trivial. Read in the data, append a zero, sort the
numbers, compute the lagged differences (appending a 3), tabulate them
and multiply the result.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;input &amp;lt;- as.integer(readLines(&#39;input10.txt&#39;))
jolts &amp;lt;- c(0, sort(input), max(input) + 3)
prod(table(diff(jolts)))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 2170
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;I could have equally appended the 3 in the second line as
&lt;code&gt;max(input) + 3&lt;/code&gt;.&lt;/p&gt;
&lt;h2 id=&#34;counting-combinations&#34;&gt;Counting combinations&lt;/h2&gt;
&lt;p&gt;Again we will be working on the lagged differences. Let’s look at a few
values from this sequence.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;head(diff(jolts), 20)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt; [1] 1 1 1 3 3 1 1 1 3 1 1 1 1 3 3 1 1 1 1 3
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Which adapters can we remove?&lt;/p&gt;
&lt;p&gt;We are interested in the lengths of the sub-sequences of &lt;code&gt;1&lt;/code&gt;s in this
series. The R function &lt;code&gt;rle&lt;/code&gt; will give the run-length encoding, i.e. the
lengths of subsequences of consecutive equal values in our vector.&lt;/p&gt;
&lt;p&gt;For a length-&lt;em&gt;n&lt;/em&gt; subsequence of differences equal to 1:&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;if &lt;em&gt;n&lt;/em&gt; = 1 the adapter can’t be removed because the gap would then
be 4:
&lt;ul&gt;
&lt;li&gt;${0 \choose 0} = 1$&lt;/li&gt;
&lt;/ul&gt;
&lt;/li&gt;
&lt;li&gt;if &lt;em&gt;n&lt;/em&gt; = 2 then you can only remove the first adapter (or not):
&lt;ul&gt;
&lt;li&gt;${1 \choose 0} + {1 \choose 1} = 2$&lt;/li&gt;
&lt;/ul&gt;
&lt;/li&gt;
&lt;li&gt;if &lt;em&gt;n&lt;/em&gt; = 3 you can keep them all, remove 1 or both of the first 2:
&lt;ul&gt;
&lt;li&gt;${2 \choose 0} + {2 \choose 1} + {2 \choose 2} = 4$&lt;/li&gt;
&lt;/ul&gt;
&lt;/li&gt;
&lt;li&gt;if &lt;em&gt;n&lt;/em&gt; = 4 you can keep them all, or remove &lt;em&gt;up to 2&lt;/em&gt; of the first
3:
&lt;ul&gt;
&lt;li&gt;${3 \choose 0} + {3 \choose 1} + {3 \choose 2} = 7$&lt;/li&gt;
&lt;/ul&gt;
&lt;/li&gt;
&lt;li&gt;and so on (though actually there aren’t any sequences longer than 4)&lt;/li&gt;
&lt;/ul&gt;
&lt;p&gt;Then multiply all these numbers of combinations together for every
subsequence.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;sequences &amp;lt;- as.data.frame(unclass(rle(diff(jolts))))
sequences &amp;lt;- subset(sequences, values == 1)
count_combos &amp;lt;- function(n) sum( choose(n-1, 0:2) )
sequences &amp;lt;- transform(sequences, combos = sapply(lengths, count_combos))
prod(sequences$combos)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 2.480359e+13
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;We probably don’t want scientific notation, so reformat the result:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;format(prod(sequences$combos), scientific = FALSE)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] &amp;quot;24803586664192&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;&lt;a id=&#39;day11&#39;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-11---seating-systemhttpsadventofcodecom2020day11&#34;&gt;Day 11 - &lt;a href=&#34;https://adventofcode.com/2020/day/11&#34;&gt;Seating system&lt;/a&gt;&lt;/h1&gt;
&lt;h2 id=&#34;convoluted-solution&#34;&gt;Convoluted solution&lt;/h2&gt;
&lt;p&gt;This puzzle is effectively applying a &lt;a href=&#34;https://en.wikipedia.org/wiki/Kernel_(image_processing)&#34;&gt;&lt;em&gt;convolution
matrix&lt;/em&gt;&lt;/a&gt; (the
set of rules) to a 2-dimensional image (the seating plan).&lt;/p&gt;
&lt;p&gt;We can import the data as a logical (binary) matrix where zero or
&lt;code&gt;FALSE&lt;/code&gt; means a seat is empty, and one or &lt;code&gt;TRUE&lt;/code&gt; means it is occupied.
Floor space is set to &lt;code&gt;NA&lt;/code&gt;.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;input &amp;lt;- do.call(rbind, strsplit(readLines(&#39;input11.txt&#39;), &#39;&#39;))
input &amp;lt;- input != &#39;L&#39;
input[input &amp;gt; 0] &amp;lt;- NA
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;The rules are:&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;If a seat is empty (&lt;code&gt;L&lt;/code&gt;) and there are no occupied seats adjacent to
it, the seat becomes occupied.&lt;/li&gt;
&lt;li&gt;If a seat is occupied (&lt;code&gt;#&lt;/code&gt;) and four or more seats adjacent to it
are also occupied, the seat becomes empty.&lt;/li&gt;
&lt;li&gt;Otherwise, the seat’s state does not change.&lt;/li&gt;
&lt;/ul&gt;
&lt;p&gt;A convolution kernel matrix can therefore be of the form:&lt;/p&gt;
&lt;p&gt;$$\begin{bmatrix}-1  &amp;amp;  -1  &amp;amp;  -1 \\-1  &amp;amp;   3  &amp;amp;  -1 \\-1  &amp;amp;  -1  &amp;amp;  -1\end{bmatrix}$$&lt;/p&gt;
&lt;p&gt;Which is followed by the filter:&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;If the result is zero or more, then occupy the seat (set equal to
&lt;code&gt;TRUE&lt;/code&gt; or 1)&lt;/li&gt;
&lt;li&gt;Otherwise, empty the seat (set equal to &lt;code&gt;FALSE&lt;/code&gt; or 0)&lt;/li&gt;
&lt;li&gt;If a cell is meant to be floor space, reset to zero (because
&lt;code&gt;OpenImageR&lt;/code&gt; is not currently written to handle &lt;code&gt;NA&lt;/code&gt;s).&lt;/li&gt;
&lt;/ul&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;kernel &amp;lt;- matrix(c(rep(-1, 4), 3, rep(-1, 4)), 3, 3)

convoluted_seating &amp;lt;- function(input, kernel) {
  seats &amp;lt;- replace(input, is.na(input), 0)
  
  for (i in 1:100) {
    convolved &amp;lt;- OpenImageR::convolution(seats, kernel, mode = &#39;same&#39;)
    new_seats &amp;lt;- replace(convolved &amp;gt;= 0, is.na(input), 0)
    
    if ( all(seats == new_seats) )
      return(sum(new_seats))
  
    seats &amp;lt;- new_seats
  }
  
  stop(&#39;Failed to converge after 100 iterations&#39;)
}

convoluted_seating(input, kernel)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 2194
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;This took 95 iterations.&lt;/p&gt;
&lt;h2 id=&#34;line-of-sight&#34;&gt;Line of sight&lt;/h2&gt;
&lt;p&gt;In the first part, floor space was just treated like a seat that nobody
sits in. Now, we have to change our convolution matrix for each pixel
such that, if there is no seat in one direction, we cast our gaze
further and borrow the state of a more distant seat.&lt;/p&gt;
&lt;p&gt;Unfortunately most image analysis packages only accept a constant matrix
as the kernel argument, rather than a function, so we shall have to roll
our own.&lt;/p&gt;
&lt;p&gt;Firstly, we run an algorithm to determine which seats are visible. This
only needs to be run once.&lt;/p&gt;
&lt;p&gt;For each seat:&lt;/p&gt;
&lt;ol&gt;
&lt;li&gt;Set radius equal to 1.&lt;/li&gt;
&lt;li&gt;Look in each of the eight directions for a seat. Is a seat visible?&lt;/li&gt;
&lt;li&gt;For any direction where this is not true, increase radius by 1.&lt;/li&gt;
&lt;li&gt;Repeat 2–3 until a visible seat is recorded for every direction.&lt;/li&gt;
&lt;/ol&gt;
&lt;p&gt;Today I discovered that &lt;code&gt;which()&lt;/code&gt; has an extra argument &lt;code&gt;arr.ind&lt;/code&gt; that,
if &lt;code&gt;TRUE&lt;/code&gt;, returns matrix indices. Handy for quickly converting a matrix
into a long (possibly sparse) representation.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;seat_ids &amp;lt;- which(!is.na(input), arr.ind = TRUE)
dirs &amp;lt;- subset(expand.grid(down = -1:1, right = -1:1), down | right)

radial_search &amp;lt;- function(seat, directions, radius = 1) {
  if (!nrow(directions))
    return(NULL)
  
  i &amp;lt;- seat[1] + radius * directions[[&#39;down&#39;]]
  j &amp;lt;- seat[2] + radius * directions[[&#39;right&#39;]]
  
  in_bounds &amp;lt;- i &amp;gt; 0 &amp;amp; i &amp;lt;= nrow(input) &amp;amp; j &amp;gt; 0 &amp;amp; j &amp;lt;= ncol(input)
  ij &amp;lt;- cbind(i, j)[in_bounds, , drop = FALSE]
  
  seat_exists &amp;lt;- !is.na( input[ij] )
  remaining_dirs &amp;lt;- directions[in_bounds, ][!seat_exists, ]
  visible &amp;lt;- unname(ij[seat_exists, , drop = FALSE])
  
  rbind(visible, radial_search(seat, remaining_dirs, radius + 1))
}

line_of_sight &amp;lt;- apply(seat_ids, 1, radial_search, directions = dirs)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Next we run the seat changing algorithm itself. For each seat:&lt;/p&gt;
&lt;ol&gt;
&lt;li&gt;Add up the number of occupied seats visible from this one.&lt;/li&gt;
&lt;li&gt;If sum is zero and seat is unoccupied, occupy the seat.&lt;/li&gt;
&lt;li&gt;Else if sum is ≥ 5 and seat is occupied, empty the seat.&lt;/li&gt;
&lt;/ol&gt;
&lt;p&gt;Repeat until seating allocation does not change.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;change_places &amp;lt;- function(visible, input) {
  seating_plan &amp;lt;- input
  floor &amp;lt;- is.na(seating_plan)
  
  for (iter in 1:100) {
    new_seating_plan &amp;lt;- seating_plan
    for (seat in seq_along(visible)) {
      current &amp;lt;- seating_plan[!floor][seat]
      neighbours &amp;lt;- sum(seating_plan[visible[[seat]]])
      if (current &amp;amp; neighbours &amp;gt;= 5) {
        new_seating_plan[!floor][seat] &amp;lt;- 0
      } else if (!current &amp;amp; !neighbours) {
        new_seating_plan[!floor][seat] &amp;lt;- 1
      }
    }
    if (all(seating_plan == new_seating_plan, na.rm = TRUE)) {
      return(sum(seating_plan, na.rm = TRUE))
    }
    seating_plan &amp;lt;- new_seating_plan
  }
  
  stop(&#39;Failed to converge after 100 iterations&#39;)
}

change_places(line_of_sight, input)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 1944
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;This was pretty slow, which is to be expected in R. To speed it up, we
can rewrite the guts in a lower-level programming language. There may
also be some scope for vectorisation.&lt;/p&gt;
&lt;p&gt;&lt;a id=&#34;day12&#34;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-12---rain-riskhttpsadventofcodecom2020day12&#34;&gt;Day 12 - &lt;a href=&#34;https://adventofcode.com/2020/day/12&#34;&gt;Rain risk&lt;/a&gt;&lt;/h1&gt;
&lt;h2 id=&#34;complex-directions&#34;&gt;Complex directions&lt;/h2&gt;
&lt;p&gt;I was actually expecting this to be more complicated, with turns in
arbitrary numbers of degrees. But it turns out that they are all
multiples of 90°, so all &lt;code&gt;F&lt;/code&gt; instructions can be simply converted into
&lt;code&gt;N&lt;/code&gt;, &lt;code&gt;E&lt;/code&gt;, &lt;code&gt;S&lt;/code&gt; or &lt;code&gt;W&lt;/code&gt; without invoking trigonometry.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(tidyr)
library(dplyr)
instructions &amp;lt;- tibble(input = readLines(&#39;input12.txt&#39;)) %&amp;gt;%
  extract(input, c(&#39;direction&#39;, &#39;value&#39;), &#39;(\\w)(\\d+)&#39;, convert = TRUE) %&amp;gt;%
  mutate(bearing = cumsum(- value * (direction == &#39;L&#39;)
                          + value * (direction == &#39;R&#39;)),
         bearing = (90 + bearing) %% 360,
         cardinal = ifelse(direction == &#39;F&#39;,
                           c(&#39;N&#39;, &#39;E&#39;, &#39;S&#39;, &#39;W&#39;)[1 + bearing / 90],
                           direction))

head(instructions)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;# A tibble: 6 x 4
  direction value bearing cardinal
  &amp;lt;chr&amp;gt;     &amp;lt;int&amp;gt;   &amp;lt;dbl&amp;gt; &amp;lt;chr&amp;gt;   
1 F             8      90 E       
2 N             2      90 N       
3 F            32      90 E       
4 F            17      90 E       
5 E             4      90 E       
6 N             4      90 N       
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Now let’s work out where we are. No need to store the latitude and
longitude in separate columns; we can add them up as complex numbers and
then sum the real and imaginary parts.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;instructions %&amp;gt;%
  mutate(east = (cardinal == &#39;E&#39;) - (cardinal == &#39;W&#39;),
         north = (cardinal == &#39;N&#39;) - (cardinal == &#39;S&#39;)) %&amp;gt;%
  summarise(position = sum(value * (east + north * 1i)),
            distance = abs(Re(position)) + abs(Im(position)))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;# A tibble: 1 x 2
  position  distance
  &amp;lt;cpl&amp;gt;        &amp;lt;dbl&amp;gt;
1 -127-752i      879
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;eulers-bermuda-triangle&#34;&gt;Euler’s Bermuda Triangle&lt;/h2&gt;
&lt;p&gt;Now the &lt;code&gt;N&lt;/code&gt;, &lt;code&gt;E&lt;/code&gt;, &lt;code&gt;S&lt;/code&gt; and &lt;code&gt;W&lt;/code&gt; directions store up instructions, which
are performed by the ship every time &lt;code&gt;F&lt;/code&gt; is invoked.&lt;/p&gt;
&lt;p&gt;The value of these instructions is rotated in the complex plane for
every &lt;code&gt;L&lt;/code&gt; or &lt;code&gt;R&lt;/code&gt; turn. &lt;a href=&#34;https://en.wikipedia.org/wiki/Euler%27s_formula&#34;&gt;Euler’s
formula&lt;/a&gt; states:
$$e^{ix} = \cos x + i\sin x,$$ and we can use this to work out how to
transform the relative coordinates of the waypoint to the ship every
time there is a turn.&lt;/p&gt;
&lt;p&gt;In the complex plane:&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;turning 90° to the right is equivalent to multiplying by $0-i$,&lt;/li&gt;
&lt;li&gt;turning 90° to the left is equivalent to multiplying by $0+i$,&lt;/li&gt;
&lt;li&gt;turning 180° is equivalent to multiplying by $-1+0i$,&lt;/li&gt;
&lt;li&gt;turning 270° is equivalent to turning by -90° so use the rule above.&lt;/li&gt;
&lt;/ul&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;instructions %&amp;gt;%
  mutate(
    east = value * ((direction == &#39;E&#39;) - (direction == &#39;W&#39;)),
    north = value * ((direction == &#39;N&#39;) - (direction == &#39;S&#39;)),
    radians = value * 2 * pi / 360 * ((direction == &#39;L&#39;) - (direction == &#39;R&#39;)),
    rotate = exp(1i * radians),
    waypoint = (10 + 1i + cumsum((east + north * 1i) * cumprod(1 / rotate))),
  ) %&amp;gt;%
  summarise(position = sum(value * (direction == &#39;F&#39;) * waypoint * cumprod(rotate)),
            distance = abs(Re(position)) + abs(Im(position)))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;# A tibble: 1 x 2
  position   distance
  &amp;lt;cpl&amp;gt;         &amp;lt;dbl&amp;gt;
1 17936-171i   18107.
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;So that we can take advantage of &lt;code&gt;cumsum&lt;/code&gt; and &lt;code&gt;cumprod&lt;/code&gt; vectorisation,
we rotate the ship rather than the waypoint, then reverse the rotation
at the end to get the final position of the ship relative to its
starting point.&lt;/p&gt;
&lt;p&gt;&lt;a id=&#34;day13&#34;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-13---shuttle-searchhttpsadventofcodecom2020day13&#34;&gt;Day 13 - &lt;a href=&#34;https://adventofcode.com/2020/day/13&#34;&gt;Shuttle search&lt;/a&gt;&lt;/h1&gt;
&lt;h2 id=&#34;earliest-bus&#34;&gt;Earliest bus&lt;/h2&gt;
&lt;p&gt;A bus’s ID indicates the interval between departures, starting at time
0.&lt;/p&gt;
&lt;p&gt;This is simple modular arithmetic: find the remainder when the timestamp
is divided by each bus’s ID/interval, then multiply the smallest such
remainder with the corresponding bus’s ID.&lt;/p&gt;
&lt;p&gt;But we want the bus to arrive &lt;em&gt;after&lt;/em&gt; we start waiting at the bus stop,
not before. So we negate the timestamp.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;input &amp;lt;- readLines(&#39;input13.txt&#39;)
timestamp &amp;lt;- as.integer(input[1])
buses &amp;lt;- as.integer(strsplit(input[2], &#39;,&#39;)[[1]])

inservice &amp;lt;- buses[!is.na(buses)]
inservice[which.min(-timestamp %% inservice)] * min(-timestamp %% inservice)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 222
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;bus-cluster&#34;&gt;Bus cluster&lt;/h2&gt;
&lt;p&gt;We seek a timepoint $t$ at which our first listed bus arrives, the
second bus arrives at time $t+1$, and so on. Thus it must have the
following properties:&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;$t \equiv 0 \mod b_0$&lt;/li&gt;
&lt;li&gt;$t \equiv -1 \mod b_1$&lt;/li&gt;
&lt;li&gt;…&lt;/li&gt;
&lt;li&gt;$t \equiv -n \mod b_n$&lt;/li&gt;
&lt;/ul&gt;
&lt;p&gt;First looking at the examples, we can take this naïve approach:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;find_timetable &amp;lt;- function(buses, maxit = 1e5) {
  offsets &amp;lt;- seq_along(buses) - 1
  for (i in seq_len(maxit)) {
    t &amp;lt;- buses[1] * i
    if ( all((-t %% buses) == offsets, na.rm = TRUE) )
      return(t)
  }
  stop(&#39;Failed to find a valid t&#39;)
}

find_timetable(c(17, NA, 13, 19))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 3417
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;find_timetable(c(67, 7, 59, 61))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 754018
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;But this probably isn’t going to scale well. Time to dust off a bit of
number theory. By the &lt;a href=&#34;https://en.wikipedia.org/wiki/Chinese_remainder_theorem&#34;&gt;Chinese remainder
theorem&lt;/a&gt;, for
any $a$, $b$ and coprime $m$, $n$, there exists a unique $x (\mod mn)$
such that $x \equiv a \mod m$ and $x \equiv b \mod n$.&lt;/p&gt;
&lt;p&gt;Here $a,b$ are offsets (the position of the bus in the list), $n$
represents a bus ID and $x$ is the solution we seek.&lt;/p&gt;
&lt;p&gt;The algorithm will be as follows:&lt;/p&gt;
&lt;ol&gt;
&lt;li&gt;Test values in the sequence $a_1, a_1 + n_1, a_1 + 2n_1, \dots$ to
find the first time $x_1$ at which a bus arrives and the second bus
arrives 1 minute later.&lt;/li&gt;
&lt;li&gt;Test values in the sequence
$x_1, x_1 + n_1n_2, x_1 + 2n_1n_2, \dots$ to get a valid time for
the first three buses.&lt;/li&gt;
&lt;li&gt;Repeat.&lt;/li&gt;
&lt;/ol&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;sieve &amp;lt;- function(a1, a2, n1, n2, maxit = 1e5) {
  x &amp;lt;- a1 + n1 * (0:maxit)
  x[which.max(x %% n2 == a2 %% n2)]
}

find_timetable2 &amp;lt;- function(buses) {
  offsets &amp;lt;- -(seq_along(buses) - 1)[!is.na(buses)] # a
  buses &amp;lt;- buses[!is.na(buses)]                     # n
  x &amp;lt;- offsets[1]
  for (i in 2:length(buses))
    x &amp;lt;- sieve(x, offsets[i], prod(head(buses, i-1)), buses[i])
  x
}

format(find_timetable2(buses), sci = FALSE)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] &amp;quot;408270049879073&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;&lt;a id=&#34;day14&#34;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-14---docking-datahttpsadventofcodecom2020day14&#34;&gt;Day 14 - &lt;a href=&#34;https://adventofcode.com/2020/day/14&#34;&gt;Docking data&lt;/a&gt;&lt;/h1&gt;
&lt;h2 id=&#34;bitmask&#34;&gt;Bitmask&lt;/h2&gt;
&lt;p&gt;The trickiest bit(!) in the first part is reading in the data. I wanted
a data frame that ‘remembered’ the value of the last mask set. The other
part is converting to and from binary. To help you along the way, R has
a function called &lt;code&gt;intToBits&lt;/code&gt;, but be careful because it converts to 32
bits and the puzzle is 36-bit.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(dplyr)
library(tidyr)
intTo36Bits &amp;lt;- function(n) {
  bit32 &amp;lt;- rev(as.character(intToBits(n)))
  c(rep(0, 4), as.integer(bit32))
}

binaryToInt &amp;lt;- function(b) {
  b &amp;lt;- as.integer(strsplit(b, &#39;&#39;)[[1]])
  sum(b * 2^rev(seq_along(b) - 1))
}

mask &amp;lt;- function(mask, x) {
  mask &amp;lt;- suppressWarnings(as.integer(strsplit(mask, &#39;&#39;)[[1]]))
  x &amp;lt;- as.integer(strsplit(x, &#39;&#39;)[[1]])
  x[!is.na(mask)] &amp;lt;- mask[!is.na(mask)]
  paste(x, collapse = &#39;&#39;)
}

program &amp;lt;- read.table(&#39;input14.txt&#39;, sep = &#39;=&#39;, strip.white = TRUE,
                      col.names = c(&#39;key&#39;, &#39;value&#39;)) %&amp;gt;%
  extract(key, c(&#39;dest&#39;, &#39;address&#39;), &#39;(mem|mask)\\[?(\\d*)\\]?&#39;,
          convert = TRUE) %&amp;gt;%
  mutate(mask = value[which(dest == &#39;mask&#39;)[cumsum(dest == &#39;mask&#39;)]]) %&amp;gt;%
  filter(dest == &#39;mem&#39;) %&amp;gt;%
  select(-dest) %&amp;gt;%
  mutate(value = as.integer(value),
         value_binary = lapply(value, intTo36Bits),
         value_binary = sapply(value_binary, paste, collapse = &#39;&#39;),
         value_masked = mapply(mask, mask, value_binary))
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;As an example, here is the first value &lt;code&gt;51331021&lt;/code&gt; being masked to become
&lt;code&gt;62069628301&lt;/code&gt;:&lt;/p&gt;
&lt;pre&gt;&lt;code&gt;value:   000000000011000011110011111111001101
mask:    1110X1110XXX101X0011010X110X10X0110X
result:  111001110011101000110101110110001101
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;What is the sum of the values in memory? Well, since we are just
&lt;em&gt;setting&lt;/em&gt; values, the only value we care about is the last one for each
address. Whatever values they took before the end are unimportant.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;program %&amp;gt;%
  group_by(address) %&amp;gt;%
  summarise(last_integer = binaryToInt(last(value_masked))) %&amp;gt;%
  pull(last_integer) %&amp;gt;% sum %&amp;gt;% format(scientific = FALSE) # 14862056079561
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] &amp;quot;14862056079561&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;memory-address-decoder&#34;&gt;Memory address decoder&lt;/h2&gt;
&lt;p&gt;In part 2, the mask applies to the memory address, &lt;em&gt;not&lt;/em&gt; to the value.
Thus the same value gets applied to possibly many addresses.&lt;/p&gt;
&lt;p&gt;It also helps to &lt;em&gt;read the question properly&lt;/em&gt;. I got stuck on this for
ages until I eventually noticed the part that says&lt;/p&gt;
&lt;blockquote&gt;
&lt;p&gt;If the bitmask bit is 0, the corresponding memory address bit is
&lt;strong&gt;unchanged&lt;/strong&gt;.&lt;/p&gt;
&lt;/blockquote&gt;
&lt;p&gt;which meant my mask was doing the wrong thing, even before the floating
bits.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;decode &amp;lt;- function(mask, x) {
  mask &amp;lt;- suppressWarnings(as.integer(strsplit(mask, &#39;&#39;)[[1]]))
  x &amp;lt;- as.integer(strsplit(x, &#39;&#39;)[[1]])
  x[!is.na(mask) &amp;amp; mask] &amp;lt;- mask[!is.na(mask) &amp;amp; mask] # no change if mask is 0!
  n_floating &amp;lt;- sum(is.na(mask))
  decoded &amp;lt;- c()
  for (i in seq_len(2^n_floating) - 1) {
    x[is.na(mask)] &amp;lt;- tail(intTo36Bits(i), n_floating)
    decoded &amp;lt;- c(decoded, paste(x, collapse = &#39;&#39;))
  }
  decoded
}

program %&amp;gt;%
  select(-value_masked) %&amp;gt;%
  mutate(address_binary = sapply(lapply(address, intTo36Bits), paste, collapse = &#39;&#39;),
         address_decoded = mapply(decode, mask, address_binary)) %&amp;gt;%
  select(address_decoded, value_binary) %&amp;gt;%
  tidyr::unnest_longer(address_decoded) %&amp;gt;%
  group_by(address_decoded) %&amp;gt;%
  summarise(last_integer = binaryToInt(last(value_binary))) %&amp;gt;%
  pull(last_integer) %&amp;gt;% sum %&amp;gt;% format(scientific = FALSE)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] &amp;quot;3296185383161&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;There are many ways I could have improved this solution. In particular,
there wasn’t any actual reason why I needed to compress the binary
digits into a string representation between operations—other than making
the tables of values easier to read during debugging. I could have
stored them as vectors or matrices in list-columns, instead.&lt;/p&gt;
&lt;p&gt;&lt;a id=&#34;day15&#34;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-15---rambunctious-recitationhttpsadventofcodecom2020day15&#34;&gt;Day 15 - &lt;a href=&#34;https://adventofcode.com/2020/day/15&#34;&gt;Rambunctious recitation&lt;/a&gt;&lt;/h1&gt;
&lt;h2 id=&#34;memory-game&#34;&gt;Memory game&lt;/h2&gt;
&lt;p&gt;The first part is straightforward even with not particularly optimal
code:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;memory_game &amp;lt;- function(n, start) {
  nstart &amp;lt;- length(start)
  spoken &amp;lt;- integer(10)
  spoken[1:nstart] &amp;lt;- start
  for (i in nstart:(n-1)) {
    before &amp;lt;- which(spoken[1:(i-1)] == spoken[i])
    if (!length(before)) {
      spoken[i+1] &amp;lt;- 0
    } else spoken[i+1] &amp;lt;- i - tail(before, 1)
  }
  spoken[n]
}

memory_game(2020, c(7, 12, 1, 0, 16, 2))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 410
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;long-term-memory&#34;&gt;Long-term memory&lt;/h2&gt;
&lt;p&gt;For the 30 millionth number spoken, it’s probably not very efficient to
carry the whole vector with us. How can we make it more efficient? This
is ten times faster:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;memory_game2 &amp;lt;- function(n, start) {
  nstart &amp;lt;- length(start)
  spoken &amp;lt;- start[-nstart]
  when &amp;lt;- seq_along(spoken)
  current &amp;lt;- start[nstart]
  for (i in nstart:(n-1)) {
    if (!current %in% spoken) {
      next_number &amp;lt;- 0
      spoken &amp;lt;- c(spoken, current)
      when &amp;lt;- c(when, i)
    } else {
      next_number &amp;lt;- i - when[spoken == current]
      when[spoken == current] &amp;lt;- i
    }
    current &amp;lt;- next_number
  }
  current
}

memory_game2(2020, c(7, 12, 1, 0, 16, 2))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 410
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Unfortunately, that still just isn’t fast enough for the problem we
have, partly because it involves growing the size of a large vector
instead of fixing its length in advance. We can use direct lookup from a
vector instead. Treat the indices of a vector (-1, because R indexes
from 1) as the possible spoken numbers, and the values at those indices
as the last time that number was spoken, or zero if it has not been said
so far.&lt;/p&gt;
&lt;p&gt;This vector needs to be of length equal to the number of rounds in the
game, i.e. 30 million elements long, which is not very big in the grand
scheme of things. (When testing, you should also make sure it is at
least as long as the size of the maximum value in the starting numbers.)&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;memory_game3 &amp;lt;- function(n, start) {
  nstart &amp;lt;- length(start)
  spoken &amp;lt;- numeric(max(n, start) + 1)
  spoken[start[-nstart] + 1] &amp;lt;- seq_len(nstart - 1)
  current &amp;lt;- start[nstart]
  for (i in nstart:(n-1)) {
    next_number &amp;lt;- (spoken[current + 1] &amp;gt; 0) * i - spoken[current + 1]
    spoken[current + 1] &amp;lt;- i
    current &amp;lt;- next_number
  }
  current
}

memory_game3(3e7, c(7, 12, 1, 0, 16, 2))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 238
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;It takes just a few seconds to run the third version. At this point I
stopped, because I had the gold star at this point. But further
improvements could still be made, if needed.&lt;/p&gt;
&lt;h2 id=&#34;rcpp-implementation&#34;&gt;Rcpp implementation&lt;/h2&gt;
&lt;p&gt;Later I came back to rewrite it in C++, just to see how much more
quickly it would run. Of course there’s a trade-off between computer
time and programmer time, but this is a simple enough example.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-cpp&#34;&gt;#include &amp;lt;Rcpp.h&amp;gt;

//[[Rcpp::export]]
int memory_game_cpp(int n, Rcpp::NumericVector start) {
  int nstart = start.length() - 1;
  if (n &amp;lt;= nstart) {
    return start[n - 1];
  }
  
  int max_start = Rcpp::max(start) + 1;
  Rcpp::NumericVector spoken(std::max(n + 1, max_start));
  for (int i = 0; i &amp;lt; nstart; i++){
    spoken[start[i]] = i + 1;
  }
  
  int current = start[nstart];
  int next_number;
  for (int i = nstart + 1; i &amp;lt; n; i++){
    next_number = int(spoken[current] &amp;gt; 0) * i - spoken[current];
    spoken[current] = i;
    current = next_number;
  }
  
  return current;
}
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;To see the difference in performance, I passed each of the functions
into the &lt;code&gt;microbenchmark&lt;/code&gt;, which measured the average runtime for
multiple runs, when passed the parameters from part 1 (i.e. &lt;code&gt;n = 2020&lt;/code&gt;).
Below is the resulting distribution of times in microseconds (on a
logarithmic scale).&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2020/aoc-day15-benchmark.png&#34; alt=&#34;&#34;&gt;&lt;/p&gt;
&lt;p&gt;For &lt;code&gt;n = 30000000&lt;/code&gt;, the C++ function completed in just under one
second—about ten times faster than my fastest pure-R code. Worth it?
Possibly not for this one-off exercise, but it’s interesting to note.&lt;/p&gt;
&lt;p&gt;&lt;a id=&#34;day16&#34;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-16---ticket-translationhttpsadventofcodecom2020day16&#34;&gt;Day 16 - &lt;a href=&#34;https://adventofcode.com/2020/day/16&#34;&gt;Ticket translation&lt;/a&gt;&lt;/h1&gt;
&lt;p&gt;The first thing we need to do is parse the input data. Everything can be
grouped into three sections that are separated by blank lines. As each
section is structured rather differently, it’s easier to treat them
separately.&lt;/p&gt;
&lt;p&gt;This is very much a job for the package &lt;code&gt;tidyr&lt;/code&gt;. In my case I will
process &lt;code&gt;your ticket&lt;/code&gt; and &lt;code&gt;nearby tickets&lt;/code&gt; together and the former will
be denoted by a &lt;code&gt;ticket_id&lt;/code&gt; of &lt;code&gt;0&lt;/code&gt;.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;input &amp;lt;- readLines(&#39;input16.txt&#39;)

library(tidyr)
rules &amp;lt;- input[cumsum(!nchar(input)) &amp;lt; 1] %&amp;gt;%
  tibble(rules = .) %&amp;gt;%
  extract(rules,
          c(&#39;field_name&#39;, &#39;min1&#39;, &#39;max1&#39;, &#39;min2&#39;, &#39;max2&#39;),
          &#39;(.+): (\\d+)-(\\d+) or (\\d+)-(\\d+)&#39;,
          convert = TRUE)

tickets &amp;lt;- input[cumsum(!nchar(input)) &amp;gt; 0] %&amp;gt;%
  tibble(value = .) %&amp;gt;%
  subset(grepl(&#39;^\\d&#39;, value)) %&amp;gt;%
  transform(value = strsplit(value, &#39;,&#39;),
            ticket_id = seq_along(value) - 1L) %&amp;gt;%
  unnest_longer(value, indices_to = &#39;field_id&#39;) %&amp;gt;%
  transform(value = as.integer(value))
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;invalid-tickets&#34;&gt;Invalid tickets&lt;/h2&gt;
&lt;p&gt;Firstly we identify and add up the invalid values.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(data.table)
setDT(tickets, key = &#39;ticket_id&#39;)
tickets[, valid_field := any(value %between% .(rules$min1, rules$max1) |
                               value %between% .(rules$min2, rules$max2)),
        by = .(ticket_id, field_id)]
tickets[(!valid_field), sum(value)]
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 19087
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;bipartite-matching&#34;&gt;Bipartite matching&lt;/h2&gt;
&lt;p&gt;Filter out any tickets with invalid fields:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;tickets[, valid_ticket := all(valid_field), by = ticket_id]
tickets &amp;lt;- tickets[(valid_ticket)]
tickets$valid_field &amp;lt;- tickets$valid_ticket &amp;lt;- NULL
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then try to work out which fields are which. For this I finally get to
use a non-equi join in &lt;code&gt;data.table&lt;/code&gt;. Also known as witchcraft.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;rules_long &amp;lt;- rules %&amp;gt;%
  pivot_longer(min1:max2,
               names_to = c(&#39;.value&#39;, &#39;rule&#39;),
               names_pattern = &#39;([a-z]{3})([1-2])&#39;)
setDT(rules_long, key = &#39;field_name&#39;)

matched_fields &amp;lt;- rules_long[tickets[ticket_id &amp;gt; 0],
                             .(field_name, field_id),
                             allow.cartesian = TRUE,
                             on = .(min &amp;lt;= value, max &amp;gt;= value)]
ntickets &amp;lt;- length(unique(tickets$ticket_id)) - 1 # for own ticket
matched_fields[, all := .N &amp;gt;= ntickets, by = .(field_name, field_id)]
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;We have field names assigned to IDs, but it’s not immediately clear what
is the unique solution that maps exactly one field name to one ID. In
graph theory, this is a &lt;em&gt;maximum bipartite matching&lt;/em&gt; and can be solved
as a linear programme.&lt;/p&gt;
&lt;p&gt;The &lt;code&gt;igraph&lt;/code&gt; package has a dedicated function for this. It’s extremely
fragile: if you forget to set the vertex &lt;code&gt;types&lt;/code&gt; then it’ll crash your R
session immediately and without explanation. The types need to indicate
whether a vertex corresponds to a field name or an ID.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(igraph)
g &amp;lt;- graph_from_data_frame(matched_fields[(all)])
V(g)$type &amp;lt;- rep(1:0, each = vcount(g) / 2)
matching &amp;lt;- max_bipartite_match(g)$matching
tickets[, field_name := matching[as.character(field_id)]]
tickets[grepl(&#39;^departure&#39;, field_name) &amp;amp; !ticket_id] -&amp;gt; departures
format(prod(departures$value), scientific = FALSE)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] &amp;quot;1382443095281&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;&lt;a id=&#34;day17&#34;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-17---conway-cubeshttpsadventofcodecom2020day17&#34;&gt;Day 17 - &lt;a href=&#34;https://adventofcode.com/2020/day/17&#34;&gt;Conway cubes&lt;/a&gt;&lt;/h1&gt;
&lt;p&gt;The idea will be to grow the size of our cube by 1 in each of the three
dimensions, keeping all the data so far in the middle. Actually doing
this seems terrible inefficient, so I will instead anticipate the final
size (i.e. &lt;code&gt;dims&lt;/code&gt; + 6 × 2) and pre-allocate this memory.&lt;/p&gt;
&lt;p&gt;The rules are:&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;if a cube is active and exactly 2 or 3 of its neighbours are also
active, the cube remains active. Otherwise, it becomes inactive.&lt;/li&gt;
&lt;li&gt;if a cube is inactive but exactly three of its neighbours are
active, the cube becomes active. Otherwise, the cube remains
inactive.&lt;/li&gt;
&lt;/ul&gt;
&lt;p&gt;This is basically like the convolution we applied in &lt;a href=&#34;#day11&#34;&gt;day 11&lt;/a&gt;,
but with an extra dimension. In R, an array is a matrix with an
arbitrary number of dimensions. We can also take advantage of the outer
product &lt;code&gt;%o%&lt;/code&gt; to pad the space with zeros initially.&lt;/p&gt;
&lt;h2 id=&#34;three-dimensions&#34;&gt;Three dimensions&lt;/h2&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;cubes &amp;lt;- do.call(rbind, strsplit(readLines(&#39;input17.txt&#39;), &#39;&#39;)) == &#39;#&#39;

conway3D &amp;lt;- function(cubes, n) {
  padded &amp;lt;- matrix(0, nrow(cubes) + 2 * n,
                      ncol(cubes) + 2 * n)
  padded[(n + 1):(n + nrow(cubes)),
         (n + 1):(n + ncol(cubes))] &amp;lt;- cubes
  pad1D &amp;lt;- c(rep(0, n + 1), 1, rep(0, n + 1))
  padded &amp;lt;- padded %o% pad1D
  I &amp;lt;- dim(padded)[1]
  J &amp;lt;- dim(padded)[2]
  K &amp;lt;- dim(padded)[3]
  state &amp;lt;- padded
  for (step in seq_len(n)) {
    new_state &amp;lt;- state
    for (i in 1:I)
      for (j in 1:J)
        for (k in 1:K) {
          is &amp;lt;- max(i - 1, 0):min(i + 1, I)
          js &amp;lt;- max(j - 1, 0):min(j + 1, J)
          ks &amp;lt;- max(k - 1, 0):min(k + 1, K)
          neighbours &amp;lt;- sum(state[is, js, ks])
          if (state[i, j, k]) {
            new_state[i, j, k] &amp;lt;- neighbours %in% 3:4
          } else {
            new_state[i, j, k] &amp;lt;- neighbours == 3
          }
        }
    state &amp;lt;- new_state
  }
  sum(state)
}

conway3D(cubes, 6)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 375
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;four-dimensions&#34;&gt;Four dimensions&lt;/h2&gt;
&lt;p&gt;Add another dimension. All this means is that adding another level to
the loop. To allocate space initially, in &lt;code&gt;conway3D&lt;/code&gt; we take the outer
product of the two-dimensional matrix with a vector of zeros with a one
in the middle (&lt;code&gt;pad1D&lt;/code&gt;). In &lt;code&gt;conway4D&lt;/code&gt; the basic idea is the same, but
this time we use a &lt;em&gt;matrix&lt;/em&gt; of zeros with a one in the middle (&lt;code&gt;pad2D&lt;/code&gt;).&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;conway4D &amp;lt;- function(cubes, n) {
  padded &amp;lt;- matrix(0, nrow(cubes) + 2 * n,
                      ncol(cubes) + 2 * n)
  padded[(n + 1):(n + nrow(cubes)),
         (n + 1):(n + ncol(cubes))] &amp;lt;- cubes
  pad2D &amp;lt;- matrix(0, 2 * n + 1, 2 * n + 1)
  pad2D[n + 1, n + 1] &amp;lt;- 1
  padded &amp;lt;- padded %o% pad2D
  I &amp;lt;- dim(padded)[1]
  J &amp;lt;- dim(padded)[2]
  K &amp;lt;- dim(padded)[3]
  L &amp;lt;- dim(padded)[4]
  state &amp;lt;- padded
  for (step in seq_len(n)) {
    new_state &amp;lt;- state
    for (i in 1:I)
      for (j in 1:J)
        for (k in 1:K)
          for (l in 1:L) {
            is &amp;lt;- max(i - 1, 0):min(i + 1, I)
            js &amp;lt;- max(j - 1, 0):min(j + 1, J)
            ks &amp;lt;- max(k - 1, 0):min(k + 1, K)
            ls &amp;lt;- max(l - 1, 0):min(l + 1, L)
            neighbours &amp;lt;- sum(state[is, js, ks, ls])
            if (state[i, j, k, l]) {
              new_state[i, j, k, l] &amp;lt;- neighbours %in% 3:4
            } else {
              new_state[i, j, k, l] &amp;lt;- neighbours == 3
            }
          }
    state &amp;lt;- new_state
  }
  sum(state)
}

conway4D(cubes, 6)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 2192
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;A five-level nested loop is probably most R users’ idea of hell. However
it runs in a couple of seconds, so presumably it’s what they actually
expect you to do here. I wouldn’t expect this code to scale well without
a rewrite in &lt;code&gt;Rcpp&lt;/code&gt; (see &lt;a href=&#34;#day15&#34;&gt;day 15&lt;/a&gt;) or a sparse matrix/tensor
library.&lt;/p&gt;
&lt;p&gt;&lt;a id=&#34;day18&#34;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-18---operation-orderhttpsadventofcodecom2020day18&#34;&gt;Day 18 - &lt;a href=&#34;https://adventofcode.com/2020/day/18&#34;&gt;Operation order&lt;/a&gt;&lt;/h1&gt;
&lt;p&gt;In an R session, the standard order of arithmetic operations applies:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;1 + 2 * 3 + 4 * 5 + 6
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 33
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;ignoring-bidmas&#34;&gt;Ignoring Bidmas&lt;/h2&gt;
&lt;p&gt;But if we define our own arithmetic operators, then R will just read
them from left to right with no ‘Bidmas’ (or ‘Bodmas’ or ‘Pemdas’) to
override it.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;local({
  `%+%` &amp;lt;- function(a, b) a + b
  `%*%` &amp;lt;- function(a, b) a * b
  1 %+% 2 %*% 3 %+% 4 %*% 5 %+% 6
})
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 71
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;It’s also possible to reassign the base &lt;code&gt;+&lt;/code&gt; and &lt;code&gt;*&lt;/code&gt; operators themselves
(with great power comes great responsibility), but if you do this then
it retains ordering, so that’s not so helpful for part 1.&lt;/p&gt;
&lt;p&gt;For now we just need a way to swap out the expressions in the maths
homework for our custom ones, then &lt;code&gt;parse&lt;/code&gt; and &lt;code&gt;eval&lt;/code&gt;uate the formulae.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;maths &amp;lt;- function(expr) {
  `%+%` &amp;lt;- function(a, b) a + b
  `%*%` &amp;lt;- function(a, b) a * b
  expr &amp;lt;- gsub(&#39;\\+&#39;, &#39;%+%&#39;, expr)
  expr &amp;lt;- gsub(&#39;\\*&#39;, &#39;%*%&#39;, expr)
  eval(parse(text = expr))
}

maths(&#39;1 + 2 * 3 + 4 * 5 + 6&#39;)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 71
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;homework &amp;lt;- readLines(&#39;input18.txt&#39;)
results &amp;lt;- sapply(homework, maths)
format(sum(results), scientific = FALSE)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] &amp;quot;50956598240016&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;a-new-order&#34;&gt;A new order&lt;/h2&gt;
&lt;p&gt;In part 2 it turns out that the order of arithmetic operations &lt;em&gt;does&lt;/em&gt;
matter, just that the precedence of addition is above multiplication.
Now we can hijack R’s understanding of operation order for our own
purposes. We’ll call it &lt;code&gt;Bidams&lt;/code&gt; to represent our new order.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;Bidams &amp;lt;- function(expr) {
  # Do not try this at home!
  `+` &amp;lt;- function(a, b) base::`*`(a, b)
  `*` &amp;lt;- function(a, b) base::`+`(a, b)
  expr &amp;lt;- gsub(&#39;\\+&#39;, &#39;tmp&#39;, expr)
  expr &amp;lt;- gsub(&#39;\\*&#39;, &#39;+&#39;, expr)
  expr &amp;lt;- gsub(&#39;tmp&#39;, &#39;*&#39;, expr)
  eval(parse(text = expr))
}

Bidams(&#39;1 + 2 * 3 + 4 * 5 + 6&#39;)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 231
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;results2 &amp;lt;- sapply(homework, Bidams)
format(sum(results2), scientific = FALSE)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] &amp;quot;535809575344339&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Would you ever want to reassign low-level operators like this? Well,
&lt;code&gt;ggplot2&lt;/code&gt; does it—by overloading the &lt;code&gt;+&lt;/code&gt; you can join &lt;code&gt;ggproto&lt;/code&gt; objects
together. (However Hadley Wickham said they would have used a pipe,
&lt;code&gt;%&amp;gt;%&lt;/code&gt;, had they discovered that first).&lt;/p&gt;
&lt;p&gt;Reassigning addition to another function is also a hilarious prank you
can play on someone who never clears out their global workspace. It’ll
teach them the value of starting with clean working environment.&lt;/p&gt;
&lt;p&gt;&lt;a id=&#34;day19&#34;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-19---monster-messageshttpsadventofcodecom2020day19&#34;&gt;Day 19 - &lt;a href=&#34;https://adventofcode.com/2020/day/19&#34;&gt;Monster messages&lt;/a&gt;&lt;/h1&gt;
&lt;p&gt;Consider the first example rule set.&lt;/p&gt;
&lt;pre&gt;&lt;code&gt;0: 1 2
1: &amp;quot;a&amp;quot;
2: 1 3 | 3 1
3: &amp;quot;b&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;This could be written as a regular expression. Rules 1 and 3 are &lt;code&gt;a&lt;/code&gt; and
&lt;code&gt;b&lt;/code&gt; respectively, so then rule 2 is &lt;code&gt;&#39;ab|ba&#39;&lt;/code&gt; and hence rule 0 is
&lt;code&gt;&#39;a(ab|ba)&#39;&lt;/code&gt;, which will match the strings &lt;code&gt;&#39;aab&#39;&lt;/code&gt; and &lt;code&gt;&#39;aba&#39;&lt;/code&gt; but not
&lt;code&gt;&#39;aaa&#39;&lt;/code&gt; or &lt;code&gt;&#39;bba&#39;&lt;/code&gt;.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;grepl(&#39;^a(ab|ba)$&#39;, c(&#39;aab&#39;, &#39;aba&#39;, &#39;aaa&#39;, &#39;bba&#39;))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1]  TRUE  TRUE FALSE FALSE
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;The tricky bit is how to build the regex from a set of rules
programmatically. Let’s look at the more complicated example.&lt;/p&gt;
&lt;pre&gt;&lt;code&gt;0: 4 1 5
1: 2 3 | 3 2
2: 4 4 | 5 5
3: 4 5 | 5 4
4: &amp;quot;a&amp;quot;
5: &amp;quot;b&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;In the first step, we notice that rules 4 and 5 are single characters,
so we can simply replace all &lt;code&gt;4&lt;/code&gt;s and &lt;code&gt;5&lt;/code&gt;s with the letters &lt;code&gt;a&lt;/code&gt; and &lt;code&gt;b&lt;/code&gt;
(dropping the quotation marks for now). We obtain:&lt;/p&gt;
&lt;pre&gt;&lt;code&gt;0: a 1 b
1: 2 3 | 3 2
2: a a | b b
3: a b | b a
4: &amp;quot;a&amp;quot;
5: &amp;quot;b&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then we see that rules 2 and 3 no longer contain any numerical IDs, so
we can slot them into place in rule 1:&lt;/p&gt;
&lt;pre&gt;&lt;code&gt;0: a 1 b
1: (a a | b b) (a b | b a) | (a b | b a) (a a | b b)
2: a a | b b
3: a b | b a
4: &amp;quot;a&amp;quot;
5: &amp;quot;b&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Hence insert the rule 1 into rule 0 and we are done.&lt;/p&gt;
&lt;h2 id=&#34;regex-generator&#34;&gt;Regex generator&lt;/h2&gt;
&lt;p&gt;Import the data:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(magrittr)
input &amp;lt;- readLines(&#39;input19.txt&#39;)
rules &amp;lt;- input[cumsum(!nchar(input)) &amp;lt; 1] %&amp;gt;%
  strsplit(&#39;: &#39;) %&amp;gt;% do.call(rbind, .) %&amp;gt;%
  as.data.frame %&amp;gt;% setNames(c(&#39;id&#39;, &#39;rule&#39;))
messages &amp;lt;- input[cumsum(!nchar(input)) &amp;gt; 0][-1]
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then implement the algorithm, which works like this:&lt;/p&gt;
&lt;ol&gt;
&lt;li&gt;For every rule, replace any integers in the pattern with the rules
corresponding to those integer IDs.&lt;/li&gt;
&lt;li&gt;Repeat until none of the patterns contain any integers.&lt;/li&gt;
&lt;/ol&gt;
&lt;p&gt;For it to be a valid regular expression, we should also ignore the
spaces between the terms, but we don’t need to do this until the very
end.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(stringr)
make_regex_bounded &amp;lt;- function(rules, max_length = Inf) {
  rules %&amp;lt;&amp;gt;%
    transform(regex = str_remove_all(rule, &#39;[&amp;quot;]&#39;)) %&amp;gt;%
    transform(char_only = str_detect(regex, &#39;\\d&#39;, negate = TRUE))
  
  while( any(!rules$char_only) ) {
    rules %&amp;lt;&amp;gt;%
      transform(regex = str_replace_all(regex,
      pattern =  &#39;\\d+&#39;,
      replacement = function(d) {
        rule_d &amp;lt;- rules$regex[rules$id == d]
        len &amp;lt;- str_count(rule_d, &#39;\\([^)]*\\)&#39;)
        if (len &amp;gt; max_length)  # for part 2
          return(&#39;x&#39;)
        if (!str_detect(rule_d, &#39;\\|&#39;))
          return(rule_d)
        sprintf(&#39;(?:%s)&#39;, rule_d)
      }
    )) %&amp;gt;%
      transform(char_only = str_detect(regex, &#39;\\d&#39;, negate = TRUE))
  }
  
  str_remove_all(rules$regex[1], &#39; &#39;)
}
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;All that remains is a bit of housekeeping: for an exact match, the
regular expression should start and end with &lt;code&gt;^&lt;/code&gt; and &lt;code&gt;$&lt;/code&gt; anchors,
otherwise it risks matching substrings of longer messages.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;matching_messages &amp;lt;- function(rules, messages) {
  longest &amp;lt;- max(nchar(messages))
  regex &amp;lt;- sprintf(&#39;^%s$&#39;, make_regex_bounded(rules, longest))
  matches &amp;lt;- str_detect(messages, regex)
  sum(matches)
}

matching_messages(rules, messages)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 285
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;loops-and-bounds&#34;&gt;Loops and bounds&lt;/h2&gt;
&lt;p&gt;The number of possible rules might be infinite, but rules are
monotonically increasing in length, whereas our input messages are of
finite length. Thus the only change we need to make is to impose a cap
on the maximum message length, deleting any parts of rules that are
longer than this, as they will never match any of our messages.&lt;/p&gt;
&lt;p&gt;We incorporated this with a maximum message length in our function
&lt;code&gt;make_regex_bounded&lt;/code&gt;. It isn’t necessary for part 1 but it will cut off
any runaway rules in part 2. It does this by replacing overlong patterns
with the literal letter &lt;code&gt;x&lt;/code&gt;, which (we assume) doesn’t appear in any of
our messages so will never match.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;rules2 &amp;lt;- within(rules, {
  rule[id == &#39;8&#39;] &amp;lt;- &#39;42 | 42 8&#39;
  rule[id == &#39;11&#39;] &amp;lt;- &#39;42 31 | 42 11 31&#39;
})

matching_messages(rules2, messages)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 412
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;I am not sure what the best way is to count the possible lengths of
matches to a regular expression but in this case I used &lt;code&gt;&#39;\([^)]*\)&#39;&lt;/code&gt;,
which detects pairs of brackets that do not contain other brackets. The
shortest possible pattern length is one (or maybe two because I didn’t
enclose single letters in brackets) so this provides a reasonable lower
bound.&lt;/p&gt;
&lt;p&gt;&lt;a id=&#34;day20&#34;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-20---jurassic-jigsawhttpsadventofcodecom2020day20&#34;&gt;Day 20 - &lt;a href=&#34;https://adventofcode.com/2020/day/20&#34;&gt;Jurassic jigsaw&lt;/a&gt;&lt;/h1&gt;
&lt;p&gt;To match up the puzzle edges, we need to find an edge of each puzzle
piece that matches up with at least one other puzzle piece. It’s
possible that there might be multiple candidates, but presumably there
is only one way to fit the entire jigsaw together.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(dplyr)
tiles &amp;lt;- tibble(input = readLines(&#39;input20.txt&#39;)) %&amp;gt;%
    mutate(is_tile_id = grepl(&#39;Tile&#39;, input),
           tile_id = input[which(is_tile_id)[cumsum(is_tile_id)]],
           tile_id = as.integer(gsub(&#39;\\D&#39;, &#39;&#39;, tile_id))) %&amp;gt;%
    subset(!is_tile_id &amp;amp; nchar(input) &amp;gt; 0, select = -is_tile_id) %&amp;gt;%
    group_by(tile_id) %&amp;gt;%
    summarise(tile_matrix = list(input),
              tile_matrix = lapply(tile_matrix, strsplit, &#39;&#39;),
              tile_matrix = lapply(tile_matrix, do.call, what = rbind))
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;We don’t care about the interior data of each tile. And since the entire
puzzle can be rotated, the solution will be non-unique unless we fix the
first tile in place and then fit the other tiles around it.&lt;/p&gt;
&lt;p&gt;Possible transformations are&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;Flip horizontally, or &lt;code&gt;matrix[, ncol(matrix):1]&lt;/code&gt;&lt;/li&gt;
&lt;li&gt;Flip vertically, or &lt;code&gt;matrix[nrow(matrix):1, ]&lt;/code&gt;&lt;/li&gt;
&lt;li&gt;Rotate 90°, or &lt;code&gt;t(matrix)&lt;/code&gt;&lt;/li&gt;
&lt;/ul&gt;
&lt;h2 id=&#34;finding-corner-pieces&#34;&gt;Finding corner pieces&lt;/h2&gt;
&lt;p&gt;If it’s a corner piece, the tile will be joined to exactly two other
tiles. If it’s an edge piece, it will join three other tiles and if it’s
an interior piece then it will join four others.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(tidyr)
dims &amp;lt;- dim(tiles$tile_matrix[[1]])
edges &amp;lt;- tiles %&amp;gt;%
  mutate(top = lapply(tile_matrix, &#39;[&#39;, 1, 1:dims[2]),
         bottom = lapply(tile_matrix, &#39;[&#39;, dims[1], 1:dims[2]), 
         left = lapply(tile_matrix, &#39;[&#39;, 1:dims[1], 1),
         right = lapply(tile_matrix, &#39;[&#39;, 1:dims[1], dims[2])) %&amp;gt;%
  select(-tile_matrix) %&amp;gt;%
  mutate_at(vars(top:right), sapply, paste, collapse = &#39;&#39;) %&amp;gt;%
  pivot_longer(top:right) %&amp;gt;%
  bind_rows(mutate(., name = paste0(name, &#39;rev&#39;),
                   value = stringi::stri_reverse(value)))
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;No point in reversing both the piece and that to which it is matched. So
we fix the first piece in place and rotate the other pieces to fit. A
corner piece is any piece that attaches to two other pieces, where those
two other pieces attach to three other pieces. The actual joining can be
done with a SQL-like &lt;code&gt;dplyr::inner_join&lt;/code&gt;:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(magrittr)
jigsaw &amp;lt;- edges %&amp;gt;%
  inner_join(filter(., tile_id != first(tile_id),
             !grepl(&#39;rev&#39;, name)), ., by = &#39;value&#39;) %&amp;gt;%
  filter(tile_id.x != tile_id.y) %&amp;gt;%
  add_count(tile_id.x, name = &#39;n.x&#39;) %&amp;gt;%
  add_count(tile_id.y, name = &#39;n.y&#39;) 
  
corner &amp;lt;- jigsaw %$%
  union(tile_id.x[n.x == 2 &amp;amp; n.y == 3],
        tile_id.y[n.y == 2 &amp;amp; n.x == 3])

prod(corner) %&amp;gt;% format(scientific = FALSE)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] &amp;quot;15670959891893&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;As you can see I don’t care how the image as a whole fits together—the
code just work out which tiles are valid corner pieces.&lt;/p&gt;
&lt;h2 id=&#34;a-more-complex-approach&#34;&gt;A more complex approach.&lt;/h2&gt;
&lt;p&gt;And now for something completely different. Storing these as matrices
seems awfully inefficient, and coming up with eight different
orientations of the tiles is a bit of a slog. What if we could store,
say, the &lt;code&gt;#&lt;/code&gt; symbols as their indices alone, in a sparse, complex number
representation?&lt;/p&gt;
&lt;p&gt;Thus we make the solution a bit like &lt;a href=&#34;#day12&#34;&gt;day 12&lt;/a&gt; by treating
rotations and translations as complex arithmetic.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;transformations &amp;lt;- expand.grid(flip = c(FALSE, TRUE),
                               rotate = 1i^(1:4),
                               tile_id = unique(tiles$tile_id))

complex_tiles &amp;lt;- tiles %&amp;gt;%
  # Convert to complex coordinates of the &#39;#&#39; symbols.
  mutate(hashes = lapply(tile_matrix, function(x) which(x == &#39;#&#39;, arr.ind = T)),
         hashes = lapply(hashes, function(x) x[, 1] + x[, 2] * 1i)) %&amp;gt;%
  select(-tile_matrix) %&amp;gt;%
  # Transform by flipping (complex conjugate) and rotating (* i).
  left_join(transformations, by = &#39;tile_id&#39;) %&amp;gt;%
  unnest_longer(hashes) %&amp;gt;%
  mutate(hashes2 = ifelse(flip, Conj(hashes) * rotate, hashes * rotate),
         hashes2 = (Re(hashes2) %% (dims[2] + 1)) +
           (Im(hashes2) %% (dims[1] + 1)) * 1i,
         # Cannot do joins on complex numbers:
         rotate = Arg(rotate) %% (2 * pi)) %&amp;gt;%
  group_by(tile_id, flip, rotate) %&amp;gt;%
  summarise(hashes = list(sort(hashes2)), .groups = &#39;drop&#39;)

complex_edges &amp;lt;- complex_tiles %&amp;gt;%
  mutate(top =    lapply(hashes, function(h) Im(h)[Re(h) == 1]),
         left =   lapply(hashes, function(h) Re(h)[Im(h) == 1]),
         right =  lapply(hashes, function(h) Re(h)[Im(h) == dims[1]]),
         bottom = lapply(hashes, function(h) Im(h)[Re(h) == dims[2]])) %&amp;gt;%
  select(-hashes) %&amp;gt;%
  mutate_at(vars(top:bottom), sapply, paste, collapse = &#39; &#39;)

# Find where the edges match between tiles.
complex_edges %&amp;lt;&amp;gt;%
  inner_join(., ., by = c(right = &#39;left&#39;),
            suffix = c(&#39;&#39;, &#39;.right&#39;)) %&amp;gt;%
  filter(tile_id != tile_id.right)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;And here is the solution to part 1, again.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;complex_edges %&amp;gt;%
  count(tile_id) %&amp;gt;% filter(n == min(n)) %$%
  prod(tile_id) %&amp;gt;% format(scientific = FALSE)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] &amp;quot;15670959891893&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;arranging-the-tiles&#34;&gt;Arranging the tiles&lt;/h2&gt;
&lt;p&gt;Now we are actually supposed to build up the image and look for patterns
in it (discarding the edges) that look like this sea monster:&lt;/p&gt;
&lt;pre&gt;&lt;code&gt;                  # 
#    ##    ##    ###
 #  #  #  #  #  #   
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Our approach starts at the top-left of the image and works to the right.
When we get to the end of a row of tiles, we &lt;em&gt;rotate&lt;/em&gt; the first tile of
the previous row so that ‘below’ becomes ‘right’ and we can get the
first tile of the next now (rotating back again to the correct
orientation). Then we convert the complex indices into a matrix of
hashes.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;complex_tiles %&amp;lt;&amp;gt;%
  mutate(hash_content = lapply(hashes, function(h) h[Re(h) &amp;gt; 1 &amp;amp; Im(h) &amp;gt; 1 &amp;amp;
                                                       Re(h) &amp;lt; dims[2] &amp;amp;
                                                       Im(h) &amp;lt; dims[1]]))

image_row &amp;lt;- function(start) {
  img &amp;lt;- NULL
  current_tile &amp;lt;- start
  repeat {
    img &amp;lt;- img %&amp;gt;%
      bind_rows(left_join(current_tile, complex_tiles))
    if ( is.na(current_tile$tile_id.right) )
      break
    next_tile &amp;lt;- current_tile %&amp;gt;%
      select(tile_id = tile_id.right,
             rotate = rotate.right,
             flip = flip.right) %&amp;gt;%
      left_join(complex_edges, by = c(&#39;tile_id&#39;, &#39;rotate&#39;, &#39;flip&#39;))
    
    current_tile &amp;lt;- next_tile
  }
  img
}

# Make sure nothing can appear above/left of start.
row_start &amp;lt;- complex_edges %&amp;gt;%
  add_count(top, name = &#39;n_top&#39;) %&amp;gt;%
  add_count(left, name = &#39;n_left&#39;) %&amp;gt;%
  filter(n_top == 1, n_left == 1) %&amp;gt;%
  slice(2) %&amp;gt;% select(-n_top, -n_left)

grid_size &amp;lt;- sqrt(nrow(tiles))
img_data &amp;lt;- tibble()
for (row in 1:grid_size) {
  img_data %&amp;lt;&amp;gt;% bind_rows(image_row(row_start))
  # Rotate to get the next row start:
  row_start %&amp;lt;&amp;gt;%
    mutate(rotate = (rotate + pi / 2) %% (2 * pi),
           flip = flip) %&amp;gt;%
    select(tile_id, flip, rotate) %&amp;gt;%
    left_join(complex_edges) %&amp;gt;%
    transmute(tile_id = tile_id.right,
              flip = flip.right,
              rotate = (rotate.right - pi / 2) %% (2 * pi)) %&amp;gt;%  # undo rotation
    left_join(complex_edges)
}

stopifnot(&#39;Image is missing tiles&#39; = nrow(img_data) == nrow(tiles))

image &amp;lt;- img_data %&amp;gt;%
  select(tile_id, hashes) %&amp;gt;%
  mutate(row = rep(1:grid_size, each = grid_size),
         col = rep(1:grid_size, times = grid_size)) %&amp;gt;%
  unnest_longer(hashes) %&amp;gt;%
  mutate(hashes = hashes + (dims[1] - 1) * ((col - 1) * 1i + (row - 1)),
         i = Im(hashes), j = Re(hashes))

image &amp;lt;- img_data %&amp;gt;%
  select(tile_id, hashes = hash_content) %&amp;gt;%
  mutate(row = rep(1:grid_size, each = grid_size),
         col = rep(1:grid_size, times = grid_size)) %&amp;gt;%
  unnest_longer(hashes) %&amp;gt;%
  mutate(hashes = hashes + (dims[1] - 2) * ((col - 1) * 1i + (row - 1)),
         i = Im(hashes), j = Re(hashes))
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Here’s what the scene looks like:&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2020/aoc-day20-jigsaw.png&#34; alt=&#34;&#34;&gt;&lt;/p&gt;
&lt;p&gt;Now let’s go monster hunting.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;monster &amp;lt;- c(&#39;                  # &#39;,
             &#39;#    ##    ##    ###&#39;,
             &#39; #  #  #  #  #  #   &#39;)
monster &amp;lt;- do.call(rbind, strsplit(monster, &#39;&#39;)) == &#39;#&#39;
monster_ids &amp;lt;- as.data.frame(which(monster, arr.ind = TRUE))

monster_search &amp;lt;- function(image, monster) {
  monsters &amp;lt;- NULL
  monster_ids &amp;lt;- as.data.frame(which(monster, arr.ind = TRUE))
  for (i in 0:(max(image$i) - max(monster_ids$row)))
    for (j in 0:(max(image$j) - max(monster_ids$col))) {
      shifted_monster &amp;lt;- transform(monster_ids, i = row + i, j = col + j)
      join &amp;lt;- semi_join(shifted_monster, image, by = c(&#39;i&#39;, &#39;j&#39;))
      if (nrow(join) == nrow(monster_ids))
        monsters &amp;lt;- bind_rows(monsters, shifted_monster[, c(&#39;i&#39;, &#39;j&#39;)])
    }
  monsters
}

for (rotation in 1i^(1:4)) {
  for (flip in 0:1) {
    transformed &amp;lt;- image %&amp;gt;%
        mutate(hashes = rotation * if (flip) Conj(hashes) else hashes,
               i = Im(hashes) %% (grid_size * dims[1] - 2),
               j = Re(hashes) %% (grid_size * dims[2] - 2))
    results &amp;lt;- monster_search(transformed, monster)
    if (length(results))
      break
  }
  if (length(results))
    break
}

cat(sprintf(&#39;Found %d monsters; water roughness is %d&#39;,
            nrow(results) / nrow(monster_ids),
            nrow(image) - nrow(results)))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;Found 38 monsters; water roughness is 1964
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Where are they on the map?&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;ggplot(transformed) +
  aes(j, i) +
  geom_tile(fill = &#39;#f5c966&#39;) +
  geom_tile(data = results, fill = &#39;#418997&#39;) +
  scale_y_reverse() +
  theme_void()
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2020/aoc-day20-monsters.png&#34; alt=&#34;&#34;&gt;&lt;/p&gt;
&lt;p&gt;This puzzle was a real slog!&lt;/p&gt;
&lt;p&gt;I got waylaid for a while by the fact you can’t do table joins on
complex number columns in &lt;code&gt;dplyr&lt;/code&gt;. My workaround was to convert the
rotations to their angles in radians (using &lt;code&gt;Arg()&lt;/code&gt;), but in retrospect
it would have been more robust to convert the numbers to string, or just
to give each tile rotation a unique ID.&lt;/p&gt;
&lt;p&gt;&lt;a id=&#34;day21&#34;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-21---allergen-assessmenthttpsadventofcodecom2020day21&#34;&gt;Day 21 - &lt;a href=&#34;https://adventofcode.com/2020/day/21&#34;&gt;Allergen assessment&lt;/a&gt;&lt;/h1&gt;
&lt;p&gt;Each allergen is found in exactly one ingredient.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;input &amp;lt;- readLines(&#39;input21.txt&#39;)

library(tidyr)
ingredients &amp;lt;- tibble(input = input) %&amp;gt;%
  tidyr::extract(input, c(&#39;ingredient&#39;, &#39;allergen&#39;),
                 &#39;(.+) \\(contains (.+)\\)&#39;) %&amp;gt;%
  transform(ingredient = strsplit(ingredient, &#39; &#39;),
            allergen = strsplit(allergen, &#39;, &#39;))
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;allergen-intersection&#34;&gt;Allergen intersection&lt;/h2&gt;
&lt;p&gt;We can find the risky ingredients via an intersection operation between
recipes that contain each allergen.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(dplyr)
risky_foods &amp;lt;- ingredients %&amp;gt;%
  unnest_longer(allergen) %&amp;gt;%
  group_by(allergen) %&amp;gt;%
  summarise(ingredient = Reduce(intersect, ingredient))
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Part 1 asks us to count up the number of times that non-risky foods
appear.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;ingredients %&amp;gt;%
  unnest_longer(ingredient) %&amp;gt;%
  count(ingredient) %&amp;gt;%
  anti_join(risky_foods) %&amp;gt;%
  pull(n) %&amp;gt;% sum
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 2786
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;bipartite-food-pairing&#34;&gt;Bipartite food pairing&lt;/h2&gt;
&lt;p&gt;This is a bipartite graph theory problem, just as in &lt;a href=&#34;#day16&#34;&gt;day 16&lt;/a&gt;.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(igraph)
g &amp;lt;- graph_from_data_frame(risky_foods)
V(g)$type &amp;lt;- V(g)$name %in% risky_foods$ingredient
matching &amp;lt;- max_bipartite_match(g)$matching

matching[V(g)$type] %&amp;gt;%
  sort %&amp;gt;% names %&amp;gt;%
  paste(collapse = &#39;,&#39;)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] &amp;quot;prxmdlz,ncjv,knprxg,lxjtns,vzzz,clg,cxfz,qdfpq&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Refreshingly straightforward.&lt;/p&gt;
&lt;p&gt;&lt;a id=&#34;day22&#34;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-22---crab-combathttpsadventofcodecom2020day22&#34;&gt;Day 22 - &lt;a href=&#34;https://adventofcode.com/2020/day/22&#34;&gt;Crab combat&lt;/a&gt;&lt;/h1&gt;
&lt;h2 id=&#34;combat&#34;&gt;Combat&lt;/h2&gt;
&lt;p&gt;Games are independent of one another until cards from previous games
come back into play. Therefore, if player 1 has $n$ cards and player2
has $m$ cards, we can simulate the first $\min(n, m)$ rounds in
parallel.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;combat &amp;lt;- function(p1, p2) {
  if (!length(p1)) return(p2)
  if (!length(p2)) return(p1)
  length(p1) &amp;lt;- length(p2) &amp;lt;- max(length(p1), length(p2))
  win1 &amp;lt;- p1 &amp;gt; p2
  result1 &amp;lt;- c(rbind(p1[win1], p2[win1]))
  result2 &amp;lt;- c(rbind(p2[!win1], p1[!win1]))
  output1 &amp;lt;- c(p1[is.na(win1)], result1)
  output2 &amp;lt;- c(p2[is.na(win1)], result2)
  combat(output1[!is.na(output1)], output2[!is.na(output2)])
}
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Test on the example data:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;ex1 &amp;lt;- c(9, 2, 6, 3, 1)
ex2 &amp;lt;- c(5, 8, 4, 7, 10)
example &amp;lt;- combat(ex1, ex2)
sum(rev(example) * seq_along(example))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 306
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Now read in the puzzle input and simulate for part 1.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;input &amp;lt;- as.integer(readLines(&#39;input22.txt&#39;))
deck &amp;lt;- matrix(input[!is.na(input)], ncol = 2)
result &amp;lt;- combat(deck[, 1], deck[, 2])
sum(rev(result) * seq_along(result))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 30138
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Apparently, I wasn’t supposed to do the first part with a recursion and
should have used a &lt;code&gt;while&lt;/code&gt; loop, instead. I have to fix this in the
second part, as we shall see.&lt;/p&gt;
&lt;h2 id=&#34;recursive-combat&#34;&gt;Recursive combat&lt;/h2&gt;
&lt;p&gt;For the next round we actually need a recursion.&lt;/p&gt;
&lt;p&gt;The rules are as follows:&lt;/p&gt;
&lt;ol&gt;
&lt;li&gt;If this exact round has happened before (during &lt;em&gt;this game&lt;/em&gt;), we
stop and player 1 automatically wins the &lt;em&gt;game&lt;/em&gt;, to prevent an
infinite recursion.&lt;/li&gt;
&lt;li&gt;If each player’s deck has more cards than the &lt;code&gt;value&lt;/code&gt; of their
latest draw, copy the next &lt;code&gt;value&lt;/code&gt; cards and play a (recursive)
sub-game to determine the winner of this round.&lt;/li&gt;
&lt;li&gt;Otherwise, the player with the higher-value card wins the round.&lt;/li&gt;
&lt;/ol&gt;
&lt;p&gt;To keep track of already-played rounds, I’m going to store the deck
configuration as a string. However, you could also take a hint from
submitting the answer to part 1: the sum of the deck multiplied by its
indices is unique.&lt;/p&gt;
&lt;p&gt;For part 2 it’s not as easy to take advantage of vectorisation, because
even though a win or a loss is still a binary value, it depends on the
result of the previous game (in the event that it goes to a sub-game).&lt;/p&gt;
&lt;p&gt;Since the outer function needs to return scores (for submitting as our
puzzle answer) but the inner functions need only to say who won each
match, we can return the final deck as a positive vector if it was
player 1 who won, and negated if it was player 2.&lt;/p&gt;
&lt;p&gt;Initially I tried to wrap up my previously-recursive function for part 1
in another recursion.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;recursive_recursive_combat &amp;lt;- function(p1, p2, subgame = FALSE,
                                       played = NULL) {
  if (!length(p1)) return(-p2)
  if (!length(p2)) return(p1)
  # If player 1 holds highest card, skip the sub-game.
  if (subgame &amp;amp; (max(p1) &amp;gt; max(p2))) return(p1)
  
  # Has this game already been played? If so, player 1 wins.
  config &amp;lt;- paste(p1, p2, collapse = &#39;,&#39;, sep = &#39;|&#39;)
  if (config %in% played) return(p1)
  played &amp;lt;- c(played, config)
  
  # Does each player have as many cards as their last dealt card value?
  # If so, play a sub-game with a copy of the next {value} cards.
  if (p1[1] &amp;lt; length(p1) &amp;amp; p2[1] &amp;lt; length(p2)) {
    win1 &amp;lt;- all( recursive_recursive_combat(head(p1[-1], p1[1]),
                                            head(p2[-1], p2[1]),
                                            subgame = TRUE) &amp;gt; 0)
  } else win1 &amp;lt;- p1[1] &amp;gt; p2[1]
  
  result1 &amp;lt;- c(p1[-1], p1[1][win1], p2[1][win1])
  result2 &amp;lt;- c(p2[-1], p2[1][!win1], p1[1][!win1])
  
  recursive_recursive_combat(result1, result2, subgame, played)
}
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;This works OK on the small example dataset. Testing on the example data,
a negative score indicates it is the crab who wins:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;example2 &amp;lt;- recursive_recursive_combat(ex1, ex2, F)
sum(rev(example2) * seq_along(example2))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] -291
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;But on the test inputs, it became clear that a recursion within a
recursion was not such a great idea. The deeply nested recursion causes
a stack overflow. (&lt;em&gt;Edit&lt;/em&gt;: at least, it did before I added the sub-game
skipping trick, described below.)&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;result2 &amp;lt;- recursive_recursive_combat(deck[, 1], deck[, 2])
sum(rev(result2) * seq_along(result2))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 31587
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Rewriting the main game as a loop is probably better coding practice.
This is the equivalent non-doubly-recursive version:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;recursive_combat &amp;lt;- function(p1, p2, subgame = FALSE) {
  if (subgame &amp;amp; (max(p1) &amp;gt; max(p2))) return(p1)
  played &amp;lt;- NULL
  while (length(p1) &amp;amp; length(p2)) {
    config &amp;lt;- paste(p1, p2, collapse = &#39;,&#39;, sep = &#39;|&#39;)
    if (config %in% played) return(p1)
    played &amp;lt;- c(played, config)
    
    if (p1[1] &amp;lt; length(p1) &amp;amp; p2[1] &amp;lt; length(p2)) {
      win1 &amp;lt;- all( recursive_combat(head(p1[-1], p1[1]),
                                    head(p2[-1], p2[1]),
                                    subgame = TRUE) &amp;gt; 0 )
    } else win1 &amp;lt;- p1[1] &amp;gt; p2[1]
    
    result1 &amp;lt;- c(p1[-1], p1[1][win1], p2[1][win1])
    result2 &amp;lt;- c(p2[-1], p2[1][!win1], p1[1][!win1])
    
    p1 &amp;lt;- result1
    p2 &amp;lt;- result2
  }
  
  if (!length(p1)) return(-p2)
  p1
}

result2 &amp;lt;- recursive_combat(deck[, 1], deck[, 2])
sum(rev(result2) * seq_along(result2))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 31587
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Writing recursive functions just to avoid loops is a bad idea because it
can result in nesting so deep that a stack overflow occurs, and it’s
just as easy to write a &lt;code&gt;while&lt;/code&gt; loop for the outer part of this
algorithm.&lt;/p&gt;
&lt;p&gt;However, since I originally solved this problem, I came across a trick
that not only prevents a stack overflow, but it speeds up the algorithm
significantly by avoiding a large amount of unnecessary computation
(both for the double recursion and outer-loop versions).&lt;/p&gt;
&lt;p&gt;Specifically: in any sub-game, if player 1 holds the highest card, they
are &lt;em&gt;guaranteed&lt;/em&gt; to win. This is because they will never hand this
maximum card over to player 2, so the sub-game will just continue until
either player 2 loses, or a loop occurs, in which case player 1 wins by
default according to rule 1.&lt;/p&gt;
&lt;p&gt;&lt;em&gt;(The maximum card will &lt;strong&gt;never&lt;/strong&gt; trigger a sub-sub-game, because the
maximum value in a set of distinct natural numbers is always greater
than or equal to the size of that set. You could even use this fact to
skip the main game of recursive combat—if you didn’t need to know the
final score.)&lt;/em&gt;&lt;/p&gt;
&lt;p&gt;By checking before each sub-game if player 1 holds the maximum card, and
skipping the sub-game if it is a foregone conclusion, a huge amount of
computation can be avoided, and it may even reduce the call stack such
that &lt;code&gt;recursive_recursive_combat()&lt;/code&gt; works without error (at least on my
input data).&lt;/p&gt;
&lt;p&gt;According to &lt;code&gt;microbenchmark&lt;/code&gt;, this trick cuts my run time from around
34 seconds to just 250 milliseconds on the full data (and the loop is a
few ms faster than the double recursion).&lt;/p&gt;
&lt;p&gt;Also: the crab lost.&lt;/p&gt;
&lt;p&gt;&lt;a id=&#34;day23&#34;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-23---crab-cupshttpsadventofcodecom2020day23&#34;&gt;Day 23 - &lt;a href=&#34;https://adventofcode.com/2020/day/23&#34;&gt;Crab cups&lt;/a&gt;&lt;/h1&gt;
&lt;h2 id=&#34;ten-moves&#34;&gt;Ten moves&lt;/h2&gt;
&lt;p&gt;In the first part, the key bit to figure out is how to cycle through a
vector, such that if you reach either the maximum index or maximum
value, the following index/value loops back round to the start.&lt;/p&gt;
&lt;p&gt;You can do this with modular arithmetic, for which I wrote a utility
function &lt;code&gt;idx()&lt;/code&gt;, which makes the rest of the code easier to read. R
indices and the values on the cups both start at 1 (rather than 0) so
you need to subtract 1, get the modulo and then add 1 again.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;crab_cups &amp;lt;- function(circle, moves = 10) {
  ncups &amp;lt;- length(circle)
  idx &amp;lt;- function(i) 1 + (i - 1) %% ncups
  i &amp;lt;- 1
  for (iter in 1:moves) {
    current &amp;lt;- circle[idx(i)]
    grab &amp;lt;- circle[idx(seq(i + 1, i + 3))]
    dest &amp;lt;- idx(current - 1:4)
    dest &amp;lt;- dest[which.min(dest %in% grab)]
    next_circle &amp;lt;- setdiff(circle, grab)
    next_circle &amp;lt;- append(next_circle, grab,
                          after = which(next_circle == dest))
    circle &amp;lt;- next_circle
    i &amp;lt;- which(circle == current) + 1
  }
  circle
}

labels &amp;lt;- function(circle) {
  n &amp;lt;- length(circle)
  i1 &amp;lt;- which(circle == 1)
  result &amp;lt;- circle[1 + (i1 + 0:(n - 2)) %% n]
  paste(result, collapse = &#39;&#39;)
}

example &amp;lt;- crab_cups(c(3, 8, 9, 1, 2, 5, 4, 6, 7))
labels(example)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] &amp;quot;92658374&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Another helper function, &lt;code&gt;labels()&lt;/code&gt;, deals with rotating the vector so
we get all the values after the cup labelled with a 1.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;input &amp;lt;- c(9, 7, 4, 6, 1, 8, 3, 5, 2)
result &amp;lt;- crab_cups(input, 100)
labels(result)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] &amp;quot;75893264&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;ten-million-moves&#34;&gt;Ten million moves&lt;/h2&gt;
&lt;p&gt;In principle we’ve just been asked to add a load of cups and run the
same thing again, but clearly this won’t scale well over ten million
moves with a million cups. There must be a trick here to reduce the
computational load, but what is it? Ten million moves is a tiny amount
relative to the number of possible orderings (which is $1000000!$) so it
seems unlikely we’ll hit a loop.&lt;/p&gt;
&lt;p&gt;There is no way to skip steps as in yesterday’s problem. Instead, we
look at how the circle itself is stored.&lt;/p&gt;
&lt;p&gt;To avoid shrinking and resizing the vector of values, or updating many
elements’ values or positions in place, we can take advantage of a data
structure known as a &lt;a href=&#34;https://en.wikipedia.org/wiki/Linked_list&#34;&gt;linked
list&lt;/a&gt;. In a linked list,
positions of elements are described by &lt;em&gt;relative&lt;/em&gt; rather than absolute
indices.&lt;/p&gt;
&lt;p&gt;We can store the cups as a linked list where each label is linked to the
label of the cup immediately preceding (anti-clockwise to) it in the
circle. Then, at each iteration, the only nodes that need updating are
the current cup, the destination cup and those cups that are immediately
adjacent to the three we pick up.&lt;/p&gt;
&lt;p&gt;There is no specific class for linked lists in base R; instead you can
use an ordinary vector where the index of each element corresponds to
the label of the previous one. An nifty one-liner for this is
&lt;code&gt;c(x[-1], x[1])[order(x)]&lt;/code&gt;, which you can see implemented below.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;linked_cups &amp;lt;- function(circle, moves = 10, terms = 9) {
  ncups &amp;lt;- length(circle)
  stopifnot(terms &amp;lt;= ncups)
  # Linked list where each index is the label of the preceding cup.
  lnklst &amp;lt;- c(circle[-1], circle[1])[order(circle)]
  current &amp;lt;- circle[1]
  for (iter in 1:moves) {
    # Pick the 3 next cups.
    grab1 &amp;lt;- lnklst[current]
    grab2 &amp;lt;- lnklst[grab1]
    grab3 &amp;lt;- lnklst[grab2]
    # Choose destination.
    dest &amp;lt;- 1 + (current - 1:4 - 1) %% ncups
    dest &amp;lt;- dest[which.min(dest %in% c(grab1, grab2, grab3))]
    # Lift out the 3 cups.
    lnklst[current] &amp;lt;- lnklst[grab3]
    # Slot in the 3 cups.
    lnklst[grab3] &amp;lt;- lnklst[dest]
    lnklst[dest] &amp;lt;- grab1
    # Move clockwise by 1.
    current &amp;lt;- lnklst[current]
  }
  
  # Convert back into a vector of labels for output.
  cups &amp;lt;- integer(terms)
  cups[1] &amp;lt;- 1
  for (i in 2:terms) cups[i] &amp;lt;- lnklst[cups[i-1]]
  cups
}

result2 &amp;lt;- linked_cups(c(input, 10:1e6), 1e7, terms = 3)
prod(result2)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 38162588308
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;As a linked list has no absolute start or end point, the function above
just returns the few terms immediately after 1 in the circle, which is
all we need for the puzzle solution.&lt;/p&gt;
&lt;p&gt;A more R-like solution might be just to use a named vector/list.
Something like:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;linked_list &amp;lt;- setNames(c(circle[-1], circle[1]), circle)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;though you have to be careful with this because &lt;code&gt;linked_list[&#39;1&#39;]&lt;/code&gt; is
not the same thing as &lt;code&gt;linked_list[1]&lt;/code&gt;. The former means ‘the label
after label 1’ whereas the latter just gives the first element of the
vector (which could be something else entirely, unless the vector were
sorted by its names). An advantage of a named vector is that you can
have any labels you like, including zeros, negative numbers,
non-integers or strings.&lt;/p&gt;
&lt;p&gt;However, for this particular example, the conversion back and forth from
integer to character makes a named vector/list slower than the
index-based solution above.&lt;/p&gt;
&lt;p&gt;&lt;a id=&#34;day24&#34;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-24---lobby-layouthttpsadventofcodecom2020day24&#34;&gt;Day 24 - &lt;a href=&#34;https://adventofcode.com/2020/day/24&#34;&gt;Lobby layout&lt;/a&gt;&lt;/h1&gt;
&lt;p&gt;The first challenge in this puzzle is parsing the input, which has no
delimiters between directions. As the directions are &lt;code&gt;e&lt;/code&gt;, &lt;code&gt;se&lt;/code&gt;, &lt;code&gt;sw&lt;/code&gt;,
&lt;code&gt;w&lt;/code&gt;, &lt;code&gt;nw&lt;/code&gt; and &lt;code&gt;ne&lt;/code&gt;, there aren’t any directions that are a partial match
for any other direction. So we can use a regular expression to split up
the input.&lt;/p&gt;
&lt;p&gt;That is, every direction ends with either &lt;code&gt;&#39;e&#39;&lt;/code&gt; or &lt;code&gt;&#39;w&#39;&lt;/code&gt;, and starts
with any other cardinal direction. So we break up the input strings as
follows using a regular expression &lt;em&gt;lookbehind&lt;/em&gt; and &lt;em&gt;lookahead&lt;/em&gt;,
effectively making a custom word boundary:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;input &amp;lt;- readLines(&#39;input24a.txt&#39;)
input &amp;lt;- stringi::stri_split(input, regex = &#39;(?&amp;lt;=[ew])(?=.)&#39;)
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;hexagonal-coordinates&#34;&gt;Hexagonal coordinates&lt;/h2&gt;
&lt;p&gt;The next thing we need is a coordinate system. An ordinary 2-dimensional
lattice in Cartesian coordinates doesn’t quite do the trick, because we
can move in six directions, not just four.&lt;/p&gt;
&lt;p&gt;We need an &lt;a href=&#34;https://math.stackexchange.com/a/2643016&#34;&gt;hexagonal coordinate
system&lt;/a&gt; and one way of
representing this is in three-dimensional space $(x, y, z)$ where
$x + y + z = 0$ for every point at the origin. Then axial offsets are:&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;origin - (0, 0)&lt;/li&gt;
&lt;li&gt;&lt;code&gt;ne&lt;/code&gt; - (1, -1)&lt;/li&gt;
&lt;li&gt;&lt;code&gt;e&lt;/code&gt; - (1, 0)&lt;/li&gt;
&lt;li&gt;&lt;code&gt;se&lt;/code&gt; - (0, 1)&lt;/li&gt;
&lt;li&gt;&lt;code&gt;sw&lt;/code&gt; - (-1, 1)&lt;/li&gt;
&lt;li&gt;&lt;code&gt;w&lt;/code&gt; - (-1, 0)&lt;/li&gt;
&lt;li&gt;&lt;code&gt;nw&lt;/code&gt; - (0, -1)&lt;/li&gt;
&lt;/ul&gt;
&lt;p&gt;It’s not so easy to visualise this, but it should be easy enough to
implement in R. Let zero represent a white tile and one represent black,
and construct a coordinate system $(x, y, z)$ defined as above.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(dplyr)
hex_coords &amp;lt;- tibble(
  dir = c(&#39;ne&#39;, &#39;e&#39;, &#39;se&#39;, &#39;sw&#39;, &#39;w&#39;, &#39;nw&#39;),
  x = c(1, 1, 0, -1, -1, 0),
  y = c(-1, 0, 1, 1, 0, -1)
)

floor_pattern &amp;lt;- tibble(
  row = rep(seq_along(input), lengths(input)),
  dir = unlist(input)
) %&amp;gt;%
  left_join(hex_coords, by = &#39;dir&#39;)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Now we have a data frame containing our instructions, we need to follow
them, which amounts to taking the cumulative sum of the individual
directions.&lt;/p&gt;
&lt;p&gt;I got very confused by this by not reading the puzzle properly. In
particular:&lt;/p&gt;
&lt;blockquote&gt;
&lt;p&gt;Each line in the list identifies &lt;strong&gt;a single tile&lt;/strong&gt; that needs to be
flipped by giving a series of steps starting from a reference tile in
the very center of the room.&lt;/p&gt;
&lt;/blockquote&gt;
&lt;p&gt;Initially I assumed that every tile you walk on as you go along the line
also got flipped. But it’s only the very end of each line that needs
flipping.&lt;/p&gt;
&lt;p&gt;Thus the solution is a simple split-apply-combine operation. We add up
the coordinates to find out which tile each line of the input refers to.
Then we count how many times each tile appears, and our result is the
number of tiles that appear an odd number of times.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;black_tiles &amp;lt;- floor_pattern %&amp;gt;%
  group_by(row) %&amp;gt;%
  summarise(x = sum(x), y = sum(y)) %&amp;gt;%
  count(x, y) %&amp;gt;%
  filter(n %% 2 == 1)

nrow(black_tiles)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 10
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;conway-tiles&#34;&gt;Conway tiles&lt;/h2&gt;
&lt;p&gt;The second part of this puzzle is essentially similar to &lt;a href=&#34;#day17&#34;&gt;day
17&lt;/a&gt;. We can adapt that code for this puzzle, or take a slightly
different approach.&lt;/p&gt;
&lt;p&gt;A reminder, the rules are:&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;any black tile with zero or more than 2 black tiles immediately
adjacent to it is flipped to white.&lt;/li&gt;
&lt;li&gt;any white tile with exactly 2 black tiles immediately adjacent to it
is flipped to black.&lt;/li&gt;
&lt;/ul&gt;
&lt;p&gt;Here is a (slow) dataframe-based approach that uses lots of joins.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;full_grid &amp;lt;- expand.grid(i = -100:100,
                         j = -100:100) %&amp;gt;%
  left_join(black_tiles, by = c(i = &#39;x&#39;, j = &#39;y&#39;)) %&amp;gt;%
  mutate(n = !is.na(n)) %&amp;gt;%
  rename(black = n) %&amp;gt;%
  tidyr::crossing(hex_coords) %&amp;gt;%
  mutate(neighbour_x = i + x,
         neighbour_y = j + y) %&amp;gt;%
  select(-x, -y)

for (day in 1:100) {
  full_grid &amp;lt;- full_grid %&amp;gt;%
    inner_join(full_grid %&amp;gt;% distinct(i, j, black),
               by = c(neighbour_x = &#39;i&#39;, neighbour_y = &#39;j&#39;),
               suffix = c(&#39;&#39;, &#39;.y&#39;)) %&amp;gt;%
    add_count(i, j, wt = black.y) %&amp;gt;%
    mutate(black = ifelse(black, n == 1 | n == 2, n == 2)) %&amp;gt;%
    select(-black.y, -n)
}

full_grid %&amp;gt;%
  filter(black) %&amp;gt;%
  distinct(i, j) %&amp;gt;%
  nrow
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 2208
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;It’s not very efficient, but it works!&lt;/p&gt;
&lt;p&gt;Here is what the grid looks like after 100 days (except the actual
pattern would be hexagonal).&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2020/aoc-day24-floor.png&#34; alt=&#34;&#34;&gt;&lt;/p&gt;
&lt;h2 id=&#34;faster-approach&#34;&gt;Faster approach?&lt;/h2&gt;
&lt;p&gt;I’ve been inspired by &lt;a href=&#34;https://twitter.com/Brotherluii/status/1342060160433401859&#34;&gt;Thomas Loock on
Twitter&lt;/a&gt;,
whose concise solution takes advantage of Python’s
&lt;a href=&#34;https://docs.python.org/3/library/collections.html#collections.defaultdict&#34;&gt;&lt;code&gt;defaultdict&lt;/code&gt;&lt;/a&gt;
data structure. This is like an ordinary Python dictionary, but if you
try to extract a key that doesn’t exist, it returns a default value
(e.g. &lt;code&gt;false&lt;/code&gt;) rather than throwing an error.&lt;/p&gt;
&lt;p&gt;Can we implement something similar in R?&lt;/p&gt;
&lt;p&gt;The nearest R equivalent to a Python dictionary is a named list. But is
there an R equivalent to a &lt;code&gt;defaultdict&lt;/code&gt;? Well, a few things, actually.
In fact, most R data structures will return either &lt;code&gt;NA&lt;/code&gt; (vectors) or
&lt;code&gt;NULL&lt;/code&gt; (lists) if the key or index is missing. The exception to this is
arrays/matrices, which throw a &lt;code&gt;subscript out of bounds&lt;/code&gt; error if that
dimension doesn’t exist.&lt;/p&gt;
&lt;p&gt;Here is an R translation. The dictionary &lt;code&gt;delta&lt;/code&gt; can be a named list.
Looping over lines of an open file is probably not very R-like, so we
use the regex from earlier to parse the input. Similarly, most of the
rest of the initial &lt;code&gt;while&lt;/code&gt; loop can be a one-liner, leaving just the
issue of getting rid of tiles flipped back to white.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;delta &amp;lt;- list(w = c(-1, 0), e = c(1, 0), ne = c(0, 1), nw = c(-1, 1),
              se = c(1, -1), sw = c(0, -1))
file &amp;lt;- readLines(&#39;input24.txt&#39;)
input &amp;lt;- stringi::stri_split(file, regex = &#39;(?&amp;lt;=[ew])(?=.)&#39;)
tiles &amp;lt;- sapply(input, function(x) Reduce(&#39;+&#39;, delta[x]))
tiles &amp;lt;- setNames(as.data.table(t(tiles)), c(&#39;x&#39;, &#39;y&#39;))
tiles &amp;lt;- tiles[j = .(n = .N), by = .(x, y)]

cat(&#39;Part 1:&#39;, tiles[n %% 2 == 1, .N])
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;Part 1: 473
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;deltaDT &amp;lt;- setNames(as.data.table(do.call(rbind, delta)), c(&#39;dx&#39;, &#39;dy&#39;))
for (day in 1:100) {
  tiles &amp;lt;- tiles[n %% 2 == 1]
  neighbours &amp;lt;- setDT(tidyr::crossing(tiles, deltaDT))
  neighbours[, x := x + dx][, y := y + dy]
  neighbours &amp;lt;- neighbours[, .(nbrs = .N), by = .(x, y)]
  tiles &amp;lt;- merge(tiles, neighbours, all = TRUE)
  # If is.na(n), tile is white.
  # If is.na(nbrs), tile has no neighbours.
  tiles[!is.na(n), new := !is.na(nbrs) &amp;amp; nbrs &amp;gt; 0 &amp;amp; nbrs &amp;lt; 3]
  tiles[is.na(n),  new := !is.na(nbrs) &amp;amp; nbrs == 2]
  tiles[, n := new][, new := NULL][, nbrs := NULL]
}

cat(&#39;Part 2:&#39;, tiles[n %% 2 == 1, .N])
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;Part 2: 4070
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Once into part 2, it’s back to a tabular solution, but this &lt;code&gt;data.table&lt;/code&gt;
implementation is much faster than the &lt;code&gt;dplyr&lt;/code&gt; version originally
implemented above.&lt;/p&gt;
&lt;p&gt;&lt;a id=&#34;day25&#34;&gt;&lt;/a&gt;&lt;/p&gt;
&lt;h1 id=&#34;day-25---combo-breakerhttpsadventofcodecom2020day25&#34;&gt;Day 25 - &lt;a href=&#34;https://adventofcode.com/2020/day/25&#34;&gt;Combo breaker&lt;/a&gt;&lt;/h1&gt;
&lt;ol&gt;
&lt;li&gt;Set value to itself multiplied by the subject number (&lt;code&gt;7&lt;/code&gt;).&lt;/li&gt;
&lt;li&gt;Set the value to itself modulo &lt;code&gt;20201227&lt;/code&gt;.&lt;/li&gt;
&lt;li&gt;Repeat &lt;code&gt;loopsize&lt;/code&gt; times until we get the original value again.&lt;/li&gt;
&lt;/ol&gt;
&lt;p&gt;Once we have the loop size for one device, change the subject to the
public key of the &lt;em&gt;other&lt;/em&gt; device and run the loop that many times to get
the encryption key. Run it both ways (using the other loop size and the
other public key) to verify the same encryption key comes out.&lt;/p&gt;
&lt;p&gt;I wrote the same function to do both tasks. The default &lt;code&gt;publickey&lt;/code&gt; and
&lt;code&gt;loop&lt;/code&gt; size are infinite. Pass it just a public key and it will give you
the loop size. Pass it a subject (from a public key) and a loop size and
it will return the encryption key.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;decrypt &amp;lt;- function(publickey = -Inf, loop = Inf, subject = 7) {
  stopifnot(is.finite(publickey) + is.finite(loop) == 1)
  value &amp;lt;- subject
  iter &amp;lt;- 1
  repeat {
    if (value == publickey) return(iter) # Loop size
    if (iter &amp;gt;= loop) return(value)      # Encryption key
    value &amp;lt;- (value * subject) %% 20201227
    iter &amp;lt;- iter + 1
  }
}
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;On the example data:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;decrypt(subject = 17807724, loop = decrypt(publickey = 5764801))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 14897079
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;decrypt(subject = 5764801, loop = decrypt(publickey = 17807724))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 14897079
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;And the puzzle inputs:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;input &amp;lt;- as.double(readLines(&#39;input25.txt&#39;))
key1 &amp;lt;- decrypt(subject = input[2], loop = decrypt(input[1]))
key2 &amp;lt;- decrypt(subject = input[1], loop = decrypt(input[2]))
stopifnot(key1 == key2)
key1
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;[1] 545789
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Running both isn’t strictly necessary but it’s good to verify they give
the same result.&lt;/p&gt;
&lt;p&gt;An even shorter version, once again inspired by &lt;a href=&#34;https://twitter.com/Brotherluii/status/1342411275431776256&#34;&gt;Thomas
Loock&lt;/a&gt;, who
recognised you only need a single loop:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;decrypt2 &amp;lt;- function(card, door) {
  val &amp;lt;- c(subj = 7, key = door)
  while(val[&#39;subj&#39;] != card)
    val &amp;lt;- (val * c(7, door)) %% 20201227
  val[&#39;key&#39;]
}

input &amp;lt;- as.double(readLines(&#39;input25.txt&#39;))
do.call(decrypt2, as.list(input))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;   key 
545789 
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Or, if you &lt;em&gt;really&lt;/em&gt; enjoy abusing R’s assignment operator (&lt;code&gt;&amp;lt;-&lt;/code&gt;), you
can do everything in two lines, plus one to print the result. It even
features a gratuitous &lt;code&gt;while&lt;/code&gt; loop that does nothing. For code golf
enthusiasts only!&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;val &amp;lt;- c(subj = 7, key = (input &amp;lt;- as.double(readLines(&#39;input25.txt&#39;)))[2])
while((val &amp;lt;- (val * c(7, input[2])) %% 20201227)[&#39;subj&#39;] != input[1]) NULL
val[&#39;key&#39;]
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;   key 
545789 
&lt;/code&gt;&lt;/pre&gt;
&lt;hr&gt;
&lt;p&gt;Merry Christmas!&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Which film should I watch during lockdown?</title>
      <link>https://selbydavid.com/2020/05/06/films/</link>
      <pubDate>Wed, 06 May 2020 12:55:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2020/05/06/films/</guid>
      <description>&lt;p&gt;My brother wrote to me this week with an interesting task:&lt;/p&gt;
&lt;blockquote&gt;
&lt;p&gt;I&amp;rsquo;ve got a list of films I&amp;rsquo;ve noted down whenever I&amp;rsquo;ve seen a good review.
But it&amp;rsquo;s hundreds long and I can never remember what a film is from its title and can&amp;rsquo;t be bothered to look them up each time.
Any chance you can knock up a script that cross-references a Rotten Tomatoes score and quick synopsis so I can browse the list more easily?&lt;/p&gt;
&lt;/blockquote&gt;
&lt;p&gt;Pretty straightforward, and the request happened to coincide with an outage in the VPN at work, so I had some free time.
I will demonstrate how I tackled this task in R, in case it helps anyone else whose family members are going stir-crazy in quarantine.&lt;/p&gt;
&lt;h2 id=&#34;in-search-of-apis&#34;&gt;In search of APIs&lt;/h2&gt;
&lt;p&gt;The first thing I did was look to see if Rotten Tomatoes had an existing application programming interface (API) that would let me access their database of film ratings.
It turns out that indeed &lt;a href=&#34;https://developer.fandango.com/rotten_tomatoes&#34; title=&#34;Rotten Tomatoes API&#34;&gt;they do have one&lt;/a&gt;, but it is aimed at people developing actual apps and web sites, rather than mere mortal members of the public.
Optimistically, I put in a request for an API key, but at the time of writing Rotten Tomatoes have not replied to me.&lt;/p&gt;
&lt;p&gt;Not to worry!
I can just put on my tricorne hat and scrape the information from their public-facing web site.&lt;/p&gt;
&lt;p&gt;Now, we don&amp;rsquo;t necessarily know the URL for every film on Rotten Tomatoes based on its title, as there may be several films with the same title&amp;mdash;such as remakes and book adaptations&amp;mdash;or the film may not be indexed by Rotten Tomatoes at all.
So to get a film&amp;rsquo;s page, we can use the web site&amp;rsquo;s search function and return the top result.&lt;/p&gt;
&lt;p&gt;Normally, to search for a film on Rotten Tomatoes, you go to a URL of the form&lt;/p&gt;
&lt;pre&gt;&lt;code&gt;https://www.rottentomatoes.com/search?search=%s
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;replacing &lt;code&gt;%s&lt;/code&gt; with your search query, and you see something like this in your browser:&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2020/rottentomatoes.png&#34; alt=&#34;Search results page for &amp;lsquo;The Good, The Bad and the Ugly&amp;rsquo; on Rotten Tomatoes&#34;&gt;&lt;/p&gt;
&lt;p&gt;So in my mind, the workflow was going to be a simple matter of:&lt;/p&gt;
&lt;ol&gt;
&lt;li&gt;Search for the film using a URL like above&lt;/li&gt;
&lt;li&gt;Scrape the search results page for a link to the film&lt;/li&gt;
&lt;li&gt;Scrape the film page for the rating and synopsis&lt;/li&gt;
&lt;/ol&gt;
&lt;p&gt;Unfortunately, the Rotten Tomatoes web site is set up, deliberately or otherwise, so that you cannot do this programmatically.
While indeed you can try to make such a search query from R, for example:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;rt_lookup &amp;lt;- function(film) {
  query &amp;lt;- URLencode(film)
  url &amp;lt;- sprintf(&#39;https://www.rottentomatoes.com/search?search=%s&#39;, query)
  httr::GET(url)
}
request &amp;lt;- rt_lookup(&#39;The Good, the Bad and the Ugly&#39;)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;the resulting &lt;code&gt;request&lt;/code&gt; does not contain any film results, as on the web site they seem to be generated by JavaScript code that only runs if you are accessing the page in a real web browser (i.e. not a robot).
There is probably a way around this, by simulating a browser session using &lt;strong&gt;RSelenium&lt;/strong&gt; or similar, but it seemed too complicated, for me.&lt;/p&gt;
&lt;p&gt;Instead, I looked for other sources of film ratings.
My first thought was the web site Metacritic, but their web site is even more robot-unfriendly than Rotten Tomatoes.
I tried to query it with very similar code to before:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;mc_lookup &amp;lt;- function(film) {
  string &amp;lt;- URLencode(film)
  url &amp;lt;- sprintf(&#39;https://www.metacritic.com/search/all/%s/results&#39;, string)
  httr::GET(url)
}
request &amp;lt;- mc_lookup(&#39;The Good, the Bad and the Ugly&#39;)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;and not only do we not get any useful results, but the server blocks us completely with a 403 (access forbidden) error.
It is as if the people who make these web sites would prefer us to access the web site in a browser, presumably so they can serve us ads or other services, and make a living.&lt;/p&gt;
&lt;p&gt;Undeterred, I turned to the stalwart of film information, the Internet Movie Database (IMDb).
Maybe it is an older web site or maybe they just don&amp;rsquo;t care about robots, but this one much more accessible.
We can make an IMDb search query using&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;imdb_lookup &amp;lt;- function(film) {
  string &amp;lt;- gsub(&#39; &#39;, &#39;+&#39;, film)
  url &amp;lt;- sprintf(&#39;https://www.imdb.com/find?s=tt&amp;amp;q=%s&amp;amp;ref_=nv_sr_sm&#39;, string)
  httr::GET(url)
}
request &amp;lt;- mc_lookup(&#39;The Good, the Bad and the Ugly&#39;)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;which programmatically retrieves the content of the following page.
Notice there are no ratings or summaries displayed on the results page, so we will need to follow the link to each film&amp;rsquo;s page to get that information.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2020/imdb.png&#34; alt=&#34;Search results page for &amp;lsquo;The Good, The Bad and the Ugly&amp;rsquo; on IMDb&#34;&gt;&lt;/p&gt;
&lt;h2 id=&#34;scraping-results&#34;&gt;Scraping results&lt;/h2&gt;
&lt;p&gt;We are only interested in one film per query, not the 200 that are returned.
A pragmatic decision is just to pick the top result, which usually corresponds to the most popular film with that title.
(If we are after a less popular edition, we can always include the year in the film title, increasing the likelihood of the desired version being the top result.)&lt;/p&gt;
&lt;p&gt;On IMDb, view the search results page in your browser&amp;rsquo;s element inspector and you will see it has an HTML structure like this:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-html&#34;&gt;&amp;lt;table class=&amp;quot;findList&amp;quot;&amp;gt;
  &amp;lt;tbody&amp;gt;
    &amp;lt;tr class=&amp;quot;findResult odd&amp;quot;&amp;gt;
      &amp;lt;td class=&amp;quot;primary_photo&amp;quot;&amp;gt;&amp;lt;!--thumbnail--&amp;gt;&amp;lt;/td&amp;gt;
      &amp;lt;td class=&amp;quot;result_text&amp;quot;&amp;gt; &amp;lt;a href=&amp;quot;/title/tt0060196/?ref_=fn_tt_tt_1&amp;quot;&amp;gt;The Good, the Bad and the Ugly&amp;lt;/a&amp;gt; (1966) &amp;lt;/td&amp;gt;
    &amp;lt;/tr&amp;gt;
...
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Parsing this table is easy with the &lt;a href=&#34;https://cran.r-project.org/package=rvest&#34;&gt;&lt;strong&gt;rvest&lt;/strong&gt;&lt;/a&gt; package.
The following function finds and extracts the first hyperlink with class &lt;code&gt;result_text&lt;/code&gt; in the &lt;code&gt;findList&lt;/code&gt; table, and requests the corresponding page.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(rvest)
get_first_imdb_result &amp;lt;- function(imdb_results) {
  if (httr::http_error(imdb_results)) return(NA)
  film_path &amp;lt;- imdb_results %&amp;gt;%
    read_html() %&amp;gt;%
    html_node(&#39;table.findList .result_text a&#39;) %&amp;gt;%
    html_attr(&#39;href&#39;)
  if (is.na(film_path)) return(NA)
  url &amp;lt;- paste0(&#39;https://imdb.com&#39;, film_path)
  httr::GET(url)
}
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;If we wanted to extract &lt;em&gt;all&lt;/em&gt; links in the table, we would use the function &lt;code&gt;html_nodes&lt;/code&gt;, rather than &lt;code&gt;html_node&lt;/code&gt;, which just returns the first.&lt;/p&gt;
&lt;p&gt;We cannot, in general, assume that earlier our call to &lt;code&gt;imdb_lookup&lt;/code&gt; will always return results, however, because we could have passed it an invalid search query, or the IMDb server could become wise to our robotic behaviour (which is surely violating that site&amp;rsquo;s terms of use) and block the request (as Metacritic does).
Thus we include return &lt;code&gt;NA&lt;/code&gt; if the search page was not found.
Also, the page could be found, but contain no results, in which case we also return &lt;code&gt;NA&lt;/code&gt;.
This is to avoid errors when we process lots of films at a time.
It is something you should always consider when querying data on a server or network outside your control.&lt;/p&gt;
&lt;p&gt;The above function requests the IMDb film page linked in the search results.
For example:&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2020/imdb_film.png&#34; alt=&#34;IMDb page for &amp;lsquo;The Good, The Bad and the Ugly&amp;rsquo; (1966)&#34;&gt;&lt;/p&gt;
&lt;p&gt;Almost there.
Now we just need to scrape the key information from this page:&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;Title (which may be different from our search query)&lt;/li&gt;
&lt;li&gt;IMDb rating&lt;/li&gt;
&lt;li&gt;Short description of the film&lt;/li&gt;
&lt;li&gt;Metascore&lt;/li&gt;
&lt;/ul&gt;
&lt;p&gt;Interestingly we have ended up obtaining Metacritic scores indirectly by scraping IMDb, even if it is not possible to scrape them from Metacritic&amp;rsquo;s own web site.&lt;/p&gt;
&lt;p&gt;Peek at the page with an element inspector to find the HTML elements you need.
For the above four pieces of information, we can select them using&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;&lt;code&gt;.title_wrapper h1&lt;/code&gt;&lt;/li&gt;
&lt;li&gt;&lt;code&gt;.imdbRating .ratingValue span&lt;/code&gt;&lt;/li&gt;
&lt;li&gt;&lt;code&gt;.summary_text&lt;/code&gt;&lt;/li&gt;
&lt;li&gt;&lt;code&gt;.metacriticScore span&lt;/code&gt;&lt;/li&gt;
&lt;/ul&gt;
&lt;p&gt;I wrote the following function to extract the same.
The base R function &lt;code&gt;trimws&lt;/code&gt; is especially useful for getting rid of any nuisance whitespace at the start and end of the page content.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;extract_imdb_info &amp;lt;- function(request) {
  page &amp;lt;- title &amp;lt;- metascore &amp;lt;- rating &amp;lt;- synopsis &amp;lt;- NA
  if (!is.na(request[[1]]))
    if (!httr::http_error(request))
      page &amp;lt;- xml2::read_html(request)
  if (!is.na(page)) {
    title &amp;lt;- html_node(page, &#39;.title_wrapper h1&#39;) %&amp;gt;% html_text %&amp;gt;% trimws
    metascore &amp;lt;- html_node(page, &#39;.metacriticScore span&#39;) %&amp;gt;% html_text
    rating &amp;lt;- html_node(page, &#39;.imdbRating .ratingValue span&#39;) %&amp;gt;% html_text
    synopsis &amp;lt;- html_node(page, &#39;.summary_text&#39;) %&amp;gt;% html_text %&amp;gt;% trimws
  }
  c(title = title,
    metascore = metascore,
    imdb_rating = rating,
    synopsis = synopsis)
}
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Once again, we can&amp;rsquo;t assume that the previous two functions passed us valid web pages, so &lt;code&gt;NA&lt;/code&gt; is returned if the &lt;code&gt;request&lt;/code&gt; is either &lt;code&gt;NA&lt;/code&gt; or is an HTTP error.
The final information is returned as a named vector.
We now have everything we need to parse a list of many films.&lt;/p&gt;
&lt;h2 id=&#34;putting-it-all-together&#34;&gt;Putting it all together&lt;/h2&gt;
&lt;p&gt;This is my final script, running on an example list of films (including one that I would expect to return an error at some point, had I not designed the code to handle such cases).&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;films &amp;lt;- c(&#39;The Matrix&#39;, &#39;Citizen Kane&#39;, &#39;Zootropolis&#39;,
           &#39;The Good, The Bad And The Ugly&#39;, &#39;Her&#39;, &#39;Inception&#39;, &#39;Bladerunner&#39;,
           &#39;How to train your dragon&#39;, &#39;A Film That Does Not Really Exist&#39;)

search_queries &amp;lt;- lapply(films, imdb_lookup)
film_pages &amp;lt;- lapply(search_queries, get_first_imdb_result)
film_info &amp;lt;- lapply(film_pages, extract_imdb_info)

results &amp;lt;- tibble::tibble(film = films, info = film_info)
results &amp;lt;- tidyr::unnest_wider(results, info)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;And the result?
A tidy data frame of films, titles, summaries and ratings.
And any films that could not be found in the movie database simply show &lt;code&gt;NA&lt;/code&gt;.&lt;/p&gt;
&lt;pre&gt;&lt;code&gt;# A tibble: 9 x 5
  film              title              metascore imdb_rating synopsis                                         
  &amp;lt;chr&amp;gt;             &amp;lt;chr&amp;gt;              &amp;lt;chr&amp;gt;     &amp;lt;chr&amp;gt;       &amp;lt;chr&amp;gt;                                            
1 The Matrix        The Matrix (1999)  73        8.7         A computer hacker learns from mysterious rebels ~
2 Citizen Kane      Citizen Kane (194~ 100       8.3         Following the death of publishing tycoon Charles~
3 Zootropolis       Zootropolis (2016) 78        8.0         In a city of anthropomorphic animals, a rookie b~
4 The Good, The Ba~ The Good, the Bad~ 90        8.8         A bounty hunting scam joins two men in an uneasy~
5 Her               Her (2013)         90        8.0         In a near future, a lonely writer develops an un~
6 Inception         Inception (2010)   74        8.8         A thief who steals corporate secrets through the~
7 Bladerunner       Blade Runner (198~ 84        8.1         A blade runner must pursue and terminate four re~
8 How to train you~ How to Train Your~ 75        8.1         A hapless young Viking who aspires to hunt drago~
9 A Film That Does~ NA                 NA        NA          NA                                               
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;The rating scores are initially character vectors, but you can convert these to numeric.
Export it to a csv file and you can search and sort it to your heart&amp;rsquo;s content.&lt;/p&gt;
&lt;p&gt;Hope this helps!&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>R code golf: the identity matrix</title>
      <link>https://selbydavid.com/2019/03/27/identity-matrix/</link>
      <pubDate>Wed, 27 Mar 2019 15:50:00 +0000</pubDate>
      
      <guid>https://selbydavid.com/2019/03/27/identity-matrix/</guid>
      <description>&lt;p&gt;How many different ways are there to create an identity matrix in R?
This was an interesting little challenge set by &lt;a href=&#34;https://twitter.com/ordrespontane&#34;&gt;Guillaume Nicoulaud&lt;/a&gt; on Twitter.&lt;/p&gt;
&lt;p&gt;In &lt;a href=&#34;https://en.wikipedia.org/wiki/Code_golf&#34;&gt;code golf&lt;/a&gt;, programmers try to write an algorithm using the shortest programme possible, often exploiting lesser-known eccentricies of each programming language.&lt;/p&gt;
&lt;p&gt;This R challenge is less about minimising your golf handicap, however, and more about showing off some features and functions in R that others might not know about.
Taking the scenic route and learning along the way.
Crazy code golf, if you like.&lt;/p&gt;
&lt;h2 id=&#34;the-identity-matrix&#34;&gt;The identity matrix&lt;/h2&gt;
&lt;p&gt;As a quick reminder, the &lt;em&gt;identity matrix&lt;/em&gt; is the linear algebraic equivalent of the number 1.
It is a diagonal matrix of ones, with all off-diagonal entries equal to zero.
The three-dimensional identity matrix, for example, is
$$\mathbf{I} = \begin{bmatrix} 1 &amp;amp; 0 &amp;amp; 0 \\ 0 &amp;amp; 1 &amp;amp; 0 \\ 0 &amp;amp; 0 &amp;amp; 1 \end{bmatrix}.$$
Multiply any matrix $\mathbf{M}$ by the identity and you get the same matrix back.
$$\mathbf{M} \mathbf{I} = \mathbf{M}$$
Multiply any matrix by its inverse $\mathbf{M}^{-1}$ (if it exists) and you get the identity matrix back.
$$\mathbf{M} \mathbf{M}^{-1} = \mathbf{M}^{-1} \mathbf{M} = \mathbf{I}$$&lt;/p&gt;
&lt;h2 id=&#34;identity-matrices-in-r&#34;&gt;Identity matrices in R&lt;/h2&gt;
&lt;p&gt;I will now show you a variety of ways to create a five-dimensional identity matrix in R, from the straightforward to the more esoteric.&lt;/p&gt;
&lt;h3 id=&#34;the-easy-way&#34;&gt;The easy way&lt;/h3&gt;
&lt;p&gt;There is a function designed for exactly this purpose, so use it.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-{r}&#34;&gt;n &amp;lt;- 5L
diag(n)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;     [,1] [,2] [,3] [,4] [,5]
[1,]    1    0    0    0    0
[2,]    0    1    0    0    0
[3,]    0    0    1    0    0
[4,]    0    0    0    1    0
[5,]    0    0    0    0    1
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;The &lt;code&gt;diag()&lt;/code&gt; function, when passed a matrix, extracts the diagonal elements from that matrix.
When passed a vector, it creates a diagonal matrix with entries equal to that vector.
When passed a scalar, as here, it creates an identity matrix with dimension &lt;code&gt;n&lt;/code&gt; by &lt;code&gt;n&lt;/code&gt;.&lt;/p&gt;
&lt;p&gt;If you were actually looking for a function to create identity matrices in R, you have found it and can stop reading here.&lt;/p&gt;
&lt;h3 id=&#34;the-optimistic-mathematicians-way&#34;&gt;The optimistic mathematician&amp;rsquo;s way&lt;/h3&gt;
&lt;p&gt;In the equation above, we saw that the identity matrix is equal to any matrix multiplied by its own inverse.
So let&amp;rsquo;s do that, using a matrix of random normal samples.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;x &amp;lt;- matrix(rnorm(n * n), n, n)
x %*% solve(x)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;              [,1]          [,2]          [,3]          [,4]          [,5]
[1,]  1.000000e+00 -1.387779e-16 -1.196959e-16 -2.498002e-16 -3.330669e-16
[2,]  0.000000e+00  1.000000e+00  2.775558e-17  0.000000e+00  2.220446e-16
[3,]  0.000000e+00  0.000000e+00  1.000000e+00  0.000000e+00  0.000000e+00
[4,] -2.220446e-16  5.551115e-17 -6.938894e-18  1.000000e+00  0.000000e+00
[5,] -5.551115e-16  1.387779e-16 -3.816392e-17  0.000000e+00  1.000000e+00
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Unfortunately computers &lt;a href=&#34;https://en.wikipedia.org/wiki/Floating-point_arithmetic&#34;&gt;don&amp;rsquo;t have infinite precision&lt;/a&gt;, so there is a bit of floating-point error here.
The result is &lt;em&gt;almost&lt;/em&gt; equal to an identity matrix.
A bit of rounding should take care of that:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;round(x %*% solve(x))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;     [,1] [,2] [,3] [,4] [,5]
[1,]    1    0    0    0    0
[2,]    0    1    0    0    0
[3,]    0    0    1    0    0
[4,]    0    0    0    1    0
[5,]    0    0    0    0    1
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Perfect!&lt;/p&gt;
&lt;h3 id=&#34;the-vectorised-index-way&#34;&gt;The vectorised index way&lt;/h3&gt;
&lt;p&gt;Diagonal entries are those whose row and column index are equal.
That is, an identity matrix is a matrix $\mathbf{D}$ whose elements are
$$d_{ij} = \begin{cases} 1 &amp;amp; i = j, \\ 0 &amp;amp; i \neq j \end{cases}.$$&lt;/p&gt;
&lt;p&gt;Or in R terms:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;.col(c(n, n)) == .row(c(n, n))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;      [,1]  [,2]  [,3]  [,4]  [,5]
[1,]  TRUE FALSE FALSE FALSE FALSE
[2,] FALSE  TRUE FALSE FALSE FALSE
[3,] FALSE FALSE  TRUE FALSE FALSE
[4,] FALSE FALSE FALSE  TRUE FALSE
[5,] FALSE FALSE FALSE FALSE  TRUE
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Multiply this result by 1, or add 0, to convert from boolean values to binary.
If you already have an $n \times n$ matrix, you can be even more concise:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;x &amp;lt;- matrix(nrow = n, ncol = n)
1 * (col(x) == row(x))
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;     [,1] [,2] [,3] [,4] [,5]
[1,]    1    0    0    0    0
[2,]    0    1    0    0    0
[3,]    0    0    1    0    0
[4,]    0    0    0    1    0
[5,]    0    0    0    0    1
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Just beware that the lower-level &lt;code&gt;.col()&lt;/code&gt; and &lt;code&gt;.row()&lt;/code&gt; functions, unlike anything else in the R universe, actually care about the difference between an integer and a float.
The command &lt;code&gt;.col(c(5, 5))&lt;/code&gt; produces the unhelpful error,&lt;/p&gt;
&lt;pre&gt;&lt;code&gt;Error in .col(c(5, 5)) : 
  a matrix-like object is required as argument to &#39;col&#39;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;whilst &lt;code&gt;.col(c(5L, 5L))&lt;/code&gt;, where the dimensions are explicitly integers, gives the desired result.&lt;/p&gt;
&lt;h3 id=&#34;the-outer-product-way&#34;&gt;The outer product way&lt;/h3&gt;
&lt;p&gt;Similar to above, but more elegant.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;outer(1:n, 1:n, &#39;==&#39;) + 0
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Thanks to &lt;a href=&#34;https://twitter.com/privefl/status/959728747854344192&#34;&gt;Florian Privé&lt;/a&gt; for this one.
The outer product function applies every possible combination of the elements of the first two arguments and returns the results in a matrix.&lt;/p&gt;
&lt;p&gt;In case that wasn&amp;rsquo;t clear, here is a &lt;em&gt;Battleship&lt;/em&gt; grid:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;outer(LETTERS[1:5], 1:5, paste0)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;     [,1] [,2] [,3] [,4] [,5]
[1,] &amp;quot;A1&amp;quot; &amp;quot;A2&amp;quot; &amp;quot;A3&amp;quot; &amp;quot;A4&amp;quot; &amp;quot;A5&amp;quot;
[2,] &amp;quot;B1&amp;quot; &amp;quot;B2&amp;quot; &amp;quot;B3&amp;quot; &amp;quot;B4&amp;quot; &amp;quot;B5&amp;quot;
[3,] &amp;quot;C1&amp;quot; &amp;quot;C2&amp;quot; &amp;quot;C3&amp;quot; &amp;quot;C4&amp;quot; &amp;quot;C5&amp;quot;
[4,] &amp;quot;D1&amp;quot; &amp;quot;D2&amp;quot; &amp;quot;D3&amp;quot; &amp;quot;D4&amp;quot; &amp;quot;D5&amp;quot;
[5,] &amp;quot;E1&amp;quot; &amp;quot;E2&amp;quot; &amp;quot;E3&amp;quot; &amp;quot;E4&amp;quot; &amp;quot;E5&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;h3 id=&#34;the-loopy-index-way&#34;&gt;The loopy index way&lt;/h3&gt;
&lt;p&gt;As above, but using loops, which in R are quite slow and should be avoided.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;x &amp;lt;- matrix(nrow = n, ncol = n)
for (i in 1:n)
  for (j in 1:n)
    if (i == j)
      x[i, j] &amp;lt;- 1
&lt;/code&gt;&lt;/pre&gt;
&lt;h3 id=&#34;the-sapply-way&#34;&gt;The &lt;code&gt;sapply&lt;/code&gt; way&lt;/h3&gt;
&lt;p&gt;If you want to use loops whilst convincing yourself that you aren&amp;rsquo;t using loops.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;sapply(1:n, function(i) as.integer(1:n == i))
&lt;/code&gt;&lt;/pre&gt;
&lt;h3 id=&#34;the-tidy-way&#34;&gt;The tidy way&lt;/h3&gt;
&lt;p&gt;The &lt;strong&gt;tidyverse&lt;/strong&gt; encourages us to store everything in long data frames, so let&amp;rsquo;s not make an exception here.
Here is a dataset describing the positions of all the ones.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;data.frame(value = 1, row_index = 1:n, column_index = 1:n)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;  row_index column_index value
1         1            1     1
2         2            2     1
3         3            3     1
4         4            4     1
5         5            5     1
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Now we can use the handy &lt;code&gt;xtabs()&lt;/code&gt; function to make a two-way contingency table.
The dimnames become no longer relevant so we can remove those while we are at it.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-{r}&#34;&gt;unname( xtabs(data.frame(1, 1:n, 1:n)) )
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;&lt;em&gt;Edit:&lt;/em&gt; An even simpler version is&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;table(data.frame(1:n, 1:n))
&lt;/code&gt;&lt;/pre&gt;
&lt;h3 id=&#34;the-sparse-way&#34;&gt;The sparse way&lt;/h3&gt;
&lt;p&gt;An identity matrix is the same as a &lt;a href=&#34;https://en.wikipedia.org/wiki/Permutation_matrix&#34;&gt;permutation matrix&lt;/a&gt; where the order of elements is not changed:
$$\{1, \dots, n\} \rightarrow \{1, \dots, n\}.$$
The &lt;strong&gt;Matrix&lt;/strong&gt; package has a special class, &lt;code&gt;pMatrix&lt;/code&gt;, for sparse permutation matrices.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(Matrix)
as(1:n, &#39;pMatrix&#39;)
&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;5 x 5 sparse Matrix of class &amp;quot;pMatrix&amp;quot;
              
[1,] | . . . .
[2,] . | . . .
[3,] . . | . .
[4,] . . . | .
[5,] . . . . |
&lt;/code&gt;&lt;/pre&gt;
&lt;h3 id=&#34;the-hard-way&#34;&gt;The hard way&lt;/h3&gt;
&lt;p&gt;Matrices are just reshaped vectors.
The elements of an identity matrix are (either column-wise or row-wise; it doesn&amp;rsquo;t matter because it&amp;rsquo;s symmetrical)
$$\{1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, \dots, 1\}$$
i.e. a one, then $n$ zeroes, another one, another $n$ zeroes and so on, finishing with the $n$th one.&lt;/p&gt;
&lt;p&gt;We can write down such a sequence and then reshape it.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;matrix(c(rep(c(1, rep(0, n)), n - 1), 1), n)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Basically unreadable, but it works!&lt;/p&gt;
&lt;p&gt;Guillaume&amp;rsquo;s own version doesn&amp;rsquo;t fit on one line but is a bit more sensible:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;x &amp;lt;- rep(0, n * n)
x[seq(1, n * n, n + 1)] &amp;lt;- 1
dim(x) &amp;lt;- c(n, n)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;&lt;a href=&#34;https://twitter.com/_ColinFay/status/963545949317599232&#34;&gt;Colin Fay&lt;/a&gt; makes a more readable solution, taking advantage of matrix broadcasting.
That is, R will repeat a vector to fit the space allocated if it isn&amp;rsquo;t already long enough.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;matrix(c(1, rep(0, n)), nrow = n, ncol = n)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Because $n^2$ isn&amp;rsquo;t an exact multiple of $n+1$, R will throw a warning, which you can ignore.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;     [,1] [,2] [,3] [,4] [,5]
[1,]    1    0    0    0    0
[2,]    0    1    0    0    0
[3,]    0    0    1    0    0
[4,]    0    0    0    1    0
[5,]    0    0    0    0    1
Warning message:
In matrix(c(1, rep(0, n)), nrow = n, ncol = n) :
  data length [6] is not a sub-multiple or multiple of the number of rows [5]
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;If this annoys you, hide it with &lt;code&gt;suppressWarnings()&lt;/code&gt;.&lt;/p&gt;
&lt;h3 id=&#34;the-silly-way&#34;&gt;The silly way&lt;/h3&gt;
&lt;p&gt;To me as a statistician, all of these methods seem are bit too&amp;hellip; deterministic.
Let&amp;rsquo;s fix that.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;m &amp;lt;- matrix(rbinom(5^2, 1, 1/5), 5)
while(any(m %*% m != m)
      || any(colSums(m) == 0)
      || any(rowSums(m) == 0))
  m[] &amp;lt;- rbinom(5^2, 1, 1/5)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;This glorious code will repeatedly sample entries of &lt;code&gt;m&lt;/code&gt; from the binomial distribution until the result is an identity matrix.
Arguably, this is the best solution.&lt;/p&gt;
&lt;hr&gt;
&lt;p&gt;With that challenge solved, what other R code golf challenges would you like to see?
Maybe all the different ways of tackling a common data wrangling task, or producing a certain kind of visualisation&amp;mdash;please let me know if you have any ideas.&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Le lait, le comprenez-vous?</title>
      <link>https://selbydavid.com/2018/07/08/milk/</link>
      <pubDate>Sun, 08 Jul 2018 11:00:00 +0200</pubDate>
      
      <guid>https://selbydavid.com/2018/07/08/milk/</guid>
      <description>&lt;p&gt;Buying milk in France is not like at home.
In the supermarket, it is always found in the farthest possible point from the shop entrance, but the similarities end there.&lt;/p&gt;
&lt;p&gt;The colour scheme used to be the same as in Old Blighty but Napoléon changed it in the early 1800s, around the same time he switched everybody to driving on the wrong side of the road.
Blue milk bottles are semi-skimmed, red is full fat&amp;mdash;except when it&amp;rsquo;s green: then it&amp;rsquo;s &lt;em&gt;organic&lt;/em&gt; full fat&amp;mdash;and skimmed milk bottles are octarine or something.
In the UK, it&amp;rsquo;s far simpler: red for skimmed, green for semi-skimmed, blue for full fat, gold for fuller than full fat and then orange for that other level that also exists.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/milk.jpg&#34; alt=&#34;Milk in a French supermarket&#34;&gt;&lt;/p&gt;
&lt;p&gt;French milk bottles don&amp;rsquo;t have little handles on them, unlike British ones, maybe because the dexterity to add &amp;lsquo;just a dash&amp;rsquo; to a cup of tea is not in high demand in France.
Bottles of drain cleaner do have the little handles, though.
I draw no conclusions from this.&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>One week in Paris</title>
      <link>https://selbydavid.com/2018/05/29/paris/</link>
      <pubDate>Tue, 29 May 2018 15:00:00 +0200</pubDate>
      
      <guid>https://selbydavid.com/2018/05/29/paris/</guid>
      <description>&lt;p&gt;I have just moved to Paris ahead of a six-month internship.
It is my first time even visiting the city, so here are some initial impressions.
As many a Français(e) will keenly remind you: &amp;lsquo;Paris is not France&amp;rsquo;, so I also hope to venture outside &lt;em&gt;la Périphérique&lt;/em&gt; soon.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/david.jpg&#34; alt=&#34;David in Paris&#34;&gt;&lt;/p&gt;
&lt;h3 id=&#34;la-circulation&#34;&gt;La circulation&lt;/h3&gt;
&lt;p&gt;In Paris, traffic signals are suggestions rather than orders.
A red man at a pedestrian crossing means &amp;ldquo;cross at your peril&amp;rdquo; whilst a green man means exactly the same.
Approximately 94% of roads and cycle paths are one-way, so route finding involves a fair bit of improvisation.&lt;/p&gt;
&lt;p&gt;![Arc de Triomphe de l&amp;rsquo;Étoile](/img/2018/paris/triomphe.jpg &amp;lsquo;Arc de Triomphe de l&amp;rsquo;Étoile&amp;rsquo;)&lt;/p&gt;
&lt;p&gt;The best places to observe Parisian drivers in their natural habitat are the many-laned roundabouts that are the Place de la Concorde and Arc de Triomphe.
The car pictured above set off for work decades ago but still hasn&amp;rsquo;t managed successfully to navigate Baron Haussmann&amp;rsquo;s road network.&lt;/p&gt;
&lt;p&gt;If you are hard as nails like me then it is actually quite efficient to cycle around the city, using Mobikes, Ofo or Vélibs on the city&amp;rsquo;s 440km of cycle paths.
Check that each wheel approximates a circle before setting off.
Bonus points if you hire a vélo that is covered in algae, having clearly just been fished out of the Seine&amp;mdash;someone I know did.&lt;/p&gt;
&lt;h3 id=&#34;la-tour-eiffel&#34;&gt;La Tour Eiffel&lt;/h3&gt;
&lt;p&gt;Nobody knows if the Blackpool Tower is smaller than the Eiffel Tower or just always farther away.
Incredibly, the French managed to copy the design of the former before it was even built.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/eiffel.jpg&#34; alt=&#34;La Tour Eiffel&#34;&gt;&lt;/p&gt;
&lt;p&gt;On our first visit, the lift to the very top was closed, but it was still possible to go to the &lt;em&gt;deuxième étage&lt;/em&gt;.
It is slightly cheaper (and quicker, given the queues) to take the stairs than to take the lift, so up the 669 steps we went.
My mum reckoned the 130-year-old structure needed dusting and a lick of paint.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/eiffelq.jpg&#34; alt=&#34;View from Eiffel Tower stairs, looking down on the queue for the lift&#34;&gt;&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/eiffel2.jpg&#34; alt=&#34;La Tour Eiffel&#34;&gt;&lt;/p&gt;
&lt;p&gt;The views over the city are pretty stunning, even from &amp;lsquo;only&amp;rsquo; 115 metres up.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/skyline.jpg&#34; alt=&#34;Paris skyline from Eiffel Tower&#34;&gt;&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/skyline2.jpg&#34; alt=&#34;Paris skyline from Eiffel Tower&#34;&gt;&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/skyline3.jpg&#34; alt=&#34;Paris skyline from Eiffel Tower&#34;&gt;&lt;/p&gt;
&lt;h3 id=&#34;les-catacombes-de-paris&#34;&gt;Les Catacombes de Paris&lt;/h3&gt;
&lt;p&gt;By the late eighteenth century, Paris ran out of space to bury its dead in cemetaries and moved them into underground mines, which were converted into ossuaries that you can visit today.&lt;/p&gt;
&lt;p&gt;Sounds like a sight to behold, but if you go this month you will find the place closed, because&amp;mdash;in classic French style&amp;mdash;all of the workers are on strike.
&lt;a href=&#34;http://www.cestlagreve.fr&#34;&gt;C&amp;rsquo;est la grève !&lt;/a&gt;&lt;/p&gt;
&lt;h3 id=&#34;musée-du-louvre&#34;&gt;Musée du Louvre&lt;/h3&gt;
&lt;p&gt;If you looked at every item in the Louvre for a minute, it would take you more than two months to see everything.
I haven&amp;rsquo;t been here that long yet.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/pyramide.jpg&#34; alt=&#34;Pyramide du Louvre&#34; title=&#34;Pyramide du Louvre&#34;&gt;&lt;/p&gt;
&lt;p&gt;The famous art museum opens onto the Jardin des Tuileries, a big park.
I tried on a few souvenir hats from the street sellers here but none of them were big enough.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/louvre.jpg&#34; alt=&#34;Musée du Louvre&#34; title=&#34;Musée du Louvre&#34;&gt;&lt;/p&gt;
&lt;h3 id=&#34;les-champs-elysées&#34;&gt;Les Champs-Elysées&lt;/h3&gt;
&lt;p&gt;During the 364 days between each final stage of le Tour de France, les Champs-Elysées become like a cross between The Mall and Oxford Street.
I couldn&amp;rsquo;t find any hats that fit my head here, either.
You can buy T-shirts for €500 but I haven&amp;rsquo;t been tempted by them yet.&lt;/p&gt;
&lt;h3 id=&#34;les-terrasses&#34;&gt;Les terrasses&lt;/h3&gt;
&lt;p&gt;French beer comes in small, medium and large-but-still-not-quite-a-pint.
Prices on &lt;em&gt;les terrasses&lt;/em&gt; are about what you&amp;rsquo;d pay at home, multiplied by five.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/terrasse.jpg&#34; alt=&#34;Les terrasses&#34;&gt;&lt;/p&gt;
&lt;p&gt;If you pick your seat strategically, you can watch &lt;em&gt;other&lt;/em&gt; people get wet when it starts to rain.
We weren&amp;rsquo;t clever enough to avoid getting caught in a hailstorm on the first day, however.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/grele.gif&#34; alt=&#34;La grêle&#34;&gt;&lt;/p&gt;
&lt;h3 id=&#34;mon-appartement-près-de-la-madeleine&#34;&gt;Mon appartement près de la Madeleine&lt;/h3&gt;
&lt;p&gt;I have a flat in the 9th arrondissement, near the trendy Madeleine and Opéra districts.
L&amp;rsquo;église de la Madeleine is a huge neo-classical church &amp;lsquo;designed as a temple to the glory of Napoleon&amp;rsquo;s army&amp;rsquo;.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/madeleine.jpg&#34; alt=&#34;La Madeleine&#34;&gt;&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/madeleine2.jpg&#34; alt=&#34;La Madeleine&#34;&gt;&lt;/p&gt;
&lt;p&gt;Local boutiques include the &lt;em&gt;Galeries Lafayette&lt;/em&gt; and &lt;em&gt;Grands Magasins Printemps&lt;/em&gt;, which are temples to the glory of shopping.
These historic high-end department stores are the only places I have found so far with hats that fit me, but at €250 a go, I haven&amp;rsquo;t splurged yet.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/lafayette.jpg&#34; alt=&#34;Galerie Lafayette&#34; title=&#34;Galerie Lafayette&#34;&gt;&lt;/p&gt;
&lt;p&gt;I start my internship next week.&lt;/p&gt;
&lt;h3 id=&#34;more-photos&#34;&gt;More photos&lt;/h3&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/seine.jpg&#34; alt=&#34;View of the Seine&#34; title=&#34;The Seine&#34;&gt;&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/seine2.jpg&#34; alt=&#34;Bridge over the Seine&#34; title=&#34;Passerelle Debilly&#34;&gt;&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/manutention.jpg&#34; alt=&#34;Rue de la Manutention&#34; title=&#34;Rue de la Manutention&#34;&gt;&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/concorde.jpg&#34; alt=&#34;Place de la Concorde&#34; title=&#34;Place de la Concorde&#34;&gt;&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/royal.jpg&#34; alt=&#34;Palais Royal&#34; title=&#34;Palais Royal&#34;&gt;&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/opera.jpg&#34; alt=&#34;View from roof of Galerie Lafayette&#34; title=&#34;View from roof of Galerie Lafayette&#34;&gt;&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/paris/carrousel.jpg&#34; alt=&#34;Arc de Triomphe du Carrousel&#34; title=&#34;Arc de Triomphe du Carrousel&#34;&gt;&lt;/p&gt;
&lt;p&gt;I now take a croissant with my morning Yorkshire Tea but supplies of the latter are dwindling.
Send more!&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Exploring influence in networks</title>
      <link>https://selbydavid.com/2018/03/07/influence/</link>
      <pubDate>Wed, 07 Mar 2018 15:00:00 +0000</pubDate>
      
      <guid>https://selbydavid.com/2018/03/07/influence/</guid>
      <description>&lt;p&gt;I have just published an &lt;a href=&#34;http://selbydavid.com/influence/&#34;&gt;interactive graphic&lt;/a&gt; showing the effect of ranking scientific communities with pairwise comparison models.
The visualisation is an interactive version of my (award-winning) &lt;em&gt;useR!2017&lt;/em&gt; poster, &lt;a href=&#34;http://selbydavid.com/2017/06/29/user2017/&#34;&gt;Ranking influential communities in networks&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;You can see how academic journals have been grouped into communities based on their citation behaviour, and notice the relative ranking within and between fields.
Occasionally journals don&amp;rsquo;t do so well within their field but are influential outside it, and vice versa.
&lt;a href=&#34;http://selbydavid.com/influence/&#34;&gt;Have an explore&lt;/a&gt; and see how your favourite fields/journals fare!&lt;/p&gt;
&lt;p&gt;Some interesting feedback so far from domain experts:&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;agronomy, or soil science, is split in two, with Brazilian journals (in Portuguese) appearing insular and cut off from the rest of the network.&lt;/li&gt;
&lt;li&gt;archaeology doesn&amp;rsquo;t form a single field&amp;mdash;rather it is two distinct sub-fields, with US-style anthropological archaeology falling under social sciences, whereas osteoarchaeology (digging up bones and stuff) lives under geosciences.&lt;/li&gt;
&lt;/ul&gt;
&lt;p&gt;Other observations:&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;statistics is great&lt;/li&gt;
&lt;li&gt;nobody understands particle physics&lt;/li&gt;
&lt;li&gt;the data, which are from 2015, also effectively &amp;lsquo;predict&amp;rsquo; &lt;a href=&#34;https://springerplus.springeropen.com/&#34;&gt;&lt;em&gt;SpringerPlus&lt;/em&gt;&lt;/a&gt; closing down in 2016&lt;/li&gt;
&lt;li&gt;Stata is used mainly by non-statisticians&lt;/li&gt;
&lt;/ul&gt;
&lt;p&gt;The analysis was done using R and the visualisation created using D3.&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;&lt;a href=&#34;http://selbydavid.com/influence/analysis.html&#34;&gt;Analysis&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;http://selbydavid.com/influence/influence.js&#34;&gt;D3 code&lt;/a&gt;&lt;/li&gt;
&lt;/ul&gt;
&lt;p&gt;I am not very good at coming up with names for algorithmically-generated fields, so if you can think of more appropriate labels for communities, do let me know.
Feedback is very welcome!&lt;/p&gt;
&lt;p&gt;&lt;a href=&#34;http://selbydavid.com/influence/&#34;&gt;Click here&lt;/a&gt; to view the visualisation.&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Building a neural network from scratch in R</title>
      <link>https://selbydavid.com/2018/01/09/neural-network/</link>
      <pubDate>Tue, 09 Jan 2018 10:00:00 +0000</pubDate>
      
      <guid>https://selbydavid.com/2018/01/09/neural-network/</guid>
      <description>
&lt;script src=&#34;https://selbydavid.com/rmarkdown-libs/header-attrs/header-attrs.js&#34;&gt;&lt;/script&gt;
&lt;link href=&#34;https://selbydavid.com/rmarkdown-libs/anchor-sections/anchor-sections.css&#34; rel=&#34;stylesheet&#34; /&gt;
&lt;script src=&#34;https://selbydavid.com/rmarkdown-libs/anchor-sections/anchor-sections.js&#34;&gt;&lt;/script&gt;


&lt;p&gt;Neural networks can seem like a bit of a black box.
But in some ways, a neural network is little more than several &lt;a href=&#34;https://en.wikipedia.org/wiki/Logistic_regression&#34;&gt;logistic regression&lt;/a&gt; models chained together.&lt;/p&gt;
&lt;p&gt;In this post I will show you how to derive a neural network from scratch with just a few lines in R.
If you don’t like mathematics, feel free to skip to the code chunks towards the end.&lt;/p&gt;
&lt;p&gt;This blog post is partly inspired by Denny Britz’s article, &lt;a href=&#34;http://www.wildml.com/2015/09/implementing-a-neural-network-from-scratch/&#34;&gt;Implementing a Neural Network from Scratch in Python&lt;/a&gt;, as well as &lt;a href=&#34;https://www.analyticsvidhya.com/blog/2017/05/neural-network-from-scratch-in-python-and-r/&#34;&gt;this article by Sunil Ray&lt;/a&gt;.&lt;/p&gt;
&lt;div id=&#34;logistic-regression&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Logistic regression&lt;/h2&gt;
&lt;p&gt;What’s a logistic regression model?
Suppose we want to build a machine that classifies objects in two groups, for example &lt;a href=&#34;https://www.youtube.com/watch?v=ACmydtFDTGs&#34;&gt;‘hot dog’ and ‘not hot dog’&lt;/a&gt;.
We will say &lt;span class=&#34;math inline&#34;&gt;\(Y_i = 1\)&lt;/span&gt; if object &lt;em&gt;i&lt;/em&gt; is a hot dog, and &lt;span class=&#34;math inline&#34;&gt;\(Y_i = 0\)&lt;/span&gt; otherwise.&lt;/p&gt;
&lt;p&gt;&lt;a href=&#34;https://www.youtube.com/watch?v=ACmydtFDTGs&#34;&gt;&lt;img src=&#34;https://selbydavid.com/img/2018/hotdog.gif&#34; /&gt;&lt;/a&gt;&lt;/p&gt;
&lt;p&gt;A logistic regression model estimates these odds,
&lt;span class=&#34;math display&#34;&gt;\[
\operatorname{odds}(Y = 1)
= \frac{\operatorname P(Y = 1)} {\operatorname P(Y = 0)}
= \frac{\operatorname P(Y = 1)} {\operatorname 1 - \operatorname P(Y = 1)}
\]&lt;/span&gt;
and for mathematical and computational reasons we take the natural logarithm of the same—the log odds.
As a &lt;a href=&#34;https://en.wikipedia.org/wiki/Generalized_linear_model&#34;&gt;generalised linear model&lt;/a&gt;, the response (the log odds) is a linear combination of the parameters and the covariates,
&lt;span class=&#34;math display&#34;&gt;\[\operatorname{log-odds}(Y = 1) = X \beta,\]&lt;/span&gt;
where &lt;span class=&#34;math inline&#34;&gt;\(X\)&lt;/span&gt; is the &lt;a href=&#34;https://en.wikipedia.org/wiki/Design_matrix&#34;&gt;design matrix&lt;/a&gt; and &lt;span class=&#34;math inline&#34;&gt;\(\beta\)&lt;/span&gt; is a vector of parameters to be found.&lt;/p&gt;
&lt;p&gt;Classical statistical inference involves looking for a parameter estimate, &lt;span class=&#34;math inline&#34;&gt;\(\hat\beta\)&lt;/span&gt;, that &lt;a href=&#34;https://en.wikipedia.org/wiki/Maximum_likelihood_estimation&#34;&gt;maximises the likelihood&lt;/a&gt; of the observations given the parameters.
For our hot dog classification problem, the likelihood function is
&lt;span class=&#34;math display&#34;&gt;\[\mathcal{L} = \prod_i \operatorname P(Y_i=1)^{y_i} \operatorname P(Y_i = 0)^{1 - y_i}\]&lt;/span&gt;
or, taking logs,
&lt;span class=&#34;math display&#34;&gt;\[\log \mathcal{L} = \sum_i \Bigl[ y_i \log \operatorname P(Y_i = 1) + (1-y_i) \log \operatorname P(Y_i = 0) \Bigr]. \]&lt;/span&gt;&lt;/p&gt;
&lt;p&gt;Let’s imagine we have been given some two-dimensional data about a sample of objects, along with their labels.
Our sample data set includes 200 observations.
Here is a random sample of five:&lt;/p&gt;
&lt;table&gt;
&lt;thead&gt;
&lt;tr class=&#34;header&#34;&gt;
&lt;th align=&#34;right&#34;&gt;x1&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;x2&lt;/th&gt;
&lt;th align=&#34;left&#34;&gt;class&lt;/th&gt;
&lt;/tr&gt;
&lt;/thead&gt;
&lt;tbody&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;right&#34;&gt;8.81&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;-6.19&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;not hot dog&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;right&#34;&gt;10.00&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;0.84&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;not hot dog&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;right&#34;&gt;-1.78&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;4.48&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;hot dog&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;right&#34;&gt;6.83&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;-0.02&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;hot dog&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;right&#34;&gt;1.71&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;-10.29&lt;/td&gt;
&lt;td align=&#34;left&#34;&gt;not hot dog&lt;/td&gt;
&lt;/tr&gt;
&lt;/tbody&gt;
&lt;/table&gt;
&lt;p&gt;And a scatter plot of all of them:&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/post/2018-01-09-neural-network_files/figure-html/plot-spirals-1.png&#34; width=&#34;672&#34; /&gt;&lt;/p&gt;
&lt;p&gt;Fitting a logistic regression model in R is easy:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;logreg &amp;lt;- glm(class ~ x1 + x2, family = binomial, data = hotdogs)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;But as the decision boundary can only be linear, it doesn’t work too well at distinguishing our two classes.
Logistic regression classifies 134 (67%) of our objects correctly.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/post/2018-01-09-neural-network_files/figure-html/logistic-boundary-1.png&#34; width=&#34;672&#34; /&gt;&lt;/p&gt;
&lt;p&gt;Nonlinearity is where neural networks are useful.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;artificial-neural-networks&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Artificial neural networks&lt;/h2&gt;
&lt;p&gt;An &lt;a href=&#34;https://en.wikipedia.org/wiki/Artificial_neural_network&#34;&gt;artificial neural network&lt;/a&gt; is so called because once upon a time it was thought to be a good model for how neurons in the brain work.
Apparently it isn’t, but the name has stuck.&lt;/p&gt;
&lt;p&gt;Suppose we have some inputs, &lt;span class=&#34;math inline&#34;&gt;\(\mathbf x\)&lt;/span&gt;, and known outputs &lt;span class=&#34;math inline&#34;&gt;\(\mathbf y\)&lt;/span&gt;.
Then the aim of the game is to find a way of estimating &lt;span class=&#34;math inline&#34;&gt;\(\mathbf y\)&lt;/span&gt; based on &lt;span class=&#34;math inline&#34;&gt;\(\mathbf x\)&lt;/span&gt;.
In a way, then, a neural network is like any other regression or classification model.&lt;/p&gt;
&lt;p&gt;Neural networks (for classification, at least) are also known as multi-layer &lt;a href=&#34;https://en.wikipedia.org/wiki/Perceptron&#34;&gt;perceptrons&lt;/a&gt;.
Like ogres and onions, they have layers—three to be exact.&lt;/p&gt;
&lt;p&gt;The output layer is our estimate of the probability that objects belong to each class.
The input layer comprises the covariates and an intercept, as before.
In the middle, there is a &lt;em&gt;hidden layer&lt;/em&gt;, which is a transformation of the input space into &lt;span class=&#34;math inline&#34;&gt;\(h\)&lt;/span&gt; dimensions, where &lt;span class=&#34;math inline&#34;&gt;\(h\)&lt;/span&gt; is a number chosen by us.
We then perform a logistic regression on this transformed space to estimate the classes.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/post/2018-01-09-neural-network_files/figure-html/neural-network-1.svg&#34; width=&#34;672&#34; /&gt;&lt;/p&gt;
&lt;p&gt;It works like this.&lt;/p&gt;
&lt;ol style=&#34;list-style-type: decimal&#34;&gt;
&lt;li&gt;Generate &lt;span class=&#34;math inline&#34;&gt;\(h\)&lt;/span&gt; different linear combinations of the input variables.&lt;/li&gt;
&lt;li&gt;Apply an ‘activation’ function, that for each observation, turns each hidden node ‘on’ or ‘off’.&lt;/li&gt;
&lt;li&gt;Fit a logistic regression model to these &lt;span class=&#34;math inline&#34;&gt;\(h\)&lt;/span&gt; transformed predictors, plus an intercept.&lt;/li&gt;
&lt;li&gt;Adjust the parameters of both the input and the output to maximise likelihood.&lt;/li&gt;
&lt;li&gt;Repeat, &lt;em&gt;ad nauseum&lt;/em&gt;.&lt;/li&gt;
&lt;/ol&gt;
&lt;p&gt;If &lt;span class=&#34;math inline&#34;&gt;\(h = 1\)&lt;/span&gt; then there is only one linear combination of the predictors, which is effectively the same thing as having no hidden layer at all, i.e. ordinary logistic regression.&lt;/p&gt;
&lt;p&gt;So we run a kind of logistic regression model on the inputs to generate a transformation of the feature space, then once more to classify our actual objects.
Each iteration of the fitting or ‘training’ process adjusts both the transformation and the regression parameters.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;hidden-layers&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Hidden layers&lt;/h2&gt;
&lt;p&gt;The input layer is a design matrix, &lt;span class=&#34;math inline&#34;&gt;\(\mathbf X = \begin{bmatrix}\mathbf 1 &amp;amp; \mathbf x\end{bmatrix}\)&lt;/span&gt;.
The output layer is a vector of estimated probabilities, &lt;span class=&#34;math inline&#34;&gt;\(\hat {\mathbf y}\)&lt;/span&gt;.
So far, this is exactly like our logistic regression model above.&lt;/p&gt;
&lt;p&gt;A neural network adds a hidden layer, which you might think of as an intermediate design matrix between the inputs and the outputs.
&lt;a href=&#34;https://en.wikipedia.org/wiki/Deep_learning&#34;&gt;Deep learning&lt;/a&gt; is just a neural network with multiple hidden layers.&lt;/p&gt;
&lt;div class=&#34;figure&#34;&gt;&lt;span id=&#34;fig:node-diagram&#34;&gt;&lt;/span&gt;
&lt;img src=&#34;https://selbydavid.com/post/2018-01-09-neural-network_files/figure-html/node-diagram-1.svg&#34; alt=&#34;Multi-layer perceptron with five hidden nodes&#34; width=&#34;672&#34; /&gt;
&lt;p class=&#34;caption&#34;&gt;
Figure 1: Multi-layer perceptron with five hidden nodes
&lt;/p&gt;
&lt;/div&gt;
&lt;p&gt;If there are &lt;span class=&#34;math inline&#34;&gt;\(d\)&lt;/span&gt; input variables then there are &lt;span class=&#34;math inline&#34;&gt;\(d+1\)&lt;/span&gt; input nodes—one for each covariate, plus an intercept, or ‘bias’ (because computer scientists like having separate names for everything).&lt;/p&gt;
&lt;p&gt;In general there are &lt;span class=&#34;math inline&#34;&gt;\(k-1\)&lt;/span&gt; output nodes, where &lt;span class=&#34;math inline&#34;&gt;\(k\)&lt;/span&gt; is the number of possible classes.
The &lt;span class=&#34;math inline&#34;&gt;\(k^\text{th}\)&lt;/span&gt; node would be the same as ‘none of the above’, so it is redundant.
In a binary classification problem like ours, there is just one output node, because &lt;span class=&#34;math inline&#34;&gt;\(\operatorname P(Y=0) = 1 - \operatorname P(Y=1)\)&lt;/span&gt;.&lt;/p&gt;
&lt;p&gt;There are &lt;span class=&#34;math inline&#34;&gt;\(h\)&lt;/span&gt; nodes in the hidden layer, plus an intercept.
Each of these is a linear combination of the inputs, passed through an &lt;a href=&#34;https://en.wikipedia.org/wiki/Activation_function&#34;&gt;&lt;em&gt;activation function&lt;/em&gt;&lt;/a&gt;.
The intercept does not depend on the nodes in the previous layer&lt;a href=&#34;#fn1&#34; class=&#34;footnote-ref&#34; id=&#34;fnref1&#34;&gt;&lt;sup&gt;1&lt;/sup&gt;&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;The activation function is often (not always) chosen to be the &lt;em&gt;sigmoid function&lt;/em&gt;, another name for the &lt;em&gt;logistic function&lt;/em&gt;,
&lt;span class=&#34;math display&#34;&gt;\[\sigma(x) = \frac 1 {1 + e^{-x}},\]&lt;/span&gt;
the inverse of the logit
&lt;span class=&#34;math display&#34;&gt;\[\operatorname{logit}(x) = \log \left( \frac{x}{1-x} \right).\]&lt;/span&gt;
If &lt;span class=&#34;math inline&#34;&gt;\(x\)&lt;/span&gt; is a probability of an event, then &lt;span class=&#34;math inline&#34;&gt;\(\operatorname{logit}(x)\)&lt;/span&gt; is its log odds.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;forward-propagation&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Forward propagation&lt;/h2&gt;
&lt;p&gt;Starting with the inputs, we &lt;a href=&#34;https://en.wikipedia.org/wiki/Feedforward_neural_network&#34;&gt;feed forward&lt;/a&gt; through the network as follows.&lt;/p&gt;
&lt;p&gt;Firstly, compute a linear combination of the covariates, using some weight matrix &lt;span class=&#34;math inline&#34;&gt;\(\mathbf W_\text{in} \in \mathbb R^{(d+1) \times h}\)&lt;/span&gt;.
&lt;span class=&#34;math display&#34;&gt;\[
\mathbf z_1
= \mathbf{XW}_\text{in}
= \begin{bmatrix}\mathbf 1 &amp;amp; \mathbf x\end{bmatrix} \mathbf W_\text{in}
\]&lt;/span&gt;
Next, apply an activation function to obtain the nodes in the hidden layer.
The hidden layer &lt;span class=&#34;math inline&#34;&gt;\(\mathbf H\)&lt;/span&gt; might be thought of as a design matrix containing the output of a logistic regression classifying whether each node is ‘activated’ or not.
&lt;span class=&#34;math display&#34;&gt;\[\mathbf h = \sigma(\mathbf z_1)\]&lt;/span&gt;
The intercept/bias is always activated, so it is fixed to be a vector of ones.
&lt;span class=&#34;math display&#34;&gt;\[\mathbf H = \begin{bmatrix} \mathbf 1 &amp;amp; \mathbf h \end{bmatrix}
            = \begin{bmatrix} \mathbf 1 &amp;amp; \sigma(\mathbf z_1) \end{bmatrix}
            = \begin{bmatrix} \mathbf 1 &amp;amp; \sigma(\mathbf {XW}_\text{in}) \end{bmatrix}\]&lt;/span&gt;
For the output layer, compute a linear combination of the hidden variables, this time using another weight matrix, &lt;span class=&#34;math inline&#34;&gt;\(\mathbf{W}_\text{out} \in \mathbb R^{(h+1) \times (k-1)}\)&lt;/span&gt;.
&lt;span class=&#34;math display&#34;&gt;\[\mathbf z_2
= \mathbf {HW}_\text{out}
= \begin{bmatrix} \mathbf 1 &amp;amp; \mathbf h\end{bmatrix} \mathbf W_\text{out}
\]&lt;/span&gt;
Apply one more function to get the output
&lt;span class=&#34;math display&#34;&gt;\[\hat {\mathbf y} = \sigma (\mathbf z_2),\]&lt;/span&gt;
which is a probability vector, &lt;span class=&#34;math inline&#34;&gt;\(\hat Y_i = \operatorname P(Y_i = 1)\)&lt;/span&gt;.&lt;/p&gt;
&lt;p&gt;Putting it all together,
&lt;span class=&#34;math display&#34;&gt;\[\hat {\mathbf y}
= \sigma \left( \mathbf {H W} _ \text{out} \right)
= \sigma \bigl( \begin{bmatrix} \mathbf 1 &amp;amp; \sigma ( \mathbf {X W} _ \text{in} ) \end{bmatrix} \mathbf W _ \text{out} \bigr).\]&lt;/span&gt;&lt;/p&gt;
&lt;p&gt;It is straightforward to write a function to perform the forward propagation process in R. Just do&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;feedforward &amp;lt;- function(x, w1, w2) {
  z1 &amp;lt;- cbind(1, x) %*% w1
  h &amp;lt;- sigmoid(z1)
  z2 &amp;lt;- cbind(1, h) %*% w2
  list(output = sigmoid(z2), h = h)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;where&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;sigmoid &amp;lt;- function(x) 1 / (1 + exp(-x))&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Where do we get the weights from?
On the first iteration, they can be random.
Then we have to make them better.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;back-propagation&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Back propagation&lt;/h2&gt;
&lt;p&gt;So far we have been taking the parameters, or weights, &lt;span class=&#34;math inline&#34;&gt;\(\mathbf W_\text{in}\)&lt;/span&gt; and &lt;span class=&#34;math inline&#34;&gt;\(\mathbf W_\text{out}\)&lt;/span&gt;, for granted.&lt;/p&gt;
&lt;p&gt;Like parameters in a linear regression, we need to choose weights that make our model ‘better’ by some criterion.
Neural network enthusiasts will say that we will train our multilayer perceptron by minimising the cross entropy loss.
That’s a fancy way of saying we fit the model using maximum likelihood.&lt;/p&gt;
&lt;p&gt;The log-likelihood for a binary classifier is
&lt;span class=&#34;math display&#34;&gt;\[\ell = \sum_i \Bigl( y_i \log \hat y_i + (1 - y_i) \log (1 - \hat y_i) \Bigr).\]&lt;/span&gt;
We can maximise this via &lt;a href=&#34;https://en.wikipedia.org/wiki/Gradient_descent&#34;&gt;gradient descent&lt;/a&gt;, a general-purpose optimisation algorithm.&lt;/p&gt;
&lt;p&gt;To minimise &lt;span class=&#34;math inline&#34;&gt;\(\ell = f(\mathbf W)\)&lt;/span&gt; via gradient descent, we iterate using the formula
&lt;span class=&#34;math display&#34;&gt;\[\mathbf W_{t+1} = \mathbf W_{t} - \gamma \cdot \nabla f(\mathbf W_{t}),\]&lt;/span&gt;
where &lt;span class=&#34;math inline&#34;&gt;\(\mathbf W_t\)&lt;/span&gt; is the weight matrix at time &lt;span class=&#34;math inline&#34;&gt;\(t\)&lt;/span&gt;, &lt;span class=&#34;math inline&#34;&gt;\(\nabla f\)&lt;/span&gt; is the gradient of &lt;span class=&#34;math inline&#34;&gt;\(f\)&lt;/span&gt; with respect to &lt;span class=&#34;math inline&#34;&gt;\(\mathbf W\)&lt;/span&gt; and &lt;span class=&#34;math inline&#34;&gt;\(\gamma\)&lt;/span&gt; is the ‘learning rate’.&lt;/p&gt;
&lt;p&gt;Choose a learning rate too high and the algorithm will leap around like a dog chasing a squirrel, going straight past the optimum; choose one too low and it will take forever, making mountains out of molehills.&lt;/p&gt;
&lt;p&gt;Using the &lt;a href=&#34;https://en.wikipedia.org/wiki/Chain_rule&#34;&gt;chain rule&lt;/a&gt;, the gradient of the log-likehood with respect to the output weights is given by
&lt;span class=&#34;math display&#34;&gt;\[\frac {\partial\ell} {\partial \mathbf W_\text{out}} =
\frac{\partial \ell}{\partial \hat {\mathbf y}}
\frac{\partial \hat {\mathbf y} }{\partial \mathbf W_\text{out}}\]&lt;/span&gt;
where
&lt;span class=&#34;math display&#34;&gt;\[\begin{aligned}
\frac{\partial\ell}{\partial \hat{\mathbf y}}
  &amp;amp;=  \frac{\mathbf y}{\hat{\mathbf y}} - \frac{1 - \mathbf y}{1 - \hat{\mathbf y}}
  = \frac{\hat{\mathbf y} - \mathbf y}{\hat{\mathbf y}(1 - \hat{\mathbf y})},\\
\frac{\partial\hat{\mathbf y}}{\partial \mathbf W_\text{out}}
  &amp;amp;=  \mathbf{H}^T \sigma(\mathbf {HW}_\text{out})\bigl( 1 - \sigma(\mathbf{HW}_\text{out}) \bigr) \\
  &amp;amp;= \mathbf H^T \hat {\mathbf y} (1 - \hat{\mathbf y}).
\end{aligned}\]&lt;/span&gt;&lt;/p&gt;
&lt;p&gt;And the gradient with respect to the input weights is
&lt;span class=&#34;math display&#34;&gt;\[
\frac {\partial\ell} {\partial \mathbf W_\text{in}}
= \frac{\partial \ell}{\partial \hat {\mathbf y} }
   \frac{\partial \hat {\mathbf y} }{\partial \mathbf H}
   \frac{\partial \mathbf H}{\partial \mathbf W_\text{in}}
\]&lt;/span&gt;
where
&lt;span class=&#34;math display&#34;&gt;\[
\begin{aligned}
\frac{\partial \hat{\mathbf y}}{\partial \mathbf H}
  &amp;amp;=  \sigma(\mathbf{HW}_\text{out}) \bigl( 1 - \sigma(\mathbf{HW}_\text{out}) \bigr) \mathbf W_\text{out}^T \\
  &amp;amp;= \hat{\mathbf y} (1 - \hat{\mathbf y}) \mathbf W_\text{out}^T, \\
\frac{\partial \mathbf H}{\partial \mathbf W_\text{in}}
  &amp;amp;= \mathbf X^T \begin{bmatrix} \mathbf 0 &amp;amp; \sigma(\mathbf{XW}_\text{in})\bigl( 1 - \sigma(\mathbf{XW}_\text{in}) \bigr) \end{bmatrix}.
\end{aligned}
\]&lt;/span&gt;&lt;/p&gt;
&lt;p&gt;In the last step, we take for granted that the intercept column of &lt;span class=&#34;math inline&#34;&gt;\(\mathbf H\)&lt;/span&gt; doesn’t depend on &lt;span class=&#34;math inline&#34;&gt;\(\mathbf W_\text{in}\)&lt;/span&gt;, but you could parametrise it differently (&lt;a href=&#34;#fn1&#34;&gt;see footnotes&lt;/a&gt;).&lt;/p&gt;
&lt;p&gt;A simple R implementation is as follows.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;backpropagate &amp;lt;- function(x, y, y_hat, w1, w2, h, learn_rate) {
  dw2 &amp;lt;- t(cbind(1, h)) %*% (y_hat - y)
  dh  &amp;lt;- (y_hat - y) %*% t(w2[-1, , drop = FALSE])
  dw1 &amp;lt;- t(cbind(1, x)) %*% (h * (1 - h) * dh)
  
  w1 &amp;lt;- w1 - learn_rate * dw1
  w2 &amp;lt;- w2 - learn_rate * dw2
  
  list(w1 = w1, w2 = w2)
}&lt;/code&gt;&lt;/pre&gt;
&lt;/div&gt;
&lt;div id=&#34;training-the-network&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;Training the network&lt;/h2&gt;
&lt;p&gt;Training is just a matter of initialising the weights, propagating forward to get an output estimate, then propagating the error backwards to update the weights towards a better solution.
Then iteratively propagate forwards and backwards until the Earth has been swallowed by the Sun, or some other stopping criterion.&lt;/p&gt;
&lt;p&gt;Here is a quick implementation using the functions defined above.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;train &amp;lt;- function(x, y, hidden = 5, learn_rate = 1e-2, iterations = 1e4) {
  d &amp;lt;- ncol(x) + 1
  w1 &amp;lt;- matrix(rnorm(d * hidden), d, hidden)
  w2 &amp;lt;- as.matrix(rnorm(hidden + 1))
  for (i in 1:iterations) {
    ff &amp;lt;- feedforward(x, w1, w2)
    bp &amp;lt;- backpropagate(x, y,
                        y_hat = ff$output,
                        w1, w2,
                        h = ff$h,
                        learn_rate = learn_rate)
    w1 &amp;lt;- bp$w1; w2 &amp;lt;- bp$w2
  }
  list(output = ff$output, w1 = w1, w2 = w2)
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Let’s &lt;code&gt;train&lt;/code&gt; a neural network with five hidden nodes (like in Figure 1) on the hot dogs data.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;x &amp;lt;- data.matrix(hotdogs[, c(&amp;#39;x1&amp;#39;, &amp;#39;x2&amp;#39;)])
y &amp;lt;- hotdogs$class == &amp;#39;hot dog&amp;#39;
nnet5 &amp;lt;- train(x, y, hidden = 5, iterations = 1e5)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;On my desktop PC, it takes about 12 seconds for the above code to run the 100,000 iterations.
Not too bad for what sounds like a lot of runs, but what are the results like?&lt;/p&gt;
&lt;p&gt;We can calculate how many objects it classified correctly:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;mean((nnet5$output &amp;gt; .5) == y)&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;## [1] 0.76&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;That’s 76%, or 152 out of 200 objects in the right class.&lt;/p&gt;
&lt;p&gt;Let’s draw a picture to see what the decision boundaries look like.
To do that, we firstly make a grid of points around the input space:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;grid &amp;lt;- expand.grid(x1 = seq(min(hotdogs$x1) - 1,
                             max(hotdogs$x1) + 1,
                             by = .25),
                    x2 = seq(min(hotdogs$x2) - 1,
                             max(hotdogs$x2) + 1,
                             by = .25))&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then feed these points forward through our trained neural network.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;ff_grid &amp;lt;- feedforward(x = data.matrix(grid[, c(&amp;#39;x1&amp;#39;, &amp;#39;x2&amp;#39;)]),
                       w1 = nnet5$w1,
                       w2 = nnet5$w2)
grid$class &amp;lt;- factor((ff_grid$output &amp;gt; .5) * 1,
                     labels = levels(hotdogs$class))&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then, using &lt;code&gt;ggplot2&lt;/code&gt;, we plot the predicted classes on a grid behind the observed points.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;ggplot(hotdogs) + aes(x1, x2, colour = class) +
  geom_point(data = grid, size = .5) +
  geom_point() +
  labs(x = expression(x[1]), y = expression(x[2]))&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/post/2018-01-09-neural-network_files/figure-html/plot-ad-hoc-1.png&#34; width=&#34;672&#34; /&gt;
The regions the neural network has classified into ‘hot dog’ and ‘not hot dog’ can no longer be separated by a single straight line.
The more nodes we add to the hidden layer, the more elaborate the decision boundaries can become, improving accuracy at the expense of computation time (as more weights must be calculated) and increased risk of &lt;a href=&#34;https://en.wikipedia.org/wiki/Overfitting&#34;&gt;over-fitting&lt;/a&gt; the data.&lt;/p&gt;
&lt;p&gt;How about 30 nodes?&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;nnet30 &amp;lt;- train(x, y, hidden = 30, iterations = 1e5)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;After 100,000 iterations, accuracy is 100%.
The decision boundary looks much smoother:&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/post/2018-01-09-neural-network_files/figure-html/plot-30-nodes-1.png&#34; width=&#34;672&#34; /&gt;&lt;/p&gt;
&lt;p&gt;And for completeness, let’s see what one hidden node (plus an intercept) gives us.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;nnet1 &amp;lt;- train(x, y, hidden = 1, iterations = 1e5)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/post/2018-01-09-neural-network_files/figure-html/plot-1-node-1.png&#34; width=&#34;672&#34; /&gt;&lt;/p&gt;
&lt;p&gt;Much worse accuracy—68%—and the decision boundary looks linear.&lt;/p&gt;
&lt;/div&gt;
&lt;div id=&#34;r6-class-implementation&#34; class=&#34;section level2&#34;&gt;
&lt;h2&gt;R6 class implementation&lt;/h2&gt;
&lt;p&gt;The above code works, mathematically, but isn’t the most elegant solution from a user interface point of view.
It’s a bit ad hoc.
One of the annoying things about writing R functions is that, unless you use the global assignment operator (&lt;code&gt;&amp;lt;&amp;lt;-&lt;/code&gt;) then the arguments are &lt;a href=&#34;https://en.wikipedia.org/wiki/Immutable_object&#34;&gt;immutable&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;Also, everything defined within the function scope is discarded.
You can return the objects in a list, but this can be unwieldy and you have to extract each object one by one to pass into the arguments of the next function.
And despite this we still have three functions and various objects cluttering the workspace.&lt;/p&gt;
&lt;p&gt;Can we do better?
A more flexible implementation is object orientated, using &lt;a href=&#34;https://cran.r-project.org/package=R6&#34;&gt;&lt;code&gt;R6&lt;/code&gt; classes&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;The following class not only supports binary classification but also &lt;a href=&#34;https://en.wikipedia.org/wiki/Multinomial_logistic_regression&#34;&gt;multinomial logistic regression&lt;/a&gt;, providing a high-level formula interface like that used when fitting an &lt;code&gt;lm&lt;/code&gt; or &lt;code&gt;glm&lt;/code&gt; with the &lt;code&gt;stats&lt;/code&gt; package.&lt;/p&gt;
&lt;p&gt;The maths for multi-class classification is very similar (partly thanks to the derivative of the &lt;a href=&#34;https://en.wikipedia.org/wiki/Softmax_function&#34;&gt;softmax function&lt;/a&gt;—the multivariate generalisation of sigmoid—cancelling out in the gradient calculation) and most of the modifications are to do with wrangling R factors to and from indicator matrix representation.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;library(R6)
NeuralNetwork &amp;lt;- R6Class(&amp;quot;NeuralNetwork&amp;quot;,
  public = list(
    X = NULL,  Y = NULL,
    W1 = NULL, W2 = NULL,
    output = NULL,
    initialize = function(formula, hidden, data = list()) {
      # Model and training data
      mod &amp;lt;- model.frame(formula, data = data)
      self$X &amp;lt;- model.matrix(attr(mod, &amp;#39;terms&amp;#39;), data = mod)
      self$Y &amp;lt;- model.response(mod)
      
      # Dimensions
      D &amp;lt;- ncol(self$X) # input dimensions (+ bias)
      K &amp;lt;- length(unique(self$Y)) # number of classes
      H &amp;lt;- hidden # number of hidden nodes (- bias)
      
      # Initial weights and bias
      self$W1 &amp;lt;- .01 * matrix(rnorm(D * H), D, H)
      self$W2 &amp;lt;- .01 * matrix(rnorm((H + 1) * K), H + 1, K)
    },
    fit = function(data = self$X) {
      h &amp;lt;- self$sigmoid(data %*% self$W1)
      score &amp;lt;- cbind(1, h) %*% self$W2
      return(self$softmax(score))
    },
    feedforward = function(data = self$X) {
      self$output &amp;lt;- self$fit(data)
      invisible(self)
    },
    backpropagate = function(lr = 1e-2) {
      h &amp;lt;- self$sigmoid(self$X %*% self$W1)
      Yid &amp;lt;- match(self$Y, sort(unique(self$Y)))
      
      haty_y &amp;lt;- self$output - (col(self$output) == Yid) # E[y] - y
      dW2 &amp;lt;- t(cbind(1, h)) %*% haty_y
      
      dh &amp;lt;- haty_y %*% t(self$W2[-1, , drop = FALSE])
      dW1 &amp;lt;- t(self$X) %*% (self$dsigmoid(h) * dh)
      
      self$W1 &amp;lt;- self$W1 - lr * dW1
      self$W2 &amp;lt;- self$W2 - lr * dW2
      
      invisible(self)
    },
    predict = function(data = self$X) {
      probs &amp;lt;- self$fit(data)
      preds &amp;lt;- apply(probs, 1, which.max)
      levels(self$Y)[preds]
    },
    compute_loss = function(probs = self$output) {
      Yid &amp;lt;- match(self$Y, sort(unique(self$Y)))
      correct_logprobs &amp;lt;- -log(probs[cbind(seq_along(Yid), Yid)])
      sum(correct_logprobs)
    },
    train = function(iterations = 1e4,
                     learn_rate = 1e-2,
                     tolerance = .01,
                     trace = 100) {
      for (i in seq_len(iterations)) {
        self$feedforward()$backpropagate(learn_rate)
        if (trace &amp;gt; 0 &amp;amp;&amp;amp; i %% trace == 0)
          message(&amp;#39;Iteration &amp;#39;, i, &amp;#39;\tLoss &amp;#39;, self$compute_loss(),
                  &amp;#39;\tAccuracy &amp;#39;, self$accuracy())
        if (self$compute_loss() &amp;lt; tolerance) break
      }
      invisible(self)
    },
    accuracy = function() {
      predictions &amp;lt;- apply(self$output, 1, which.max)
      predictions &amp;lt;- levels(self$Y)[predictions]
      mean(predictions == self$Y)
    },
    sigmoid = function(x) 1 / (1 + exp(-x)),
    dsigmoid = function(x) x * (1 - x),
    softmax = function(x) exp(x) / rowSums(exp(x))
  )
)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;What do each of the methods do?&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;&lt;code&gt;initialize&lt;/code&gt; is run every time you make a new network. It initialises the weight matrices to be the correct dimensions, populated with random initial values.&lt;/li&gt;
&lt;li&gt;&lt;code&gt;fit&lt;/code&gt; runs one step of forward propagation but returns the result instead of storing it. Useful for predicting from new test data without changing the model.&lt;/li&gt;
&lt;li&gt;&lt;code&gt;feedforward&lt;/code&gt; runs &lt;code&gt;fit&lt;/code&gt; but saves the results, for training.&lt;/li&gt;
&lt;li&gt;&lt;code&gt;backpropagate&lt;/code&gt; does what you might expect, saving the results for training.&lt;/li&gt;
&lt;li&gt;&lt;code&gt;train&lt;/code&gt; runs forward and back propagation, storing the results and printing the progress to the console every &lt;code&gt;trace&lt;/code&gt; iterations.&lt;/li&gt;
&lt;li&gt;&lt;code&gt;predict&lt;/code&gt; uses argmax to estimate a single discrete class for each observation (whereas &lt;code&gt;fit&lt;/code&gt; only returns probabilities).&lt;/li&gt;
&lt;li&gt;&lt;code&gt;accuracy&lt;/code&gt; and &lt;code&gt;compute_loss&lt;/code&gt; return the proportion of correct class assignments and the negative log likelihood (‘log loss’), respectively&lt;/li&gt;
&lt;li&gt;&lt;code&gt;sigmoid&lt;/code&gt;, &lt;code&gt;dsigmoid&lt;/code&gt; and &lt;code&gt;softmax&lt;/code&gt; are utility functions.&lt;/li&gt;
&lt;/ul&gt;
&lt;p&gt;Let’s see our fancy neural network in action on the famous &lt;a href=&#34;https://en.wikipedia.org/wiki/Iris_flower_data_set&#34;&gt;iris data set&lt;/a&gt;.
Firstly, initialise the network by specifying the input and output variables and the number of hidden nodes.
(Let’s go for five.)&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;irisnet &amp;lt;- NeuralNetwork$new(Species ~ ., data = iris, hidden = 5)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;I have implemented a formula interface so I can regress &lt;code&gt;Species&lt;/code&gt; on the other four variables (&lt;code&gt;Petal.Length&lt;/code&gt;, &lt;code&gt;Petal.Width&lt;/code&gt;, &lt;code&gt;Sepal.Length&lt;/code&gt; and &lt;code&gt;Sepal.Width&lt;/code&gt;) without having to type it out in full.&lt;/p&gt;
&lt;p&gt;That’s the framework assembled.
Now we can train the model.
No need to assign any new variables—the R6 object modifies itself in place.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;irisnet$train(9999, trace = 1e3, learn_rate = .0001)
## Iteration 1000   Loss 151.054969487204   Accuracy 0.68
## Iteration 2000   Loss 81.6280605667542   Accuracy 0.853333333333333
## Iteration 3000   Loss 64.5735942975868   Accuracy 0.966666666666667
## Iteration 4000   Loss 51.0996158369837   Accuracy 0.973333333333333
## Iteration 5000   Loss 40.105949050699    Accuracy 0.973333333333333
## Iteration 6000   Loss 32.3280157122779   Accuracy 0.973333333333333
## Iteration 7000   Loss 27.0449301604686   Accuracy 0.98
## Iteration 8000   Loss 23.3961690114  Accuracy 0.98
## Iteration 9000   Loss 20.7875204792586   Accuracy 0.98&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;You might notice that the log loss is going down even while accuracy stays the same.
This is because the model is becoming more or less confident about each of its predictions, even if the argmax doesn’t change.&lt;/p&gt;
&lt;p&gt;Everything is stored inside the &lt;code&gt;NeuralNetwork&lt;/code&gt; object.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;irisnet&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;## &amp;lt;NeuralNetwork&amp;gt;
##   Public:
##     accuracy: function () 
##     backpropagate: function (lr = 0.01) 
##     clone: function (deep = FALSE) 
##     compute_loss: function (probs = self$output) 
##     dsigmoid: function (x) 
##     feedforward: function (data = self$X) 
##     fit: function (data = self$X) 
##     initialize: function (formula, hidden, data = list()) 
##     output: 0.968263186096496 0.962577356981835 0.965919909020745 0. ...
##     predict: function (data = self$X) 
##     sigmoid: function (x) 
##     softmax: function (x) 
##     train: function (iterations = 10000, learn_rate = 0.01, tolerance = 0.01, 
##     W1: 0.535763605328154 1.04640352732849 1.11188605221437 -1.7 ...
##     W2: -0.412354248171205 2.04939691705817 -1.70485310730503 -3 ...
##     X: 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1  ...
##     Y: setosa setosa setosa setosa setosa setosa setosa setosa  ...&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;One other nice thing about R6 classes is you can chain methods together where they return &lt;code&gt;self&lt;/code&gt; or &lt;code&gt;invisible(self)&lt;/code&gt;.
So if I want to train for 1000 iterations and then predict for some new data, all in one line, it’s as simple as&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;irisnet$train(1000)$predict(newdata)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;There are plenty of improvements we could make to the &lt;code&gt;NeuralNetwork&lt;/code&gt; class but most of them are beyond the scope of this article, and left as an exercise to the interested reader.
Here are some ideas:&lt;/p&gt;
&lt;ul&gt;
&lt;li&gt;user-selectable activation functions, rather than hard-coded sigmoid&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;https://en.wikipedia.org/wiki/Regularization_(mathematics)&#34;&gt;regularisation&lt;/a&gt;, and including regularisation loss as part of &lt;code&gt;compute_loss()&lt;/code&gt;&lt;/li&gt;
&lt;li&gt;arbitrary number of hidden layers, to enable deep learning (multiple hidden layers) or logistic regression (no hidden layer)&lt;/li&gt;
&lt;li&gt;regression as well as classification&lt;/li&gt;
&lt;li&gt;more intelligent initial weights&lt;/li&gt;
&lt;li&gt;changing learning rate over time&lt;/li&gt;
&lt;/ul&gt;
&lt;p&gt;But you might be wondering: can I actually classify pictures of hot dogs with this?
Probably not from raw pixels—image analysis is usually a job for a &lt;a href=&#34;https://en.wikipedia.org/wiki/Convolutional_neural_network&#34;&gt;convolutional neural network&lt;/a&gt;, which is a more advanced topic for another day.&lt;/p&gt;
&lt;p&gt;For further reading, try &lt;a href=&#34;http://www.deeplearningbook.org/&#34;&gt;Chapter 6 of &lt;em&gt;Deep Learning&lt;/em&gt;&lt;/a&gt; (2016) by Goodfellow, Bengio and Courville.&lt;/p&gt;
&lt;p&gt;I hope you found this useful!
Let me know if anything is unclear.
Full source code for this post is available &lt;a href=&#34;https://github.com/Selbosh/selbosh.github.io/blob/source/content/post/2018-01-09-neural-network.Rmd&#34;&gt;on GitHub&lt;/a&gt;.&lt;/p&gt;
&lt;/div&gt;
&lt;div class=&#34;footnotes&#34;&gt;
&lt;hr /&gt;
&lt;ol&gt;
&lt;li id=&#34;fn1&#34;&gt;&lt;p&gt;If you wanted to be very general, then you could say the bias &lt;em&gt;does&lt;/em&gt; depend on the previous layer, but the respective weight is fixed at zero. Then the weighted sum would be zero and &lt;span class=&#34;math inline&#34;&gt;\(\sigma(0) = 1\)&lt;/span&gt;, so you get a vector of ones.&lt;a href=&#34;#fnref1&#34; class=&#34;footnote-back&#34;&gt;↩︎&lt;/a&gt;&lt;/p&gt;&lt;/li&gt;
&lt;/ol&gt;
&lt;/div&gt;
</description>
    </item>
    
    <item>
      <title>Using R on Android</title>
      <link>https://selbydavid.com/2017/12/29/r-android/</link>
      <pubDate>Fri, 29 Dec 2017 15:00:00 +0000</pubDate>
      
      <guid>https://selbydavid.com/2017/12/29/r-android/</guid>
      <description>&lt;p&gt;I just discovered a way to get R running on my smartphone, with full support for packages, graphics and &lt;a href=&#34;http://rmarkdown.rstudio.com/&#34;&gt;R Markdown&lt;/a&gt;, and no need to connect to an external server.
This is really handy for quickly checking R code, trying out ideas and writing blog posts on the go.
It works quite well!&lt;/p&gt;
&lt;p&gt;Here I will show you how to do the same on your Android device.
This post was inspired by &lt;a href=&#34;https://stackoverflow.com/a/45361256&#34;&gt;this answer on StackOverflow&lt;/a&gt;.&lt;/p&gt;
&lt;h2 id=&#34;initial-setup&#34;&gt;Initial setup&lt;/h2&gt;
&lt;p&gt;Install &lt;a href=&#34;https://play.google.com/store/apps/details?id=com.gnuroot.debian&#34;&gt;GNUroot Debian&lt;/a&gt; from the Google Play Store.
This application effectively gives you a full Linux environment within Android, without rooting your device.
It just works.&lt;/p&gt;
&lt;p&gt;GNUroot Debian emulates a command line interface or &amp;ldquo;X Terminal&amp;rdquo; like on a regular desktop PC.
You can work in multiple windows, and you have access to all the files on your Android system.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2017/gnuroot.png&#34; alt=&#34;GNUroot Debian&#34;&gt;&lt;/p&gt;
&lt;p&gt;You can use it not only to run R on your phone, but also Python or any other command-line tools supported by GNU/Linux.&lt;/p&gt;
&lt;h2 id=&#34;installing-r&#34;&gt;Installing R&lt;/h2&gt;
&lt;p&gt;To install R, type the following commands in GNUroot Debian, hitting Enter after each line and waiting for the respective processes to finish.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-bash&#34;&gt;apt-get update
apt-get upgrade
apt-get install r-base r-base-dev
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Now you have R installed on your phone.&lt;/p&gt;
&lt;h2 id=&#34;interactive-r-commands&#34;&gt;Interactive R commands&lt;/h2&gt;
&lt;p&gt;Starting an R session is as simple as typing&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-bash&#34;&gt;R
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;into the terminal.&lt;/p&gt;
&lt;p&gt;You will know R is running because the start of the command prompt will change from a hash, &lt;code&gt;#&lt;/code&gt;, to a greater-than sign, &lt;code&gt;&amp;gt;&lt;/code&gt;.
This is just like the usual interactive R user interface (because it &lt;em&gt;is&lt;/em&gt; the usual interface).
Run commands and load and install packages to your heart&amp;rsquo;s content.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2017/interactiveR.png&#34; alt=&#34;Interactive R session in GNUroot Debian&#34;&gt;&lt;/p&gt;
&lt;p&gt;To quit R and return to the Linux command line, type&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;q()
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;and hit Enter.&lt;/p&gt;
&lt;p&gt;You can run quick R one-liners without diving into a full R session, by using the following syntax.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-bash&#34;&gt;Rscript -e &amp;quot;rnorm(5)&amp;quot; # five random numbers
Rscript -e &amp;quot;print(&#39;Hello, world&#39;)&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Be careful about matching quotation marks.&lt;/p&gt;
&lt;p&gt;You can also use the syntax&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-bash&#34;&gt;R -e &amp;quot;rnorm(5)&amp;quot;
R -e &amp;quot;print(&#39;Hello, world&#39;)&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;which does the same thing but prints more verbose output to the console.&lt;/p&gt;
&lt;p&gt;Pressing Up and Down on your keyboard lets you cycle through recently used commands, saving you from needing to retype repeated or very similar commands.
Usually touch-screen keyboards don&amp;rsquo;t have arrow keys, but you can install the &lt;a href=&#34;https://play.google.com/store/apps/details?id=org.pocketworkstation.pckeyboard&#34;&gt;Hacker&amp;rsquo;s Keyboard&lt;/a&gt; for Android, which does (at least in landscape mode).&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2017/hackers-keyboard.png&#34; alt=&#34;Hacker&amp;rsquo;s Keyboard&#34;&gt;&lt;/p&gt;
&lt;h2 id=&#34;running-scripts&#34;&gt;Running scripts&lt;/h2&gt;
&lt;p&gt;To write nontrivial programmes and not lose your work, you will want to write and run R scripts from files.
While you could open a Linux text editor within GNUroot, this is probably more trouble than it&amp;rsquo;s worth.
Dedicated Android text editors are better optimised for use with a small touch screen and don&amp;rsquo;t need arrow keys or special control commands to work.
&lt;a href=&#34;https://play.google.com/store/apps/details?id=com.rhmsoft.edit&#34;&gt;QuickEdit&lt;/a&gt; is a free text editor with syntax highlighting for R and Markdown, line numbering and other useful features.&lt;/p&gt;
&lt;p&gt;In your text editor, write a basic R script, like the following.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;x &amp;lt;- &amp;quot;Hello&amp;quot;
y &amp;lt;- &amp;quot;world!&amp;quot;
cat(x, y, sep = &#39;, &#39;)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Save the file as &lt;code&gt;test.R&lt;/code&gt; and put it somewhere easy to find, like your &lt;code&gt;Documents&lt;/code&gt; folder.&lt;/p&gt;
&lt;p&gt;Reopen GNUroot Debian. Navigate to the directory where you saved your R script file. In my case, I had saved it to Documents, which I reached using&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-bash&#34;&gt;cd sdcard/Documents
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;The command &lt;code&gt;cd&lt;/code&gt; means &amp;ldquo;change directory&amp;rdquo;. Type &lt;code&gt;ls&lt;/code&gt; for a list of files and folders in the current directory. If you make a wrong turn, simply type&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-bash&#34;&gt;cd ..
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;to go up (back) one folder.&lt;/p&gt;
&lt;p&gt;Once you&amp;rsquo;ve found your R script file, evaluate it with&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;Rscript test.R
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;or&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;R -f test.R
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;for more detailed output.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2017/Rscript.png&#34; alt=&#34;Evaluating an R script on Android&#34;&gt;&lt;/p&gt;
&lt;p&gt;If you prefer working in R to in a Linux terminal, then you can equivalently do everything within an R session:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;getwd() # show current directory
list.files() # equivalent to ls
setwd(&#39;sdcard/Documents&#39;) # equivalent to cd
source(&#39;test.R&#39;) # run the script
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;saving-output&#34;&gt;Saving output&lt;/h2&gt;
&lt;p&gt;If your scripts produce output, like plots saved as image files or data in csv files, you can open these with ordinary Android apps and share them.
Just keep track of where the files are saved.&lt;/p&gt;
&lt;p&gt;For example, here is a short script that produces a plot and saves it as a PNG.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;n &amp;lt;- 1000
g &amp;lt;- 16
cx &amp;lt;- rep(1:4, each = 4) * n * 2
cy &amp;lt;- rep(1:4, times = 4) * n * 2
t &amp;lt;- 1:1000
x &amp;lt;- rep(t * cos(t), each = g) + cx
y &amp;lt;- rep(t * sin(t), each = g) + cy
png(&amp;quot;test.png&amp;quot;, width = 600, height = 600)
par(mar = rep(0, 4))
plot(x, y,
     col = rep(c(2, 4), each = g),
     asp = 1,
     axes = FALSE)
dev.off()
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Run the script and use &lt;code&gt;ls&lt;/code&gt; or &lt;code&gt;list.files()&lt;/code&gt; to verify that a new file, &lt;code&gt;test.png&lt;/code&gt; has been created.
In your Android launcher, go to &lt;strong&gt;Files &amp;gt; Local &amp;gt; Internal storage &amp;gt; Documents&lt;/strong&gt; (the names might vary depending on your device) and you should see your new plot, which you can open and share like any other image.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2017/test.png&#34; alt=&#34;Test R plot&#34;&gt;&lt;/p&gt;
&lt;h2 id=&#34;r-markdown-on-android&#34;&gt;R Markdown on Android&lt;/h2&gt;
&lt;p&gt;Rendering/knitting R Markdown documents requires the R package &lt;strong&gt;knitr&lt;/strong&gt; and the external application &lt;strong&gt;pandoc&lt;/strong&gt;.
Install the former using&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;install.packages(&#39;knitr&#39;, dependencies = TRUE)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;If you accidentally choose a CRAN mirror that doesn&amp;rsquo;t work, you can select another one with&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;chooseCRANmirror()
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;You also need pandoc.
Install it from the command line with&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-bash&#34;&gt;apt-get install pandoc
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;After installing, you might need to restart your terminal to ensure pandoc has been properly added to the PATH (and so can be found by R).&lt;/p&gt;
&lt;p&gt;Write a minimal R Markdown document in your Android text editor, for example&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-markdown&#34;&gt;# Hello, world!

I am an *R Markdown* document.
A horse has `r 2+2` legs.
Here is some random noise.

```{r}
plot(runif(100), runif(100))
```
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Convert it using&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-bash&#34;&gt;Rscript -e &amp;quot;rmarkdown::render(&#39;test.rmd&#39;)&amp;quot;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;And using &lt;code&gt;ls&lt;/code&gt; or &lt;code&gt;list.files()&lt;/code&gt; or your Android file explorer, you should see the output Markdown, HTML, Word, or PDF document, which you can open in your Android text editor, browser, word processor or PDF reader, respectively.
Once again, share or upload it like any other file.&lt;/p&gt;
&lt;p&gt;So there we have it: R and R Markdown running on Android!
I hope you found this useful.
This blog post was written on a Huawei Honor 8 smartphone using QuickEdit text editor.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2017/android-r.gif&#34; alt=&#34;R on Android&#34;&gt;&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>useR! poster: ranking influential communities</title>
      <link>https://selbydavid.com/2017/06/29/user2017/</link>
      <pubDate>Thu, 29 Jun 2017 18:30:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2017/06/29/user2017/</guid>
      <description>&lt;p&gt;Next week I will be presenting a poster at the &lt;a href=&#34;https://user2017.brussels&#34;&gt;useR!2017&lt;/a&gt; conference in Brussels.&lt;/p&gt;
&lt;p&gt;My topic is &lt;strong&gt;Ranking influential communities in networks&lt;/strong&gt;.
Using a large dataset of citations from the Web of Science, we grouped academic journals into communities based on their citation behaviour.
These communities closely correspond to recognisable research fields, so I was able to label them.&lt;/p&gt;
&lt;p&gt;We then modelled the flow of influence within and between these communities.
A journal having a high influence score means it tends to receive more citations than it gives out when interacting with other influential journals.&lt;/p&gt;
&lt;p&gt;Statistics comes second in the inter-field ranking (after economics).
We all know how cool statistics is, so the model must be right.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2017/user2017.png&#34; alt=&#34;useR!2017 poster&#34; title=&#34;Ranking influential communities in networks&#34;&gt;&lt;/p&gt;
&lt;p&gt;Here is a preview.
You can download the full PDF on the &lt;a href=&#34;https://user2017.brussels/posters&#34;&gt;conference web site&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;The poster is mostly reproducible: the full R source code for the analysis is &lt;a href=&#34;https://github.com/Selbosh/user2017&#34;&gt;available on GitHub&lt;/a&gt;, as is the Scribus file that generated the poster itself.
I say &amp;lsquo;mostly&amp;rsquo; because the code is open but unfortunately the raw data is not.&lt;/p&gt;
&lt;p&gt;In a maximally reproducible workflow, we could even consider designing the entire poster with Markdown.
An idea for a future R package, perhaps?&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Chernoff faces in ggplot2</title>
      <link>https://selbydavid.com/2017/06/25/ggchernoff/</link>
      <pubDate>Sun, 25 Jun 2017 18:25:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2017/06/25/ggchernoff/</guid>
      <description>
&lt;script src=&#34;https://selbydavid.com/rmarkdown-libs/header-attrs/header-attrs.js&#34;&gt;&lt;/script&gt;
&lt;link href=&#34;https://selbydavid.com/rmarkdown-libs/anchor-sections/anchor-sections.css&#34; rel=&#34;stylesheet&#34; /&gt;
&lt;script src=&#34;https://selbydavid.com/rmarkdown-libs/anchor-sections/anchor-sections.js&#34;&gt;&lt;/script&gt;


&lt;p&gt;I am pleased to introduce my first R package for general consumption, &lt;a href=&#34;https://github.com/Selbosh/ggChernoff&#34;&gt;&lt;strong&gt;ggChernoff&lt;/strong&gt;&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;Inspiration stems from Leland Wilkinson’s book, &lt;a href=&#34;http://www.springer.com/gb/book/9780387245447&#34;&gt;&lt;em&gt;The Grammar of Graphics&lt;/em&gt;&lt;/a&gt;, whose principles were later implemented as the &lt;a href=&#34;http://vita.had.co.nz/papers/layered-grammar.pdf&#34;&gt;layered grammar of graphics&lt;/a&gt; in Hadley Wickham’s popular R package, &lt;a href=&#34;http://ggplot2.org/&#34;&gt;ggplot2&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;Wilkinson’s grammar generalises data visualisation.
Rather than choosing a types of graph from a list—for example bar plot, pie chart or line graphs—instead we break down graphics into algebra, scales, statistics, geometry, coordinates and aesthetics.&lt;/p&gt;
&lt;p&gt;What does that actually mean? Suppose we want to transform the following data,&lt;/p&gt;
&lt;table&gt;
&lt;thead&gt;
&lt;tr class=&#34;header&#34;&gt;
&lt;th align=&#34;left&#34;&gt;name&lt;/th&gt;
&lt;th align=&#34;right&#34;&gt;value&lt;/th&gt;
&lt;/tr&gt;
&lt;/thead&gt;
&lt;tbody&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;a&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;37&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;even&#34;&gt;
&lt;td align=&#34;left&#34;&gt;b&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;21&lt;/td&gt;
&lt;/tr&gt;
&lt;tr class=&#34;odd&#34;&gt;
&lt;td align=&#34;left&#34;&gt;c&lt;/td&gt;
&lt;td align=&#34;right&#34;&gt;42&lt;/td&gt;
&lt;/tr&gt;
&lt;/tbody&gt;
&lt;/table&gt;
&lt;p&gt;into the following simple visualisation.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/post/2017-06-25-ggchernoff_files/figure-html/lineplot-1.png&#34; width=&#34;672&#34; /&gt;&lt;/p&gt;
&lt;p&gt;In &lt;em&gt;Grammar of Graphics&lt;/em&gt; terms, we produce the plot using these semantics.&lt;/p&gt;
&lt;dl&gt;
&lt;dt&gt;Variables&lt;/dt&gt;
&lt;dd&gt;&lt;code&gt;name&lt;/code&gt;, &lt;code&gt;value&lt;/code&gt;
&lt;/dd&gt;
&lt;dt&gt;Algebra&lt;/dt&gt;
&lt;dd&gt;&lt;code&gt;name&lt;/code&gt; × &lt;code&gt;value&lt;/code&gt; → (a, 37), (b, 21), (c, 42).
&lt;/dd&gt;
&lt;dt&gt;Scales&lt;/dt&gt;
&lt;dd&gt;&lt;ul&gt;
&lt;li&gt;(37, 21, 42) → (0.88, 0.50, 1.00)
&lt;ul&gt;
&lt;li&gt;(a, b, c) → (3, 2, 1)&lt;/li&gt;
&lt;/ul&gt;&lt;/li&gt;
&lt;/ul&gt;
&lt;/dd&gt;
&lt;dt&gt;Geometry&lt;/dt&gt;
&lt;dd&gt;For each tuple, draw a line between two points.
&lt;/dd&gt;
&lt;dt&gt;Coordinates&lt;/dt&gt;
&lt;dd&gt;use Cartesian (x, y) coordinates in 2-dimensional space.
&lt;/dd&gt;
&lt;dt&gt;Aesthetics&lt;/dt&gt;
&lt;dd&gt;&lt;ul&gt;
&lt;li&gt;(0, &lt;code&gt;name&lt;/code&gt;) → (&lt;em&gt;x&lt;/em&gt;&lt;sub&gt;1&lt;/sub&gt;, &lt;em&gt;y&lt;/em&gt;&lt;sub&gt;1&lt;/sub&gt;)
&lt;ul&gt;
&lt;li&gt;(&lt;code&gt;value&lt;/code&gt;, &lt;code&gt;name&lt;/code&gt;) → (&lt;em&gt;x&lt;/em&gt;&lt;sub&gt;2&lt;/sub&gt;, &lt;em&gt;y&lt;/em&gt;&lt;sub&gt;2&lt;/sub&gt;)&lt;/li&gt;
&lt;/ul&gt;&lt;/li&gt;
&lt;/ul&gt;
&lt;/dd&gt;
&lt;/dl&gt;
&lt;p&gt;Our line plot above is grammatically equivalent to a bar chart—just make the lines thicker!
Now, what if we swap Cartesian coordinates for polar coordinates, (r, θ)?
The resulting graphic is still grammatically correct, though perhaps not very useful.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/post/2017-06-25-ggchernoff_files/figure-html/polar-1.png&#34; width=&#34;384&#34; /&gt;
We can even transpose it to (θ, r) coordinates, for another grammatically-valid data visualisation.
&lt;img src=&#34;https://selbydavid.com/post/2017-06-25-ggchernoff_files/figure-html/radial-1.png&#34; width=&#34;384&#34; /&gt;&lt;/p&gt;
&lt;p&gt;These plots don’t necessarily have names, so you don’t have to hunt through a list to find the right tool to create them.
It is just a matter of knowing how the &lt;em&gt;Grammar of Graphics&lt;/em&gt; works.&lt;/p&gt;
&lt;p&gt;Look at the specifications for our plot again.
Geometry and aesthetics don’t have to be as conventional as lines and boxes of different sizes.
Let’s try something completely different!&lt;/p&gt;
&lt;p&gt;A couple of amendments to the specifications…&lt;/p&gt;
&lt;dl&gt;
&lt;dt&gt;Geometry&lt;/dt&gt;
&lt;dd&gt;For each tuple, draw a face.
&lt;/dd&gt;
&lt;dt&gt;Aesthetics&lt;/dt&gt;
&lt;dd&gt;&lt;ul&gt;
&lt;li&gt;&lt;code&gt;name&lt;/code&gt; → x
&lt;ul&gt;
&lt;li&gt;0 → y&lt;/li&gt;
&lt;li&gt;&lt;code&gt;value&lt;/code&gt; → smile&lt;/li&gt;
&lt;/ul&gt;&lt;/li&gt;
&lt;/ul&gt;
&lt;/dd&gt;
&lt;/dl&gt;
&lt;p&gt;…and we produce this graph.
&lt;img src=&#34;https://selbydavid.com/post/2017-06-25-ggchernoff_files/figure-html/smile-1.png&#34; width=&#34;480&#34; /&gt;&lt;/p&gt;
&lt;p&gt;Using faces for multivariate data visualisation is an idea credited to &lt;a href=&#34;https://en.wikipedia.org/wiki/Chernoff_face&#34;&gt;Herman Chernoff&lt;/a&gt;, and which Wilkinson discusses in some detail in &lt;em&gt;The Grammar of Graphics&lt;/em&gt;.
In principle, you can represent data using all kinds of weird and wonderful things, so long as you can clearly define geometry, aesthetics, scales and so on to integrate them into a grammatical workflow.&lt;/p&gt;
&lt;p&gt;My R package, &lt;a href=&#34;https://github.com/Selbosh/ggChernoff&#34;&gt;ggChernoff&lt;/a&gt;, extends ggplot2 with a new face geom and aesthetics for its mouth and eyebrows.
By mapping variables to the right aesthetic you can make your data happy or sad, angry or expressionless.&lt;/p&gt;
&lt;p&gt;Here is another set of aesthetic mappings.&lt;/p&gt;
&lt;dl&gt;
&lt;dt&gt;Aesthetics&lt;/dt&gt;
&lt;dd&gt;&lt;ul&gt;
&lt;li&gt;&lt;code&gt;name&lt;/code&gt; → x
&lt;ul&gt;
&lt;li&gt;0 → y&lt;/li&gt;
&lt;li&gt;1 → smile&lt;/li&gt;
&lt;li&gt;&lt;code&gt;value&lt;/code&gt; → eyebrows&lt;/li&gt;
&lt;/ul&gt;&lt;/li&gt;
&lt;/ul&gt;
&lt;/dd&gt;
&lt;/dl&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/post/2017-06-25-ggchernoff_files/figure-html/eyebrow-1.png&#34; width=&#34;480&#34; /&gt;&lt;/p&gt;
&lt;p&gt;This is a nice way to add a bit of personality to your data visualisations.
Unlike the package &lt;a href=&#34;https://github.com/dill/emoGG&#34;&gt;emoGG&lt;/a&gt;, which involves selecting pre-drawn icons from a list, the faces in ggChernoff are procedurally generated, in the spirit of the grammar of graphics.&lt;/p&gt;
&lt;p&gt;More demonstrations are coming in a future post.
The package ggChernoff is &lt;a href=&#34;https://github.com/Selbosh/ggChernoff&#34;&gt;now available on GitHub&lt;/a&gt;.&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Publishing from blogdown to GitHub with Travis</title>
      <link>https://selbydavid.com/2017/06/22/blogdown-travis/</link>
      <pubDate>Thu, 22 Jun 2017 08:00:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2017/06/22/blogdown-travis/</guid>
      <description>&lt;p&gt;Yihui Xie&amp;rsquo;s new &lt;a href=&#34;https://bookdown.org/yihui/blogdown/&#34;&gt;blogdown&lt;/a&gt; package is a brilliantly elegant and simple tool for creating R-themed blogs and web sites.
Starting your own blog is as simple as one line of R code:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;blogdown::new_site()
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;By default, blogdown uses &lt;a href=&#34;http://gohugo.io&#34;&gt;Hugo&lt;/a&gt;, a static web site generator written in Google&amp;rsquo;s Go programming language.
This has a number of advantages over Jekyll (the site generator that powers GitHub Pages) and from personal experience, everything just seems to work more smoothly.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2017/hugo-lithium.png&#34; alt=&#34;Example blogdown site&#34; title=&#34;Example blogdown site&#34;&gt;&lt;/p&gt;
&lt;p&gt;Previously I wrote about &lt;a href=&#34;http://selbydavid.com/2017/06/16/rmarkdown-jekyll/&#34;&gt;automatically deploying an R Markdown Jekyll blog with Travis&lt;/a&gt;.
In this post, I am going to explain how you can use Travis to knit your R Markdown blog posts, then publish them with Hugo/blogdown.&lt;/p&gt;
&lt;p&gt;Why Travis? In the official blogdown documentation, Yihui &lt;a href=&#34;https://bookdown.org/yihui/blogdown/netlify.html&#34;&gt;recommends Netflify&lt;/a&gt;, a rival service, instead.
However, for the time being at least, Netlify doesn&amp;rsquo;t have R support.
This means that any R Markdown (vs plain Markdown) posts you write will need to be built locally before pushing them to your Git repository, and therefore you can only maintain R-infused content from a computer with R + blogdown installed.&lt;/p&gt;
&lt;p&gt;In an ideal world, you should be able to create content from any computer (or device) that has a web browser.
Therefore we will push plain text to Git and have Travis compile all the R chunks for us, then automatically push the built site to GitHub Pages.&lt;/p&gt;
&lt;p&gt;A few weeks ago Neal Richardson published a &lt;a href=&#34;https://nealrichardson.github.io/2017/06/01/building-a-blogdown-site-with-travis-ci/&#34;&gt;post on a similar topic&lt;/a&gt;, but that guide is a bit more complicated than it needs to be, because it doesn&amp;rsquo;t take advantage of Travis&amp;rsquo;s &lt;a href=&#34;https://docs.travis-ci.com/user/deployment/pages/&#34;&gt;native GitHub Pages support&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;You should be able to get up and running extremely quickly, with minimal Git knowledge required.
Want to see a fully working example?
Take a look at &lt;a href=&#34;https://github.com/Selbosh/selbosh.github.io&#34;&gt;this site&amp;rsquo;s GitHub repository&lt;/a&gt;.
For a minimal (non-Travis) blogdown site, see &lt;a href=&#34;https://github.com/Selbosh/wrugdown&#34;&gt;this example site&lt;/a&gt;.&lt;/p&gt;
&lt;h2 id=&#34;getting-started&#34;&gt;Getting started&lt;/h2&gt;
&lt;p&gt;Install blogdown with&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;devtools::install_github(&#39;rstudio/blogdown&#39;)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;then, in an empty folder, create a site.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;blogdown::new_site()
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;For a crash course in blogdown and Git for beginners, read my post &lt;a href=&#34;http://selbydavid.com/wrugdown/2017/05/10/getting-started-with-blogdown/&#34;&gt;Getting started with blogdown&lt;/a&gt;.
More complete information is available in the &lt;a href=&#34;https://bookdown.org/yihui/blogdown/&#34;&gt;official blogdown book&lt;/a&gt; as well as the &lt;a href=&#34;http://gohugo.io/overview/introduction/&#34;&gt;online Hugo documentation&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;Want a web site that looks like mine? Run&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;blogdown::install_theme(&#39;Selbosh/hugo-tea&#39;)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;then switch your &lt;code&gt;theme&lt;/code&gt; to &lt;code&gt;hugo-tea&lt;/code&gt; in your &lt;code&gt;config.toml&lt;/code&gt; file.&lt;/p&gt;
&lt;h2 id=&#34;linking-github-to-travis&#34;&gt;Linking GitHub to Travis&lt;/h2&gt;
&lt;p&gt;This follows my &lt;a href=&#34;https://selbydavid.com/2017/06/16/rmarkdown-jekyll/#linking-github-to-travis&#34;&gt;earlier guide&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;Create a &lt;a href=&#34;https://github.com/settings/tokens&#34;&gt;GitHub personal access token&lt;/a&gt;, making sure the &amp;ldquo;repo&amp;rdquo; box is ticked so it has permission to push to repositories. Copy the token to your clipboard.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2017/github-pat.png&#34; alt=&#34;Creating a GitHub PAT&#34;&gt;&lt;/p&gt;
&lt;p&gt;On &lt;a href=&#34;https://travis-ci.org/&#34;&gt;Travis&lt;/a&gt;, enable the GitHub repository corresponding to your blogdown site. In Settings, create a new environment variable called &lt;code&gt;GITHUB_PAT&lt;/code&gt; and paste your token into the Value field.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2017/travis-pat.png&#34; alt=&#34;Adding a Travis environment variable&#34;&gt;&lt;/p&gt;
&lt;h2 id=&#34;configuring-travis&#34;&gt;Configuring Travis&lt;/h2&gt;
&lt;p&gt;In the root of your directory, create a file called &lt;code&gt;.travis.yml&lt;/code&gt; containing the following.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-yaml&#34;&gt;language: r
cache: packages
branches:
    only:
        - source
r_github_packages:
    - rstudio/blogdown

before_script:
    - Rscript -e &#39;blogdown::install_hugo(version = &amp;quot;0.20.7&amp;quot;)&#39;

script:
    - Rscript -e &#39;blogdown::build_site()&#39;

deploy:
    provider: pages
    skip_cleanup: true
    github_token: $GITHUB_PAT
    on:
        branch: source
    local_dir: public
    target_branch: master
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;If you are hosting your site on &lt;code&gt;username.github.io&lt;/code&gt;&amp;mdash;like &lt;a href=&#34;https://github.com/Selbosh/selbosh.github.io&#34;&gt;my site&lt;/a&gt;&amp;mdash;there is no need to change any of the settings above.
You push your code to a branch called &lt;code&gt;source&lt;/code&gt; and the compiled site is deployed to &lt;code&gt;master&lt;/code&gt;.&lt;/p&gt;
&lt;p&gt;If, instead, you have a &lt;a href=&#34;https://help.github.com/articles/user-organization-and-project-pages/&#34;&gt;Project Page&lt;/a&gt; (i.e. if the repository is called anything other than &lt;code&gt;username.github.io&lt;/code&gt;), you can replace &lt;code&gt;source&lt;/code&gt; with &lt;code&gt;master&lt;/code&gt; and &lt;code&gt;master&lt;/code&gt; with &lt;code&gt;gh-pages&lt;/code&gt;. Or just leave it how it is&amp;mdash;just make sure your repo settings have the &lt;code&gt;target_branch&lt;/code&gt; set as the &amp;ldquo;Source&amp;rdquo; for GitHub Pages.&lt;/p&gt;
&lt;p&gt;Travis&amp;rsquo;s &lt;a href=&#34;https://docs.travis-ci.com/user/languages/r/&#34;&gt;R environment&lt;/a&gt; was originally designed for &lt;a href=&#34;http://r-pkgs.had.co.nz/tests.html&#34;&gt;testing&lt;/a&gt; R packages, not building web sites.
As a result, Travis will complain if it doesn&amp;rsquo;t find a &lt;code&gt;DESCRIPTION&lt;/code&gt; file&amp;mdash;the minimum requirement of an R package&amp;mdash;in your repository.
It is enough to add a placeholder &lt;code&gt;DESCRIPTION&lt;/code&gt; file with the following arbitrary contents:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-yaml&#34;&gt;Package: arbitrary
Title: Does not matter.
Version: 0.0.1
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;This is enough to convince Travis to proceed.&lt;/p&gt;
&lt;h2 id=&#34;get-publishing&#34;&gt;Get publishing&lt;/h2&gt;
&lt;p&gt;Now, when you push a new commit to the &lt;code&gt;source&lt;/code&gt; branch of your GitHub repository, Travis will clone it, build the site and push it to the &lt;code&gt;master&lt;/code&gt; branch.
In my experience it takes about two minutes from pushing changes to the updated site being live.&lt;/p&gt;
&lt;p&gt;If you have nothing better to do then you can watch Travis as it tries to deploy your blog. There&amp;rsquo;s no need to monitor it, though: if it fails for any reason, you&amp;rsquo;ll receive an e-mail.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2017/travis-log.png&#34; alt=&#34;Travis log for a successful build&#34; title=&#34;Travis log for a successful build&#34;&gt;&lt;/p&gt;
&lt;p&gt;Hopefully this guide helps. If you have any questions or feedback, feel free to leave a comment below or &lt;a href=&#34;https://selbydavid.com/about&#34;&gt;contact me&lt;/a&gt;.&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Cloudy with a chance of engagement</title>
      <link>https://selbydavid.com/2017/06/20/cloudy/</link>
      <pubDate>Tue, 20 Jun 2017 12:30:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2017/06/20/cloudy/</guid>
      <description>&lt;p&gt;Last summer I took part in an internship with the fledgling &lt;a href=&#34;https://www.turing.ac.uk/&#34;&gt;Alan Turing Institute&lt;/a&gt; at the British Library in London.
My group helped analyse data from &lt;a href=&#34;https://www.cloudywithachanceofpain.com/&#34;&gt;Cloudy with a Chance of Pain&lt;/a&gt;, a citizen science project that uses smartphone app data to model the relationship between weather and joint pain.&lt;/p&gt;
&lt;p&gt;A robust statistical model relies on a steady stream of self-reported pain data from each participant.
Naturally, the actual data available was nothing like that.
It looked more like this:&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2017/cloudy-data.png&#34; alt=&#34;Sequences of data entry&#34; title=&#34;Each dot is a day a participant provided data&#34;&gt;&lt;/p&gt;
&lt;p&gt;Unlike in a traditional epidemiological study, people could join at any time.
Some reported data every day, some every couple of days, some had one week on, one week off, while others would lose interest after a few months, after a few weeks or even after the first day.&lt;/p&gt;
&lt;p&gt;To avoid selection bias in a subsequent analysis, we needed to understand the behaviour of these participants.
Why do some people drop out? Why do some people give more data than others?&lt;/p&gt;
&lt;p&gt;Some accepted measures of &amp;lsquo;engagement&amp;rsquo; in longitudinal studies might include counting people who provided data after a particular date, or the proportion of people who used the app on more than &lt;em&gt;x&lt;/em&gt;% of days.
These thresholds are often arbitrary and can quickly lead us down a &lt;a href=&#34;http://www.stat.columbia.edu/~gelman/research/unpublished/p_hacking.pdf&#34;&gt;garden of forking paths&lt;/a&gt;, where we (consciously or subconsciously) choose values that return the result we want.&lt;/p&gt;
&lt;p&gt;Instead, we went for a more automated approach that clustered user data using a mixture of &lt;a href=&#34;https://en.wikipedia.org/wiki/Hidden_Markov_model&#34;&gt;hidden Markov models&lt;/a&gt;.
At any time, an app user could be in one of three states: high engagement, low engagement or disengagement.
Each user is clustered according to their probability of switching between these states, allowing us to compare and contrast highly-engaged users with &amp;lsquo;tourists&amp;rsquo;.&lt;/p&gt;
&lt;p&gt;An article I wrote about this project was recently published in &lt;a href=&#34;https://www.significancemagazine.com/&#34;&gt;&lt;em&gt;Significance&lt;/em&gt;&lt;/a&gt;, the magazine of the Royal Statistical Society and American Statistical Association.
For more details on what we did, &lt;a href=&#34;http://onlinelibrary.wiley.com/doi/10.1111/j.1740-9713.2017.01013.x/abstract&#34;&gt;read the article&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;&lt;a href=&#34;http://onlinelibrary.wiley.com/doi/10.1111/j.1740-9713.2017.01013.x/abstract&#34;&gt;&lt;img src=&#34;https://selbydavid.com/img/2017/cloudy.png&#34; alt=&#34;&#34;&gt;&lt;/a&gt;&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Pretty errors, warnings and messages in R Markdown</title>
      <link>https://selbydavid.com/2017/06/18/rmarkdown-alerts/</link>
      <pubDate>Sun, 18 Jun 2017 13:15:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2017/06/18/rmarkdown-alerts/</guid>
      <description>&lt;p&gt;When knitting an R Markdown document to HTML output, R chunks can produce warnings, errors or messages.&lt;/p&gt;
&lt;p&gt;Normally these messages look like any other console output:&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2017/alerts2.png&#34; alt=&#34;R Markdown alert messages&#34;&gt;&lt;/p&gt;
&lt;p&gt;Pretty ugly, and usually something I find myself trying to hide at the earliest opportunity.&lt;/p&gt;
&lt;p&gt;But if you&amp;rsquo;re using R Markdown&amp;rsquo;s default template, which uses &lt;a href=&#34;http://getbootstrap.com/&#34;&gt;Twitter Bootstrap&lt;/a&gt;, you can promote warnings, errors and messages to first-class citizens.&lt;/p&gt;
&lt;p&gt;What if you could have them looking like this?&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2017/alerts.png&#34; alt=&#34;Bootstrap-styled alert messages&#34;&gt;&lt;/p&gt;
&lt;p&gt;Bootstrap includes &lt;a href=&#34;http://getbootstrap.com/components/#alerts&#34;&gt;dedicated message boxes&lt;/a&gt; for danger, warnings and information.
If you were writing an ordinary web site, you would generate these using the following HTML markup:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-html&#34;&gt;&amp;lt;div class=&amp;quot;alert alert-danger&amp;quot;
  &amp;lt;strong&amp;gt;Danger:&amp;lt;/strong&amp;gt; This is a warning!
&amp;lt;/div&amp;gt;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;You can achieve this in R Markdown using knitr chunk hooks.
Just add the following code to a chunk near the start of your &lt;code&gt;.Rmd&lt;/code&gt; file.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;knitr::knit_hooks$set(
   error = function(x, options) {
     paste(&#39;\n\n&amp;lt;div class=&amp;quot;alert alert-danger&amp;quot;&amp;gt;&#39;,
           gsub(&#39;##&#39;, &#39;\n&#39;, gsub(&#39;^##\ Error&#39;, &#39;**Error**&#39;, x)),
           &#39;&amp;lt;/div&amp;gt;&#39;, sep = &#39;\n&#39;)
   },
   warning = function(x, options) {
     paste(&#39;\n\n&amp;lt;div class=&amp;quot;alert alert-warning&amp;quot;&amp;gt;&#39;,
           gsub(&#39;##&#39;, &#39;\n&#39;, gsub(&#39;^##\ Warning:&#39;, &#39;**Warning**&#39;, x)),
           &#39;&amp;lt;/div&amp;gt;&#39;, sep = &#39;\n&#39;)
   },
   message = function(x, options) {
     paste(&#39;\n\n&amp;lt;div class=&amp;quot;alert alert-info&amp;quot;&amp;gt;&#39;,
           gsub(&#39;##&#39;, &#39;\n&#39;, x),
           &#39;&amp;lt;/div&amp;gt;&#39;, sep = &#39;\n&#39;)
   }
)
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;And you&amp;rsquo;re done! For a full demonstration and further details, read &lt;a href=&#34;http://selbydavid.com/vignettes/alerts.html&#34;&gt;this vignette&lt;/a&gt;.&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Deploying an R Markdown Jekyll site to GitHub Pages</title>
      <link>https://selbydavid.com/2017/06/16/rmarkdown-jekyll/</link>
      <pubDate>Fri, 16 Jun 2017 12:00:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2017/06/16/rmarkdown-jekyll/</guid>
      <description>&lt;p&gt;GitHub Pages&#39; built-in &lt;a href=&#34;https://jekyllrb.com/&#34;&gt;Jekyll&lt;/a&gt; support makes it very easy for techie types to deploy static web sites.
Simply push your plain text Markdown content to a repository and the server-side Jekyll engine will render it for the web.&lt;/p&gt;
&lt;p&gt;Markdown is good, but &lt;a href=&#34;http://rmarkdown.rstudio.com/&#34;&gt;R Markdown&lt;/a&gt; is even better, assuming we ever want to write anything involving plots or data analysis.
How can we write and edit blog posts in R Markdown and serve them on GitHub Pages without having to build everything locally?&lt;/p&gt;
&lt;p&gt;In this post I will explain how you can use &lt;a href=&#34;https://travis-ci.org/&#34;&gt;Travis CI&lt;/a&gt; to knit R Markdown posts and deploy them to a GitHub Pages Jekyll site.&lt;/p&gt;
&lt;p&gt;Yihui Xie&lt;sup id=&#34;fnref:1&#34;&gt;&lt;a href=&#34;#fn:1&#34; class=&#34;footnote-ref&#34; role=&#34;doc-noteref&#34;&gt;1&lt;/a&gt;&lt;/sup&gt; has added Jekyll support to the &lt;a href=&#34;https://cran.rstudio.com/web/packages/servr/index.html&#34;&gt;servr&lt;/a&gt; package and published a &lt;a href=&#34;https://jekyll.yihui.name/2014/09/jekyll-with-knitr.html&#34;&gt;blog post&lt;/a&gt; and &lt;a href=&#34;https://github.com/yihui/knitr-jekyll&#34; title=&#34;knitr-jekyll&#34;&gt;GitHub repository&lt;/a&gt; demonstrating how to use &lt;code&gt;servr::jekyll&lt;/code&gt; to serve a Jekyll site locally with R Markdown.&lt;/p&gt;
&lt;p&gt;This is a nice, but incomplete solution, because it means we can only really write and edit posts from computers on which R, servr and Jekyll are installed.
Jekyll is written in Ruby, which can be a pain to install on Windows and fiddly to configure for GitHub Pages.&lt;/p&gt;
&lt;p&gt;Ideally, we want to be able to maintain our web site from anywhere we have access to a web browser, just as we would a WordPress or Blogger site.&lt;/p&gt;
&lt;p&gt;What we are going to do instead is knit our R Markdown posts in the cloud, which automatically pushes the resulting plain Markdown files and images to GitHub, where they will be served by Jekyll like a regular site.&lt;/p&gt;
&lt;p&gt;For reference, I have created a &lt;a href=&#34;https://github.com/Selbosh/jekyll-rmd&#34;&gt;minimal working repository&lt;/a&gt;.&lt;/p&gt;
&lt;h2 id=&#34;linking-github-to-travis&#34;&gt;Linking GitHub to Travis&lt;/h2&gt;
&lt;p&gt;If you have not already done so, set up a &lt;a href=&#34;https://help.github.com/articles/about-github-pages-and-jekyll/&#34;&gt;regular GitHub Pages Jekyll site&lt;/a&gt;.
There are plenty of good guides for this on the web, so I won&amp;rsquo;t go into the details here.&lt;/p&gt;
&lt;p&gt;Once that is all working smoothly, sign up for a free &lt;a href=&#34;https://travis-ci.org/&#34;&gt;Travis CI&lt;/a&gt; account.
Travis is a service designed to run unit tests on software packages so that bugs are not introduced during development.
However, rather than running tests on software, we are going to be using Travis&amp;rsquo;s infrastructure to build our web site for us.&lt;/p&gt;
&lt;p&gt;In the Travis &amp;lsquo;Accounts&amp;rsquo; screen, look for your site&amp;rsquo;s repository and switch it on (green tick).
It doesn&amp;rsquo;t actually do anything just yet, but now Travis knows to watch for future commits to this repo.&lt;/p&gt;
&lt;p&gt;You will also need to &lt;a href=&#34;https://help.github.com/articles/creating-a-personal-access-token-for-the-command-line/&#34;&gt;generate a personal access token&lt;/a&gt; on GitHub, which grants Travis permission to push to your branch. Copy it to your clipboard.&lt;/p&gt;
&lt;p&gt;Back on Travis, on the settings page for your branch, create an Environment Variable with name &lt;code&gt;GITHUB_PAT&lt;/code&gt; and paste the personal access token into the Value field.&lt;/p&gt;
&lt;h2 id=&#34;configuring-the-travis-build&#34;&gt;Configuring the Travis build&lt;/h2&gt;
&lt;p&gt;Travis is &lt;a href=&#34;https://docs.travis-ci.com/user/customizing-the-build&#34;&gt;controlled by a file&lt;/a&gt; called &lt;code&gt;.travis.yml&lt;/code&gt; that lives in the root of your Git repository.
As a baseline, I recommend creating a file that contains the following configuration.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-yaml&#34;&gt;language: r
cache: packages
pandoc_version: 1.17.2

branches:
  only: source

script:
  - Rscript -e &#39;servr:::knit_maybe(c(&amp;quot;.&amp;quot;, &amp;quot;_source&amp;quot;, &amp;quot;_posts&amp;quot;), c(&amp;quot;.&amp;quot;, &amp;quot;_posts&amp;quot;, &amp;quot;_posts&amp;quot;), &amp;quot;build.R&amp;quot;, &amp;quot;jekyll&amp;quot;)&#39;
  
deploy:
  provider: pages
  skip_cleanup: true
  github_token: $GITHUB_PAT
  on:
    branch: source
  target_branch: master
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Let&amp;rsquo;s walk through this, line by line. The first two lines are:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-yaml&#34;&gt;language: r
cache: packages
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Since we will be knitting R Markdown files into Markdown, we want Travis to have a copy of R installed. &lt;a href=&#34;https://docs.travis-ci.com/user/languages/r/&#34;&gt;R is natively supported in Travis&lt;/a&gt; thanks to work by the community.&lt;/p&gt;
&lt;p&gt;A Travis R build comes with pandoc and LaTeX, ostensibly for building R package documentation. To generate standalone R Markdown documents or web sites with Travis, you need to hoodwink the system into thinking it is building a real R package.&lt;/p&gt;
&lt;p&gt;The most minimal R package comprises a single file, called &lt;code&gt;DESCRIPTION&lt;/code&gt;. More on that &lt;a href=&#34;#r-files&#34;&gt;below&lt;/a&gt;.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-yaml&#34;&gt;pandoc_version: 1.17.2
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Pandoc is a key piece of software that R Markdown uses to convert documents between various formats.
By default, Travis seems to use an old version of pandoc (1.15 or so), which can cause unexpected errors when trying to render R Markdown documents.
At the time of writing 1.17.2 seems to be the recommended version of pandoc for R Markdown, though I expect &lt;a href=&#34;http://pandoc.org/releases.html&#34;&gt;newer releases&lt;/a&gt; should be fine, too.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-yaml&#34;&gt;branches:
  only: source
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Choose the branch of your repository to which you will submit your code.
For a personal site&amp;mdash;i.e. &lt;code&gt;username.github.io&lt;/code&gt;&amp;mdash;GitHub says the final rendered web site files have to be on the &lt;code&gt;master&lt;/code&gt; branch, so we want to push our source code somewhere else.
I have opted to use a branch called &lt;code&gt;source&lt;/code&gt; but you can use whatever you like.&lt;/p&gt;
&lt;p&gt;Whenever you push commits to the &lt;code&gt;source&lt;/code&gt; branch, Travis will notice and start a build.
The output will then be deployed to another branch.
We choose &lt;code&gt;only: source&lt;/code&gt; so that Travis doesn&amp;rsquo;t trigger itself when it pushes your site to the &lt;code&gt;master&lt;/code&gt; branch, otherwise we would get an endless feedback loop.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-yaml&#34;&gt;script:
  - Rscript -e &#39;servr:::knit_maybe(c(&amp;quot;.&amp;quot;, &amp;quot;_source&amp;quot;, &amp;quot;_posts&amp;quot;), c(&amp;quot;.&amp;quot;, &amp;quot;_posts&amp;quot;, &amp;quot;_posts&amp;quot;), &amp;quot;build.R&amp;quot;, &amp;quot;jekyll&amp;quot;)&#39;
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;When you push a new commit to the repository, the script above looks for &lt;code&gt;.Rmd&lt;/code&gt; files, converts them into &lt;code&gt;.md&lt;/code&gt; files and puts them in the root directory (in the case of R Markdown pages) or the &lt;code&gt;_posts&lt;/code&gt; directory in the case of R Markdown blog posts.&lt;/p&gt;
&lt;p&gt;Why not use &lt;code&gt;servr::jekyll(serve = TRUE)&lt;/code&gt;? Because that command requires Jekyll to be installed&amp;mdash;not available on Travis&amp;rsquo;s R environment&amp;mdash;and we aren&amp;rsquo;t interested in building the whole site with Jekyll on Travis anyway.
All we want is plain Markdown files and images, which GitHub Pages&#39; own Jekyll engine will build into an HTML site for us.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-yaml&#34;&gt;deploy:
  provider: pages
  skip_cleanup: true
  github_token: $GITHUB_PAT
  on:
    branch: source
  target_branch: master
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Once the site is built, it needs to be published or &lt;code&gt;deploy&lt;/code&gt;ed somewhere.
The line &lt;code&gt;provider: pages&lt;/code&gt; means we take advantage of &lt;a href=&#34;https://docs.travis-ci.com/user/deployment/pages/&#34;&gt;Travis&amp;rsquo;s native GitHub Pages support&lt;/a&gt; and don&amp;rsquo;t have to write our own shell script to run all the complicated git commands.&lt;/p&gt;
&lt;p&gt;Skipping cleanup means Travis doesn&amp;rsquo;t delete everything it builds, which you might want when testing an R package, but not when building a web site.&lt;/p&gt;
&lt;p&gt;The GitHub personal access token gives Travis permission to push to your repository.
Make sure the variable name (after the &lt;code&gt;$&lt;/code&gt; sign) matches the one you set in Travis settings.&lt;/p&gt;
&lt;p&gt;The last few lines specify Travis should look for your source code (R Markdown and Markdown files) and where to deploy the generated Markdown files.
If you are working on a &lt;a href=&#34;https://help.github.com/articles/user-organization-and-project-pages/&#34;&gt;Project page rather than a User page&lt;/a&gt;, then you probably want to change the settings to the following.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-yaml&#34;&gt;  on:
    branch: master
  target_branch: gh-pages
&lt;/code&gt;&lt;/pre&gt;
&lt;h2 id=&#34;description-file&#34;&gt;DESCRIPTION file&lt;/h2&gt;
&lt;p&gt;To convince Travis it is building a valid R package, include a &lt;code&gt;DESCRIPTION&lt;/code&gt; file in the root directory of the repository with the following contents.&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-yaml&#34;&gt;Package: placeholder
Title: Does not matter.
Version: 0.0.1
Imports: servr, rmarkdown
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;The &lt;code&gt;Package&lt;/code&gt;, &lt;code&gt;Title&lt;/code&gt; and &lt;code&gt;Version&lt;/code&gt; are arbitrary, but &lt;code&gt;Imports&lt;/code&gt; describes which R packages should be installed when building your site.
You need servr and rmarkdown at least.
If R code chunks in your blog posts make use of other R packages, you might want to include those here as well.&lt;/p&gt;
&lt;h2 id=&#34;buildr&#34;&gt;build.R&lt;/h2&gt;
&lt;p&gt;&lt;a href=&#34;https://github.com/Selbosh/jekyll-rmd/blob/master/build.R&#34;&gt;This file&lt;/a&gt; is called on your R Markdown files.
It knits them to Markdown and makes sure plots get saved to the right directory.&lt;/p&gt;
&lt;h2 id=&#34;push-a-new-post&#34;&gt;Push a new post&lt;/h2&gt;
&lt;p&gt;When you next push a commit to the &lt;code&gt;on&lt;/code&gt; branch of your GitHub repository, Travis will start building and deploying your site. If it fails, you&amp;rsquo;ll receive an email about it and can have a look through the logs to find out why.&lt;/p&gt;
&lt;p&gt;You should now have a system that automagically renders and deploys your R Markdown posts every time you push them to your site&amp;rsquo;s GitHub repository.
If anything is unclear, have a look at my &lt;a href=&#34;https://github.com/Selbosh/jekyll-rmd&#34;&gt;minimal working repository&lt;/a&gt; or &lt;a href=&#34;https://github.com/Selbosh/old-jekyll&#34;&gt;a real example&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;If you found this helpful or have any comments or questions, feel free to &lt;a href=&#34;https://selbydavid.com/about&#34;&gt;get in touch&lt;/a&gt;.&lt;/p&gt;
&lt;section class=&#34;footnotes&#34; role=&#34;doc-endnotes&#34;&gt;
&lt;hr&gt;
&lt;ol&gt;
&lt;li id=&#34;fn:1&#34; role=&#34;doc-endnote&#34;&gt;
&lt;p&gt;Yihui has since turned his attention to the &lt;a href=&#34;https://bookdown.org/yihui/blogdown/&#34;&gt;blogdown&lt;/a&gt; package, which is much more fleshed-out project based on the Hugo static site generator&amp;mdash;a rival to Jekyll. (I will explain how to set up blogdown with Travis in a future post.) &lt;a href=&#34;#fnref:1&#34; class=&#34;footnote-backref&#34; role=&#34;doc-backlink&#34;&gt;&amp;#x21a9;&amp;#xfe0e;&lt;/a&gt;&lt;/p&gt;
&lt;/li&gt;
&lt;/ol&gt;
&lt;/section&gt;
</description>
    </item>
    
    <item>
      <title>Secret Santa in R</title>
      <link>https://selbydavid.com/2016/12/07/santa/</link>
      <pubDate>Wed, 07 Dec 2016 09:00:00 +0000</pubDate>
      
      <guid>https://selbydavid.com/2016/12/07/santa/</guid>
      <description>
&lt;script src=&#34;https://selbydavid.com/rmarkdown-libs/header-attrs/header-attrs.js&#34;&gt;&lt;/script&gt;


&lt;p&gt;Our office just exchanged presents for &lt;em&gt;Secret Santa&lt;/em&gt;, a tradition where each person is randomly assigned someone else to give an anonyous gift. One of the challenges of Secret Santa is keeping the pairs of gift-givers and receivers both random and secret. How can you do this while also taking part yourself? Using R, of course!&lt;/p&gt;
&lt;p&gt;Firstly, recruit people! Write their names down, one per line, in a text file. The order doesn’t matter. For example, we might have a file called &lt;code&gt;santa_names.txt&lt;/code&gt;, with contents as follows:&lt;/p&gt;
&lt;pre&gt;&lt;code&gt;Tom
Dick
Harry
Jane
Leslie
Susan
Alex
Sam
Chris&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Then read these names into R.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;names &amp;lt;- readLines(&amp;#39;santa_names.txt&amp;#39;)&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;We now have a character vector called &lt;code&gt;names&lt;/code&gt;.&lt;/p&gt;
&lt;p&gt;The key to a truly random pairing of gift givers and recipients is that it shouldn’t depend on any systematic order, such as the order people signed up, or the alphabetical order of their names.&lt;/p&gt;
&lt;p&gt;Here is one way we might try to do it. First, randomly reorder the &lt;code&gt;names&lt;/code&gt;. Then, have every person in this list give to the next person on the list, with the very last person then giving to the first.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;names2 &amp;lt;- sample(names)
data.frame(sender = names2,
           recipient = c(tail(names2, -1), names2[1]))&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;##   sender recipient
## 1 Leslie      Alex
## 2   Alex     Susan
## 3  Susan       Sam
## 4    Sam       Tom
## 5    Tom     Chris
## 6  Chris      Jane
## 7   Jane      Dick
## 8   Dick     Harry
## 9  Harry    Leslie&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;In R, the &lt;code&gt;sample()&lt;/code&gt; function draws randomly from a vector, and by default it does this without replacement, so we don’t have to worry about missing anybody off or somebody appearing twice. We can use it as a quick way to reorder the list of names at random. The &lt;code&gt;tail&lt;/code&gt; command with argument &lt;code&gt;-1&lt;/code&gt; will select every element in the list except the first.&lt;/p&gt;
&lt;p&gt;This works in the sense that everybody gives and receives one gift and nobody gives to themselves, but is not entirely random or secret. If you find out that Susan gave to Leslie, then you know for a fact that Leslie didn’t give to Susan. With enough of these titbits of information you could reconstruct the entire list. Ideally we want no discernable pattern.&lt;/p&gt;
&lt;p&gt;Why not just randomly sample twice from the &lt;code&gt;names&lt;/code&gt; list?&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;data.frame(sender = sample(names),
           recipient = sample(names))&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;##   sender recipient
## 1 Leslie     Chris
## 2   Alex      Dick
## 3  Susan     Harry
## 4    Sam       Tom
## 5    Tom      Alex
## 6  Chris       Sam
## 7   Jane      Jane
## 8   Dick     Susan
## 9  Harry    Leslie&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;There’s a problem. Jane has been assigned to herself! That won’t do! The solution is quite straightforward, though: just keep sampling until this doesn’t happen. We can keep the order of senders fixed and vary the order of the recipients until nobody gives to themselves, like so.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;sender &amp;lt;- sample(names)
recipient &amp;lt;- sample(names)
i &amp;lt;- 1
while (any(sender == recipient)) {
  i &amp;lt;- i + 1
  recipient &amp;lt;- sample(names)
}
data.frame(sender, recipient)&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;##   sender recipient
## 1  Chris      Alex
## 2   Jane       Tom
## 3   Alex     Chris
## 4    Tom    Leslie
## 5   Dick     Susan
## 6  Susan       Sam
## 7  Harry      Jane
## 8    Sam      Dick
## 9 Leslie     Harry&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Success! Everybody gives and receives a gift, nobody gives to themselves and there is no particular pattern. (Unlike the first method, Alex gives to Chris even though Chris already gives to Alex.)&lt;/p&gt;
&lt;p&gt;If you’re curious, you can find out how many attempts it took to find a valid set of pairs:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;i&lt;/code&gt;&lt;/pre&gt;
&lt;pre&gt;&lt;code&gt;## [1] 2&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Now, how do you let everybody know who they have been assigned, without revealing it to anybody else? (Including you!) We can write a text file for every person, with the name of the file corresponding to the giver and the contents of the file revealing the recipient.&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;for (i in seq_along(names)) {
  writeLines(recipient[i], paste0(sender[i], &amp;#39;.txt&amp;#39;))
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;If you were feeling really clever, you could automate the e-mail sending from R as well, but it should be easy enough to attach and send the files by hand without peeking.&lt;/p&gt;
&lt;p&gt;Putting it all together:&lt;/p&gt;
&lt;pre class=&#34;r&#34;&gt;&lt;code&gt;names &amp;lt;- readLines(&amp;#39;santa_names.txt&amp;#39;)
sender &amp;lt;- sample(names)
recipient &amp;lt;- sample(names)
while (any(sender == recipient)) {
  recipient &amp;lt;- sample(names)
}
for (i in seq_along(names)) {
  writeLines(recipient[i], paste0(sender[i], &amp;#39;.txt&amp;#39;))
}&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;&lt;strong&gt;Merry Christmas!&lt;/strong&gt;&lt;/p&gt;
&lt;div class=&#34;figure&#34;&gt;
&lt;img src=&#34;https://selbydavid.com/img/2016/santa.jpg&#34; alt=&#34;&#34; /&gt;
&lt;p class=&#34;caption&#34;&gt;Secret Santa at Warwick&lt;/p&gt;
&lt;/div&gt;
</description>
    </item>
    
    <item>
      <title>Poster: PageRank and the Bradley–Terry model</title>
      <link>https://selbydavid.com/2016/12/02/ima-poster/</link>
      <pubDate>Fri, 02 Dec 2016 09:00:00 +0000</pubDate>
      
      <guid>https://selbydavid.com/2016/12/02/ima-poster/</guid>
      <description>&lt;p&gt;Here is my poster that I presented at the 2nd IMA Conference on the Mathematical Challenges of Big Data in London on 1st&amp;ndash;2nd December 2016. It is entitled &amp;ldquo;PageRank and the Bradley&amp;ndash;Terry model: Measuring influence with the Scroogefactor&amp;rdquo;.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2016/ima-poster.png&#34; alt=&#34;Zeeman Building, University of Warwick&#34;&gt;&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Sent to Coventry</title>
      <link>https://selbydavid.com/2015/09/30/warwick/</link>
      <pubDate>Wed, 30 Sep 2015 09:00:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2015/09/30/warwick/</guid>
      <description>&lt;p&gt;I have just moved to the University of Warwick to start my PhD in Statistics. So far most of the people I have met would regard Coventry as a bit of a downgrade from Edinburgh, but the Warwick campus seems to make up for it.&lt;/p&gt;
&lt;p&gt;The Mathematics and Statistics building comes with resident geese.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2015/zeeman.jpg&#34; alt=&#34;Zeeman Building, University of Warwick&#34;&gt;&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Edinburgh Broadband Map</title>
      <link>https://selbydavid.com/2015/05/16/broadband/</link>
      <pubDate>Sat, 16 May 2015 09:00:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2015/05/16/broadband/</guid>
      <description>&lt;p&gt;Despite living in the capital city of Scotland, my home broadband speeds (especially upload speeds) are painfully slow. There is no fibre-optic offered on my road, while my friend two streets over enjoys super-fast internet. It turns out, through the power of data visualisation, that EH16 is a bit of a broadband speed &amp;ldquo;notspot&amp;rdquo; along with a few other slow neighbourhoods throughout Edinburgh. The big empty hole to the east of the city centre is Arthur&amp;rsquo;s Seat and Holyrood Park.&lt;/p&gt;
&lt;script type=&#39;text/javascript&#39; src=&#39;https://public.tableau.com/javascripts/api/viz_v1.js&#39;&gt;&lt;/script&gt;&lt;div class=&#39;tableauPlaceholder&#39; style=&#39;width: 100%; height: 400px; margin: 0 auto;&#39;&gt;&lt;noscript&gt;&lt;a href=&#39;#&#39;&gt;&lt;img alt=&#39;Hotspots and Notspots: Edinburgh Home Broadband Speeds &#39; src=&#39;https:&amp;#47;&amp;#47;public.tableau.com&amp;#47;static&amp;#47;images&amp;#47;Ed&amp;#47;EdinburghBroadband&amp;#47;Map&amp;#47;1_rss.png&#39; style=&#39;border: none&#39; /&gt;&lt;/a&gt;&lt;/noscript&gt;&lt;object class=&#39;tableauViz&#39; width=&#39;100%&#39; height=&#39;400px&#39; style=&#39;display:none;&#39;&gt;&lt;param name=&#39;host_url&#39; value=&#39;https%3A%2F%2Fpublic.tableau.com%2F&#39; /&gt; &lt;param name=&#39;site_root&#39; value=&#39;&#39; /&gt;&lt;param name=&#39;name&#39; value=&#39;EdinburghBroadband&amp;#47;Map&#39; /&gt;&lt;param name=&#39;tabs&#39; value=&#39;no&#39; /&gt;&lt;param name=&#39;toolbar&#39; value=&#39;yes&#39; /&gt;&lt;param name=&#39;static_image&#39; value=&#39;https:&amp;#47;&amp;#47;public.tableau.com&amp;#47;static&amp;#47;images&amp;#47;Ed&amp;#47;EdinburghBroadband&amp;#47;Map&amp;#47;1.png&#39; /&gt; &lt;param name=&#39;animate_transition&#39; value=&#39;yes&#39; /&gt;&lt;param name=&#39;display_static_image&#39; value=&#39;yes&#39; /&gt;&lt;param name=&#39;display_spinner&#39; value=&#39;yes&#39; /&gt;&lt;param name=&#39;display_overlay&#39; value=&#39;yes&#39; /&gt;&lt;param name=&#39;display_count&#39; value=&#39;yes&#39; /&gt;&lt;param name=&#39;showVizHome&#39; value=&#39;no&#39; /&gt;&lt;param name=&#39;showTabs&#39; value=&#39;y&#39; /&gt;&lt;param name=&#39;bootstrapWhenNotified&#39; value=&#39;true&#39; /&gt;&lt;/object&gt;&lt;/div&gt;
&lt;p&gt;Data source: &lt;a href=&#34;http://data.gov.uk/dataset/broadband-coverage/resource/0f6b7671-eb9a-49bd-8913-90d1c07af11d&#34;&gt;Ofcom&lt;/a&gt;&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Everything is awesome</title>
      <link>https://selbydavid.com/2015/02/17/lego/</link>
      <pubDate>Tue, 17 Feb 2015 09:00:00 +0000</pubDate>
      
      <guid>https://selbydavid.com/2015/02/17/lego/</guid>
      <description>&lt;p&gt;Today I took part in the Lego Calculator Challenge, an event that was run as part of Edinburgh University&amp;rsquo;s Innovative Learning Week. The day included revising the finer points of adding in base 6 and learning about how people managed to do complicated calculations on mechanical computers before Alan Turing invented the Casio &lt;em&gt;fx&lt;/em&gt;-83.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2015/lego/tea.jpg&#34; alt=&#34;Working on the Lego Calculator Challenge&#34;&gt;&lt;/p&gt;
&lt;p&gt;With the aid of &lt;a href=&#34;https://vimeo.com/46344551&#34;&gt;this therapeutic video&lt;/a&gt;, Lego expert Alex Allmont showed us some of the clever things that are possible using gears and ratchets. I also learnt the existence of and the inner workings of a car&amp;rsquo;s differential gear in a ten-minute time span, thanks to an excellent &lt;a href=&#34;https://www.youtube.com/watch?v=K4JhruinbWc&#34;&gt;film by Chevrolet from the 1930s&lt;/a&gt;. Using exactly the same kind of differential gear, but in reverse, we built our own &amp;ldquo;differential adders&amp;rdquo;, capable of adding or subtracting numbers up to 20.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2015/lego/differential.jpg&#34; alt=&#34;Stuff&#34;&gt;&lt;/p&gt;
&lt;p&gt;Selecting two numbers from the top wheels will automatically compute and output their sum on the lower wheel. Conversely, fixing a number on the lower wheel first will let you perform subtraction. Awesome.&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Twitter score predictions are not infallible</title>
      <link>https://selbydavid.com/2014/06/14/world-cup/</link>
      <pubDate>Sat, 14 Jun 2014 09:00:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2014/06/14/world-cup/</guid>
      <description>&lt;p&gt;This evening saw the Netherlands face Spain for their first match in the group stage of the 2014 Fifa World Cup. 604 score predictions were made on Twitter in the hour before kick-off. When the final whistle blew, 100% of them had missed the mark.&lt;/p&gt;
&lt;p&gt;The Twittersphere overwhelmingly tipped a 2&amp;ndash;1 victory to Spain, the reigning world champions. A bit of a shame, then, that the Netherlands trounced them 5&amp;ndash;1. Maybe the &lt;a href=&#34;http://www.bbc.co.uk/news/uk-england-27810714&#34; title=&#34;World Cup 2014: Animals &#39;predict&#39; World Cup results - BBC News&#34;&gt;animal pundits&lt;/a&gt; will do better.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2014/twitterscore.png&#34; alt=&#34;Twitter predicted vs. actual score of Group B Netherlands vs. Spain match on 13 June 2014&#34;&gt;&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Data mining: tea is for Twitter</title>
      <link>https://selbydavid.com/2014/06/07/tea-bieber/</link>
      <pubDate>Sat, 07 Jun 2014 09:00:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2014/06/07/tea-bieber/</guid>
      <description>&lt;p&gt;As part of my first foray into data science, I decided to have a go at opinion mining on Twitter. It&amp;rsquo;s common knowledge that everything stops for tea, but how much does the Twittersphere agree? And what else are microbloggers saying about the drink?&lt;/p&gt;
&lt;p&gt;Using the free R statistical software it is very easy to start data mining on Twitter&lt;sup id=&#34;fnref:1&#34;&gt;&lt;a href=&#34;#fn:1&#34; class=&#34;footnote-ref&#34; role=&#34;doc-noteref&#34;&gt;1&lt;/a&gt;&lt;/sup&gt;. A short R script quickly retrieved 699 recent tweets containing the tag #tea. The code looks something like this:&lt;/p&gt;
&lt;pre&gt;&lt;code class=&#34;language-r&#34;&gt;library(twitteR)
cred &amp;lt;- OAuthFactory$new(...)
...
load(&amp;quot;twitter authentication.Rdata&amp;quot;)
registerTwitterOAuth(cred)
require(plyr)
data&amp;lt;- searchTwitter(&amp;quot;#tea&amp;quot;, n=1500, cainfo=&amp;quot;cacert.pem&amp;quot;)
text = laply(data, function(t) t$getText())
&lt;/code&gt;&lt;/pre&gt;
&lt;p&gt;Before anything interesting can be gleaned from the dataset, some housework must be done. Text mining&lt;sup id=&#34;fnref:2&#34;&gt;&lt;a href=&#34;#fn:2&#34; class=&#34;footnote-ref&#34; role=&#34;doc-noteref&#34;&gt;2&lt;/a&gt;&lt;/sup&gt; removes irrelevant URLs, punctuation, symbols and &amp;ldquo;stop words&amp;rdquo;, leaving each tweet ready for scrutiny.&lt;/p&gt;
&lt;p&gt;So what are our friends on Twitter saying about tea? Finding out calls for a graph. But not just any graph: a word cloud&lt;sup id=&#34;fnref:3&#34;&gt;&lt;a href=&#34;#fn:3&#34; class=&#34;footnote-ref&#34; role=&#34;doc-noteref&#34;&gt;3&lt;/a&gt;&lt;/sup&gt;, displaying words according to frequency.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2014/tea.png&#34; alt=&#34;Word cloud made from 699 tweets containing the hashtag &amp;lsquo;#tea&amp;rsquo;&#34;&gt;&lt;/p&gt;
&lt;p&gt;Obviously every tweet contains &amp;ldquo;tea&amp;rdquo; because that&amp;rsquo;s what was sought. People also like to discuss milk and sugar, as well as coffee (possibly during cataclysmic breakfast drink dilemmas). To the right of centre, &lt;strong&gt;tcot&lt;/strong&gt; stands for &amp;ldquo;top conservatives on Twitter&amp;rdquo;, who enjoy talking about tea &amp;mdash; and tea parties &amp;mdash; as much as anyone. Other notable phrases include &amp;ldquo;freedom&amp;rdquo;, &amp;ldquo;greatness&amp;rdquo;, &amp;ldquo;best&amp;rdquo; and &amp;ldquo;delicious&amp;rdquo;. But we&amp;rsquo;ll do some more objective analysis shortly.&lt;/p&gt;
&lt;p&gt;For variety, I also had a go at mining Twitter&amp;rsquo;s public streaming API for a larger sample, this time using Python. Here&amp;rsquo;s what some ten thousand tweets say about Canadian pop star Justin Bieber:&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2014/justin.png&#34; alt=&#34;Word cloud made from 10,000 tweets containing the word &amp;lsquo;bieber&amp;rsquo;&#34;&gt;&lt;/p&gt;
&lt;p&gt;He&amp;rsquo;s racist? &lt;em&gt;And&lt;/em&gt; shirtless. Who knew?&lt;/p&gt;
&lt;p&gt;To assess public opinion more objectively, we can perform sentiment analysis, which involves assigning a mood to each tweet and observing the distribution&lt;sup id=&#34;fnref:4&#34;&gt;&lt;a href=&#34;#fn:4&#34; class=&#34;footnote-ref&#34; role=&#34;doc-noteref&#34;&gt;4&lt;/a&gt;&lt;/sup&gt;. A tweet&amp;rsquo;s mood score derives from comparing each constituent word against a database of &amp;ldquo;positive&amp;rdquo; and &amp;ldquo;negative&amp;rdquo; English words then adding and subtracting 1 respectively. A total less than -2 is very negative, zero is neutral and greater than +2 is very positive.&lt;/p&gt;
&lt;p&gt;For example, this tweet gets a score of +5:&lt;/p&gt;
&lt;blockquote&gt;
&lt;p&gt;@justinbieber i&amp;rsquo;m so happy to say : &amp;ldquo;Justin Bieber is my idol and he&amp;rsquo;s perfect&amp;rdquo; because i love you so much you&amp;rsquo;re a very good man&lt;/p&gt;
&lt;/blockquote&gt;
&lt;p&gt;whereas this one is assigned a score of -4:&lt;/p&gt;
&lt;blockquote&gt;
&lt;p&gt;Justin Bieber has serious issues, i wish he&amp;rsquo;d just sort his shit out because I for one am sick of seeing stupid crap about him in the news&lt;/p&gt;
&lt;/blockquote&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2014/sentiment.png&#34; alt=&#34;Histogram comparison of sentiment scores for tweets about tea and Justin Bieber&#34;&gt;&lt;/p&gt;
&lt;p&gt;Our #tea dataset has a score distribution that&amp;rsquo;s mostly positive, with a mean sentiment score of +0.15 and a variance of 0.36. Clearly our intuition is correct and people really do like tea. Indeed, nobody really had much of a bad word to say about the beverage; the minimum score given was -2, which could easily have been obtained from a false-negative tweet like &amp;ldquo;I hate people who dislike #tea&amp;rdquo; (though it wasn&amp;rsquo;t).&lt;/p&gt;
&lt;p&gt;On the other hand, the outlook isn&amp;rsquo;t so rosy for our friend Justin. From our dataset of 10,003 tweets, the mean mood score is -0.07, which is slightly negative. He&amp;rsquo;s a divisive topic of discussion, too: the score variance is 0.87, giving a more widely-spread distribution of sentiments.&lt;/p&gt;
&lt;p&gt;So it&amp;rsquo;s official. Twitter likes tea more than it likes Justin Bieber. Probably. Time for a cuppa.&lt;/p&gt;
&lt;section class=&#34;footnotes&#34; role=&#34;doc-endnotes&#34;&gt;
&lt;hr&gt;
&lt;ol&gt;
&lt;li id=&#34;fn:1&#34; role=&#34;doc-endnote&#34;&gt;
&lt;p&gt;Jeff Gentry (2013). &lt;a href=&#34;http://CRAN.R-project.org/package=twitteR&#34;&gt;&lt;em&gt;twitteR: R based Twitter client&lt;/em&gt;&lt;/a&gt;. R package version 1.1.7. &lt;a href=&#34;#fnref:1&#34; class=&#34;footnote-backref&#34; role=&#34;doc-backlink&#34;&gt;&amp;#x21a9;&amp;#xfe0e;&lt;/a&gt;&lt;/p&gt;
&lt;/li&gt;
&lt;li id=&#34;fn:2&#34; role=&#34;doc-endnote&#34;&gt;
&lt;p&gt;Ingo Feinerer and Kurt Hornik (2014). &lt;a href=&#34;http://CRAN.R-project.org/package=tm&#34;&gt;&lt;em&gt;tm: Text Mining Package&lt;/em&gt;&lt;/a&gt;. R package version 0.5-10. &lt;a href=&#34;#fnref:2&#34; class=&#34;footnote-backref&#34; role=&#34;doc-backlink&#34;&gt;&amp;#x21a9;&amp;#xfe0e;&lt;/a&gt;&lt;/p&gt;
&lt;/li&gt;
&lt;li id=&#34;fn:3&#34; role=&#34;doc-endnote&#34;&gt;
&lt;p&gt;Ian Fellows (2013). &lt;a href=&#34;http://CRAN.R-project.org/package=wordcloud&#34;&gt;&lt;em&gt;wordcloud: Word Clouds&lt;/em&gt;&lt;/a&gt;. R package version 2.4. &lt;a href=&#34;#fnref:3&#34; class=&#34;footnote-backref&#34; role=&#34;doc-backlink&#34;&gt;&amp;#x21a9;&amp;#xfe0e;&lt;/a&gt;&lt;/p&gt;
&lt;/li&gt;
&lt;li id=&#34;fn:4&#34; role=&#34;doc-endnote&#34;&gt;
&lt;pre&gt;&lt;code&gt;Jeffrey Breen (2011). [*R by example: mining Twitter for consumer attitudes towards airlines.*](http://www.slideshare.net/jeffreybreen/r-by-example-mining-twitter-for)
&lt;/code&gt;&lt;/pre&gt;
 &lt;a href=&#34;#fnref:4&#34; class=&#34;footnote-backref&#34; role=&#34;doc-backlink&#34;&gt;&amp;#x21a9;&amp;#xfe0e;&lt;/a&gt;&lt;/li&gt;
&lt;/ol&gt;
&lt;/section&gt;
</description>
    </item>
    
    <item>
      <title>T-set mug</title>
      <link>https://selbydavid.com/2014/06/05/t-set/</link>
      <pubDate>Thu, 05 Jun 2014 09:00:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2014/06/05/t-set/</guid>
      <description>&lt;p&gt;The set of all &lt;em&gt;t&lt;/em&gt; makes the perfect tea set for mathematicians and other numerate geeks. A natural accompaniment to your &lt;a href=&#34;https://selbydavid.com/2014/06/04/t-pot/&#34;&gt;Student&amp;rsquo;s t-distribution teapot&lt;/a&gt;, the t-set lets you collect mugs in a mathematical way.&lt;/p&gt;
&lt;p&gt;Get yours now &lt;a href=&#34;http://www.zazzle.co.uk/mathematical_t_set_black_coffee_mugs-168015681676499039&#34; title=&#34;t-set mug&#34;&gt;from Zazzle&lt;/a&gt;.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2014/t-set.png&#34; alt=&#34;t-set mug&#34;&gt;&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Student&#39;s t-distribution teapot</title>
      <link>https://selbydavid.com/2014/06/04/t-pot/</link>
      <pubDate>Wed, 04 Jun 2014 09:00:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2014/06/04/t-pot/</guid>
      <description>&lt;p&gt;Where is a student&amp;rsquo;s tea distributed? Probably in a teapot. Thus the &lt;a href=&#34;http://www.zazzle.co.uk/students_t_distribution_teapot-180267930175357597&#34;&gt;Student&amp;rsquo;s t-distribution teapot&lt;/a&gt; is born.&lt;/p&gt;
&lt;p&gt;Warmly emblazoned across the outside is the probability density function of &lt;a href=&#34;http://en.wikipedia.org/wiki/Student&#39;s_t-distribution&#34;&gt;Student&amp;rsquo;s t-distribution&lt;/a&gt;, in case you need to estimate the mean of a normally distributed population and pour a cup of tea at the same time.&lt;/p&gt;
&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/2014/t-pot.png&#34; alt=&#34;Student&amp;rsquo;s t-distribution teapot&#34;&gt;&lt;/p&gt;
&lt;p&gt;Lovingly designed for students and academics who take their probability and statistics as seriously as they take a proper brew. You can get one for yourself &lt;a href=&#34;http://www.zazzle.co.uk/students_t_distribution_teapot-180267930175357597&#34;&gt;from Zazzle&lt;/a&gt;. Goes nicely with a &lt;a href=&#34;https://selbydavid.com/2014/06/05/t-set/&#34;&gt;t-set mug&lt;/a&gt;.&lt;/p&gt;
</description>
    </item>
    
    <item>
      <title>Contours Magazine</title>
      <link>https://selbydavid.com/2014/06/04/contours/</link>
      <pubDate>Wed, 04 Jun 2014 08:00:00 +0100</pubDate>
      
      <guid>https://selbydavid.com/2014/06/04/contours/</guid>
      <description>&lt;p&gt;&lt;a href=&#34;http://www.maths.ed.ac.uk/outreach/contours-magazine&#34;&gt;Contours magazine&lt;/a&gt; is a student publication produced by the University of Edinburgh School of Mathematics, featuring interviews with maths lecturers. I was editor and graphic designer for the 2013&amp;ndash;14 edition. &lt;a href=&#34;http://issuu.com/uoemaths/docs/contours_web&#34;&gt;Click here to read it on Issuu&lt;/a&gt;, or pick up a hard copy from the King&amp;rsquo;s Buildings campus.&lt;/p&gt;
&lt;blockquote&gt;
&lt;p&gt;What does a mathematician do when they aren&amp;rsquo;t lecturing students? What kind of questions are they thinking about? What inspired them to study their subject and what do they do when they get stuck on a problem? What are the big questions facing mathematicians today?&lt;/p&gt;
&lt;/blockquote&gt;
&lt;div data-configid=&#34;0/8134592&#34; style=&#34;height:456px; margin-left:auto; margin-right:auto;&#34; class=&#34;issuuembed&#34;&gt;&lt;/div&gt;&lt;script type=&#34;text/javascript&#34; src=&#34;//e.issuu.com/embed.js&#34; async=&#34;true&#34;&gt;&lt;/script&gt;</description>
    </item>
    
    <item>
      <title>About me</title>
      <link>https://selbydavid.com/about/</link>
      <pubDate>Mon, 01 Jan 0001 00:00:00 +0000</pubDate>
      
      <guid>https://selbydavid.com/about/</guid>
      <description>&lt;p&gt;&lt;img src=&#34;https://selbydavid.com/img/david.jpg&#34; style=&#34;border-radius: 50%; width: 15rem;&#34; /&gt;&lt;/p&gt;
&lt;p&gt;Hello, my name is David Selby and I am a researcher at the German Research Center for Artificial Intelligence (DFKI) and University of Kaiserslautern. I previously worked as research associate in data science at the Centre for Epidemiology Versus Arthritis, University of Manchester, and &lt;a href=&#34;http://webcat.warwick.ac.uk/record=b3690782&#34;&gt;completed my PhD in statistics&lt;/a&gt; at the University of Warwick under the supervision of Prof David Firth.&lt;/p&gt;
&lt;p&gt;Originally from North Yorkshire, I aim to maintain a reliable supply of Yorkshire Tea.
I am enthusiastic about &lt;a href=&#34;https://www.r-project.org/&#34;&gt;R&lt;/a&gt; and helped organise &lt;a href=&#34;http://warwick.ac.uk/wrug&#34;&gt;Warwick R User Group&lt;/a&gt; as well as the &lt;a href=&#34;https://personalpages.manchester.ac.uk/staff/david.selby/rthritis.html&#34;&gt;R-thritis Statistical Computing Group&lt;/a&gt;.&lt;/p&gt;
&lt;p style=&#34;text-align: center;&#34;&gt;
&lt;a href=&#39;mailto:selby@informatik.uni-kl.de&#39; title=&#34;E-mail me&#34;&gt;
  &lt;span class=&#34;fa-stack fa-lg&#34;&gt;
  &lt;i class=&#34;fa fa-circle fa-stack-2x&#34;&gt;&lt;/i&gt;
  &lt;i class=&#34;fa fa-envelope fa-stack-1x fa-inverse&#34;&gt;&lt;/i&gt;
  &lt;/span&gt;
&lt;/a&gt;
&lt;a href=&#34;https://www.facebook.com/selbosh&#34; title=&#34;Facebook&#34;&gt;
  &lt;span class=&#34;fa-stack fa-lg&#34;&gt;
  &lt;i class=&#34;fa fa-circle fa-stack-2x&#34;&gt;&lt;/i&gt;
  &lt;i class=&#34;fa fa-facebook fa-stack-1x fa-inverse&#34;&gt;&lt;/i&gt;
  &lt;/span&gt;
&lt;/a&gt;
&lt;a href=&#34;https://github.com/Selbosh&#34; title=&#34;GitHub&#34;&gt;
  &lt;span class=&#34;fa-stack fa-lg&#34;&gt;
  &lt;i class=&#34;fa fa-circle fa-stack-2x&#34;&gt;&lt;/i&gt;
  &lt;i class=&#34;fa fa-github fa-stack-1x fa-inverse&#34;&gt;&lt;/i&gt;
  &lt;/span&gt;
&lt;/a&gt;
&lt;a href=&#34;https://linkedin.com/in/daselby&#34; title=&#34;LinkedIn&#34;&gt;
  &lt;span class=&#34;fa-stack fa-lg&#34;&gt;
  &lt;i class=&#34;fa fa-circle fa-stack-2x&#34;&gt;&lt;/i&gt;
  &lt;i class=&#34;fa fa-linkedin fa-stack-1x fa-inverse&#34;&gt;&lt;/i&gt;
  &lt;/span&gt;
&lt;/a&gt;
&lt;a href=&#34;https://twitter.com/TeaStats&#34; title=&#34;Twitter&#34;&gt;
  &lt;span class=&#34;fa-stack fa-lg&#34;&gt;
  &lt;i class=&#34;fa fa-circle fa-stack-2x&#34;&gt;&lt;/i&gt;
  &lt;i class=&#34;fa fa-twitter fa-stack-1x fa-inverse&#34;&gt;&lt;/i&gt;
  &lt;/span&gt;
&lt;/a&gt;
&lt;a href=&#34;https://vis.social/@TeaStats&#34; title=&#34;Mastodon&#34;&gt;
  &lt;span class=&#34;fa-stack fa-lg&#34;&gt;
  &lt;i class=&#34;fa fa-circle fa-stack-2x&#34;&gt;&lt;/i&gt;
  &lt;i class=&#34;fa fa-brands fa-mastodon fa-stack-1x fa-inverse&#34;&gt;&lt;/i&gt;
  &lt;/span&gt;
&lt;/a&gt;
&lt;a href=&#34;https://www.research.manchester.ac.uk/portal/en/researchers/david-selby(3ea65643-2b3b-48ed-ad3c-8fa73fe36e0d).html&#34; title=&#34;Academic page&#34;&gt;
  &lt;span class=&#34;fa-stack fa-lg&#34;&gt;
  &lt;i class=&#34;fa fa-circle fa-stack-2x&#34;&gt;&lt;/i&gt;
  &lt;i class=&#34;fa fa-graduation-cap fa-stack-1x fa-inverse&#34;&gt;&lt;/i&gt;
  &lt;/span&gt;
&lt;/a&gt;
&lt;/p&gt;
&lt;p&gt;Get in touch with me using any of the methods above.&lt;/p&gt;
&lt;p&gt;This blog is a collection of non-academic or trivial projects themed around data science, R programming and reproducible research.
For more information about my academic work, please visit my &lt;a href=&#34;http://warwick.ac.uk/dselby&#34;&gt;Warwick PhD page&lt;/a&gt; or my &lt;a href=&#34;https://www.research.manchester.ac.uk/portal/en/researchers/david-selby(3ea65643-2b3b-48ed-ad3c-8fa73fe36e0d).html&#34;&gt;Manchester academic page&lt;/a&gt;.
For teaching resources at the Centre for Epidemiology, see my &lt;a href=&#34;https://personalpages.manchester.ac.uk/staff/david.selby/index.html&#34;&gt;Manchester personal page&lt;/a&gt;.&lt;/p&gt;
&lt;h3 id=&#34;other-warwick-bloggers&#34;&gt;Other Warwick bloggers&lt;/h3&gt;
&lt;ul&gt;
&lt;li&gt;&lt;a href=&#34;http://www.nathancunn.com/&#34;&gt;Nathan Cunningham&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;https://statgeek.net/&#34;&gt;David Firth&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;http://ellakaye.rbind.io/&#34;&gt;Ella Kaye&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;http://numbers.sg/&#34;&gt;Kenneth Lim&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;https://mattstats.wordpress.com/&#34;&gt;Matt Moores&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;http://www.iitypeii.com/&#34;&gt;Murray Pollock&lt;/a&gt;&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;https://xianblog.wordpress.com/&#34;&gt;Christian Robert&lt;/a&gt;&lt;/li&gt;
&lt;/ul&gt;
&lt;h3 id=&#34;useful-links&#34;&gt;Useful links&lt;/h3&gt;
&lt;ul&gt;
&lt;li&gt;&lt;a href=&#34;https://www.lightingrumours.com&#34;&gt;Lighting Rumours&lt;/a&gt;, a blog I edit about the photography industry&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;https://www.r-bloggers.com/&#34;&gt;R-bloggers&lt;/a&gt;, a compendium of R-themed blogs&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;https://rweekly.org&#34;&gt;RWeekly.org&lt;/a&gt;, more R-themed blogs&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;http://warwick.ac.uk/wrug&#34;&gt;Warwick R User Group&lt;/a&gt;, a local group for talks on R&lt;/li&gt;
&lt;li&gt;&lt;a href=&#34;https://personalpages.manchester.ac.uk/staff/david.selby/rthritis.html&#34;&gt;Rthritis Statistical Computing Group&lt;/a&gt;, an R group in Manchester&lt;/li&gt;
&lt;/ul&gt;
</description>
    </item>
    
  </channel>
</rss>